?? mainfrm.pas
字號(hào):
unit MainFrm;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ComCtrls, ActnList, StdCtrls, Grids,ExtCtrls, Menus,
IniFiles, Mask, StrUtils, Gauges;
CONST
ncSIZE = 9;
cMaxCells = (ncSIZE * ncSIZE);
//' Indexes to guesses we've already tried (hopefully not too many)
ncGUESSEDMAX = 50; //' arbitrary number
CellColor = $00D9D9FF;
Type
udtSQUARE = record // could be smallint or byte rather than integers!
Value: Integer; // ' 0=not set, else value 1..9
Possibles: Array [1..ncSIZE] OF Integer;// ' 1=possible, 0=not possible -- use boolean!
GuessLevel: Integer; // ' 0=firm, else level of guess 1,2,3,...
Given: Boolean; // ' True if given in problem
nRow: Integer; // ' For fast lookup. Set by InitPuzzle
nCol: Integer; // ' ditto
nBox: Integer; // ' ditto
end;
type
TMainForm = class(TForm)
ActionList: TActionList;
StatusBar: TStatusBar;
ActSolve: TAction;
ActClearGrid: TAction;
Panel1: TPanel;
MainMenu: TMainMenu;
MnuFile: TMenuItem;
ActExit: TAction;
MnuFileFadeOnExit: TMenuItem;
Exit1: TMenuItem;
N1: TMenuItem;
ActOpenFile: TAction;
ActSaveFile: TAction;
Open1: TMenuItem;
Save1: TMenuItem;
OpenDlg: TOpenDialog;
PanelMajorCells: TPanel;
PanelCells: TPanel;
EdtCell1: TMaskEdit;
EdtCell2: TMaskEdit;
EdtCell3: TMaskEdit;
EdtCell10: TMaskEdit;
EdtCell11: TMaskEdit;
EdtCell12: TMaskEdit;
EdtCell19: TMaskEdit;
EdtCell20: TMaskEdit;
EdtCell21: TMaskEdit;
EdtCell28: TMaskEdit;
EdtCell29: TMaskEdit;
EdtCell30: TMaskEdit;
EdtCell37: TMaskEdit;
EdtCell38: TMaskEdit;
EdtCell39: TMaskEdit;
EdtCell46: TMaskEdit;
EdtCell47: TMaskEdit;
EdtCell48: TMaskEdit;
EdtCell55: TMaskEdit;
EdtCell56: TMaskEdit;
EdtCell57: TMaskEdit;
EdtCell64: TMaskEdit;
EdtCell65: TMaskEdit;
EdtCell66: TMaskEdit;
EdtCell73: TMaskEdit;
EdtCell74: TMaskEdit;
EdtCell75: TMaskEdit;
EdtCell7: TMaskEdit;
EdtCell8: TMaskEdit;
EdtCell9: TMaskEdit;
EdtCell16: TMaskEdit;
EdtCell17: TMaskEdit;
EdtCell18: TMaskEdit;
EdtCell25: TMaskEdit;
EdtCell26: TMaskEdit;
EdtCell27: TMaskEdit;
EdtCell61: TMaskEdit;
EdtCell62: TMaskEdit;
EdtCell63: TMaskEdit;
EdtCell70: TMaskEdit;
EdtCell71: TMaskEdit;
EdtCell72: TMaskEdit;
EdtCell79: TMaskEdit;
EdtCell80: TMaskEdit;
EdtCell81: TMaskEdit;
EdtCell34: TMaskEdit;
EdtCell35: TMaskEdit;
EdtCell36: TMaskEdit;
EdtCell43: TMaskEdit;
EdtCell44: TMaskEdit;
EdtCell45: TMaskEdit;
EdtCell52: TMaskEdit;
EdtCell53: TMaskEdit;
EdtCell54: TMaskEdit;
EdtCell4: TMaskEdit;
EdtCell5: TMaskEdit;
EdtCell6: TMaskEdit;
EdtCell13: TMaskEdit;
EdtCell14: TMaskEdit;
EdtCell15: TMaskEdit;
EdtCell22: TMaskEdit;
EdtCell23: TMaskEdit;
EdtCell24: TMaskEdit;
EdtCell58: TMaskEdit;
EdtCell59: TMaskEdit;
EdtCell60: TMaskEdit;
EdtCell67: TMaskEdit;
EdtCell68: TMaskEdit;
EdtCell69: TMaskEdit;
EdtCell76: TMaskEdit;
EdtCell77: TMaskEdit;
EdtCell78: TMaskEdit;
EdtCell31: TMaskEdit;
EdtCell32: TMaskEdit;
EdtCell33: TMaskEdit;
EdtCell40: TMaskEdit;
EdtCell41: TMaskEdit;
EdtCell42: TMaskEdit;
EdtCell49: TMaskEdit;
EdtCell50: TMaskEdit;
EdtCell51: TMaskEdit;
Panel3: TPanel;
Label10: TLabel;
Label11: TLabel;
Label12: TLabel;
Label13: TLabel;
Label14: TLabel;
Label15: TLabel;
Label16: TLabel;
Label17: TLabel;
Label18: TLabel;
Panel2: TPanel;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
Label5: TLabel;
Label6: TLabel;
Label7: TLabel;
Label8: TLabel;
Label9: TLabel;
SaveDlg: TSaveDialog;
ActReloadFile: TAction;
Reload1: TMenuItem;
ActPrintSolution: TAction;
Print1: TMenuItem;
N2: TMenuItem;
MnuFileVisualize: TMenuItem;
GgIterations: TGauge;
GgDepth: TGauge;
PanelGauges: TPanel;
PanelDNo: TPanel;
PaneliNo: TPanel;
PaneliiNo: TPanel;
PanelIterationsInfo: TPanel;
PanelDDNo: TPanel;
PanelDepthInfo: TPanel;
Panel4: TPanel;
Panel5: TPanel;
Panel6: TPanel;
Panel7: TPanel;
Panel8: TPanel;
Panel9: TPanel;
BtnMySolve: TButton;
Button1: TButton;
Panel10: TPanel;
GbxChoices: TGroupBox;
LblRC: TLabel;
PanelPossibleChoices: TPanel;
PopUpCell: TPopupMenu;
PopUpCellCheat: TMenuItem;
ActCheat: TAction;
Panel11: TPanel;
Options1: TMenuItem;
Reports1: TMenuItem;
Cheat1: TMenuItem;
ActUndo: TAction;
Undo1: TMenuItem;
procedure ActSolveExecute(Sender: TObject);
procedure ActClearGridExecute(Sender: TObject);
procedure ActExitExecute(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormCreate(Sender: TObject);
procedure MnuFileFadeOnExitClick(Sender: TObject);
procedure ActOpenFileExecute(Sender: TObject);
procedure ActSaveFileExecute(Sender: TObject);
procedure FormKeyPress(Sender: TObject; var Key: Char);
procedure EdtCellChange(Sender: TObject);
procedure EdtCellKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
procedure EdtCellEnter(Sender: TObject);
procedure ActReloadFileExecute(Sender: TObject);
procedure ActPrintSolutionExecute(Sender: TObject);
procedure MnuFileVisualizeClick(Sender: TObject);
procedure PopUpCellCheatClick(Sender: TObject);
procedure ActCheatExecute(Sender: TObject);
procedure EdtCellExit(Sender: TObject);
procedure EdtCellKeyPress(Sender: TObject; var Key: Char);
procedure ActUndoExecute(Sender: TObject);
private
{ Private declarations }
Cheating: Boolean;
CheatingForCellNo: Integer;
LastSudokuFile: String;
LoadingORSolving: Boolean;
VisualDelay: Integer;
mnGuessLevel: Integer; // Global level at which we're guessing (0=firm)
rIterations, rDepth, rMaxDepth: Integer;
UndoStr: String;
Function CheatCellIndex(idx:Integer):Integer;
Function GetCellIndex(edtName:String):Integer;
Function GetWindowsDirectory(): string;
Function GetUserName(): string;
function PopUndoStack():String;
Function SquaresToString():String;
procedure GetIniSettings();
procedure LoadCellHints();
procedure ClearCellHints();
procedure ClearUndoStack();
procedure PushUndoStack(s:String);
procedure PutIniSettings();
Procedure ReloadSqauresFromString(gridStr:String);
Procedure ReloadGridFromString(gridStr:String);
Procedure LoadFile(fn:String);
Procedure UserMessage(msg:String);
public
{ Public declarations }
ExeBaseName: String;
ExeDirPath: String;
UserID: String;
WinDirPath: String;
GridSudoku: TList;
Squares: Array [1..(ncSIZE * ncSIZE)] of udtSQUARE; // Store matrix in a linear array
Guessed: Array [1..ncGUESSEDMAX] of Integer;
mnDifficulty: Integer; //' Difficulty level
// Function AlreadyGuessed(idx:Integer):Boolean;
Function CountPossibles(idx:Integer):Integer;
// Function FindMinPossibles():Integer;
Function GetIndex(iRow, iCol:Integer):Integer;
Function GetRow(idx:Integer):Integer;
Function GetCol(idx:Integer):Integer;
Function GetBox(idx:Integer):Integer;
Function GridToString():String;
Function InThisCol(TheValue, Idx:Integer):Boolean;
Function InThisRow(TheValue, Idx:Integer):Boolean;
Function InThisBox(TheValue, Idx:Integer):Boolean;
Function IsDataOK():Integer;
Function MissingValues():Integer;
Function PossiblesInBox(TheValue, nBox:Integer; VAR FoundAt:Integer):Integer;
Function PossiblesInCol(TheValue, nCol:Integer; VAR FoundAt:Integer):Integer;
Function PossiblesInRow(TheValue, nRow:Integer; VAR FoundAt:Integer):Integer;
Function ReadInput():Integer;
// Function SetSquareRC(iValue,iRow,iCol:Integer; IsGiven:Boolean):Boolean;
Function TheNthPossible(idx, nth:Integer):Integer;
Function ThePossible(idx:Integer):Integer;
Function TryEachBox():Boolean;
Function TryEachCol():Boolean;
// Function TryGuess():Boolean;
Function TryEachRow():Boolean;
// Function TrySolve():Boolean;
Function SetKnownValues():Boolean;
Function SetSquare(iValue, Idx:Integer):Boolean;
//
// Procedure DoPuzzle();
Procedure FillInResults();
Procedure InitPuzzle();
// Procedure UndoGuess(Lvl:Integer);
//
Function CellWithLowestPossibles():Integer;
Function GetSquare(Idx:Integer):Integer;
Function SolveThePuzzle():Integer;
Function MYMissingValues():Integer;
Procedure MYDoPuzzle();
Procedure SetAllKnownCells();
end;
var
MainForm: TMainForm;
implementation
uses SplashScr, QRGridSolution;
{$R *.dfm}
Procedure TMainForm.UserMessage(msg:String);
begin
// MemoUserMessages.Lines.Add(msg);
end;
procedure TMainForm.FormCreate(Sender: TObject);
var
AComponent: TComponent;
i: Integer;
Begin
ShortDateFormat := 'mm/dd/yyyy';
LoadingORSolving := False;
Cheating := False;
CheatingForCellNo := 0;
ExeDirPath := IncludeTrailingPathDelimiter(ExtractFilePath(paramStr(0)));
ExeBaseName := ExtractFileName(paramStr(0));
ExeBaseName := ChangeFileExt(ExeBaseName, '');
statusbar.panels[0].text := ExeBaseName;
statusbar.panels[1].text := '';
UserID := GetUserName();
statusbar.panels[2].text := UserID;
ClearUndoStack();
GetIniSettings;
GridSudoku := TList.Create;
GridSudoku.Clear;
GridSudoku.Add(EdtCell1); // set up a dummy for index[0]
// setup the array of cells/conrols (control Array)
for i := 1 to cMaxCells do begin
AComponent := FindComponent('EdtCell'+IntToStr(i)) ;
if Assigned(AComponent) then begin
GridSudoku.Add(TMaskEdit(AComponent));
TMaskEdit(AComponent).PopupMenu := PopUpCell; // manually set popmenu
end;
end; //for
InitPuzzle();
LoadCellHints();
end;
procedure TMainForm.FormClose(Sender: TObject; var Action: TCloseAction);
VAR
i, cavb: 0..255;
j: Integer;
begin
PutIniSettings;
GridSudoku.Clear;
GridSudoku.Free;
if MnuFileFadeOnExit.Checked then begin
if AlphaBlend=False then begin
AlphaBlendValue:=255;
AlphaBlend:=True;
end;
cavb:=AlphaBlendValue;
i := cavb;
J := cavb;
While j > 0 do begin
AlphaBlendValue := i;
Application.ProcessMessages;
i := i - 10;
j := j - 10;
end
end;
end;
procedure TMainForm.ActExitExecute(Sender: TObject);
begin
close;
Application.Terminate;
end;
procedure TMainForm.ActPrintSolutionExecute(Sender: TObject);
VAR
rp: TQPGridSolution;
TmpWS: TWindowState;
h: Integer;
begin
TmpWS := WindowState;
WindowState := wsMinimized;
rp := TQPGridSolution.Create(Self);
TRY
rp.ReportTitle := 'SUDOKUGRID';
rp.PreviewInitialState := wsNormal;
h := Screen.Height - 30;
rp.PreviewHeight := h;
// ratio for a 8.5 x 11 inch sheet of paper
rp.PreviewWidth := Trunc(h * 0.75);
// rp.lblCell1.Caption := '9';
rp.Preview;
finally
WindowState := tmpWS;
rp.Free;
end;
end;
function TMainForm.GetUserName(): string;
var
pUserName : PChar; //holds the user name
cUserNameSize : Cardinal; //holds the size of the user name
begin
//retrieve the required size of the user name buffer
cUserNameSize := 0;
windows.GetUserName(nil, cUserNameSize);
//allocate memory for the user name
pUserName := StrAlloc(cUserNameSize);
//retrieve the user name
if windows.GetUserName(pUserName,cUserNameSize) then
Result := pUserName
else begin
Result := '';
end;
//dispose of allocated memory
StrDispose(pUserName);
end;
function TMainForm.GetWindowsDirectory(): string;
var
myStr: Array[0..256] of Char;
Begin
Windows.GetWindowsDirectory(myStr,SizeOf(myStr));
Result := myStr;
Result := IncludeTrailingPathDelimiter(Result);
end;
// -------------------------------------------------------------------------
// -------------------------------------------------------------------------
// sudoku routines begin
// -------------------------------------------------------------------------
// -------------------------------------------------------------------------
// Returns no of possibles for This Value in this col
?? 快捷鍵說明
復(fù)制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號(hào)
Ctrl + =
減小字號(hào)
Ctrl + -