Sudoku: change ScratchPad:

- different text representation of digitset
- custom editor for DigitSets
- forbid editing cells taht are already locked (in FRawData)
- disable RangeSelect in the grids


git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@7245 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
lazarus-bart
2020-01-06 18:21:54 +00:00
parent 046838f1ce
commit e138543a0b
8 changed files with 302 additions and 17 deletions

View File

@@ -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

View File

@@ -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.

View File

@@ -22,6 +22,8 @@ object ScratchForm: TScratchForm
RowCount = 9 RowCount = 9
ScrollBars = ssNone ScrollBars = ssNone
TabOrder = 0 TabOrder = 0
OnClick = ScratchGridClick
OnPrepareCanvas = ScratchGridPrepareCanvas
end end
object btnCopy: TButton object btnCopy: TButton
AnchorSideLeft.Control = ScratchGrid AnchorSideLeft.Control = ScratchGrid

View File

@@ -6,7 +6,8 @@ interface
uses uses
Classes, SysUtils, Forms, Controls, Graphics, Dialogs, Grids, StdCtrls, Classes, SysUtils, Forms, Controls, Graphics, Dialogs, Grids, StdCtrls,
SudokuType; Math,
SudokuType, DigitSetEditor;
type type
@@ -20,12 +21,16 @@ type
procedure btnCopyClick(Sender: TObject); procedure btnCopyClick(Sender: TObject);
procedure FormActivate(Sender: TObject); procedure FormActivate(Sender: TObject);
procedure FormCreate(Sender: TObject); procedure FormCreate(Sender: TObject);
procedure ScratchGridClick(Sender: TObject);
procedure ScratchGridPrepareCanvas(sender: TObject; aCol, aRow: Integer;
{%H-}aState: TGridDrawState);
private private
FRawData: TRawGrid; FRawData: TRawGrid;
FOnCopyValues: TCopyValuesEvent; FOnCopyValues: TCopyValuesEvent;
procedure SetRawData(Data: TRawGrid); procedure SetRawData(Data: TRawGrid);
procedure GridToValues(out Values: TValues); procedure GridToValues(out Values: TValues);
procedure KeepInView; procedure KeepInView;
procedure EditCell(ACol, ARow: Integer);
public public
property RawData: TRawGrid write SetRawData; property RawData: TRawGrid write SetRawData;
property OnCopyValues: TCopyValuesEvent read FOnCopyValues write FOnCopyValues; property OnCopyValues: TCopyValuesEvent read FOnCopyValues write FOnCopyValues;
@@ -38,6 +43,51 @@ implementation
{$R *.lfm} {$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 } { TScratchForm }
procedure TScratchForm.FormActivate(Sender: TObject); procedure TScratchForm.FormActivate(Sender: TObject);
@@ -45,8 +95,14 @@ begin
Self.OnActivate := nil; Self.OnActivate := nil;
ScratchGrid.ClientWidth := 9 * ScratchGrid.DefaultColWidth; ScratchGrid.ClientWidth := 9 * ScratchGrid.DefaultColWidth;
ScratchGrid.ClientHeight := 9 * ScratchGrid.DefaultRowHeight; ScratchGrid.ClientHeight := 9 * ScratchGrid.DefaultRowHeight;
//writeln(format('ScratchGrid: %d x %d',[ScratchGrid.ClientWidth,ScratchGrid.ClientHeight]));
ClientWidth := 2 * ScratchGrid.Left + ScratchGrid.Width; 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; KeepInView;
end; end;
@@ -61,8 +117,54 @@ begin
end; end;
procedure TScratchForm.FormCreate(Sender: TObject); procedure TScratchForm.FormCreate(Sender: TObject);
var
DefWH: Integer;
begin 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; end;
procedure TScratchForm.SetRawData(Data: TRawGrid); procedure TScratchForm.SetRawData(Data: TRawGrid);
@@ -79,7 +181,8 @@ begin
if Data[Col,Row].Locked then if Data[Col,Row].Locked then
S := IntToStr(Data[Col,Row].Value) S := IntToStr(Data[Col,Row].Value)
else 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; ScratchGrid.Cells[Col-1,Row-1] := S;
end; end;
end; end;
@@ -88,7 +191,7 @@ end;
procedure TScratchForm.GridToValues(out Values: TValues); procedure TScratchForm.GridToValues(out Values: TValues);
var var
Col, Row: Integer; Col, Row: Integer;
AValue: Longint; AValue: TDigits;
S: String; S: String;
begin begin
Values := Default(TValues); Values := Default(TValues);
@@ -97,9 +200,10 @@ begin
for Row := 0 to 8 do for Row := 0 to 8 do
begin begin
S := ScratchGrid.Cells[Col, Row]; S := ScratchGrid.Cells[Col, Row];
//DigitSet := StrToDigitSet(S);
if Length(S) >= 1 then if Length(S) >= 1 then
begin begin
if TryStrToInt(S, AValue) then if TryCellTextToDigit(S, AValue) then
Values[Col + 1, Row + 1] := AValue; Values[Col + 1, Row + 1] := AValue;
end; end;
end; end;
@@ -119,5 +223,22 @@ begin
Left := FL; Left := FL;
end; 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. end.

View File

@@ -15,11 +15,6 @@
<Item2 Name="Debug"> <Item2 Name="Debug">
<CompilerOptions> <CompilerOptions>
<Version Value="11"/> <Version Value="11"/>
<Parsing>
<SyntaxOptions>
<UseAnsiStrings Value="False"/>
</SyntaxOptions>
</Parsing>
<CodeGeneration> <CodeGeneration>
<Checks> <Checks>
<IOChecks Value="True"/> <IOChecks Value="True"/>
@@ -60,7 +55,7 @@
<PackageName Value="LCL"/> <PackageName Value="LCL"/>
</Item1> </Item1>
</RequiredPackages> </RequiredPackages>
<Units Count="4"> <Units Count="5">
<Unit0> <Unit0>
<Filename Value="sudoku.lpr"/> <Filename Value="sudoku.lpr"/>
<IsPartOfProject Value="True"/> <IsPartOfProject Value="True"/>
@@ -71,6 +66,7 @@
<ComponentName Value="Form1"/> <ComponentName Value="Form1"/>
<HasResources Value="True"/> <HasResources Value="True"/>
<ResourceBaseClass Value="Form"/> <ResourceBaseClass Value="Form"/>
<UnitName Value="SudokuMain"/>
</Unit1> </Unit1>
<Unit2> <Unit2>
<Filename Value="sudokutype.pas"/> <Filename Value="sudokutype.pas"/>
@@ -85,6 +81,13 @@
<ResourceBaseClass Value="Form"/> <ResourceBaseClass Value="Form"/>
<UnitName Value="ScratchPad"/> <UnitName Value="ScratchPad"/>
</Unit3> </Unit3>
<Unit4>
<Filename Value="digitseteditor.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="DigitSetEditorForm"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="DigitSetEditor"/>
</Unit4>
</Units> </Units>
</ProjectOptions> </ProjectOptions>
<CompilerOptions> <CompilerOptions>

View File

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

View File

@@ -23,7 +23,7 @@ object Form1: TForm1
DefaultRowHeight = 30 DefaultRowHeight = 30
FixedCols = 0 FixedCols = 0
FixedRows = 0 FixedRows = 0
Options = [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine, goRangeSelect, goEditing, goSmoothScroll] Options = [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine, goEditing, goSmoothScroll]
RowCount = 9 RowCount = 9
ScrollBars = ssNone ScrollBars = ssNone
TabOrder = 2 TabOrder = 2

View File

@@ -1,4 +1,4 @@
unit sudokumain; unit SudokuMain;
{ {
*************************************************************************** ***************************************************************************
@@ -267,8 +267,8 @@ procedure TForm1.ShowScratchPad(RawData: TRawGrid);
begin begin
ScratchForm.OnCopyValues := @OnCopyBackValues; ScratchForm.OnCopyValues := @OnCopyBackValues;
ScratchForm.RawData := RawData; ScratchForm.RawData := RawData;
ScratchForm.ScratchGrid.Options := SGrid.Options + [goEditing]; ScratchForm.ScratchGrid.Options := SGrid.Options - [goEditing];
ScratchForm.ScratchGrid.OnPrepareCanvas := @Self.SGridPrepareCanvas; ScratchForm.Left := Left + Width + 10;
ScratchForm.Show; ScratchForm.Show;
end; end;