⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 mainfrm.pas

📁 Sudoku is a logic-based number placement puzzle. A deceptively simple game of logic, Sudoku is puzzl
💻 PAS
📖 第 1 页 / 共 4 页
字号:
       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 + -