main.pas

来自「用于开发税务票据管理的软件」· PAS 代码 · 共 1,529 行 · 第 1/4 页

  RedoStrings.Clear;
end;

procedure TfrmMain.mnuLoad1Click(Sender: TObject);
begin
  if dlgOpenGame.Execute then
    LoadGame(dlgOpenGame.FileName);
end;

procedure TfrmMain.LoadGame(const FileName: String);
begin
  RedoStrings.Clear;
  memMoveList.Clear;
  memMoveList.Lines.BeginUpdate;
  try
    if not Chessboard1.LoadGame(FileName) then Exit;

    AddToFileHistory(FileName);
    Caption := 'Chess - [' + ExtractFileName(FileName) + ']';
    GameName := FileName;
    if Chessboard1.Turn = 0 then
      lblTurn.Caption := 'BLACK to move'
    else
      lblTurn.Caption := 'WHITE to move';
    SetInterface(True);
    lblCheck.Visible := Chessboard1.Check;
    UpdateUndoRedo;
  finally
    memMoveList.Lines.EndUpdate;
  end;
end;

procedure TfrmMain.mnuSaveAs1Click(Sender: TObject);
begin
  if memMoveList.Lines.Count = 0 then
  begin
    MessageDlg('There have been no moves yet!', mtInformation, [mbOK], 0);
    Exit;
  end
  else
    if Chessboard1.TimeLimitEnabled then PauseGame;

    if dlgSaveGame.Execute then
    begin
      Chessboard1.SaveGame(dlgSaveGame.FileName);
      SavedBefore := True;
      GameName := dlgSaveGame.FileName;
      AddToFileHistory(GameName);
      Caption := 'Chess - [' + ExtractFileName(GameName) + ']';
    end;

    if Chessboard1.TimeLimitEnabled then UnpauseGame;
end;

procedure TfrmMain.mnuSave1Click(Sender: TObject);
begin
  if SavedBefore then
    Chessboard1.SaveGame(GameName)
  else
    mnuSaveAs1Click(Self);
end;

procedure TfrmMain.FormCreate(Sender: TObject);
var
  i: TRegIniFile;
  iter: Integer;
