mainfrm.pas

Sudoku is a logic-based number placement puzzle. A deceptively simple game of logic, Sudoku is puzzl

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