diff --git a/applications/sudoku/digitseteditor.lfm b/applications/sudoku/digitseteditor.lfm new file mode 100644 index 000000000..ee2930d41 --- /dev/null +++ b/applications/sudoku/digitseteditor.lfm @@ -0,0 +1,63 @@ +object DigitSetEditorForm: TDigitSetEditorForm + Left = 668 + Height = 240 + Top = 144 + Width = 320 + BorderStyle = bsDialog + Caption = 'DigitSetEditorForm' + ClientHeight = 240 + ClientWidth = 320 + KeyPreview = True + OnActivate = FormActivate + OnKeyPress = FormKeyPress + OnShow = FormShow + LCLVersion = '2.1.0.0' + object DigitCG: TCheckGroup + Left = 16 + Height = 89 + Top = 16 + Width = 136 + AutoFill = True + Caption = 'Digits' + ChildSizing.LeftRightSpacing = 6 + ChildSizing.VerticalSpacing = 6 + ChildSizing.EnlargeHorizontal = crsScaleChilds + ChildSizing.ShrinkHorizontal = crsScaleChilds + ChildSizing.ShrinkVertical = crsScaleChilds + ChildSizing.Layout = cclLeftToRightThenTopToBottom + ChildSizing.ControlsPerLine = 3 + ClientHeight = 69 + ClientWidth = 132 + Columns = 3 + Items.Strings = ( + '1' + '2' + '3' + '4' + '5' + '6' + '7' + '8' + '9' + ) + ParentBiDiMode = False + TabOrder = 0 + Data = { + 09000000020202020202020202 + } + end + object btnOK: TButton + AnchorSideLeft.Control = DigitCG + AnchorSideRight.Control = DigitCG + AnchorSideRight.Side = asrBottom + Left = 16 + Height = 25 + Top = 112 + Width = 136 + Anchors = [akTop, akLeft, akRight] + Caption = '&Ok' + Default = True + ModalResult = 1 + TabOrder = 1 + end +end diff --git a/applications/sudoku/digitseteditor.pas b/applications/sudoku/digitseteditor.pas new file mode 100644 index 000000000..f009d6209 --- /dev/null +++ b/applications/sudoku/digitseteditor.pas @@ -0,0 +1,95 @@ +unit DigitSetEditor; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls, StdCtrls, + SudokuType; + +type + + { TDigitSetEditorForm } + + TDigitSetEditorForm = class(TForm) + btnOK: TButton; + DigitCG: TCheckGroup; + procedure FormActivate(Sender: TObject); + procedure FormKeyPress(Sender: TObject; var Key: char); + procedure FormShow(Sender: TObject); + private + FPreferredRight: Integer; + function GetDigitSet: TDigitSet; + procedure SetDigitSet(ASet: TDigitSet); + procedure SetRight({%H-}Data: PtrInt); + + public + property DigitSet: TDigitSet read GetDigitSet write SetDigitSet; + property PreferredRight: Integer read FPreferredRight write FPreferredRight; + end; + +var + DigitSetEditorForm: TDigitSetEditorForm; + +implementation + +{$R *.lfm} + +{ TDigitSetEditorForm } + +procedure TDigitSetEditorForm.FormKeyPress(Sender: TObject; var Key: char); +var + Digit: Integer; +begin + if (Key in ['1'..'9']) then + begin + Digit := Ord(Key) - Ord('0'); + DigitCG.Checked[Pred(Digit)] := not DigitCG.Checked[Pred(Digit)]; + Key := #0; + end; + if (Key = #27) then //escape + begin + Key := #0; + ModalResult := mrCancel; + end; +end; + +procedure TDigitSetEditorForm.FormShow(Sender: TObject); +begin + Application.QueueAsyncCall(@SetRight, FPreferredRight) +end; + +procedure TDigitSetEditorForm.FormActivate(Sender: TObject); +begin + OnACtivate := nil; + ClientWidth := 2 * DigitCG.Left + DigitCG.Width; + ClientHeight := btnOK.Top + btnOK.Height + DigitCG.Top; +end; + +function TDigitSetEditorForm.GetDigitSet: TDigitSet; +var + i: Integer; +begin + Result := []; + for i := 0 to DigitCG.Items.Count - 1 do + if DigitCG.Checked[i] then Include(Result, Succ(i)); +end; + +procedure TDigitSetEditorForm.SetDigitSet(ASet: TDigitSet); +var + D: TDigits; +begin + for D in TDigits do + begin + DigitCG.Checked[D-1] := (D in ASet); //don't use Pred(D) here, gives RangeCheckError when D=1 + end; +end; + +procedure TDigitSetEditorForm.SetRight(Data: PtrInt); +begin + Left := FPreferredRight - Width; +end; + +end. + diff --git a/applications/sudoku/scratchpad.lfm b/applications/sudoku/scratchpad.lfm index 8387ef25c..b21e9ca30 100644 --- a/applications/sudoku/scratchpad.lfm +++ b/applications/sudoku/scratchpad.lfm @@ -22,6 +22,8 @@ object ScratchForm: TScratchForm RowCount = 9 ScrollBars = ssNone TabOrder = 0 + OnClick = ScratchGridClick + OnPrepareCanvas = ScratchGridPrepareCanvas end object btnCopy: TButton AnchorSideLeft.Control = ScratchGrid diff --git a/applications/sudoku/scratchpad.pas b/applications/sudoku/scratchpad.pas index 002432b7a..bc0953ce9 100644 --- a/applications/sudoku/scratchpad.pas +++ b/applications/sudoku/scratchpad.pas @@ -6,7 +6,8 @@ interface uses Classes, SysUtils, Forms, Controls, Graphics, Dialogs, Grids, StdCtrls, - SudokuType; + Math, + SudokuType, DigitSetEditor; type @@ -20,12 +21,16 @@ type procedure btnCopyClick(Sender: TObject); procedure FormActivate(Sender: TObject); procedure FormCreate(Sender: TObject); + procedure ScratchGridClick(Sender: TObject); + procedure ScratchGridPrepareCanvas(sender: TObject; aCol, aRow: Integer; + {%H-}aState: TGridDrawState); private FRawData: TRawGrid; FOnCopyValues: TCopyValuesEvent; procedure SetRawData(Data: TRawGrid); procedure GridToValues(out Values: TValues); procedure KeepInView; + procedure EditCell(ACol, ARow: Integer); public property RawData: TRawGrid write SetRawData; property OnCopyValues: TCopyValuesEvent read FOnCopyValues write FOnCopyValues; @@ -38,6 +43,51 @@ implementation {$R *.lfm} +function DigitSetToStr(ASet: TDigitSet): String; + function Get(D: Integer): Char; + begin + if (D in ASet) then + Result := Char(Ord('0') + D) + else + Result := 'x';//#32; + end; +begin + Result := Format('%s-%s-%s'+LineEnding+'%s-%s-%s'+LineEnding+'%s-%s-%s',[Get(1),Get(2),Get(3),Get(4),Get(5),Get(6),Get(7),Get(8),Get(9)]); +end; + +function StrToDigitSet(const S: String): TDigitSet; +var + Ch: Char; +begin + Result := []; + for Ch in S do + if (Ch in ['1'..'9']) then + Include(Result, Ord(Ch) - Ord('0')); +end; + +{ + +} +function TryCellTextToDigit(const AText: String; out Value: TDigits): Boolean; +var + Ch: Char; + S: String; +begin + Result := False; + S := ''; + for Ch in AText do + if (Ch in ['1'..'9']) then S := S + Ch; + if (Length(S) = 1) then + begin + Ch := S[1]; + if (Ch in ['1'..'9']) then + begin + Value := Ord(Ch) - Ord('0'); + Result := True; + end; + end; +end; + { TScratchForm } procedure TScratchForm.FormActivate(Sender: TObject); @@ -45,8 +95,14 @@ begin Self.OnActivate := nil; ScratchGrid.ClientWidth := 9 * ScratchGrid.DefaultColWidth; ScratchGrid.ClientHeight := 9 * ScratchGrid.DefaultRowHeight; + //writeln(format('ScratchGrid: %d x %d',[ScratchGrid.ClientWidth,ScratchGrid.ClientHeight])); ClientWidth := 2 * ScratchGrid.Left + ScratchGrid.Width; - ClientHeight := btnCopy.Top + btnCopy.Height + 10; + //writeln(format('btnCopy.Top: %d, btnCopy.Height: %d',[btnCopy.Top,btnCopy.Height])); + Self.ReAlign; + //ClientHeight := btnCopy.Top + btnCopy.Height + 10; + //Above doesn't work: at this time btnCopy.Top still holds designtime value, even when it's top is anchored to the grid + ClientHeight := ScratchGrid.Top + ScratchGrid.Height + 10 + btnCopy.Height + 10; + //writeln(format('ClientHeight: %d',[ClientHeight])); KeepInView; end; @@ -61,8 +117,54 @@ begin end; procedure TScratchForm.FormCreate(Sender: TObject); +var + DefWH: Integer; begin - ScratchGrid.DefaultColWidth := ScratchGrid.Canvas.TextWidth(' [1,2,3,4,5,6,7,8,9] ') + 8; + DefWH := Max(ScratchGrid.Canvas.TextWidth(' 8-8-8 '), 3 * ScratchGrid.Canvas.TextHeight('8')) + 10; + ScratchGrid.DefaultColWidth := DefWH; + ScratchGrid.DefaultRowHeight := DefWH; +end; + +procedure TScratchForm.ScratchGridClick(Sender: TObject); +var + Col, Row: Integer; +begin + Col := ScratchGrid.Col; + Row := ScratchGrid.Row; + if not FRawData[Col+1,Row+1].Locked then + EditCell(Col, Row); +end; + +procedure TScratchForm.ScratchGridPrepareCanvas(sender: TObject; aCol, aRow: Integer; aState: TGridDrawState); +var + NeedsColor: Boolean; + GridTextStyle: TTextStyle; +begin + GridTextStyle := (Sender as TStringGrid).Canvas.TextStyle; + GridTextStyle.Alignment := taCenter; + GridTextStyle.Layout := tlCenter; + GridTextStyle.SingleLine := False; + (Sender as TStringGrid).Canvas.TextStyle := GridTextStyle; + NeedsColor := False; + if aCol in [0..2, 6..8] then + begin + if aRow in [0..2, 6..8] then + NeedsColor := True; + end + else + begin + if aRow in [3..5] then + NeedsColor := True; + end; + if NeedsColor then + (Sender as TStringGrid).Canvas.Brush.Color := $00EEEEEE; + //if (aRow=0) and (aCol=0) then + if FRawData[aCol+1, aRow+1].Locked then + begin + (Sender as TStringGrid).Canvas.Brush.Color := $00F8E3CB; // $00F1CEA3; + (Sender as TStringGrid).Canvas.Font.Color := clRed; + (Sender as TStringGrid).Canvas.Font.Style := [fsBold] + end; end; procedure TScratchForm.SetRawData(Data: TRawGrid); @@ -79,7 +181,8 @@ begin if Data[Col,Row].Locked then S := IntToStr(Data[Col,Row].Value) else - S := DbgS(Data[Col,Row].DigitsPossible); + //S := DbgS(Data[Col,Row].DigitsPossible); + S := DigitSetToStr(Data[Col,Row].DigitsPossible); ScratchGrid.Cells[Col-1,Row-1] := S; end; end; @@ -88,7 +191,7 @@ end; procedure TScratchForm.GridToValues(out Values: TValues); var Col, Row: Integer; - AValue: Longint; + AValue: TDigits; S: String; begin Values := Default(TValues); @@ -97,9 +200,10 @@ begin for Row := 0 to 8 do begin S := ScratchGrid.Cells[Col, Row]; + //DigitSet := StrToDigitSet(S); if Length(S) >= 1 then begin - if TryStrToInt(S, AValue) then + if TryCellTextToDigit(S, AValue) then Values[Col + 1, Row + 1] := AValue; end; end; @@ -119,5 +223,22 @@ begin Left := FL; end; +procedure TScratchForm.EditCell(ACol, ARow: Integer); +var + S: String; + DigitSet: TDigitSet; +begin + S := ScratchGrid.Cells[ACol, ARow]; + DigitSet := StrToDigitSet(S); + DigitSetEditorForm.DigitSet := DigitSet; + DigitSetEditorForm.Top := Top; + DigitSetEditorForm.PreferredRight := Left; + if (DigitSetEditorForm.ShowModal = mrOK) then + begin + S := DigitSetToStr(DigitSetEditorForm.DigitSet); + ScratchGrid.Cells[ACol, ARow] := S; + end; +end; + end. diff --git a/applications/sudoku/sudoku.lpi b/applications/sudoku/sudoku.lpi index c042e12c4..4c89073a4 100644 --- a/applications/sudoku/sudoku.lpi +++ b/applications/sudoku/sudoku.lpi @@ -15,11 +15,6 @@ - - - - - @@ -60,7 +55,7 @@ - + @@ -71,6 +66,7 @@ + @@ -85,6 +81,13 @@ + + + + + + + diff --git a/applications/sudoku/sudoku.lpr b/applications/sudoku/sudoku.lpr index ffb00db69..950399d0e 100644 --- a/applications/sudoku/sudoku.lpr +++ b/applications/sudoku/sudoku.lpr @@ -27,12 +27,13 @@ program sudoku; uses Interfaces, // this includes the LCL widgetset Forms - { add your units here }, sudokumain, scratchpad; + { add your units here }, sudokumain, scratchpad, digitseteditor; begin Application.Initialize; Application.CreateForm(TForm1, Form1); Application.CreateForm(TScratchForm, ScratchForm); + Application.CreateForm(TDigitSetEditorForm, DigitSetEditorForm); Application.Run; end. diff --git a/applications/sudoku/sudokumain.lfm b/applications/sudoku/sudokumain.lfm index 7f02d3795..183cf7dde 100644 --- a/applications/sudoku/sudokumain.lfm +++ b/applications/sudoku/sudokumain.lfm @@ -23,7 +23,7 @@ object Form1: TForm1 DefaultRowHeight = 30 FixedCols = 0 FixedRows = 0 - Options = [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine, goRangeSelect, goEditing, goSmoothScroll] + Options = [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine, goEditing, goSmoothScroll] RowCount = 9 ScrollBars = ssNone TabOrder = 2 diff --git a/applications/sudoku/sudokumain.pas b/applications/sudoku/sudokumain.pas index b6e2f2742..9775d9391 100644 --- a/applications/sudoku/sudokumain.pas +++ b/applications/sudoku/sudokumain.pas @@ -1,4 +1,4 @@ -unit sudokumain; +unit SudokuMain; { *************************************************************************** @@ -267,8 +267,8 @@ procedure TForm1.ShowScratchPad(RawData: TRawGrid); begin ScratchForm.OnCopyValues := @OnCopyBackValues; ScratchForm.RawData := RawData; - ScratchForm.ScratchGrid.Options := SGrid.Options + [goEditing]; - ScratchForm.ScratchGrid.OnPrepareCanvas := @Self.SGridPrepareCanvas; + ScratchForm.ScratchGrid.Options := SGrid.Options - [goEditing]; + ScratchForm.Left := Left + Width + 10; ScratchForm.Show; end;