Sudoku: restrict user input in grid.

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@7228 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
lazarus-bart
2020-01-04 17:19:07 +00:00
parent 20e629be7a
commit e1d784ff8a
2 changed files with 31 additions and 0 deletions

View File

@ -27,6 +27,7 @@ object Form1: TForm1
ScrollBars = ssNone
TabOrder = 2
OnPrepareCanvas = SGridPrepareCanvas
OnSelectEditor = SGridSelectEditor
OnSetEditText = SGridSetEditText
end
object ButtonFill: TButton

View File

@ -43,9 +43,12 @@ type
SGrid: TStringGrid;
procedure ButtonFillClick(Sender: TObject);
procedure ButtonSolveClick(Sender: TObject);
procedure EditorKeyPress(Sender: TObject; var Key: char);
procedure FormActivate(Sender: TObject);
procedure SGridPrepareCanvas(sender: TObject; aCol, aRow: Integer;
{%H-}aState: TGridDrawState);
procedure SGridSelectEditor(Sender: TObject; {%H-}aCol, {%H-}aRow: Integer;
var Editor: TWinControl);
procedure SGridSetEditText(Sender: TObject; ACol, ARow: Integer;
const Value: string);
private
@ -84,6 +87,19 @@ begin
ShowSolution;
end;
procedure TForm1.EditorKeyPress(Sender: TObject; var Key: char);
var
Ed: TStringCellEditor;
begin
if (Sender is TStringCellEditor) then
begin
Ed := TStringCellEditor(Sender);
Ed.SelectAll; //Key will now overwrite selection, in effect allowing to enter only 1 key
if not (Key in [#8, '1'..'9']) then Key := #0;
end;
end;
procedure TForm1.FormActivate(Sender: TObject);
begin
Self.OnActivate := nil;
@ -92,6 +108,7 @@ begin
ClientWidth := 2 * SGrid.Left + SGrid.Width;
end;
procedure TForm1.SGridPrepareCanvas(sender: TObject; aCol, aRow: Integer;
aState: TGridDrawState);
var
@ -116,6 +133,18 @@ begin
(Sender as TStringGrid).Canvas.Brush.Color := $00EEEEEE;
end;
procedure TForm1.SGridSelectEditor(Sender: TObject; aCol, aRow: Integer;
var Editor: TWinControl);
var
Ed: TStringCellEditor;
begin
if Editor is TStringCellEditor then
begin
Ed := TStringCellEditor(Editor);
Ed.OnKeyPress := @EditorKeyPress;
end;
end;
procedure TForm1.SGridSetEditText(Sender: TObject; ACol, ARow: Integer;
const Value: string);
begin
@ -153,6 +182,7 @@ begin
ShowMessage(Format('Unable to completely solve sudoku (tried %d steps).',[Steps]));
end;
procedure TForm1.ShowSolution;
var
Col, Row: Integer;