From 636e8484ce968ca2d2b4d4ba0c840a16c1e166bf Mon Sep 17 00:00:00 2001 From: lazarus-bart Date: Sun, 5 Jan 2020 13:56:22 +0000 Subject: [PATCH] Sudoku: implement a scratchpad for Sudoku's that aren't completely solved. git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@7242 8e941d3f-bd1b-0410-a28a-d453659cc2b4 --- applications/sudoku/scratchpad.lfm | 40 ++++++++ applications/sudoku/scratchpad.pas | 145 +++++++++++++++++++++++++++++ applications/sudoku/sudoku.lpi | 14 +-- applications/sudoku/sudoku.lpr | 3 +- applications/sudoku/sudokumain.pas | 78 +++++++++++----- applications/sudoku/sudokutype.pas | 5 +- 6 files changed, 254 insertions(+), 31 deletions(-) create mode 100644 applications/sudoku/scratchpad.lfm create mode 100644 applications/sudoku/scratchpad.pas diff --git a/applications/sudoku/scratchpad.lfm b/applications/sudoku/scratchpad.lfm new file mode 100644 index 000000000..8387ef25c --- /dev/null +++ b/applications/sudoku/scratchpad.lfm @@ -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 diff --git a/applications/sudoku/scratchpad.pas b/applications/sudoku/scratchpad.pas new file mode 100644 index 000000000..13a80c61d --- /dev/null +++ b/applications/sudoku/scratchpad.pas @@ -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. + diff --git a/applications/sudoku/sudoku.lpi b/applications/sudoku/sudoku.lpi index aaeeed589..4731faa6c 100644 --- a/applications/sudoku/sudoku.lpi +++ b/applications/sudoku/sudoku.lpi @@ -60,7 +60,7 @@ - + @@ -77,15 +77,17 @@ + + + + + + + - - - - - diff --git a/applications/sudoku/sudoku.lpr b/applications/sudoku/sudoku.lpr index 2725cae09..ffb00db69 100644 --- a/applications/sudoku/sudoku.lpr +++ b/applications/sudoku/sudoku.lpr @@ -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. diff --git a/applications/sudoku/sudokumain.pas b/applications/sudoku/sudokumain.pas index f81d7f38a..b6e2f2742 100644 --- a/applications/sudoku/sudokumain.pas +++ b/applications/sudoku/sudokumain.pas @@ -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; diff --git a/applications/sudoku/sudokutype.pas b/applications/sudoku/sudokutype.pas index eb854053b..b7589b289 100644 --- a/applications/sudoku/sudokutype.pas +++ b/applications/sudoku/sudokutype.pas @@ -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);