main.pas

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

unit Main;

interface

uses
  SysUtils, Windows, Messages, Classes, Graphics, Controls, ShellAPI,
  Forms, Dialogs, Menus, Buttons, ExtCtrls, StdCtrls, Board,
  Piece, Registry, ComCtrls, ToolWin, Backdrop, Richedit, ImgList;

const
  FILE_HISTORY_SIZE = 3;

type
  TfrmMain = class(TForm)
    mnuMainMenu: TMainMenu;
    mnuFile1: TMenuItem;
    mnuLoad1: TMenuItem;
    mnuSave1: TMenuItem;
    mnuSaveAs1: TMenuItem;
    mnuN1: TMenuItem;
    mnuExit1: TMenuItem;
    mnuGame1: TMenuItem;
    mnuPlayer1Human1: TMenuItem;
    mnuPlayer2Human1: TMenuItem;
    mnuN2: TMenuItem;
    mnuResign2: TMenuItem;
    mnuAskforDraw1: TMenuItem;
    mnuN3: TMenuItem;
    mnuShowValidMoves1: TMenuItem;
    mnuOptions1: TMenuItem;
    mnuHelp1: TMenuItem;
    mnuHelpContents1: TMenuItem;
    mnuN4: TMenuItem;
    mnuAboutthisprogram1: TMenuItem;
    mnuNew1: TMenuItem;
    pnllnfo: TPanel;
    dlgOpenGame: TOpenDialog;
    dlgSaveGame: TSaveDialog;
    dlgColour: TColorDialog;
    lblTurn: TLabel;
    memMoveList: TMemo;
    mnuAnalysePosition1: TMenuItem;
    lblCheck: TLabel;
    mnuDrawGridLines1: TMenuItem;
    mnuOptions2: TMenuItem;
    btnSaveMoves: TBitBtn;
    dlgSaveText: TSaveDialog;
    mnuUndo1: TMenuItem;
    mnuN5: TMenuItem;
    Chessboard1: TChessboard;
    tlbMain: TToolBar;
    btnNew: TToolButton;
    btnLoad: TToolButton;
    btnSave: TToolButton;
    btnN1: TToolButton;
    btnResign: TToolButton;
    btnDraw: TToolButton;
    btnN3: TToolButton;
    btnGrid: TToolButton;
    ilstMainToolbar: TImageList;
    btnN4: TToolButton;
    btnExit: TToolButton;
    btnOption: TToolButton;
    mnuSaveMoves1: TMenuItem;
    popBoardPopup: TPopupMenu;
    mnuPositionMode1: TMenuItem;
    btnUndo: TToolButton;
    btnN2: TToolButton;
    mnuShowValidMoves2: TMenuItem;
    mnuWhiteSquares1: TMenuItem;
    mnuBlackSquares1: TMenuItem;
    mnuBackground1: TMenuItem;
    mnuGridLines1: TMenuItem;
    mnuHighlightPiece1: TMenuItem;
    mnuHighlightEnemyPiece1: TMenuItem;
    mnuBoardColours1: TMenuItem;
    mnuN6: TMenuItem;
    mnuIndex1: TMenuItem;
    mnuFilterPieces1: TMenuItem;
    mnuBlackSquares2: TMenuItem;
    mnuBackground2: TMenuItem;
    mnuGridLines2: TMenuItem;
    mnuN7: TMenuItem;
    mnuHighlightPiece2: TMenuItem;
    mnuHighlightEnemyPiece2: TMenuItem;
    mnuWhiteSquares2: TMenuItem;
    mnuRedo1: TMenuItem;
    btnRedo: TToolButton;
    tmrGameTime: TTimer;
    mnuTimeLimit1: TMenuItem;
    mnuTimeLimitEnabled1: TMenuItem;
    mnuShowTimeLeft1: TMenuItem;
    sbrStatusBar: TStatusBar;
    popUndo: TPopupMenu;
    mnuUndoPos1: TMenuItem;
    mnuUndoPos2: TMenuItem;
    mnuUndoPos3: TMenuItem;
    mnuUndoPos4: TMenuItem;
    mnuUndoPos5: TMenuItem;
    mnuUndoPos6: TMenuItem;
    mnuUndoPos7: TMenuItem;
    mnuUndoPos8: TMenuItem;
    mnuUndoPos9: TMenuItem;
    mnuUndoPos10: TMenuItem;
    popRedo: TPopupMenu;
    mnuRedoPos1: TMenuItem;
    mnuRedoPos2: TMenuItem;
    mnuRedoPos3: TMenuItem;
    mnuRedoPos4: TMenuItem;
    mnuRedoPos5: TMenuItem;
    mnuRedoPos6: TMenuItem;
    mnuRedoPos7: TMenuItem;
    mnuRedoPos8: TMenuItem;
    mnuRedoPos9: TMenuItem;
    mnuRedoPos10: TMenuItem;
    bgndFancy: TBackdrop;
    popBgndColour: TPopupMenu;
    mnuUseRed1: TMenuItem;
    mnuUseGreen1: TMenuItem;
    mnuUseBlue1: TMenuItem;
    popToolbar: TPopupMenu;
    mnuShowTextCaptions1: TMenuItem;
    mnuShowHints1: TMenuItem;
    mnun10: TMenuItem;
    mnuDirection1: TMenuItem;
    mnuLeftRight1: TMenuItem;
    mnuRightLeft1: TMenuItem;
    mnuUpDown1: TMenuItem;
    mnuDownUp1: TMenuItem;
    mnuViewCapturedPieces1: TMenuItem;
    mnuTime1: TMenuItem;
    mnuHighlightSquares1: TMenuItem;
    mnuHighlightSquares2: TMenuItem;
    mnuSelectPieceFilter1: TMenuItem;
    mnuHighlightPotentialCapture1: TMenuItem;
    mnuHighlightPotentialCapture2: TMenuItem;
    mnuHighlightStartDrag1: TMenuItem;
    mnuHighlightStartDrag2: TMenuItem;
    mnuHighlightDragStartSquare1: TMenuItem;
    mnuHighlightCurrentMoveSquare1: TMenuItem;
    mnuHighlightCurrentMoveSquare2: TMenuItem;
    mnuGeneral1: TMenuItem;
    mnuN12: TMenuItem;
    mnuBoardColours2: TMenuItem;
    mnuHighlighting1: TMenuItem;
    mnuResetBoardOnGameEnd1: TMenuItem;
    mnuHighlightColours1: TMenuItem;
    mnuN9: TMenuItem;
    mnuPanelBackground1: TMenuItem;
    mnuDirection2: TMenuItem;
    mnuDownUp2: TMenuItem;
    mnuUpDown2: TMenuItem;
    mnuRightLeft2: TMenuItem;
    mnuLeftRight2: TMenuItem;
    mnuN8: TMenuItem;
    mnuUseRed2: TMenuItem;
    mnuUseGreen2: TMenuItem;
    mnuUseBlue2: TMenuItem;
    mnuContinueLastGameOnStartup1: TMenuItem;
    mnuN13: TMenuItem;
    mnuPauseGame1: TMenuItem;
    mnuShowPieceHints1: TMenuItem;
    mnuUndo2: TMenuItem;
    mnuRedo2: TMenuItem;
    N1: TMenuItem;
    mnuN14: TMenuItem;
    mnuFileHistory1: TMenuItem;
    mnuFileHistory2: TMenuItem;
    mnuFileHistory3: TMenuItem;
    mnuFileHistory4: TMenuItem;
    procedure mnuHelpContents1Click(Sender: TObject);
    procedure mnuExit1Click(Sender: TObject);
    procedure mnuPlayer1Human1Click(Sender: TObject);
    procedure mnuPlayer2Human1Click(Sender: TObject);
    procedure mnuDrawGridLines1Click(Sender: TObject);
    procedure mnuAboutthisprogram1Click(Sender: TObject);
    procedure mnuResign2Click(Sender: TObject);
    procedure mnuLoad1Click(Sender: TObject);
    procedure mnuSaveAs1Click(Sender: TObject);
    procedure mnuSave1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Chessboard1EndTurn(MovedPiece: TPiece; const From, WhereTo: TPoint;
      SpecialCases: TSetOfSpecials);
    procedure mnuNew1Click(Sender: TObject);
    procedure SaveMovesbtnClick(Sender: TObject);
    procedure mnuAskforDraw1Click(Sender: TObject);
    procedure mnuPositionMode1Click(Sender: TObject);
    procedure WhiteSquareColour1Click(Sender: TObject);
    procedure BlackSquareColour1Click(Sender: TObject);
    procedure BackgroundColour1Click(Sender: TObject);
    procedure mnuShowValidMoves2Click(Sender: TObject);
    procedure popBoardPopupPopup(Sender: TObject);
    procedure mnuShowValidMoves1Click(Sender: TObject);
    procedure GridLineColour1Click(Sender: TObject);
    procedure HighlightColour1Click(Sender: TObject);
    procedure HighlightEnemyColour1Click(Sender: TObject);
    procedure mnuIndex1Click(Sender: TObject);
    procedure Chessboard1TimeLoss(Loser: TColour; var ResetGame: Boolean);
    procedure mnuFilterPieces1Click(Sender: TObject);
    procedure Chessboard1Draw(Stalemate, Repetition: Boolean; var ResetGame: Boolean);
    procedure Chessboard1Checkmate(Winner: TColour; var ResetGame: Boolean);
    procedure tmrGameTimeTimer(Sender: TObject);
    procedure mnuTimeLimit1Click(Sender: TObject);
    procedure mnuTimeLimitEnabled1Click(Sender: TObject);
    procedure FormKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure mnuShowTimeLeft1Click(Sender: TObject);
    procedure popUndoPopup(Sender: TObject);
    procedure mnuUndoPos1Click(Sender: TObject);
    procedure mnuRedoPos1Click(Sender: TObject);
    procedure popRedoPopup(Sender: TObject);
    procedure mnuUndo1Click(Sender: TObject);
    procedure mnuRedo1Click(Sender: TObject);
    procedure mnuUseRed1Click(Sender: TObject);
    procedure mnuUseGreen1Click(Sender: TObject);
    procedure mnuUseBlue1Click(Sender: TObject);
    procedure mnuShowTextCaptions1Click(Sender: TObject);
    procedure mnuShowHints1Click(Sender: TObject);
    procedure mnuLeftRight1Click(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure mnuViewCapturedPieces1Click(Sender: TObject);
    procedure mnuAnalysePosition1Click(Sender: TObject);
    procedure mnuHighlightSquares1Click(Sender: TObject);
    procedure mnuSelectPieceFilter1Click(Sender: TObject);
    procedure mnuHighlightPotentialCapture1Click(Sender: TObject);
    procedure mnuHighlightStartDrag1Click(Sender: TObject);
    procedure mnuHighlightDragStartSquare1Click(Sender: TObject);
    procedure mnuHighlightCurrentMoveSquare1Click(Sender: TObject);
    procedure ShowOptionsScreen(Sender: TObject);
    procedure mnuResetBoardOnGameEnd1Click(Sender: TObject);
    procedure mnuContinueLastGameOnStartup1Click(Sender: TObject);
    procedure mnuGame1Click(Sender: TObject);
    procedure mnuPauseGame1Click(Sender: TObject);
    procedure mnuShowPieceHints1Click(Sender: TObject);
    procedure Chessboard1PositionMove(MovedColour: TColour; const From,
      WhereTo: TPoint);
    procedure mnuFile1Click(Sender: TObject);
    procedure mnuFileHistory1Click(Sender: TObject);
  private
    { Private declarations }
    FileHistory: Array[0..FILE_HISTORY_SIZE] of String;
    GameName: String;
    PauseGameOnDialogue,
    SavedBefore,
    SaveOnExit: Boolean;
    ShowMovesWarning: Boolean;
    RedoStrings: TStringList;
    ResetBoardOnGameEnd: Boolean;

    procedure AddToFileHistory(const Filename: String);
    procedure AppHint(Sender: TObject);
    procedure LoadGame(const FileName: String);
    procedure PauseGame;
    procedure ResetEverything(ResetGame: Boolean);
    procedure SetInterface(Val: Boolean);
    procedure UnpauseGame;
    procedure UpdateUndoRedo;

    function GetMenuNumber(WantedMenu: TPopupMenu; MenuTag: Integer): TMenuItem;
    function ResignCheck(ResetAll: Boolean): Boolean;
  protected
    { Protected declarations }
    procedure WMDropFiles(var Msg: TWMDropFiles); message WM_DROPFILES;
  public
    { Public declarations }
  end;

var
  frmMain: TfrmMain;

implementation

uses TimeLeft, Captured, Filters, Options, Preview, Warn, About;

{$R *.DFM}

procedure TfrmMain.WMDropFiles(var Msg: TWMDropFiles);
var
  pFilename: Array[0..255] of char;
  Filename: String;
begin
  Filename := '';
  DragQueryFile(Msg.Drop, 0, pFilename, SizeOf(pFileName));

  Filename := pFileName;

  if Lowercase(ExtractFileExt(Filename)) = '.sav' then
    LoadGame(Filename);

  inherited;
end;

procedure TfrmMain.AppHint(Sender: TObject);
begin
  sbrStatusBar.Panels[2].Text := GetLongHint(Application.Hint);
end;

procedure TfrmMain.mnuHelpContents1Click(Sender: TObject);
begin
  Application.HelpCommand(HELP_FINDER, 0);
end;

procedure TfrmMain.mnuExit1Click(Sender: TObject);
begin
  Close;
end;

procedure TfrmMain.mnuPlayer1Human1Click(Sender: TObject);
begin
  mnuPlayer1Human1.Checked := not mnuPlayer1Human1.Checked;
end;

procedure TfrmMain.mnuPlayer2Human1Click(Sender: TObject);
begin
  mnuPlayer2Human1.Checked := not mnuPlayer2Human1.Checked;
end;

procedure TfrmMain.mnuDrawGridLines1Click(Sender: TObject);
begin
  mnuDrawGridLines1.Checked := not mnuDrawGridLines1.Checked;
  Chessboard1.DrawLines := mnuDrawGridLines1.Checked;
end;

procedure TfrmMain.mnuAboutthisprogram1Click(Sender: TObject);
begin
  if Chessboard1.TimeLimitEnabled then PauseGame;
  TfrmAboutBox.Execute;
  if Chessboard1.TimeLimitEnabled then UnpauseGame;
end;

procedure TfrmMain.mnuResign2Click(Sender: TObject);
begin
  ResignCheck(True);
end;

function TfrmMain.ResignCheck(ResetAll: Boolean): Boolean;
begin
  Result := True;

  if Chessboard1.GameRunning then
  begin
    if Messagedlg('Are you sure you want to resign?', mtConfirmation, [mbYes, mbNo], 0) = mrYes then
    begin
      if Chessboard1.Turn = 1 then
        Messagedlg('You lose, white!', mtInformation, [mbOk], 0)
      else
        MessageDlg('You lose, black!', mtInformation, [mbOK], 0);

      if ResetAll then
      begin
        if ResetBoardOnGameEnd then
          ResetEverything(True)
        else
        begin
          Chessboard1.FinishCurrentGame;
          SetInterface(False);
        end;
      end;
    end
    else
      Result := False;
  end;
end;

procedure TfrmMain.ResetEverything(ResetGame: Boolean);
begin
  if Chessboard1.BackgroundColour <> Color then
    Color := Chessboard1.BackgroundColour;

  GameName := '';
  Caption := 'Chess - [Untitled Game]';
  SavedBefore := False;
  lblTurn.Caption := 'WHITE to move';
  if ResetGame then
  begin
    Chessboard1.ResetBoard;
    SetInterface(True);
  end;

  lblCheck.Visible := False;
  memMoveList.Clear;