Sudoku: give better message if sudoku isn't completely solved.

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@7224 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
lazarus-bart
2020-01-04 15:20:09 +00:00
parent 268c0c1146
commit 2070a8bf06
2 changed files with 47 additions and 31 deletions

View File

@ -28,7 +28,7 @@ interface
uses
Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, Grids,
Buttons, StdCtrls, sudokutype;
Buttons, StdCtrls, SudokuType;
type
@ -47,7 +47,8 @@ type
private
{ private declarations }
theValues: TValues;
procedure SolveSudoku;
function SolveSudoku: Boolean;
procedure ShowSolution;
public
{ public declarations }
end;
@ -73,19 +74,10 @@ begin
end;
procedure TForm1.ButtonSolveClick(Sender: TObject);
var
c, r: Integer;
begin
StringGrid1.Options := StringGrid1.Options - [goEditing];
SolveSudoku;
StringGrid1.Clean;
for c := 1 to 9 do begin
for r := 1 to 9 do begin
StringGrid1.Cells[c - 1, r - 1] := theValues[c, r];
if StringGrid1.Cells[c - 1, r - 1] = '0' then
StringGrid1.Cells[c - 1, r - 1] := ' ';
end;
end;
ShowSolution;
end;
@ -123,25 +115,48 @@ begin
end;
end;
procedure TForm1.SolveSudoku;
function TForm1.SolveSudoku: Boolean;
var
aSudoku: TSudoku;
c, r: Integer;
Stappen: Integer;
Col, Row: Integer;
Steps: Integer;
begin
for c := 0 to 8 do begin
for r := 0 to 8 do begin
if Length(StringGrid1.Cells[c, r]) >= 1 then begin
theValues[c + 1, r + 1] := StringGrid1.Cells[c, r][1];
end else begin
theValues[c + 1, r + 1] := ' ';
for Col := 0 to 8 do begin
for Row := 0 to 8 do begin
if Length(StringGrid1.Cells[Col, Row]) >= 1 then
begin
theValues[Col + 1, Row + 1] := StringGrid1.Cells[Col, Row][1];
end
else
begin
theValues[Col + 1, Row + 1] := ' ';
end;
end;
end;
aSudoku := TSudoku.Create;
Stappen := aSudoku.GiveSolution(theValues);
Result := aSudoku.GiveSolution(theValues, Steps);
aSudoku.Free;
ShowMessage('Sudoku solved in ' + IntToStr(Stappen) + ' steps.');
if Result then
ShowMessage(Format('Sudoku solved in %d steps.', [Steps]))
else
ShowMessage(Format('Unable to completely solve sudoku (tried %d steps).',[Steps]));
end;
procedure TForm1.ShowSolution;
var
Col, Row: Integer;
Ch: Char;
begin
for Col := 0 to 8 do
begin
for Row := 0 to 8 do
begin
Ch := theValues[Col + 1, Row + 1];
if Ch = '0' then
Ch := #32;
StringGrid1.Cells[Col, Row] := Ch;
end;
end;
end;
end.

View File

@ -1,4 +1,4 @@
unit sudokutype;
unit SudokuType;
{
***************************************************************************
@ -41,7 +41,7 @@ type
{ TSudoku }
TSudoku = class(TObject)
function GiveSolution(var Values: TValues): Integer;
function GiveSolution(var Values: TValues; out ASteps: Integer): Boolean;
private
Grid : Array[1..9, 1..9] of TSquare;
Steps: Integer;
@ -51,7 +51,7 @@ type
procedure CheckBlock(c, r: Integer);
procedure CheckDigits(d: Integer);
procedure Fill(Values: TValues);
procedure Solve;
function Solve: Boolean;
function Solved: Boolean;
end;
@ -95,7 +95,7 @@ begin
end;
end;
procedure TSudoku.Solve;
function TSudoku.Solve: Boolean;
var
c, r: Integer;
begin
@ -113,21 +113,22 @@ begin
end;
for c := 1 to 9 do CheckDigits(c);
CalculateValues;
until Solved or (Steps > 50);
Result := Solved;
until Result or (Steps > 50);
end;
function TSudoku.GiveSolution(var Values: TValues): Integer;
function TSudoku.GiveSolution(var Values: TValues; out ASteps: Integer): Boolean;
var
c, r: Integer;
begin
Fill(Values);
Solve;
Result := Solve;
for c := 1 to 9 do begin
for r := 1 to 9 do begin
Values[c, r] := Grid[c, r].Value;
end;
end;
Result := Steps;
ASteps := Steps;
end;
procedure TSudoku.CalculateValues;