advglowbutton.pas

来自「一个非常棒的控件.做商业软件特别适用.里面的控件涉及面非常的广,有兴趣的话可以下」· PAS 代码 · 共 1,982 行 · 第 1/5 页

{***************************************************************************}
{ TAdvGlowButton component                                                  }
{ for Delphi & C++Builder                                                   }
{ version 1.4                                                               }
{                                                                           }
{ written by TMS Software                                                   }
{            copyright ?2006                                               }
{            Email : [e-mail]                                   }
{            Web : http://www.tmssoftware.com                               }
{                                                                           }
{ The source code is given as is. The author is not responsible             }
{ for any possible damage done due to the use of this code.                 }
{ The component can be freely used in any application. The complete         }
{ source code remains property of the author and may not be distributed,    }
{ published, given or sold in any form as such. No parts of the source      }
{ code can be included in any other component or application without        }
{ written authorization of the author.                                      }
{***************************************************************************}

unit AdvGlowButton;

{$R ADVGLOWBUTTONDB.RES}

{$I TMSDEFS.INC}

{$T-}

interface

uses
  Classes, Windows, Forms, Dialogs, Controls, Graphics, Messages, ExtCtrls,
  SysUtils, Math, Menus, DB, ImgList, AdvGDIP, GDIPicture, ActnList,
  AdvHintInfo, AdvStyleIF;

const
  DropDownSectWidth = 13;

  MAJ_VER = 1; // Major version nr.
  MIN_VER = 4; // Minor version nr.
  REL_VER = 0; // Release nr.
  BLD_VER = 0; // Build nr.

  // 1.0.5.1 : Fixed issue with width & height initialization
  // 1.0.5.2 : Improved fade painting
  // 1.1.0.0 : New separate dropdown button hot & down effect
  //         : Silver, Blue, Black styles added
  // 1.2.0.0 : New DropDownSplit property added
  // 1.2.0.1 : Fixed issue with ModalResult <> mrNone
  // 1.2.0.2 : Fixed issue with Action handling Checked state
  // 1.2.0.3 : Fixed issue with disabled painting
  // 1.2.0.4 : Fixed issue with key handling
  // 1.3.0.0 : Added new property FocusType
  //         : Added new ShortCutHint, ShortCutHintPos & methods ShowShortCutHint, HideShortCutHint
  // 1.3.0.1 : Fixed issue with font and aaNone
  // 1.3.0.2 : Fixed issue with hot & down border painting
  // 1.3.1.0 : New : exposed OnMouseEnter, OnMouseLeave
  //         : Fixed issue with Down property for bsCheck style
  // 1.3.1.1 : Fixed issue with Down property for buttons with GroupIndex > 0
  // 1.3.1.2 : Improved transitioning from transparent to hot
  // 1.3.1.3 : Fixed issue with actionlinks & bsCheck type
  // 1.3.2.0 : New styler interface added
  // 1.3.3.0 : New public property DroppedDown added
  // 1.3.4.0 : New TAdvCustomGlowButton.ParentFont added
  //         : TButtonLayout blGlyphLeftAdjusted and blGlyphRightAdjusted added
  // 1.3.5.0 : New borderless display possible by setting BorderStyle = bsNone
  // 1.4.0.0 : Improved : seamlessly works with TrueType & non TrueType fonts
  //         : New : Spacing property added
  //         : New : WordWrap property added
  //         : New : AutoSize property added
  //         : New : MarginVert property added
  //         : New : MarginHorz property added
  //         : New : Rounded property added
  //         : New : DropDownDirection property added
  //         : New : HotImages, HotPicture property added

type
  TAdvCustomGlowButton = class;
  TAdvGlowButton = class;

  TGlowState = (gsHover, gsPush, gsNone);
  TAdvButtonStyle = (bsButton, bsCheck);
  TAdvButtonState = (absUp, absDisabled, absDown, absDropDown, absExclusive);
  TButtonLayout = (blGlyphLeft, blGlyphTop, blGlyphRight, blGlyphBottom, blGlyphLeftAdjusted, blGlyphRightAdjusted);
  TDropDownPosition = (dpRight, dpBottom);
  TDropDownDirection = (ddDown, ddRight);
  TGDIPGradient = (ggRadial, ggVertical, ggDiagonalForward, ggDiagonalBackward);

  TFocusType = (ftBorder, ftHot, ftHotBorder, ftNone);

  TShortCutHintPos = (shpLeft, shpTop, shpRight, shpBottom);

  TButtonPosition = (bpStandalone, bpLeft, bpMiddle, bpRight);

  TWinCtrl = class(TWinControl)
  public
    procedure PaintCtrls(DC: HDC; First: TControl);
  end;

{$IFDEF DELPHI6_LVL}
  TAdvGlowButtonActionLink = class(TControlActionLink)
  protected
    FClient: TAdvCustomGlowButton; //TAdvGlowButton;
    procedure AssignClient(AClient: TObject); override;
    function IsCheckedLinked: Boolean; override;
    function IsGroupIndexLinked: Boolean; override;
    procedure SetGroupIndex(Value: Integer); override;
    procedure SetChecked(Value: Boolean); override;
    procedure SetImageIndex(Value: Integer); override;
  end;
{$ENDIF}

  TShortCutHintWindow = class(THintWindow)
  private
    procedure WMEraseBkGnd(var Message: TWMEraseBkGnd); message WM_ERASEBKGND;
  protected
    procedure Paint; override;
    procedure CreateParams(var Params:TCreateParams);override;
  end;

  TGlowButtonAppearance = class(TPersistent)
  private
    FOnChange: TNotifyEvent;
    FBorderColor: TColor;
    FBorderColorHot: TColor;
    FBorderColorDown: TColor;
    FColor: TColor;
    FColorTo: TColor;
    FColorDown: TColor;
    FColorDownTo: TColor;
    FColorHot: TColor;
    FColorHotTo: TColor;
    FColorCheckedTo: TColor;
    FBorderColorDisabled: TColor;
    FBorderColorChecked: TColor;
    FColorDisabled: TColor;
    FColorDisabledTo: TColor;
    FColorChecked: TColor;
    FColorMirror: TColor;
    FColorMirrorTo: TColor;
    FColorMirrorHot: TColor;
    FColorMirrorHotTo: TColor;
    FColorMirrorDown: TColor;
    FColorMirrorDownTo: TColor;
    FGradientDown: TGDIPGradient;
    FGradientMirror: TGDIPGradient;
    FGradientMirrorHot: TGDIPGradient;
    FGradient: TGDIPGradient;
    FGradientMirrorDown: TGDIPGradient;
    FGradientHot: TGDIPGradient;
    FColorMirrorDisabledTo: TColor;
    FColorMirrorDisabled: TColor;
    FColorMirrorCheckedTo: TColor;
    FColorMirrorChecked: TColor;
    FGradientChecked: TGDIPGradient;
    FGradientDisabled: TGDIPGradient;
    FGradientMirrorChecked: TGDIPGradient;
    FGradientMirrorDisabled: TGDIPGradient;
  protected
    procedure Changed;
  public
    constructor Create;
    procedure Assign(Source: TPersistent); override;
    property OnChange: TNotifyEvent read FOnChange write FOnChange;
  published
    property BorderColor: TColor read FBorderColor write FBorderColor default clSilver;
    property BorderColorHot: TColor read FBorderColorHot write FBorderColorHot default clBlue;
    property BorderColorDown: TColor read FBorderColorDown write FBorderColorDown default clNavy;
    property BorderColorChecked: TColor read FBorderColorChecked write FBorderColorChecked default clBlue;
    property BorderColorDisabled: TColor read FBorderColorDisabled write FBorderColorDisabled default clGray;
    property Color: TColor read FColor write FColor default clWhite;
    property ColorTo: TColor read FColorTo write FColorTo default clWhite;
    property ColorChecked: TColor read FColorChecked write FColorChecked;
    property ColorCheckedTo: TColor read FColorCheckedTo write FColorCheckedTo;
    property ColorDisabled: TColor read FColorDisabled write FColorDisabled;
    property ColorDisabledTo: TColor read FColorDisabledTo write FColorDisabledTo;
    property ColorDown: TColor read FColorDown write FColorDown;
    property ColorDownTo: TColor read FColorDownTo write FColorDownTo;
    property ColorHot: TColor read FColorHot write FColorHot;
    property ColorHotTo: TColor read FColorHotTo write FColorHotTo;
    property ColorMirror: TColor read FColorMirror write FColorMirror default clSilver;
    property ColorMirrorTo: TColor read FColorMirrorTo write FColorMirrorTo default clWhite;
    property ColorMirrorHot: TColor read FColorMirrorHot write FColorMirrorHot;
    property ColorMirrorHotTo: TColor read FColorMirrorHotTo write FColorMirrorHotTo;
    property ColorMirrorDown: TColor read FColorMirrorDown write FColorMirrorDown;
    property ColorMirrorDownTo: TColor read FColorMirrorDownTo write FColorMirrorDownTo;
    property ColorMirrorChecked: TColor read FColorMirrorChecked write FColorMirrorChecked;
    property ColorMirrorCheckedTo: TColor read FColorMirrorCheckedTo write FColorMirrorCheckedTo;
    property ColorMirrorDisabled: TColor read FColorMirrorDisabled write FColorMirrorDisabled;
    property ColorMirrorDisabledTo: TColor read FColorMirrorDisabledTo write FColorMirrorDisabledTo;
    property Gradient: TGDIPGradient read FGradient write FGradient default ggVertical;
    property GradientMirror: TGDIPGradient read FGradientMirror write FGradientMirror default ggVertical;
    property GradientHot: TGDIPGradient read FGradientHot write FGradientHot default ggRadial;
    property GradientMirrorHot: TGDIPGradient read FGradientMirrorHot write FGradientMirrorHot default ggRadial;
    property GradientDown: TGDIPGradient read FGradientDown write FGradientDown default ggRadial;
    property GradientMirrorDown: TGDIPGradient read FGradientMirrorDown write FGradientMirrorDown default ggRadial;
    property GradientChecked: TGDIPGradient read FGradientChecked write FGradientChecked default ggRadial;
    property GradientMirrorChecked: TGDIPGradient read FGradientMirrorChecked write FGradientMirrorChecked default ggVertical;
    property GradientDisabled: TGDIPGradient read FGradientDisabled write FGradientDisabled default ggRadial;
    property GradientMirrorDisabled: TGDIPGradient read FGradientMirrorDisabled write FGradientMirrorDisabled default ggRadial;
  end;

  TAdvCustomGlowButton = class(TCustomControl, ITMSStyle)
  private
    FHot: Boolean;
    FActive: Boolean;
    FDown: Boolean;
    FLeftDown: Boolean;
    FMouseDown: Boolean;
    FTimer: TTimer;
    FStepHover: Integer;
    FStepPush: Integer;
    FTimeInc: Integer;
    FGlowState: TGlowState;
    FImages: TImageList;
    FImageIndex: TImageIndex;
    FState: TAdvButtonState;
    FMouseInControl: Boolean;
    FMouseEnter: Boolean;
    FDownChecked: Boolean;
    FInitialDown: Boolean;
    FDragging: Boolean;
    FStyle: TAdvButtonStyle;
    FGroupIndex: Integer;
    FAllowAllUp: Boolean;
    FTransparent: Boolean;
    FLayout: TButtonLayout;
    FDropDownButton: Boolean;
    FDropDownSplit: Boolean;
    FDropDownDirection: TDropDownDirection;
    FDropDownMenu: TPopupMenu;
    FOnDropDown: TNotifyEvent;
    FDropDownPosition: TDropDownPosition;
    FAppearance: TGlowButtonAppearance;
    FDisabledImages: TImageList;
    FInternalImages: TImageList;
    FHotImages: TImageList;
    FIPicture: TGDIPPicture;
    FIDisabledPicture: TGDIPPicture;
    FIHotPicture: TGDIPPicture;
    FShowCaption: Boolean;
    FAntiAlias: TAntiAlias;
    FModalResult: TModalResult;
    FDefault: boolean;
    FCancel: Boolean;
    FInButton: Boolean;
    FBorderStyle: TBorderStyle;
    FButtonPosition: TButtonPosition;
    FOfficeHint: TAdvHintInfo;
    FCheckLinked: Boolean;
    FFocusType: TFocusType;
    FShortCutHint: TShortCutHintWindow;
    FShortCutHintPos: TShortCutHintPos;
    FShortCutHintText: string;
    FShowDisabled: Boolean;
    FOnInternalKeyDown: TKeyEvent;
    FOnMouseLeave: TNotifyEvent;
    FOnMouseEnter: TNotifyEvent;
    FDroppedDown: Boolean;
    FOverlappedText: Boolean;
    FSpacing: Integer;
    FAutoSize: Boolean;
    FWordWrap: Boolean;
    FDoAutoSize: Boolean;
    FFirstPaint: Boolean;
    FMarginVert: integer;
    FMarginHorz: integer;
    FRounded: Boolean;
    procedure SetOfficeHint(const Value: TAdvHintInfo);
    procedure SetButtonPosition(const Value: TButtonPosition);
    procedure SetBorderStyle(const Value: TBorderStyle);
    function GetVersion: string;
    procedure SetVersion(const Value: string);
    procedure SetDefault(const Value: boolean);
    procedure SetAntiAlias(const Value: TAntiAlias);
    procedure SetShowCaption(const Value: Boolean);
    procedure SetDisabledPicture(const Value: TGDIPPicture);
    procedure SetHotPicture(const Value: TGDIPPicture);
    procedure SetPicture(const Value: TGDIPPicture);
    procedure SetTransparent(const Value: Boolean);
    procedure UpdateExclusive;
    procedure UpdateTracking;
    procedure SetImageIndex(const Value: TImageIndex);
    procedure SetImages(const Value: TImageList);
    procedure CMDialogKey(var Message: TCMDialogKey); message CM_DIALOGKEY;
    procedure CMDialogChar(var Message: TCMDialogChar); message CM_DIALOGCHAR;
    procedure CMFocusChanged(var Message: TCMFocusChanged); message CM_FOCUSCHANGED;
    procedure WMGetDlgCode(var Message: TMessage); message WM_GETDLGCODE;
    procedure CNCommand(var Message: TWMCommand); message CN_COMMAND;
    procedure CMTextChanged(var Message: TMessage); message CM_TEXTCHANGED;
    procedure CMMouseLeave(var Msg: TMessage); message CM_MOUSELEAVE;
    procedure CMMouseEnter(var Msg: TMessage); message CM_MOUSEENTER;
    procedure WMSetText(var Message: TWMSetText); message WM_SETTEXT;
    procedure WMEraseBkGnd(var Message: TWMEraseBkGnd); message WM_ERASEBKGND;
    procedure CMEnabledChanged(var Message: TMessage); message CM_ENABLEDCHANGED;
{$IFNDEF TMSDOTNET}
    procedure CMButtonPressed(var Message: TMessage); message CM_BUTTONPRESSED;
{$ENDIF}
    procedure WMLButtonUp(var Msg:TWMLButtonDown); message WM_LBUTTONUP;
    procedure WMLDblClk(var Msg: TWMLButtonDblClk); message WM_LBUTTONDBLCLK;
    procedure TimerProc(Sender: TObject);
    procedure OnAppearanceChanged(Sender: TObject);
    procedure SetDown(Value: Boolean);
    procedure SetStyle(const Value: TAdvButtonStyle);
    procedure SetGroupIndex(const Value: Integer);
    procedure SetAllowAllUp(const Value: Boolean);
    procedure SetLayout(const Value: TButtonLayout);
    procedure SetDropDownButton(const Value: Boolean);
    procedure PopupBtnDown;
    procedure SetDropDownPosition(const Value: TDropDownPosition);
    procedure SetDropDownDirection(const Value: TDropDownDirection);
    procedure SetAppearance(const Value: TGlowButtonAppearance);
    procedure SetDisabledImages(const Value: TImageList);
    procedure PictureChanged(Sender: TObject);
    procedure DoDropDown;
    procedure SetSpacing(const Value: integer);
    procedure SetAutoSizeEx(const Value: boolean);
    procedure SetShowDisabled(const Value: boolean);
    procedure SetWordWrap(const Value: boolean);
    procedure SetMarginVert(const Value: integer);
    procedure SetMarginHorz(const Value: integer);
    procedure SetRounded(const Value: boolean);
    procedure PerformResize;
    function IsFontStored: Boolean;
//    procedure SetCaption(const Value: string);
//    function GetCaption: string;
  protected
    FDefaultPicDrawing: Boolean;
    FDefaultCaptionDrawing: Boolean;
    procedure DrawGlyphCaption; virtual;
    procedure GetToolImage(bmp: TBitmap); virtual;
    procedure SetDroppedDown(Value: Boolean);
    procedure CreateParams(var Params:TCreateParams); override;
    procedure Paint; override;
    procedure Loaded; override;
    procedure DoEnter; override;
    procedure DoExit; override;
    procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    procedure KeyUp(var Key: Word; Shift: TShiftState); override;
    procedure KeyPress(var Key: Char); override;
{$IFDEF DELPHI6_LVL}
    function GetActionLinkClass: TControlActionLinkClass; override;
    procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override;
{$ENDIF}
    procedure Notification(AComponent: TComponent; AOperation: TOperation); override;
    property GlowState: TGlowState read FGlowState write FGlowState;
{$IFDEF TMSDOTNET}
    procedure ButtonPressed(Group: Integer; Button: TAdvGlowButton);
{$ENDIF}
    property Down: Boolean read FDownChecked write SetDown default False;
    property Style: TAdvButtonStyle read FStyle write SetStyle default bsButton;
    property State: TAdvButtonState read FState write FState;
    property GroupIndex: Integer read FGroupIndex write SetGroupIndex default 0;
    property AllowAllUp: Boolean read FAllowAllUp write SetAllowAllUp default False;
    property Layout: TButtonLayout read FLayout write SetLayout default blGlyphLeft;
    property DroppedDown: Boolean read FDroppedDown;
    property DropDownButton: Boolean read FDropDownButton write SetDropDownButton default False;
    property DropDownDirection: TDropDownDirection read FDropDownDirection write SetDropDownDirection default ddDown;
    property DropDownPosition: TDropDownPosition read FDropDownPosition write SetDropDownPosition default dpRight;
    property DropDownSplit: Boolean read FDropDownSplit write FDropDownSplit default true;
    property DropDownMenu: TPopupMenu read FDropDownMenu write FDropDownMenu;
    property OnDropDown: TNotifyEvent read FOnDropDown write FOnDropDown;
    function GetVersionNr: Integer; virtual;
    function IsMenuButton: Boolean; virtual;
    property CheckLinked: Boolean read FCheckLinked write FCheckLinked;
    property OnInternalKeyDown: TKeyEvent read FOnInternalKeyDown write FOnInternalKeyDown; // Used by AdvToolBar
    property OverlappedText: boolean read FOverlappedText write FOverlappedText;
    property DoAutoSize: boolean read FDoAutoSize write FDoAutoSize;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure CreateWnd; override;
    procedure Click; override;
    property Appearance: TGlowButtonAppearance read FAppearance write SetAppearance;
    procedure ShowShortCutHint;
    procedure HideShortCutHint;
    procedure SetComponentStyle(AStyle: TTMSStyle);
  published
    property Align;
    property Action;
    property Anchors;
    property AntiAlias: TAntiAlias read FAntiAlias write SetAntiAlias default aaClearType;
    property AutoSize: boolean read FAutoSize write SetAutoSizeEx default false;
    property BorderStyle: TBorderStyle read FBorderStyle write SetBorderStyle default bsSingle;
    property Cancel: Boolean read FCancel write FCancel default False;
    //property Caption: string read GetCaption write SetCaption;
    property Caption;
    property Constraints;
    property Default: boolean read FDefault write SetDefault default False;
    property Font stored IsFontStored;
    property ImageIndex: TImageIndex read FImageIndex write SetImageIndex default -1;
    property Images: TImageList read FImages write SetImages;
    property DisabledImages: TImageList read FDisabledImages write SetDisabledImages;
    property DisabledPicture: TGDIPPicture read FIDisabledPicture write SetDisabledPicture;
    property DragMode;
    property DragKind;