unit sudoku;
{This is the user interface part of the Soduku Solver program by Dave Glover.
It presents the form and controls, manages the user input, saves and retrives puzzles,
and calls the solvepuzzle procedure to calculate the Sudoku result.
The solvepuzzle module is in the solver module, and uses a calling parameter
of the selected puzzle.}
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
Grids, solver;
type
{ TFormSudokuSolver }
TFormSudokuSolver = class(TForm)
Label2: TLabel;
Label3: TLabel;
Statistics: TLabel;
Timetaken: TLabel;
puzzlelistbox: TComboBox;
Solve: TButton;
Save: TButton;
Label1: TLabel;
StringGrid1: TStringGrid;
procedure FormCreate(Sender: TObject);
procedure puzzlelistboxChange(Sender: TObject);
procedure FormPaint(Sender: TObject);
procedure puzzlelistboxKeyPress(Sender: TObject; var Key: char);
procedure SaveClick(Sender: TObject);
procedure SolveClick(Sender: TObject);
procedure StringGrid1DrawCell(Sender: TObject; aCol, aRow: Integer;
aRect: TRect; aState: TGridDrawState);
procedure StringGrid1ValidateEntry(sender: TObject; aCol, aRow: Integer;
const OldValue: string; var NewValue: String);
private
{ private declarations }
public
{ public declarations }
end;
var
FormSudokuSolver: TFormSudokuSolver;
i,x,y,z : integer;
list1 : Tstringlist;
PF, TF : textfile;
puzzlearray, resultarray: array[0..81] of integer;
Puzzlestring, filename : string;
const
easylist = 'Example,,,9,,,8,4,1,,' +
',,,5,3,,9,,,' +
'5,,,,1,,2,6,,' +
',,,3,,7,1,,,' +
',,,,6,,,,,' +
',,6,8,,1,,,,' +
',9,5,,2,,,,4,' +
',,2,,8,5,,,,' +
',8,3,9,,,5,,,';
emptylist = ',,,,,,,,,' +
',,,,,,,,,' +
',,,,,,,,,' +
',,,,,,,,,' +
',,,,,,,,,' +
',,,,,,,,,' +
',,,,,,,,,' +
',,,,,,,,,' +
',,,,,,,,,';
implementation
{$R *.lfm}
{ TFormSudokuSolver }
procedure TFormSudokuSolver.puzzlelistboxChange(Sender: TObject);
var
selectedlist : string;
begin
//when a puzzle is chosen from the drop down, populate the grid with
//that puzzle from the file, otherwise clear the grid
selectedlist := 'Clear' + emptylist;
filename := 'Sudoku.txt';
assignfile (PF, filename);
Reset (PF);
// read the puzzle file to find the puzzle that matches the selected puzzle
while not eof (PF) do
begin
readln (PF, puzzlestring);
if puzzlelistbox.text = leftstr(puzzlestring, length(puzzlelistbox.text)) then
selectedlist := puzzlestring;
end;
closefile (PF);
//populate the grid with the selected puzzle
timetaken.Color := clForm;
z := 0;
timetaken.caption := '';
list1 := TStringList.Create;
list1.Delimiter := ',';
list1.DelimitedText := selectedlist;
for y:=0 to StringGrid1.RowCount-1 do begin
for x:=0 to StringGrid1.ColCount-1 do begin
inc (z);
StringGrid1.Cells[x,y]:=list1[z];
end;
end;
list1.free;
end;
procedure TFormSudokuSolver.puzzlelistboxKeyPress(Sender: TObject; var Key: char);
begin
//when new grid name is chosen, set up a blank grid in the puzzle file.
if key = chr(13) then
if (puzzlelistbox.text <> '')
and (puzzlelistbox.items.Indexof (puzzlelistbox.text) < 0) then
begin
filename := 'Sudoku.txt';
assignfile (PF, filename);
Append (PF);
writeln (pf, puzzlelistbox.text + emptylist);
closefile (PF);
end;
end;
procedure TFormSudokuSolver.SaveClick(Sender: TObject);
var
thispuzzle, looppuzzle : string;
namelength : integer;
newrecord : boolean;
begin
//save the current grid to the current named item. or saved grid if nothing selected
if (puzzlelistbox.text = 'Clear Grid') or
(puzzlelistbox.text = '') then
thispuzzle := 'savedgrid'
else
thispuzzle := puzzlelistbox.text;
// create a string with the grid contents and the puzzle name
namelength := length (thispuzzle);
for y:=0 to StringGrid1.RowCount-1 do begin
for x:=0 to StringGrid1.ColCount-1 do begin
thispuzzle := thispuzzle + ',' + StringGrid1.Cells[x,y]
end;
end;
//copy the puzzle file to a temp file, modifying only the selcted puzzle record
filename := 'Sudoku.txt';
assignfile (PF, filename);
assignfile (TF, 'temp.txt');
Reset (PF);
Rewrite (TF);
newrecord := True;
while not eof (PF) do
begin
readln (PF,looppuzzle);
if leftstr(looppuzzle,namelength) = leftstr(thispuzzle,namelength) then
begin
writeln (TF, thispuzzle);
newrecord := False;
end
else
writeln (TF, looppuzzle);
end;
if newrecord then
writeln (TF, thispuzzle);
closefile (PF);
closefile (TF);
//copy the temp file to the puzzle file
filename := 'Sudoku.txt';
assignfile (PF, filename);
assignfile (TF, 'temp.txt');
Reset (TF);
Rewrite (PF);
while not eof (TF) do
begin
readln (TF,looppuzzle);
writeln (PF, looppuzzle);
end;
closefile (PF);
closefile (TF);
//erase the temp file
assignfile (TF, 'temp.txt');
erase (TF);
end;
procedure TFormSudokuSolver.SolveClick(Sender: TObject);
var showpuzzle: string;
starttime, endtime: Ttimestamp;
duration : integer;
begin
//solve the puzzle in the grid
//extract the grid into an array of integers
z:=0;
showpuzzle := '';
for y:=0 to StringGrid1.RowCount-1 do begin
for x:=0 to StringGrid1.ColCount-1 do begin
inc (z);
if StringGrid1.Cells[x,y] = '' then
puzzlearray[z] := 0
else
val(StringGrid1.Cells[x,y],puzzlearray[z]);
showpuzzle := showpuzzle + (inttostr(puzzlearray[z]) + ' ');
end;
end;
// showmessage ('puzzle string ' + showpuzzle);
//call the solving module - results are in another array of integers
levelcount := 0;
highestlevelcount := 0;
recursioncount := 0;
starttime := DateTimeToTimeStamp(Now);
resultarray := solvepuzzle (puzzlearray);
endtime:= DateTimeToTimeStamp(Now);
//populate the array with the results matrix
duration := endtime.time - starttime.time;
if duration = 0 then
timetaken.caption := 'Time taken < 1 millisecond'
else
timetaken.caption := 'Time taken ' + inttostr(duration) + ' milliseconds';
z:= 0;
//check to see if puzzle was actually solved!
if resultarray[0] > 0 then
begin
timetaken.caption := 'No Solution to this puzzle';
timetaken.Color := clred;
end;
for y:=0 to StringGrid1.RowCount-1 do begin
for x:=0 to StringGrid1.ColCount-1 do begin
inc (z);
StringGrid1.Cells[x,y] := inttostr(resultarray[z]);
end;
end;
statistics.caption := 'Recursions: Depth ' + inttostr(highestlevelcount) +
' Total ' + inttostr(recursioncount);
end;
procedure TFormSudokuSolver.StringGrid1DrawCell(Sender: TObject; aCol, aRow: Integer;
aRect: TRect; aState: TGridDrawState);
begin
//colour the three by three boes in contrasting colours
with (Sender as TStringGrid) do
begin
if ((arow in [0,1,2,6,7,8]) and (acol in [0,1,2,6,7,8]))
or ((arow in [3,4,5]) and (acol in [3,4,5])) then
Canvas.Brush.Color := $00E1FFF9
else
Canvas.Brush.Color := clBtnFace;
canvas.FillRect(arect);
Canvas.TextRect(aRect, aRect.Left + 6, aRect.Top, cells[acol, arow]);
end
end;
procedure TFormSudokuSolver.StringGrid1ValidateEntry(sender: TObject; aCol, aRow: Integer;
const OldValue: string; var NewValue: String);
var
thisvalue : string;
begin
//validate each entry as being a space or a single digit between 1 and 9
ThisValue := trim(StringGrid1.Cells[aCol,aRow]);
if ((Length(Thisvalue) > 0) and (ThisValue < '1') or (ThisValue >'9'))
or (Length(Thisvalue) > 1) then
begin
NewValue := OldValue;
showmessage ('Only 1 through 9 allowed');
end
else
begin
NewValue := Thisvalue;
end;
end;
procedure TFormSudokuSolver.FormCreate(Sender: TObject);
var
y: integer;
x: integer;
begin
// fill the grid StringGrid1.
for x:=0 to StringGrid1.colCount-1 do begin
for y:=0 to StringGrid1.RowCount-1 do begin
StringGrid1.Cells[x,y]:=' ';
end;
end;
end;
procedure TFormSudokuSolver.FormPaint(Sender: TObject);
begin
{populate combo box}
filename := 'Sudoku.txt';
puzzlelistbox.items.add('Clear Grid');
//if puzzle file does not exist, then create it and add the example puzzle
if not fileexists(filename) then
begin
assignfile (PF, filename);
Rewrite (PF);
Writeln (PF, easylist);
closefile (PF);
end;
//when puzzle file exists read the fle, extract the name from each line
//and populate combo box
assignfile (PF, filename);
Reset (PF);
while not eof (PF) do
begin
readln (PF, puzzlestring);
list1 := TStringList.Create;
list1.Delimiter := ',';
list1.DelimitedText := puzzlestring;
puzzlelistbox.items.add(list1[0]);
list1.free;
end;
closefile (PF);
end;
end.