begin
//  Application.HintPause := 0;
  Application.OnHint := AppHint;

  ShowMovesWarning := True;
  RedoStrings := TStringList.Create;

  i := TRegIniFile.Create('Software\Chess2000');

  try
    Left   := i.ReadInteger('Position', 'Left', Left);
    Top    := i.ReadInteger('Position', 'Top', Top);
    Width  := i.ReadInteger('Position', 'Width', Width);
    Height := i.ReadInteger('Position', 'Height', Height);

    if i.ReadBool('Position', 'Maximised', False) then
      WindowState := wsMaximized;

    if i.ReadBool('Board', 'DrawLines', True) <> mnuDrawGridLines1.Checked then
      mnuDrawGridLines1Click(Self);

    Chessboard1.ShowPieceHints := i.ReadBool('Board', 'ShowPieceHints', True);
    mnuShowPieceHints1.Checked := Chessboard1.ShowPieceHints;

    // Board colours
    Chessboard1.WhiteSquareColour := i.ReadInteger('Board', 'WhitesquareColour', clBtnFace);
    Chessboard1.BlackSquareColour := i.ReadInteger('Board', 'BlacksquareColour', clGray);
    Chessboard1.BackgroundColour := i.ReadInteger('Board', 'BackgroundColour', RGB(212,208,200));
    Chessboard1.HighlightColour  := i.ReadInteger('Board', 'HighlightColour', clYellow);
    Chessboard1.HighlightEnemyColour := i.ReadInteger('Board', 'HighlightEnemyColour', clRed);
    Chessboard1.GridLineColour   := i.ReadInteger('Board', 'GridLineColour', clBlack);
    Chessboard1.StartDragColour := i.ReadInteger('Board', 'StartDragColour', clYellow);
    Chessboard1.HighlightCaptureColour := i.ReadInteger('Board', 'HighlightCaptureColour', clLime);
    Chessboard1.ValidMoveDragColour := i.ReadInteger('Board', 'HighlightValidMoveDrag', clAqua);

    Color := Chessboard1.BackgroundColour;

    Chessboard1.SmoothPieces := i.ReadBool('Board', 'SmoothPieces', False);
    mnuFilterPieces1.Checked := Chessboard1.SmoothPieces;

    ShowMovesWarning := i.ReadBool('General', 'SaveAsTextWarning', True);
    SaveOnExit := i.ReadBool('General', 'SaveCurrentGame', False);
    mnuContinueLastGameOnStartup1.Checked := SaveOnExit;

    // Panel background colours
    if i.ReadBool('General', 'UseBackgroundRed', False) <> mnuUseRed1.Checked then
      mnuUseRed1Click(Self);
    if i.ReadBool('General', 'UseBackgroundGreen', True) <> mnuUseGreen1.Checked then
      mnuUseGreen1Click(Self);
    if i.ReadBool('General', 'UseBackgroundBlue', True) <> mnuUseBlue1.Checked then
      mnuUseBlue1Click(Self);

    try
      bgndFancy.Direction := TFillDirection(i.ReadInteger('General', 'BackgroundDir', 2));

      case bgndFancy.Direction of
        drLeftRight : mnuLeftRight1Click( mnuLeftRight1);
        drRightLeft : mnuLeftRight1Click( mnuRightLeft1);
        drUpDown    : mnuLeftRight1Click( mnuUpDown1);
        drDownUp    : mnuLeftRight1Click( mnuDownUp1);
      end;
    except
      bgndFancy.Direction := drUpDown;
    end;

    if i.ReadBool('General', 'HighlightSquares', True) = False then
      mnuHighlightSquares1Click(Self);

    Chessboard1.TimeLimit := i.ReadInteger('General', 'TimeLimit', Chessboard1.TimeLimit);
    Chessboard1.TimeLimitEnabled := i.ReadBool('General', 'TimeLimitEnabled', False);
    mnuTimeLimitEnabled1.Checked := Chessboard1.TimeLimitEnabled;

    Chessboard1.PieceFilter := i.ReadString('General', 'PieceFilter', 'blur');
    Chessboard1.HighlightStartSquare := i.ReadBool('General', 'HighlightDragStartSquare', True);
    mnuHighlightDragStartSquare1.Checked := Chessboard1.HighlightStartSquare;

    PauseGameOnDialogue := i.ReadBool('General', 'PauseGameOnDialogue', True);
    mnuPauseGame1.Checked := PauseGameOnDialogue;
    
    ResetBoardOnGameEnd := i.ReadBool('General', 'ResetBoardOnGameEnd', False);
    mnuResetBoardOnGameEnd1.Checked := ResetBoardOnGameEnd;

    // Load the file history
    for iter := 0 to High(FileHistory) do
      FileHistory[iter] := i.ReadString('General', Format('FileHistory%d',[iter]), '(Empty)');

    if ParamCount > 0 then
      LoadGame(ParamStr(1))
    else
    if SaveOnExit then
      if FileExists('lastgame.sav') then
        LoadGame('lastgame.sav');
  finally
    i.Free;
  end;

  DragAcceptFiles(Handle, True);
end;

procedure TfrmMain.FormClose(Sender: TObject; var Action: TCloseAction);
var
  i: TRegIniFile;
  iter: Integer;
