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

📄 options.pas

📁 用于开发税务票据管理的软件
💻 PAS
字号:
unit Options;

interface

uses
  Windows, Messages, Graphics, Classes, Controls, Forms,
  StdCtrls, ExtCtrls, Buttons, Backdrop, ComCtrls, Dialogs, Spin;

const
  HIGHLIGHTCOLOUR = clRed;
  DEFAULTCOLOUR = clWhite;

type
  TfrmOptions = class(TForm)
    bgndLovely: TBackdrop;
    btnOK: TBitBtn;
    btnCancel: TBitBtn;
    bvlBottomLine: TBevel;
    lblOptions: TLabel;
    lblGeneral: TLabel;
    lblBoardColours: TLabel;
    lblHighlighting: TLabel;
    lblTime: TLabel;
    pageSettings: TPageControl;
    tabGeneral: TTabSheet;
    tablBoardColours: TTabSheet;
    tabHighlighting: TTabSheet;
    tabTime: TTabSheet;
    imgTick1: TImage;
    imgTick2: TImage;
    imgTick3: TImage;
    imgTick4: TImage;
    chkPreview: TCheckBox;
    chkEnableHighlighting: TCheckBox;
    grpHighlightingColours: TGroupBox;
    chkContinueLastGame: TCheckBox;
    chkHighlightStartDragSquare: TCheckBox;
    btnValidMoveColour: TButton;
    btnInvalidMoveColour: TButton;
    btnCaptureColour: TButton;
    btnStartSquareColour: TButton;
    btnCurrentDragColour: TButton;
    chkShowValidMoves: TCheckBox;
    chkShowPieceHints: TCheckBox;
    pnlValidMoveColour: TPanel;
    pnlInvalidMoveColour: TPanel;
    pnlCaptureColour: TPanel;
    pnlStartSquareColour: TPanel;
    pnlCurrentDragColour: TPanel;
    lblTimeNote: TLabel;
    chkEnableTimeLimit: TCheckBox;
    dlgColour: TColorDialog;
    lblTimeLimit: TLabel;
    speTimeLimit: TSpinEdit;
    lblTimeLimitMinutes: TLabel;
    chkPauseGame: TCheckBox;
    chkDrawGridLines: TCheckBox;
    grpPanelBackground: TGroupBox;
    rgpBackgroundDirection: TRadioGroup;
    chkUseRed: TCheckBox;
    chkUseGreen: TCheckBox;
    chkUseBlue: TCheckBox;
    grpBoardColours: TGroupBox;
    pnlWhiteSquaresColour: TPanel;
    btnWhiteSquaresColour: TButton;
    btnBlackSquaresColour: TButton;
    pnlBlackSquaresColour: TPanel;
    pnlGridLinesColour: TPanel;
    pnlBackgroundColour: TPanel;
    btnBackgroundColour: TButton;
    btnGridLinesColour: TButton;
    chkResetBoardOnGameEnd: TCheckBox;
    lblUncheckResetBoard: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure chkPreviewClick(Sender: TObject);
    procedure chkEnableHighlightingClick(Sender: TObject);
    procedure chkHighlightStartDragSquareClick(Sender: TObject);
    procedure chkShowValidMovesClick(Sender: TObject);
    procedure btnValidMoveColourClick(Sender: TObject);
    procedure btnInvalidMoveColourClick(Sender: TObject);
    procedure btnCaptureColourClick(Sender: TObject);
    procedure btnStartSquareColourClick(Sender: TObject);
    procedure btnCurrentDragColourClick(Sender: TObject);
    procedure btnWhiteSquaresColourClick(Sender: TObject);
    procedure btnBlackSquaresColourClick(Sender: TObject);
    procedure btnGridLinesColourClick(Sender: TObject);
    procedure btnBackgroundColourClick(Sender: TObject);
    procedure chkDrawGridLinesClick(Sender: TObject);
    procedure lblGeneralClick(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure lblUncheckResetBoardClick(Sender: TObject);
    procedure chkResetBoardOnGameEndClick(Sender: TObject);
  private
    { Private declarations }
    CurrHighlight: Integer;   // label mouse is currently over
  protected
    { Protected declarations }
    //procedure WMEraseBkgnd(var Msg: TWMEraseBkgnd); message WM_ERASEBKGND;
  public
    { Public declarations }
    procedure SetBackgroundColour(NewColour: TColor);
    procedure SetGridLinesColour(NewColour: TColor);
    procedure SetBlackSquaresColour(NewColour: TColor);
    procedure SetWhiteSquaresColour(NewColour: TColor);
    procedure SetCurrentDragColour(NewColour: TColor);
    procedure SetStartSquareColour(NewColour: TColor);
    procedure SetCaptureColour(NewColour: TColor);
    procedure SetInvalidMoveColour(NewColour: TColor);
    procedure SetValidMoveColour(NewColour: TColor);
  end;

var
  frmOptions: TfrmOptions;

implementation

uses Preview;

{$R *.DFM}

{procedure TfrmOptions.WMEraseBkgnd(var Msg: TWMEraseBkgnd);
begin
  Msg.Result := 1;
end;}

procedure TfrmOptions.FormCreate(Sender: TObject);
begin
  CurrHighlight := 1;                    // "General" label
end;

procedure TfrmOptions.chkPreviewClick(Sender: TObject);
begin
  frmOptionsPreview.Visible := chkPreview.Checked;
end;

procedure TfrmOptions.chkEnableHighlightingClick(Sender: TObject);
begin
  chkHighlightStartDragSquare.Enabled := chkEnableHighlighting.Checked;
  chkShowValidMoves.Enabled := chkEnableHighlighting.Checked;
  grpHighlightingColours.Enabled := chkEnableHighlighting.Checked;
  frmOptionsPreview.Chessboard1.ShowSquareHighlights := chkEnableHighlighting.Checked;
end;

procedure TfrmOptions.chkHighlightStartDragSquareClick(Sender: TObject);
begin
  frmOptionsPreview.mnuHighlightDragStartSquare1Click(Sender);
end;

procedure TfrmOptions.chkShowValidMovesClick(Sender: TObject);
begin
  frmOptionsPreview.mnuShowValidMovesMode1Click(Sender);
end;

procedure TfrmOptions.btnValidMoveColourClick(Sender: TObject);
begin
  dlgColour.Color := pnlValidMoveColour.Color;
  if dlgColour.Execute then
    SetValidMoveColour(dlgColour.Color);
end;

procedure TfrmOptions.SetValidMoveColour(NewColour: TColor);
begin
  pnlValidMoveColour.Color := NewColour;
  frmOptionsPreview.Chessboard1.HighlightColour := NewColour;
end;

procedure TfrmOptions.btnInvalidMoveColourClick(Sender: TObject);
begin
  dlgColour.Color := pnlInvalidMoveColour.Color;
  if dlgColour.Execute then
    SetInvalidMoveColour(dlgColour.Color);
end;

procedure TfrmOptions.SetInvalidMoveColour(NewColour: TColor);
begin
  pnlInvalidMoveColour.Color := NewColour;
  frmOptionsPreview.Chessboard1.HighlightEnemyColour := NewColour;
end;

procedure TfrmOptions.btnCaptureColourClick(Sender: TObject);
begin
  dlgColour.Color := pnlCaptureColour.Color;
  if dlgColour.Execute then
    SetCaptureColour(dlgColour.Color);
end;

procedure TfrmOptions.SetCaptureColour(NewColour: TColor);
begin
  pnlCaptureColour.Color := NewColour;
  frmOptionsPreview.Chessboard1.HighlightCaptureColour := NewColour;
end;

procedure TfrmOptions.btnStartSquareColourClick(Sender: TObject);
begin
  dlgColour.Color := pnlStartSquareColour.Color;
  if dlgColour.Execute then
    SetStartSquareColour(dlgColour.Color);
end;

procedure TfrmOptions.SetStartSquareColour(NewColour: TColor);
begin
  pnlStartSquareColour.Color := NewColour;
  frmOptionsPreview.Chessboard1.StartDragColour := NewColour;
end;

procedure TfrmOptions.btnCurrentDragColourClick(Sender: TObject);
begin
  dlgColour.Color := pnlCurrentDragColour.Color;
  if dlgColour.Execute then
    SetCurrentDragColour(dlgColour.Color);
end;

procedure TfrmOptions.SetCurrentDragColour(NewColour: TColor);
begin
  pnlCurrentDragColour.Color := NewColour;
  frmOptionsPreview.Chessboard1.ValidMoveDragColour := NewColour;
end;

procedure TfrmOptions.btnWhiteSquaresColourClick(Sender: TObject);
begin
  dlgColour.Color := pnlWhiteSquaresColour.Color;
  if dlgColour.Execute then
    SetWhiteSquaresColour(dlgColour.Color);
end;

procedure TfrmOptions.SetWhiteSquaresColour(NewColour: TColor);
begin
  pnlWhiteSquaresColour.Color := NewColour;
  frmOptionsPreview.Chessboard1.WhiteSquareColour := NewColour;
end;

procedure TfrmOptions.btnBlackSquaresColourClick(Sender: TObject);
begin
  dlgColour.Color := pnlBlackSquaresColour.Color;
  if dlgColour.Execute then
    SetBlackSquaresColour(dlgColour.Color);
end;

procedure TfrmOptions.SetBlackSquaresColour(NewColour: TColor);
begin
  pnlBlackSquaresColour.Color := NewColour;
  frmOptionsPreview.Chessboard1.BlackSquareColour := NewColour;
end;

procedure TfrmOptions.btnGridLinesColourClick(Sender: TObject);
begin
  dlgColour.Color := pnlGridLinesColour.Color;
  if dlgColour.Execute then
    SetGridLinesColour(dlgColour.Color);
end;

procedure TfrmOptions.SetGridLinesColour(NewColour: TColor);
begin
  pnlGridLinesColour.Color := NewColour;
  frmOptionsPreview.Chessboard1.GridLineColour := NewColour;
end;

procedure TfrmOptions.btnBackgroundColourClick(Sender: TObject);
begin
  dlgColour.Color := pnlBackgroundColour.Color;
  if dlgColour.Execute then
    SetBackgroundColour(dlgColour.Color);
end;

procedure TfrmOptions.SetBackgroundColour(NewColour: TColor);
begin
  pnlBackgroundColour.Color := NewColour;
  frmOptionsPreview.Chessboard1.BackgroundColour := NewColour;
end;

procedure TfrmOptions.chkDrawGridLinesClick(Sender: TObject);
begin
  frmOptionsPreview.Chessboard1.DrawLines := chkDrawGridLines.Checked;
end;

{ The following procedure is shared between the labels on the left of the form.
  It highlights the new choice when it is clicked, and unhighlights the
  previously selected label }
procedure TfrmOptions.lblGeneralClick(Sender: TObject);
var
  CurrLabel: TLabel;
  i: Integer;
begin
  CurrLabel := Sender as TLabel;

  if CurrLabel.Tag <> CurrHighlight then
  begin
    CurrLabel.Font.Color := HIGHLIGHTCOLOUR;
    CurrLabel.Font.Style := CurrLabel.Font.Style + [fsUnderline];

    // Unhighlight the old highlighted label
    for i := 0 to ComponentCount - 1 do
      if (Components[i] is TLabel) and
         ((Components[i] as TLabel).Tag = CurrHighlight) then
      with (Components[i] as TLabel) do
      begin
        Font.Color := DEFAULTCOLOUR;
        Font.Style := Font.Style - [fsUnderline];
      end;

    CurrHighlight := CurrLabel.Tag;
    pageSettings.ActivePage := pageSettings.Pages[CurrHighlight - 1];
  end;
end;

procedure TfrmOptions.FormShow(Sender: TObject);
begin
  if chkPreview.Checked then frmOptionsPreview.Show;
end;

procedure TfrmOptions.FormClose(Sender: TObject;
  var Action: TCloseAction);
begin
  // The following temporarily stops the options preview form from
  // unchecking the 'Preview' checkbox when it closes, which is its
  // normal behaviour
  frmOptionsPreview.OnClose := nil;
  frmOptionsPreview.Close;
  frmOptionsPreview.OnClose := frmOptionsPreview.FormClose;
end;

procedure TfrmOptions.lblUncheckResetBoardClick(Sender: TObject);
begin
  chkResetBoardOnGameEnd.Checked := False;
  MessageDlg('You can now change the time options by finishing your game, and '+
             'going back to this options screen', mtInformation, [mbOK], 0);
end;

procedure TfrmOptions.chkResetBoardOnGameEndClick(Sender: TObject);
begin
  if lblTimeNote.Visible then
    lblUncheckResetBoard.Visible := chkResetBoardOnGameEnd.Checked;
end;

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -