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

📄 fthbtns.pas

📁 Gestione Cellulari Nokia
💻 PAS
📖 第 1 页 / 共 2 页
字号:

{*******************************************************}
{                                                       }
{       4th GUI Library for Delphi                      }
{       Buttons Unit                                    }
{                                                       }
{       Copyright (c) 1996,2001 Sergey S. Tkachenko     }
{       e-mail: tkachenko@360.com.ua                    }
{          Web: www.4thfebruary.f2s.com                 }
{                                                       }
{*******************************************************}

unit FthBtns;

{$I FTHVER.INC}

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Menus,
  ExtCtrls;

type
  TFourthStandardButtonSeparatorStyle = (ssVertLines, ssRectangle);

  TFourthStandardButtonOptions = class(TPersistent)
  private
    FAlignment: TAlignment;
    FBackgroundColor: TColor;
    FDisabledFont: TFont;
    FDrawLeftLine: Boolean;
    FDrawRightLine: Boolean;
    FFont: TFont;
    FHotTrackCursor: TCursor;
    FHotTrackFont: TFont;
    FLevel1LightColor: TColor;
    FLevel1ShadowColor: TColor;
    FLevel2LightColor: TColor;
    FLevel2ShadowColor: TColor;
    FLevel3Color: TColor;
    FOnChange: TNotifyEvent;
    FSeparatorStyle: TFourthStandardButtonSeparatorStyle;
    FTransparent: Boolean;
    FVertLineColor: TColor;
    procedure SetAlignment(Value: TAlignment);
    procedure SetBackgroundColor(Value: TColor);
    procedure SetDisabledFont(Value: TFont);
    procedure SetDrawLeftLine(Value: Boolean);
    procedure SetDrawRightLine(Value: Boolean);
    procedure SetFont(Value: TFont);
    procedure SetHotTrackCursor(Value: TCursor);
    procedure SetHotTrackFont(Value: TFont);
    procedure SetLevel1LightColor(Value: TColor);
    procedure SetLevel1ShadowColor(Value: TColor);
    procedure SetLevel2LightColor(Value: TColor);
    procedure SetLevel2ShadowColor(Value: TColor);
    procedure SetLevel3Color(Value: TColor);
    procedure SetSeparatorStyle(Value: TFourthStandardButtonSeparatorStyle);
    procedure SetTransparent(Value: Boolean);
    procedure SetVertLineColor(Value: TColor);
  protected
    property OnChange: TNotifyEvent read FOnChange write FOnChange;
    procedure FontChanged(Sender: TObject);
  public
    constructor Create;
  published
    property Alignment: TAlignment read FAlignment write SetAlignment;
    property BackgroundColor: TColor read FBackgroundColor write SetBackgroundColor;
    property DisabledFont: TFont read FDisabledFont write SetDisabledFont;
    property DrawLeftLine: Boolean read FDrawLeftLine write SetDrawLeftLine;
    property DrawRightLine: Boolean read FDrawRightLine write SetDrawRightLine;
    property Font: TFont read FFont write SetFont;
    property HotTrackCursor: TCursor read FHotTrackCursor write SetHotTrackCursor;
    property HotTrackFont: TFont read FHotTrackFont write SetHotTrackFont;
    property Level1LightColor: TColor read FLevel1LightColor write SetLevel1LightColor;
    property Level1ShadowColor: TColor read FLevel1ShadowColor write SetLevel1ShadowColor;
    property Level2LightColor: TColor read FLevel2LightColor write SetLevel2LightColor;
    property Level2ShadowColor: TColor read FLevel2ShadowColor write SetLevel2ShadowColor;
    property Level3Color: TColor read FLevel3Color write SetLevel3Color;
    property SeparatorStyle: TFourthStandardButtonSeparatorStyle read FSeparatorStyle write SetSeparatorStyle;
    property Transparent: Boolean read FTransparent write SetTransparent;
    property VertLineColor: TColor read FVertLineColor write SetVertLineColor;
  end;

  TFourthStandardButtonState = (bsUp, bsDisabled, bsDown);

  TFourthStandardButton = class(TCustomControl)
  private
    FCaption: TCaption;
    FDragging: Boolean;
    FDropMenu: TPopupMenu;
    FModalResult: TModalResult;
    FMouseInControl: Boolean;
    FOldCursor: TCursor;
    FOptions: TFourthStandardButtonOptions;
    FOnMouseEnter: TNotifyEvent;
    FOnMouseLeave: TNotifyEvent;
    procedure SetCaption(Value: TCaption);
    procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
    procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
    procedure CMEnabledChanged(var Message: TMessage); message CM_ENABLEDCHANGED;
    procedure CMSysColorChange(var Message: TMessage); message CM_SYSCOLORCHANGE;
    procedure CMButtonPressed(var Message: TMessage); message CM_BUTTONPRESSED;
    procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
    procedure WMGetDlgCode(var Message: TWMGetDlgCode); message WM_GETDLGCODE;
    procedure WMEraseBkgnd(var Message: TWMEraseBkgnd); message WM_ERASEBKGND;
  protected
    FState: TFourthStandardButtonState;
    procedure Loaded; override;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); override;
    procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); override;
    procedure OptionsChange(Sender: TObject);
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Paint; override;
    procedure Click; override;
  published
{$IFDEF FCL_D4}
    property Action;
{$ENDIF}
    property Align;
{$IFDEF FCL_D4}
    property Anchors;
{$ENDIF}
    property Caption: TCaption read FCaption write SetCaption;
    property Cursor;
    property DragCursor;
{$IFDEF FCL_D4}
    property DragKind;
{$ENDIF}
    property DragMode;
    property DropDownMenu: TPopupMenu read FDropMenu write FDropMenu;
    property Enabled;
    property Height;
    property Left;
    property ModalResult: TModalResult read FModalResult write FModalResult default 0;
    property Options: TFourthStandardButtonOptions read FOptions write FOptions;
    property ParentShowHint;
    property Name;
    property ShowHint;
    property Top;
    property Tag;
    property Visible;
    property Width;
{$IFDEF FCL_D4}
    property OnCanResize;
{$ENDIF}
    property OnClick;
{$IFDEF FCL_D4}
    property OnConstrainedResize;
{$ENDIF}
{$IFDEF FCL_D5}
    property OnContextPopup;
{$ENDIF}
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
{$IFDEF FCL_D4}
    property OnEndDock;
{$ENDIF}
    property OnEndDrag;
    property OnMouseDown;
    property OnMouseEnter: TNotifyEvent read FOnMouseEnter write FOnMouseEnter;
    property OnMouseLeave: TNotifyEvent read FOnMouseLeave write FOnMouseLeave;
    property OnMouseMove;
    property OnMouseUp;
{$IFDEF FCL_D4}
    property OnResize;
    property OnStartDock;
{$ENDIF}
    property OnStartDrag;
  end;