begin
  i := TRegIniFile.Create('Software\Chess2000');

  try
    { Save form position }
    i.WriteBool('Position', 'Maximised', WindowState = wsMaximized);
    if WindowState = wsMaximized then WindowState := wsNormal;

    i.WriteInteger('Position', 'Left', Left);
    i.WriteInteger('Position', 'Top', Top);
    i.WriteInteger('Position', 'Width', Width);
    i.WriteInteger('Position', 'Height', Height);

    { Save chessboard things }
    i.WriteBool('Board', 'DrawLines', Chessboard1.DrawLines);
    i.WriteBool('Board', 'ShowPieceHints', Chessboard1.ShowPieceHints);
    i.WriteBool('Board', 'SmoothPieces', Chessboard1.SmoothPieces);
    i.WriteInteger('Board', 'WhitesquareColour', ColorToRGB(Chessboard1.WhiteSquareColour));
    i.WriteInteger('Board', 'BlacksquareColour', ColorToRGB(Chessboard1.BlackSquareColour));
    i.WriteInteger('Board', 'BackgroundColour', ColorToRGB(Chessboard1.BackgroundColour));
    i.WriteInteger('Board', 'HighlightColour', ColorToRGB(Chessboard1.HighlightColour));
    i.WriteInteger('Board', 'HighlightEnemyColour', ColorToRGB(Chessboard1.HighlightEnemyColour));
    i.WriteInteger('Board', 'GridLineColour', ColorToRGB(Chessboard1.GridLineColour));
    i.WriteInteger('Board', 'StartDragColour', ColorToRGB(Chessboard1.StartDragColour));
    i.WriteInteger('Board', 'HighlightCaptureColour', ColorToRGB(Chessboard1.HighlightCaptureColour));
    i.WriteInteger('Board', 'HighlightValidMoveDrag', ColorToRGB(Chessboard1.ValidMoveDragColour));

    i.WriteBool('General', 'SaveAsTextWarning', ShowMovesWarning);

    if SaveOnExit and Chessboard1.GameRunning then
      if memMoveList.Lines.Count > 0 then
        Chessboard1.SaveGame('lastgame.sav');

    i.WriteBool('General', 'SaveCurrentGame', SaveOnExit);
    i.WriteBool('General', 'UseBackgroundRed', bgndFancy.ChangeRColour);
    i.WriteBool('General', 'UseBackgroundGreen', bgndFancy.ChangeBColour);
    i.WriteBool('General', 'UseBackgroundBlue', bgndFancy.ChangeBColour);
    i.WriteInteger('General', 'BackgroundDir', Integer(bgndFancy.Direction));

    i.WriteBool('General', 'HighlightSquares', Chessboard1.ShowSquareHighlights);

    i.WriteBool('General', 'TimeLimitEnabled', mnuTimeLimitEnabled1.Checked);
    i.WriteInteger('General', 'TimeLimit', Chessboard1.TimeLimit);
    i.WriteBool('General', 'HighlightDragStartSquare', Chessboard1.HighlightStartSquare);
    i.WriteBool('General', 'PauseGameOnDialogue', PauseGameOnDialogue);

    i.WriteBool('General', 'ResetBoardOnGameEnd', ResetBoardOnGameEnd);

    // Save the file history
    for iter := 0 to High(FileHistory) do
      i.WriteString('General', Format('FileHistory%d',[iter]), FileHistory[iter]);

    i.WriteString('General', 'PieceFilter', Chessboard1.PieceFilter);
  finally
    i.Free;
  end;
end;

procedure TfrmMain.FormDestroy(Sender: TObject);
begin
  DragAcceptFiles(Handle, False);
  RedoStrings.Free;
end;

procedure TfrmMain.Chessboard1EndTurn(MovedPiece: TPiece; const From,
  WhereTo: TPoint; SpecialCases: TSetOfSpecials);
var
  Move: ShortString;
begin
  if Chessboard1.Turn = 1 then
    lblTurn.Caption := 'WHITE to move'
  else
    lblTurn.Caption := 'BLACK to move';

  UpdateUndoRedo;
  if Chessboard1.RedoPossible then
  begin
    if RedoStrings.Count > 0 then
    RedoStrings.Delete(RedoStrings.Count - 1);
  end;

  Move := '';
  { If black moved then add a tab character first }
  if Chessboard1.Turn = 1 then Move := Move + #9;
  Move := Move + IntToStr(Chessboard1.TurnNumber) + '. ';

  { Checks for castling }
  if (spKingsideCastling in SpecialCases) or (spQueenSideCastling in SpecialCases) then
  begin
    Move := Move + '0-0';
    if spQueenSideCastling in SpecialCases then Move := Move + '-0';
    memMoveList.Lines.Add(Move);
    Exit;
  end;

  if not (spPromoting in SpecialCases) then
    if MovedPiece.Hint <> 'Pawn' then
      Move := Move + MovedPiece.GetPrefix;

  if (spCapture in SpecialCases) or (spEnPassant in SpecialCases) then
  begin
    { if pawn captured, need a prefix (so it doesn't say, for example, "xb4") }
    if (MovedPiece.Hint = 'Pawn') or (spPromoting in SpecialCases) then
      Move := Move + Chr(From.X + 96);
    Move := Move + 'x';
  end;
  { This converts the number (1-8) into file letter (a-f) }
  Move := Move + Chr(WhereTo.X + 96);
  Move := Move + IntToStr(WhereTo.Y);

  if (spPromoting in SpecialCases) then
    Move := Move + '(' + MovedPiece.GetPrefix + ')';

  if spEnPassant in SpecialCases then
    Move := Move + ' e.p.';

  if spCheck in SpecialCases then
  begin
    Move := Move + '+';
    lblCheck.Visible := True;
  end
  else
    lblCheck.Visible := False;

  memMoveList.Lines.Add(Move);
end;

procedure TfrmMain.mnuNew1Click(Sender: TObject);
begin
  if (mnuPlayer1Human1.Checked) and (mnuPlayer2Human1.Checked) and
     (Chessboard1.GameRunning) then
    if ResignCheck(False) = False then
      Exit;

  ResetEverything(True);
end;

procedure TfrmMain.SaveMovesbtnClick(Sender: TObject);
var
  DoIt: word;
begin
  if memMoveList.Lines.Count = 0 then
  begin
    MessageDlg('There have been no moves yet!', mtInformation, [mbOK], 0);
    Exit;
  end;

  if ShowMovesWarning = True then
  try
    dlgWarning := TdlgWarning.Create(Application);
    dlgWarning.ShowModal;
  finally
    DoIt := dlgWarning.ModalResult;
    ShowMovesWarning := not dlgWarning.chkWarn.Checked;
    dlgWarning.Free;
  end
  else
    DoIt := mrOK;

  if DoIt = mrOK then
    if dlgSaveText.Execute then
      memMoveList.Lines.SaveToFile(dlgSaveText.FileName);
end;

procedure TfrmMain.mnuAskforDraw1Click(Sender: TObject);
begin
  // CODE TO ASK FOR A DRAW
  if Chessboard1.GameRunning then
    if MessageDlg('Do you want to call the game a draw?', mtInformation, [mbYes, mbNo], 0) = mrYes then
    begin
      if ResetBoardOnGameEnd then
        ResetEverything(True)
      else
      begin
        Chessboard1.FinishCurrentGame;
        SetInterface(False);
      end;
    end;
end;

procedure TfrmMain.mnuPositionMode1Click(Sender: TObject);
begin
  mnuPositionMode1.Checked := not mnuPositionMode1.Checked;
  Chessboard1.PositionMode := mnuPositionMode1.Checked;
end;

procedure TfrmMain.mnuHighlightPotentialCapture1Click(Sender: TObject);
begin
  if Chessboard1.TimeLimitEnabled then PauseGame;

  dlgColour.Color := Chessboard1.HighlightCaptureColour;
  if dlgColour.Execute then
    Chessboard1.HighlightCaptureColour := dlgColour.Color;

  if Chessboard1.TimeLimitEnabled then UnpauseGame;
end;

procedure TfrmMain.WhiteSquareColour1Click(Sender: TObject);
begin
  if Chessboard1.TimeLimitEnabled then PauseGame;

  dlgColour.Color := Chessboard1.WhiteSquareColour;
  if dlgColour.Execute then
    Chessboard1.WhiteSquareColour := dlgColour.Color;

  if Chessboard1.TimeLimitEnabled then UnpauseGame;
end;

procedure TfrmMain.BlackSquareColour1Click(Sender: TObject);
begin
  if Chessboard1.TimeLimitEnabled then PauseGame;

  dlgColour.Color := Chessboard1.BlackSquareColour;
  if dlgColour.Execute then