pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

Sudoku: implement a scratchpad for Sudoku's that aren't completely solved.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@7242 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
lazarus-bart
2020-01-05 13:56:22 +00:00
parent 46162a2189
commit 636e8484ce
6 changed files with 254 additions and 31 deletions
Download Patch File Download Diff File Expand all files Collapse all files

40
applications/sudoku/scratchpad.lfm Normal file
View File

@ -0,0 +1,40 @@
object ScratchForm: TScratchForm
Left = 755
Height = 545
Top = 113
Width = 799
Caption = 'ScratchPad'
ClientHeight = 545
ClientWidth = 799
OnActivate = FormActivate
OnCreate = FormCreate
LCLVersion = '2.1.0.0'
object ScratchGrid: TStringGrid
Left = 16
Height = 283
Top = 13
Width = 736
ColCount = 9
DefaultColWidth = 80
DefaultRowHeight = 30
FixedCols = 0
FixedRows = 0
RowCount = 9
ScrollBars = ssNone
TabOrder = 0
end
object btnCopy: TButton
AnchorSideLeft.Control = ScratchGrid
AnchorSideTop.Control = ScratchGrid
AnchorSideTop.Side = asrBottom
Left = 16
Height = 25
Top = 306
Width = 253
AutoSize = True
BorderSpacing.Top = 10
Caption = 'Copy values back and close the ScratchPad'
OnClick = btnCopyClick
TabOrder = 1
end
end

145
applications/sudoku/scratchpad.pas Normal file
View File

@ -0,0 +1,145 @@
unit ScratchPad;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, Forms, Controls, Graphics, Dialogs, Grids, StdCtrls,
SudokuType;
type
{ TScratchForm }
TCopyValuesEvent = procedure(Sender: TObject; Values: TValues) of Object;
TScratchForm = class(TForm)
btnCopy: TButton;
ScratchGrid: TStringGrid;
procedure btnCopyClick(Sender: TObject);
procedure FormActivate(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
FRawData: TRawGrid;
FOnCopyValues: TCopyValuesEvent;
procedure SetRawData(Data: TRawGrid);
procedure GridToValues(out Values: TValues);
procedure KeepInView;
public
property RawData: TRawGrid write SetRawData;
property OnCopyValues: TCopyValuesEvent read FOnCopyValues write FOnCopyValues;
end;
var
ScratchForm: TScratchForm;
implementation
{$R *.lfm}
function DbgS( ASet: TDigitSet): String; overload;
var
D: TDigits;
begin
Result := '[';
for D in ASet do
begin
Result := Result + IntToStr(D) + ',';
end;
if (Result[Length(Result)] = ',') then System.Delete(Result, Length(Result), 1);
Result := Result + ']';
end;
function DbgS(ASquare: TSquare): String; overload;
const
BoolStr: Array[Boolean] of String = ('False','True');
begin
Result := '[Value: ' + IntToStr(ASquare.Value) + ', ';
Result := Result + 'Locked: ' + BoolStr[ASquare.Locked] + ', ';
Result := Result + 'DigitsPossible: ' + DbgS(ASquare.DigitsPossible) + ']';
end;
{ TScratchForm }
procedure TScratchForm.FormActivate(Sender: TObject);
begin
Self.OnActivate := nil;
ScratchGrid.ClientWidth := 9 * ScratchGrid.DefaultColWidth;
ScratchGrid.ClientHeight := 9 * ScratchGrid.DefaultRowHeight;
ClientWidth := 2 * ScratchGrid.Left + ScratchGrid.Width;
ClientHeight := btnCopy.Top + btnCopy.Height + 10;
KeepInView;
end;
procedure TScratchForm.btnCopyClick(Sender: TObject);
var
Values: TValues;
begin
if not Assigned(FOnCopyValues) then Exit;
GridToValues(Values);
FOnCopyValues(Self, Values);
Close;
end;
procedure TScratchForm.FormCreate(Sender: TObject);
begin
ScratchGrid.DefaultColWidth := ScratchGrid.Canvas.TextWidth(' [1,2,3,4,5,6,7,8,9] ') + 8;
end;
procedure TScratchForm.SetRawData(Data: TRawGrid);
var
Row, Col: Integer;
S: String;
begin
FRawData := Data;
for Col := 1 to 9 do
begin
for Row := 1 to 9 do
begin
//writeln('Col: ',Col,', Row: ',Row,', Square: ',DbgS(Data[Col,Row]));
if Data[Col,Row].Locked then
S := IntToStr(Data[Col,Row].Value)
else
S := DbgS(Data[Col,Row].DigitsPossible);
ScratchGrid.Cells[Col-1,Row-1] := S;
end;
end;
end;
procedure TScratchForm.GridToValues(out Values: TValues);
var
Col, Row: Integer;
AValue: Longint;
S: String;
begin
Values := Default(TValues);
for Col := 0 to 8 do
begin
for Row := 0 to 8 do
begin
S := ScratchGrid.Cells[Col, Row];
if Length(S) >= 1 then
begin
if TryStrToInt(S, AValue) then
Values[Col + 1, Row + 1] := AValue;
end;
end;
end;
end;
procedure TScratchForm.KeepInView;
var
SW, FR, Diff, FL: Integer;
begin
SW := Screen.Width;
FR := Left + Width + 8;
FL := Left;
Diff := FR - SW;
if (Diff > 0) then FL := Left - Diff;
if (FL < 0) then FL := 0;
Left := FL;
end;
end.

14
applications/sudoku/sudoku.lpi
View File

@ -60,7 +60,7 @@
<PackageName Value="LCL"/>
</Item1>
</RequiredPackages>
<Units Count="3">
<Units Count="4">
<Unit0>
<Filename Value="sudoku.lpr"/>
<IsPartOfProject Value="True"/>
@ -77,15 +77,17 @@
<IsPartOfProject Value="True"/>
<UnitName Value="SudokuType"/>
</Unit2>
<Unit3>
<Filename Value="scratchpad.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="ScratchForm"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="ScratchPad"/>
</Unit3>
</Units>
</ProjectOptions>
<CompilerOptions>
<Version Value="11"/>
<Parsing>
<SyntaxOptions>
<UseAnsiStrings Value="False"/>
</SyntaxOptions>
</Parsing>
<Linking>
<Options>
<Win32>

3
applications/sudoku/sudoku.lpr
View File

@ -27,11 +27,12 @@ program sudoku;
uses
Interfaces, // this includes the LCL widgetset
Forms
{ add your units here }, sudokumain;
{ add your units here }, sudokumain, scratchpad;
begin
Application.Initialize;
Application.CreateForm(TForm1, Form1);
Application.CreateForm(TScratchForm, ScratchForm);
Application.Run;
end.

78
applications/sudoku/sudokumain.pas
View File

@ -31,7 +31,7 @@ interface
uses
Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, Grids,
Buttons, StdCtrls, SudokuType;
Buttons, StdCtrls, SudokuType, ScratchPad;
type
@ -60,9 +60,12 @@ type
var Editor: TWinControl);
private
{ private declarations }
theValues: TValues;
function SolveSudoku: Boolean;
procedure ShowSolution;
//theValues: TValues;
procedure OnCopyBackValues(Sender: TObject; Values: TValues);
function SolveSudoku(out Values: TValues; out RawData: TRawGrid; out Steps: Integer): Boolean;
procedure GridToValues(out Values: TValues);
procedure ValuesToGrid(const Values: TValues);
procedure ShowScratchPad(RawData: TRawGrid);
procedure LoadSudokuFromFile(const Fn: String);
procedure SaveSudokuToFile(const Fn: String);
function IsValidSudokuFile(Lines: TStrings): Boolean;
@ -121,10 +124,22 @@ begin
end;
procedure TForm1.btnSolveClick(Sender: TObject);
var
Res: Boolean;
RawData: TRawGrid;
Values: TValues;
Steps: Integer;
begin
SGrid.Options := SGrid.Options - [goEditing];
SolveSudoku;
ShowSolution;
Res := SolveSudoku(Values, RawData, Steps);
ValuesToGrid(Values);
if Res then
ShowMessage(Format('Sudoku solved in %d steps.', [Steps]))
else
begin
ShowMessage(Format('Unable to completely solve sudoku (tried %d steps).',[Steps]));
ShowScratchPad(RawData);
end;
end;
procedure TForm1.EditorKeyPress(Sender: TObject; var Key: char);
@ -193,35 +208,45 @@ begin
end;
function TForm1.SolveSudoku: Boolean;
function TForm1.SolveSudoku(out Values: TValues; out RawData: TRawGrid; out Steps: Integer): Boolean;
var
aSudoku: TSudoku;
Col, Row: Integer;
Steps, AValue: Integer;
begin
theValues := Default(TValues); //initialize all to zero
GridToValues(Values);
RawData := Default(TRawGrid);
aSudoku := TSudoku.Create;
Result := aSudoku.GiveSolution(Values, RawData, Steps);
aSudoku.Free;
end;
procedure TForm1.GridToValues(out Values: TValues);
var
Col, Row: Integer;
S: String;
AValue: Longint;
begin
Values := Default(TValues); //initialize all to zero
for Col := 0 to 8 do
begin
for Row := 0 to 8 do
begin
if Length(SGrid.Cells[Col, Row]) >= 1 then
S := Trim(SGrid.Cells[Col, Row]);
if Length(S) = 1 then
begin
if TryStrToInt(SGrid.Cells[Col, Row][1], AValue) then
theValues[Col + 1, Row + 1] := AValue;
if TryStrToInt(S, AValue) then
Values[Col + 1, Row + 1] := AValue;
end;
end;
end;
aSudoku := TSudoku.Create;
Result := aSudoku.GiveSolution(theValues, Steps);
aSudoku.Free;
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.OnCopyBackValues(Sender: TObject; Values: TValues);
begin
ValuesToGrid(Values);
end;
procedure TForm1.ShowSolution;
procedure TForm1.ValuesToGrid(const Values: TValues);
var
Col, Row: Integer;
Ch: Char;
@ -230,7 +255,7 @@ begin
begin
for Row := 0 to 8 do
begin
Ch := IntToStr(theValues[Col + 1, Row + 1])[1];
Ch := IntToStr(Values[Col + 1, Row + 1])[1];
if Ch = '0' then
Ch := VisualEmptyChar;
SGrid.Cells[Col, Row] := Ch;
@ -238,6 +263,15 @@ begin
end;
end;
procedure TForm1.ShowScratchPad(RawData: TRawGrid);
begin
ScratchForm.OnCopyValues := @OnCopyBackValues;
ScratchForm.RawData := RawData;
ScratchForm.ScratchGrid.Options := SGrid.Options + [goEditing];
ScratchForm.ScratchGrid.OnPrepareCanvas := @Self.SGridPrepareCanvas;
ScratchForm.Show;
end;
procedure TForm1.LoadSudokuFromFile(const Fn: String);
var
SL: TStringList;

5
applications/sudoku/sudokutype.pas
View File

@ -43,7 +43,7 @@ type
{ TSudoku }
TSudoku = class(TObject)
function GiveSolution(var Values: TValues; out Steps: Integer): Boolean;
function GiveSolution(var Values: TValues; out RawData: TRawGrid; out Steps: Integer): Boolean;
private
Grid: TRawGrid;
procedure CalculateValues(out IsSolved: Boolean);
@ -132,7 +132,7 @@ begin
until Result or (Steps > 50);
end;
function TSudoku.GiveSolution(var Values: TValues; out Steps: Integer): Boolean;
function TSudoku.GiveSolution(var Values: TValues; out RawData: TRawGrid; out Steps: Integer): Boolean;
var
c, r: Integer;
begin
@ -145,6 +145,7 @@ begin
Values[c, r] := Grid[c, r].Value;
end;
end;
RawData := Grid;
end;
procedure TSudoku.CalculateValues(out IsSolved: Boolean);