implementation

{ TFourthStandardButtonOptions }

constructor TFourthStandardButtonOptions.Create;
begin
  FAlignment := taCenter;
  FBackgroundColor := cl3DDkShadow;
  FDisabledFont := TFont.Create;
  FDisabledFont.Color := clBtnShadow;
  FDisabledFont.OnChange := FontChanged;
  FFont := TFont.Create;
  FFont.Color := clBtnHighlight;
  FFont.OnChange := FontChanged;
  FHotTrackCursor := crDefault;
  FHotTrackFont := TFont.Create;
  FHotTrackFont.Color := clBtnText;
  FHotTrackFont.OnChange := FontChanged;
  FLevel1LightColor := cl3DLight;
  FLevel1ShadowColor := cl3DDkShadow;
  FLevel2LightColor := clBtnHighlight;
  FLevel2ShadowColor := clBtnShadow;
  FLevel3Color := clBtnFace;
  FDrawLeftLine := True;
  FDrawRightLine := True;
  FSeparatorStyle := ssVertLines;
  FTransparent := False;
  FVertLineColor := clBtnFace;
end;

procedure TFourthStandardButtonOptions.SetAlignment(Value: TAlignment);
begin
  if FAlignment <> Value then
  begin
    FAlignment := Value;
    if Assigned(FOnChange) then FOnChange(Self);
  end;
end;

procedure TFourthStandardButtonOptions.SetBackgroundColor(Value: TColor);
begin
  if FBackgroundColor <> Value then
  begin
    FBackgroundColor := Value;
    if Assigned(FOnChange) then FOnChange(Self);
  end;
end;

procedure TFourthStandardButtonOptions.SetDisabledFont(Value: TFont);
begin
  if FDisabledFont <> Value then
  begin
    FDisabledFont.Assign(Value);
    if Assigned(FOnChange) then FOnChange(Self);
  end;
end;

procedure TFourthStandardButtonOptions.SetDrawLeftLine(Value: Boolean);
begin
  if FDrawLeftLine <> Value then
  begin
    FDrawLeftLine := Value;
    if Assigned(FOnChange) then FOnChange(Self);
  end;
end;

procedure TFourthStandardButtonOptions.SetDrawRightLine(Value: Boolean);
begin
  if FDrawRightLine <> Value then
  begin
    FDrawRightLine := Value;
    if Assigned(FOnChange) then FOnChange(Self);
  end;
end;

procedure TFourthStandardButtonOptions.SetFont(Value: TFont);
begin
  if FFont <> Value then
  begin
    FFont.Assign(Value);
    if Assigned(FOnChange) then FOnChange(Self);
  end;
end;

procedure TFourthStandardButtonOptions.SetHotTrackCursor(Value: TCursor);
begin
  if FHotTrackCursor <> Value then
  begin
    FHotTrackCursor := Value;
    if Assigned(FOnChange) then FOnChange(Self);
  end;
end;

procedure TFourthStandardButtonOptions.SetHotTrackFont(Value: TFont);
begin
  if FHotTrackFont <> Value then
  begin
    FHotTrackFont.Assign(Value);
    if Assigned(FOnChange) then FOnChange(Self);
  end;
end;

procedure TFourthStandardButtonOptions.SetLevel1LightColor(Value: TColor);
begin
  if FLevel1LightColor <> Value then
  begin
    FLevel1LightColor := Value;
    if Assigned(FOnChange) then FOnChange(Self);
  end;
end;

procedure TFourthStandardButtonOptions.SetLevel1ShadowColor(Value: TColor);
begin
  if FLevel1ShadowColor <> Value then
  begin
    FLevel1ShadowColor := Value;
    if Assigned(FOnChange) then FOnChange(Self);
  end;
end;

procedure TFourthStandardButtonOptions.SetLevel2LightColor(Value: TColor);
begin
  if FLevel2LightColor <> Value then
  begin
    FLevel2LightColor := Value;
    if Assigned(FOnChange) then FOnChange(Self);
  end;
end;

procedure TFourthStandardButtonOptions.SetLevel2ShadowColor(Value: TColor);
begin
  if FLevel2ShadowColor <> Value then
  begin
    FLevel2ShadowColor := Value;
    if Assigned(FOnChange) then FOnChange(Self);

⌨️ 快捷键说明

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