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

Sudoku: restrict user input in grid.

Browse Source 
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
Download Patch File Download Diff File Expand all files Collapse all files

1
applications/sudoku/sudokumain.lfm
View File

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

30
applications/sudoku/sudokumain.pas
View File

@ -43,9 +43,12 @@ type
SGrid: TStringGrid; SGrid: TStringGrid;
procedure ButtonFillClick(Sender: TObject); procedure ButtonFillClick(Sender: TObject);
procedure ButtonSolveClick(Sender: TObject); procedure ButtonSolveClick(Sender: TObject);
procedure EditorKeyPress(Sender: TObject; var Key: char);
procedure FormActivate(Sender: TObject); procedure FormActivate(Sender: TObject);
procedure SGridPrepareCanvas(sender: TObject; aCol, aRow: Integer; procedure SGridPrepareCanvas(sender: TObject; aCol, aRow: Integer;
{%H-}aState: TGridDrawState); {%H-}aState: TGridDrawState);
procedure SGridSelectEditor(Sender: TObject; {%H-}aCol, {%H-}aRow: Integer;
var Editor: TWinControl);
procedure SGridSetEditText(Sender: TObject; ACol, ARow: Integer; procedure SGridSetEditText(Sender: TObject; ACol, ARow: Integer;
const Value: string); const Value: string);
private private
@ -84,6 +87,19 @@ begin
ShowSolution; ShowSolution;
end; 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); procedure TForm1.FormActivate(Sender: TObject);
begin begin
Self.OnActivate := nil; Self.OnActivate := nil;
@ -92,6 +108,7 @@ begin
ClientWidth := 2 * SGrid.Left + SGrid.Width; ClientWidth := 2 * SGrid.Left + SGrid.Width;
end; end;
procedure TForm1.SGridPrepareCanvas(sender: TObject; aCol, aRow: Integer; procedure TForm1.SGridPrepareCanvas(sender: TObject; aCol, aRow: Integer;
aState: TGridDrawState); aState: TGridDrawState);
var var
@ -116,6 +133,18 @@ begin
(Sender as TStringGrid).Canvas.Brush.Color := $00EEEEEE; (Sender as TStringGrid).Canvas.Brush.Color := $00EEEEEE;
end; 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; procedure TForm1.SGridSetEditText(Sender: TObject; ACol, ARow: Integer;
const Value: string); const Value: string);
begin begin
@ -153,6 +182,7 @@ begin
ShowMessage(Format('Unable to completely solve sudoku (tried %d steps).',[Steps])); ShowMessage(Format('Unable to completely solve sudoku (tried %d steps).',[Steps]));
end; end;
procedure TForm1.ShowSolution; procedure TForm1.ShowSolution;
var var
Col, Row: Integer; Col, Row: Integer;