📄 mainfrm.pas
字号:
For iCol := 4 To 6 do begin
Index := GetIndex(iRow, iCol);
Squares[Index].nBox := 8;
end;
For iCol := 7 To 9 do begin
Index := GetIndex(iRow, iCol);
Squares[Index].nBox := 9;
end;
end;
end;
procedure TMainForm.ActSolveExecute(Sender: TObject);
begin
MYDoPuzzle();
end;
procedure TMainForm.ActClearGridExecute(Sender: TObject);
VAR
i: Integer;
begin
For i := 1 To cMaxCells do begin
TMaskEdit(GridSudoku[i]).Text := '';
end;
InitPuzzle();
LoadCellHints();
TMaskEdit(GridSudoku[1]).SetFocus;
end;
procedure TMainForm.FillInResults;
VAR
iRow,iCol,i: Integer;
begin
For iRow := 1 To ncSIZE do begin
For iCol := 1 To ncSIZE do begin
i := GetIndex(iRow, iCol);
If Squares[i].Value > 0 Then begin // Found a solution
TMaskEdit(GridSudoku[GetIndex(iRow,iCol)]).Text := IntToStr(Squares[i].Value);
end;
end;
end;
end;
// -------------------------------------------------------------------------
// -------------------------------------------------------------------------
// sudoku routines END
// -------------------------------------------------------------------------
// -------------------------------------------------------------------------
procedure TMainForm.GetIniSettings;
VAR
iniFileName: string;
iniFile: TiniFile;
WindowStat: LongInt;
begin
WinDirPath := GetWindowsDirectory();
if WinDirPath = '' then begin
MessageDlg('System Error: Unable to determine the '+
'Windows System Directory. Process terminated.',
mtInformation,[mbOk], 0);
Application.Terminate;
end;
SplashScreen.StatusBar.Panels[1].Text := 'Loading ini Values...';
SplashScreen.Update;
// IniFileName := WinDirPath + ExeBaseName +'.ini';
IniFileName := ExeDirPath + ExeBaseName+'.ini';
iniFile := TiniFile.create(InifileName);
MainForm.Top := IniFile.ReadInteger('MainForm','Top', 50);
MainForm.Left := IniFile.ReadInteger('MainForm','Left', 50);
MainForm.Height := IniFile.ReadInteger('MainForm','Height',MainForm.Height);
MainForm.Width := IniFile.ReadInteger('MainForm','Width', MainForm.Width);
// DBGrid1stHalf.Height := IniFile.ReadInteger('MainForm', 'Grid1stHalf',DBGrid1stHalf.Height);
MnuFileFadeOnExit.Checked
:= iniFile.ReadBool('MainForm', 'ExitFade',True);
MnuFileVisualize.Checked
:= iniFile.ReadBool('MainForm', 'Visualize',False);
VisualDelay := IniFile.ReadInteger('MainForm','VisualDelay', 75);
WindowStat := IniFile.ReadInteger('MainForm','ApplicationState', ord(MainForm.WindowState));
LastSudokuFile := iniFile.ReadString('MainForm','FileLoadDir',ExeDirPath);
MainForm.WindowState := TWindowState(WindowStat);
IniFile.Free;
LastSudokuFile := IncludeTrailingPathDelimiter(LastSudokuFile);
statusbar.panels[0].text := 'Visuals:'+ifthen(MnuFileVisualize.Checked,'ON','OFF');
(*{IniFileName := ExeDirPath + ExeBaseName+'.ini';
iniFile := TiniFile.create(InifileName);
UserLockOut := IniFile.ReadBool('MainForm', 'LockOut', True);
IniFile.Free;
StrList.Free; }
if (UserLockOut) then begin
{ MessageDlg('Sorry, but this program is currently under construction.'+
CRLF+'Please be patient...Ron is working on it.',
mtInformation,[mbOk], 0); }
GiveLockedOutMessage;
Application.Terminate;
end; *)
// MemoUserMessages.Lines.Clear;
SplashScreen.StatusBar.Panels[1].Text := '';
SplashScreen.Update;
sleep(2000); // wait so the splash screen has a chance to show
end;
procedure TMainForm.PutIniSettings;
VAR
iniFileName: string;
iniFile: TiniFile;
begin
statusbar.Panels[2].Text := 'Saving ini Values...';
// IniFileName := WinDirPath + ExeBaseName +'.ini';
IniFileName := ExeDirPath + ExeBaseName+'.ini';
iniFile := TiniFile.create(InifileName);
IniFile.WriteInteger('MainForm', 'Top', MainForm.Top);
IniFile.WriteInteger('MainForm', 'Left', MainForm.Left);
IniFile.WriteInteger('MainForm', 'Height', MainForm.Height);
IniFile.WriteInteger('MainForm', 'Width', MainForm.Width);
iniFile.WriteBool( 'MainForm', 'ExitFade', MnuFileFadeOnExit.Checked);
iniFile.WriteBool( 'MainForm', 'Visualize', MnuFileVisualize.Checked);
IniFile.WriteInteger('MainForm','VisualDelay', VisualDelay);
IniFile.WriteInteger('MainForm', 'ApplicationState', ord(MainForm.WindowState));
iniFile.WriteString('MainForm','FileLoadDir',ExtractFilePath(LastSudokuFile));
IniFile.Free;
statusbar.Panels[2].Text := ' ';
end;
procedure TMainForm.MnuFileFadeOnExitClick(Sender: TObject);
begin
MnuFileFadeOnExit.Checked := NOT(MnuFileFadeOnExit.Checked);
end;
procedure TMainForm.MnuFileVisualizeClick(Sender: TObject);
begin
MnuFileVisualize.Checked := NOT(MnuFileVisualize.Checked);
statusbar.panels[0].text := 'Visuals:'+ifthen(MnuFileVisualize.Checked,'ON','OFF');
end;
procedure TMainForm.LoadFile(fn: String);
var
i,LL, BadIndex: integer;
F: TextFile;
FirstLine,c: string;
begin
LoadingORSolving := True;
// ActReloadFile.Enabled := False;
if NOT(FileExists(fn)) then begin
beep;
UserMessage('The reload file no longer exists:'+ fn);
LastSudokuFile := ExtractFilePath(fn);
end else begin
PanelDNo.Caption := '0';
PaneliNo.Caption := '0';
GgDepth.Progress := 0;
GgIterations.Progress := 0;
Caption := 'Su Duko Solver - '+ExtractFileName(fn);
LastSudokuFile := fn;
AssignFile(F,fn);
Reset(F);
Readln(F, FirstLine); { Read the first line out of the file }
// MemoUserMessages.Lines.Append(FirstLine); { Add the line to the memo }
CloseFile(F);
//read only upto the first cMaxCell characters
// check for bad data too
LL := Length(FirstLine);
For i := 1 to cMaxCells do begin
if i <= LL then begin
c := MIDStr(FirstLine,i,1);
end else begin
c:= '';
end;
// Strip bad data characters, only numeric digits,
if ((c > '9') OR (c < '1')) then begin // change zero's too
c := '';
end;
// if c = '0' then
// TMaskEdit(GridSudoku[i]).Text := ''
// else begin
// TMaskEdit(GridSudoku[i]).Text := c;
// end;
TMaskEdit(GridSudoku[i]).Text := c;
end;
InitPuzzle(); //Set up matrix
BadIndex := ReadInput(); // Read the data into matrix
If BadIndex = 0 Then begin
LoadCellHints();
// ActReloadFile.Enabled := True;
end else begin
beep;
LblRC.Caption := 'Cell (,)';
PanelPossibleChoices.Caption := '';
UserMessage('Invalid input data. Problem with ('+
IntToStr(GetRow(BadIndex))+','+
IntToStr(GetCol(BadIndex))+')');
end;
end;
ClearUndoStack();
PushUndoStack(GridToString());
LoadingORSolving := False;
end;
procedure TMainForm.ActReloadFileExecute(Sender: TObject);
begin
// if last sudoku file name is not set then show open file dialog
if TRIM(ExtractFileName(LastSudokuFile)) = '' then
ActOpenFile.Execute
else begin
LoadFile(LastSudokuFile);
end;
end;
procedure TMainForm.ActOpenFileExecute(Sender: TObject);
begin
OpenDlg.Title := 'Open Sudoku File';
OpenDlg.InitialDir := ExtractFilePath(LastSudokuFile);
if OpenDlg.Execute then begin
LoadFile(OpenDlg.FileName);
end;
end;
procedure TMainForm.ActSaveFileExecute(Sender: TObject);
var
F: TextFile;
SudokuStr,c: string;
i: Integer;
begin
SaveDlg.Title := 'Save Sudoku File';
SaveDlg.InitialDir := ExtractFilePath(LastSudokuFile);
if SaveDlg.Execute then begin
LastSudokuFile := SaveDlg.FileName;
Caption := 'Su Duko Solver - '+ExtractFileName(LastSudokuFile);
AssignFile(F,LastSudokuFile);
Rewrite(F);
SudokuStr := '';
For i := 1 to cMaxCells do begin
c := TRIM(TMaskEdit(GridSudoku[i]).Text);
if c = '' then
SudokuStr := SudokuStr + '0'
else begin
SudokuStr := SudokuStr + c;
end;
end;
Writeln(F, SudokuStr); { write the string to file}
CloseFile(F);
UserMessage('Sudoku puzzle successfully written to file: '+ LastSudokuFile);
// ActReloadFile.Enabled := True;
end;
end;
// for the given string, determine the index number based on
// the last one or two character of the edit fields name.
function TMainForm.GetCellIndex(edtName: String): Integer;
Var
i: Integer;
n: String;
begin
n := RightStr(edtName,2);
i := StrToIntDef(n,-1);
if i < 0 then begin // try again for a single digit number
n := RightStr(edtName,1);
i := StrToIntDef(n,1); // if failed default to one
end;
Result := i;
end;
procedure TMainForm.FormKeyPress(Sender: TObject; var Key: Char);
begin
if Key = #13 then begin // if it's an enter key
Key := #0; // eat enter key
Perform(WM_NEXTDLGCTL, 0, 0); // move to next control
end;
{ if key = CHR(vk_Right) then begin
Key := #0; // eat enter key
Perform(WM_NEXTDLGCTL, 0, 0); // move to next control
end; }
end;
procedure TMainForm.EdtCellKeyPress(Sender: TObject; var Key: Char);
VAR
c,h: String;
i: Integer;
begin
Inherited KeyPress(Key); // For user events
// if NOT(LoadingORSolving) then begin // disable during processing
// Check for Numeric and backspaces
if (Key in [#8, '0'..'9']) then begin
// if (key >= '1') AND (key <= '9') then begin // key nums 1 - 9
c := key;
h := TMaskEdit(sender).Hint;
i := POS(c,h);
// only valid choices are keyed in
if (i = 0) then begin
StatusBar.Panels[0].Text := ' BAD:'+Key;
key := #0;
beep; // bad key
end else begin // good key stroke
PushUndoStack(GridToString());
end;
end;
// end;
end;
procedure TMainForm.EdtCellChange(Sender: TObject);
VAR
BadIndex: Integer;
c,h: String;
i: Integer;
begin
if NOT(LoadingORSolving) then begin // disable during processing
// if ((TMaskEdit(sender).Text >= '0') And (TMaskEdit(sender).Text <= '9'))
// OR (TMaskEdit(sender).Text = '') then begin
c := TMaskEdit(sender).Text;
h := TMaskEdit(sender).Hint;
i := POS(c,h);
// only valid choices are keyed in
if ((i > 0) OR (TMaskEdit(sender).Text = '')) then begin
// MemoUserMessages.Lines.Clear;
// PushUndoStack(GridToString());
InitPuzzle(); //Set up matrix
BadIndex := ReadInput(); // Read the data into matrix
If BadIndex = 0 Then begin
LoadCellHints();
end else begin
beep;
ClearCellHints();
LblRC.Caption := 'ERR@Cell ('+IntToStr(GetRow(BadIndex))+','+
IntToStr(GetCol(BadIndex))+')';
PanelPossibleChoices.Caption := '';
UserMessage('Invalid input data. Problem with ('+
IntToStr(GetRow(BadIndex))+','+
IntToStr(GetCol(BadIndex))+')');
end;
Perform(WM_NEXTDLGCTL, 0, 0);
end else begin
if (TMaskEdit(sender).Text <> '') then begin
TMaskEdit(sender).Text := '';
beep;
end;
end;
end;
end;
procedure TMainForm.EdtCellEnter(Sender: TObject);
VAR
i, idx, cnt: Integer;
MyRow,MyCol,MyBox: Integer;
begin
idx := GetCellIndex(TMaskEdit(sender).Name);
CheatingForCellNo := idx;
cnt := CountPossibles(idx);
ActCheat.Enabled := ((cnt > 1) OR
((GetSquare(idx) = 0) AND (cnt = 1)) );
PopUpCellCheat.Enabled := ActCheat.Enabled;
MyRow := Squares[idx].nRow;
MyCol := Squares[idx].nCol;
MyBox := Squares[idx].nBox;
LblRC.Caption := 'Cell ('+IntToStr(MyRow)+','+IntToStr(MyCol)+')';
PanelPossibleChoices.Caption := TMaskEdit(Sender).Hint;
// for each cell in same column,row and box set color
// or reset background color
for i:= 1 to cMaxCells do begin
if MyRow = Squares[i].nRow then begin //same row
TMaskEdit(GridSudoku[i]).Color := CellColor;
end else begin
if MyCol = Squares[i].nCol then begin //same row
TMaskEdit(GridSudoku[i]).Color := CellColor;
end else begin
if MyBox = Squares[i].nBox then begin //same row
TMaskEdit(GridSudoku[i]).Color := CellColor;
end else begin
TMaskEdit(GridSudoku[i]).Color := clWindow;
end;
end;
end;
end; // for i
end;
procedure TMainForm.EdtCellExit(Sender: TObject);
begin
CheatingForCellNo := 0;
ActCheat.Enabled := False;
PopUpCellCheat.Enabled := ActCheat.Enabled;
end;
procedure TMainForm.EdtCellKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
VAR
{ BadIndex: Integer;
c,h: String; }
i: Integer;
begin
i := GetCellIndex(TMaskEdit(sender).Name);
case key of
vk_LEFT: begin
DEC(i);
if i < 1 then begin
i := cMaxCells;
end;
TMaskEdit(GridSudoku[i]).SetFocus;
end;
vk_RIGHT: begin
INC(i);
if i > cMaxCells then begin
i := 1;
end;
TMaskEdit(GridSudoku[i]).SetFocus;
end;
vk_UP: begin
i := i - ncSIZE;
if i < 1 then begin
i := cMaxCells + i;
end;
TMaskEdit(GridSudoku[i]).SetFocus;
end;
vk_DOWN: begin
i := i + ncSIZE;
if i > cMaxCells then begin
i := i - cMaxCells;
end;
TMaskEdit(GridSudoku[i]).SetFocus;
end;
Else begin
i := 0;
end;
end; // end;
// TMaskEdit(GridSudoku[i]).SetFocus;
{ if NOT(LoadingORSolving) then begin // disable during processing
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -