main.pas

用于开发税务票据管理的软件

    Chessboard1.BlackSquareColour := dlgColour.Color;

  if Chessboard1.TimeLimitEnabled then UnpauseGame;
end;

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

  dlgColour.Color := Chessboard1.BackgroundColour;
  if dlgColour.Execute then
  begin
    Chessboard1.BackgroundColour := dlgColour.Color;
    if Chessboard1.GameRunning = False then
      Color := Chessboard1.BackgroundColour;
  end;

  if Chessboard1.TimeLimitEnabled then UnpauseGame;
end;

procedure TfrmMain.mnuShowValidMoves2Click(Sender: TObject);
begin
  mnuShowValidMoves1Click(Sender);
end;

procedure TfrmMain.popBoardPopupPopup(Sender: TObject);
begin
  mnuShowValidMoves2.Checked := mnuShowValidMoves1.Checked;
  mnuUndo2.Enabled := Chessboard1.UndoPossible;
  mnuRedo2.Enabled := Chessboard1.RedoPossible;
end;

procedure TfrmMain.mnuShowValidMoves1Click(Sender: TObject);
begin
  mnuShowValidMoves1.Checked := not mnuShowValidMoves1.Checked;
  Chessboard1.ShowValidMovesMode := mnuShowValidMoves1.Checked;
  if not mnuShowValidMoves1.Checked then Chessboard1.Invalidate;
end;

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

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

  if Chessboard1.TimeLimitEnabled then UnpauseGame;
end;

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

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

  if Chessboard1.TimeLimitEnabled then UnpauseGame;
end;

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

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

  if Chessboard1.TimeLimitEnabled then UnpauseGame;
end;

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

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

  if Chessboard1.TimeLimitEnabled then UnpauseGame;
end;

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

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

  if Chessboard1.TimeLimitEnabled then UnpauseGame;
end;

procedure TfrmMain.mnuIndex1Click(Sender: TObject);
begin
  Application.HelpCommand(HELP_INDEX, 0);
end;

procedure TfrmMain.Chessboard1TimeLoss(Loser: TColour; var ResetGame: Boolean);
begin
  if Loser = cWhite then
    ShowMessage('Black wins on time!')
  else
    ShowMessage('White wins on time!');

  if ResetBoardOnGameEnd then
  begin
    ResetGame := True;
    ResetEverything(False);
  end
  else
    SetInterface(False);
end;

procedure TfrmMain.mnuFilterPieces1Click(Sender: TObject);
begin
  mnuFilterPieces1.Checked := not mnuFilterPieces1.Checked;
  Chessboard1.SmoothPieces := mnuFilterPieces1.Checked;
  Chessboard1.Refresh;
end;

procedure TfrmMain.Chessboard1Draw(Stalemate, Repetition: Boolean; var ResetGame: Boolean);
begin
  if Stalemate then
    MessageDlg('The game has been drawn since it is in stalemate', mtInformation, [mbOK], 0)
  else
    MessageDlg('You have repeated the same position 3 times - the game is therefore a draw',
               mtInformation, [mbOK], 0);

  if ResetBoardOnGameEnd then
  begin
    ResetGame := True;
    ResetEverything(False);
  end
  else
    SetInterface(False);
end;

procedure TfrmMain.Chessboard1Checkmate(Winner: TColour; var ResetGame: Boolean);
var
  S: ShortString;
begin
  S := 'Well done ';
  if Winner = cWhite then S := S + 'White, ' else S := S + 'Black, ';
  S := S + 'you''ve managed to get checkmate.  You win!';
  MessageDlg(S, mtInformation, [mbOK], 0);

  if ResetBoardOnGameEnd then
  begin
    ResetGame := True;
    ResetEverything(False);
  end
  else
    SetInterface(False);
end;

procedure TfrmMain.UpdateUndoRedo;
begin
  mnuRedo1.Enabled := ChessBoard1.RedoPossible;
  mnuUndo1.Enabled := ChessBoard1.UndoPossible;
  btnRedo.Enabled := mnuRedo1.Enabled;
  btnUndo.Enabled := mnuUndo1.Enabled;

  if not mnuRedo1.Enabled then
    RedoStrings.Clear;
end;

procedure TfrmMain.tmrGameTimeTimer(Sender: TObject);
var
  Val: Cardinal;
begin
  Val := Chessboard1.TimeWhite;
  sbrStatusBar.Panels[0].Text := Format('White: %d:%.2d', [Val div 60, Val mod 60]);
  Val := Chessboard1.TimeBlack;
  sbrStatusBar.Panels[1].Text := Format('Black: %d:%.2d', [Val div 60, Val mod 60]);
end;

procedure TfrmMain.mnuTimeLimit1Click(Sender: TObject);
var
  S: String;
  Val: Cardinal;
  ClickedOK: Boolean;
begin
  Val := Chessboard1.TimeLimit div 60;
  S := IntToStr(Val);

  repeat
    ClickedOK := InputQuery('Time Limit', 'Please enter the time for each side (in minutes)', S);
    if not ClickedOK then Exit;

    try
      Val := StrToInt(S);
      if Val < 1 then
        MessageDlg('You''ve got to enter at least one minute of time.  Be sensible!',
                  mtInformation, [mbOK], 0);
    except
      Val := 0;
      MessageDlg('Please enter a valid whole number', mtError, [mbOK], 0);
    end;

  until (not ClickedOK) or (ClickedOK and (Val >= 1));

  if ClickedOK then
  begin
    Chessboard1.TimeLimit := Val * 60;
    if mnuTimeLimitEnabled1.Checked = False then
      if MessageDlg('Do you want to enable the time limit?',
                     mtConfirmation, [mbYes, mbNo], 0) = mrYes then
        mnuTimeLimitEnabled1Click(Self);
  end;
end;

procedure TfrmMain.mnuTimeLimitEnabled1Click(Sender: TObject);
begin
  mnuTimeLimitEnabled1.Checked := not mnuTimeLimitEnabled1.Checked;
  Chessboard1.TimeLimitEnabled := mnuTimeLimitEnabled1.Checked;
end;

procedure TfrmMain.SetInterface(Val: Boolean);
var
  iter: Integer;
begin
  for iter := 0 to ComponentCount - 1 do
    if (Components[iter] is TToolButton) then
    begin
      with (Components[iter] as TToolButton) do
        if Tag = -1 then Enabled := Val;
    end
    else
    if (Components[iter] is TMenuItem) then
    begin
      with (Components[iter] as TMenuItem) do
        if Tag = -1 then Enabled := Val;
    end;

  btnSaveMoves.Enabled := Val;
  mnuTimeLimit1.Enabled := not Val;
  mnuTimeLimitEnabled1.Enabled := not Val;
  mnuPauseGame1.Enabled := not Val;

  if Val = False then
  begin
    Caption := 'Chess';
    lblCheck.Visible := False;
  end;
  UpdateUndoRedo;
end;

procedure TfrmMain.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if Key = VK_ESCAPE then
    Close;
end;

procedure TfrmMain.mnuShowTimeLeft1Click(Sender: TObject);
begin
  frmTimeLeft := TfrmTimeLeft.Create(Application);
  with frmTimeLeft do
  try
    PauseGame;

    cggTimeWhite.Max := Chessboard1.TimeLimit;
    cggTimeWhite.Value := Chessboard1.TimeWhite;
    cggTimeBlack.Max := Chessboard1.TimeLimit;
    frmTimeLeft.cggTimeBlack.Value := Chessboard1.TimeBlack;
    ggeTimeWhite.MaxValue := cggTimeWhite.Max;
    ggeTimeBlack.MaxValue := cggTimeBlack.Max;
    ggeTimeWhite.Progress := cggTimeWhite.Value;
    ggeTimeBlack.Progress := cggTimeBlack.Value;
    ShowModal;
  finally
    UnpauseGame;
    Free;
  end;
end;

procedure TfrmMain.popUndoPopup(Sender: TObject);
var
  iter: Integer;
  Menu: TMenuItem;
begin
  for iter := memMoveList.Lines.Count-1 downto memMoveList.Lines.Count-10 do
  begin
    Menu := GetMenuNumber(popUndo, memMoveList.Lines.Count-iter);
    Assert(Menu <> nil);
    if iter < 0 then
      Menu.Visible := False
    else
    begin
      Menu.Visible := True;
      Menu.Caption := memMoveList.Lines[iter];
    end;
  end;
end;

function TfrmMain.GetMenuNumber(WantedMenu: TPopupMenu; MenuTag: Integer): TMenuItem;
var
  iter: Integer;
begin
  for iter := 0 to WantedMenu.Items.Count - 1 do
    if WantedMenu.Items[iter].Tag = menuTag then
    begin
      Result := WantedMenu.Items[iter];
      Exit;
    end;

  Result := nil;
end;

procedure TfrmMain.mnuUndoPos1Click(Sender: TObject);
var
  iter: Integer;
begin
  memMoveList.Lines.BeginUpdate;
  try
    memMoveList.Perform(EM_HIDESELECTION, 1, 0);
    for iter := 0 to TMenuItem(Sender).Tag-1 do
      if Chessboard1.Undo then
      begin
        RedoStrings.Add(memMoveList.Lines[memMoveList.Lines.Count-1]);
        memMoveList.Lines.Delete(memMoveList.Lines.Count - 1);
      end;
  finally
    memMoveList.Lines.EndUpdate;
    memMoveList.Perform(EM_HIDESELECTION, 0, 0);
  end;

  if Chessboard1.Turn = 1 then
    lblTurn.Caption := 'WHITE to move'
  else
    lblTurn.Caption := 'BLACK to move';

  lblCheck.Visible := Chessboard1.Check;

  UpdateUndoRedo;
end;

procedure TfrmMain.mnuRedoPos1Click(Sender: TObject);
var
  iter: Integer;
begin
  memMoveList.Lines.BeginUpdate;
  try
    for iter := 0 to TMenuItem(Sender).Tag - 1 do
      if Chessboard1.RedoPossible then
      begin
        Chessboard1.Redo;
//        RedoStrings.Delete(RedoStrings.Count - 1);
      end;
  finally
    memMoveList.Lines.EndUpdate;
  end;

  UpdateUndoRedo;
end;

procedure TfrmMain.popRedoPopup(Sender: TObject);
var
  iter: Integer;
  Menu: TMenuItem;
begin
  for iter := RedoStrings.Count-1 downto RedoStrings.Count - 10 do
  begin
    Menu := GetMenuNumber(popRedo, RedoStrings.Count-iter);
    if iter < 0 then
      Menu.Visible := False
    else
    begin
      Menu.Visible := True;
      Menu.Caption := RedoStrings[iter];
    end;

  end;
end;

procedure TfrmMain.mnuUndo1Click(Sender: TObject);
begin
  if Chessboard1.UndoPossible then
  begin
    RedoStrings.Add(memMoveList.Lines[memMoveList.Lines.Count-1]);
    memMoveList.Lines.Delete(memMoveList.Lines.Count - 1);