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

📄 suibutton.pas

📁 SUIPack是一款为Delphi和C++Builder开发的所见即所得的界面增强VCL组件
💻 PAS
📖 第 1 页 / 共 4 页
字号:
////////////////////////////////////////////////////////////////////////////////
//
//
//  FileName    :   SUIButton.pas
//  Creator     :   Shen Min
//  Date        :   2002-05-30 V1-V3
//                  2003-06-14 V4
//                  2006-06-14 V6
//  Comment     :
//
//  Copyright (c) 2002-2006 Sunisoft
//  http://www.sunisoft.com
//  Email: support@sunisoft.com
//
////////////////////////////////////////////////////////////////////////////////

unit SUIButton;

interface

{$I SUIPack.inc}

uses Windows, Messages, Classes, Controls, ExtCtrls, Graphics, Buttons,
     StdCtrls, Math, ComCtrls, SysUtils, Forms, ActnList, 
     SUIImagePanel, SUIThemes, SUIMgr, SUI2Define;

type
    TsuiCustomButton = class(TCustomControl)
    private
        m_AutoSize : Boolean;
        m_Caption : TCaption;
        m_Cancel : Boolean;
        m_Default : Boolean;
        m_Transparent : Boolean;
        m_ModalResult : TModalResult;
        m_UIStyle : TsuiUIStyle;
        m_FileTheme : TsuiFileTheme;
        m_BoldFont : Boolean;
        m_PicTransparent: Boolean;
        m_Timer : TTimer;
        m_MouseContinuouslyDownInterval : Integer;
        m_FocusedRectMargin : Integer;
        m_Active : Boolean;

        m_OnMouseEnter : TNotifyEvent;
        m_OnMouseExit : TNotifyEvent;
        m_OnMouseContinuouslyDown : TNotifyEvent;

        procedure MouseLeave(var Msg : TMessage); message CM_MOUSELEAVE;
        procedure CancelMode(var Msg : TMessage); message CM_CANCELMODE;
        procedure MouseEnter(var Msg : TMessage); message CM_MOUSEENTER;
        procedure CMFONTCHANGED(var Msg : TMessage); message CM_FONTCHANGED;
        procedure CMDialogKey(var Message: TCMDialogKey); message CM_DIALOGKEY;
        procedure WMERASEBKGND(var Msg : TMessage); message WM_ERASEBKGND;
        procedure CMDialogChar (var Msg : TCMDialogChar); message CM_DIALOGCHAR;
        procedure WMKeyDown (var Msg : TWMKeyDown); message WM_KEYDOWN;
        procedure WMKeyUp (var Msg : TWMKeyUp); message WM_KEYUP;
        procedure WMKillFocus (var Msg : TWMKillFocus); message WM_KILLFOCUS;
        procedure WMSetFocus (var Msg: TWMSetFocus); message WM_SETFOCUS;
        procedure CMFocusChanged(var Msg: TCMFocusChanged); message CM_FOCUSCHANGED;
        procedure CMTextChanged(var Msg : TMessage); message CM_TEXTCHANGED;

        procedure OnTimer(Sender : TObject);

        procedure SetAutoSize2(const Value: Boolean);
        procedure SetCaption2(const Value : TCaption);
        procedure SetDefault(const Value: Boolean);
        procedure SetUIStyle(const Value : TsuiUIStyle);
        procedure SetPicTransparent(const Value: Boolean);
        procedure SetFileTheme(const Value: TsuiFileTheme);
        procedure SetTransparent(const Value: Boolean);
        function GetTabStop() : Boolean;
        procedure SetTabStop(Value : Boolean);
        procedure SetFocusedRectMargin(const Value: Integer);

    protected
        m_MouseIn : Boolean;
        m_MouseDown : Boolean;

        procedure AutoSizeChanged(); virtual;
        procedure CaptionChanged(); virtual;
        procedure FontChanged(); virtual;
        procedure TransparentChanged(); virtual;
        procedure EnableChanged(); virtual;
        procedure UIStyleChanged(); virtual;

        procedure PaintPic(ACanvas : TCanvas; Bitmap : TBitmap); virtual;
        procedure PaintText(ACanvas : TCanvas; Text : String); virtual;
        procedure PaintFocus(ACanvas : TCanvas); virtual;

        procedure PaintButtonNormal(Buf : TBitmap); virtual;
        procedure PaintButtonMouseOn(Buf : TBitmap); virtual;
        procedure PaintButtonMouseDown(Buf : TBitmap); virtual;
        procedure PaintButtonDisabled(Buf : TBitmap); virtual;

        procedure PaintButton(ThemeIndex, Count, Index : Integer; const Buf : TBitmap);

        procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
        procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
        procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override;
        procedure SetEnabled(Value : Boolean); override;
        procedure Paint(); override;
        procedure Notification(AComponent: TComponent; Operation: TOperation); override;
        procedure CreateWnd; override;

        property FileTheme : TsuiFileTheme read m_FileTheme write SetFileTheme;
        property UIStyle : TsuiUIStyle read m_UIStyle write SetUIStyle;
        property Transparent : Boolean read m_Transparent write SetTransparent;
        property ModalResult : TModalResult read m_ModalResult write m_ModalResult;
        property PicTransparent : Boolean read m_PicTransparent write SetPicTransparent;
        property FocusedRectMargin : Integer read m_FocusedRectMargin write SetFocusedRectMargin;

    public
        constructor Create(AOwner : TComponent); override;
        procedure Click(); override;

        property MouseContinuouslyDownInterval : Integer read m_MouseContinuouslyDownInterval write m_MouseContinuouslyDownInterval;
        property Cancel : Boolean read m_Cancel write m_Cancel default false;
        property Default : Boolean read m_Default write SetDefault default false;

        property OnMouseEnter : TNotifyEvent read m_OnMouseEnter write m_OnMouseEnter;
        property OnMouseExit : TNotifyEvent read m_OnMouseExit write m_OnMouseExit;
        property OnMouseContinuouslyDown : TNotifyEvent read m_OnMouseContinuouslyDown write m_OnMouseContinuouslyDown;

    published
        property BiDiMode;
        property Anchors;
        property ParentColor;
        property Font;
        property PopupMenu;
        property ShowHint;
        property Caption : TCaption read m_Caption write SetCaption2 stored true;
        property AutoSize : Boolean read m_AutoSize write SetAutoSize2;
        property Visible;
        property ParentShowHint;
        property ParentBiDiMode;
        property ParentFont;
        property TabStop read GetTabStop write SetTabStop default True;

        property OnEnter;
        property OnExit;
    end;

    TsuiImageButton = class(TsuiCustomButton)
    private
        m_PicNormal : TPicture;
        m_PicMouseOn : TPicture;
        m_PicMouseDown : TPicture;
        m_PicDisabled : TPicture;
        m_Stretch: Boolean;
        m_DrawFocused : Boolean;

        procedure SetPicDisabledF(const Value: TPicture);
        procedure SetPicMouseDownF(const Value: TPicture);
        procedure SetPicMouseOnF(const Value: TPicture);
        procedure SetPicNormalF(const Value: TPicture);
        procedure SetStretch(const Value: Boolean);
        procedure SetDrawFocused(const Value: Boolean);
        function GetUIStyle2() : TsuiUIStyle;

    protected
        procedure AutoSizeChanged(); override;

        procedure PaintButtonNormal(Buf : TBitmap); override;
        procedure PaintButtonMouseOn(Buf : TBitmap); override;
        procedure PaintButtonMouseDown(Buf : TBitmap); override;
        procedure PaintButtonDisabled(Buf : TBitmap); override;
        procedure PaintFocus(ACanvas : TCanvas); override;

        procedure PaintPic(ACanvas : TCanvas; Bitmap : TBitmap); override;

    public
        constructor Create(AOwner : TComponent); override;
        destructor Destroy(); override;

    published
        property UIStyle read GetUIStyle2;
        property DrawFocused : Boolean read m_DrawFocused write SetDrawFocused;
        property FocusedRectMargin;
        property PicNormal : TPicture read m_PicNormal write SetPicNormalF;
        property PicMouseOn : TPicture read m_PicMouseOn write SetPicMouseOnF;
        property PicMouseDown : TPicture read m_PicMouseDown write SetPicMouseDownF;
        property PicDisabled : TPicture read m_PicDisabled write SetPicDisabledF;
        property Stretch : Boolean read m_Stretch write SetStretch;
        property Cancel;
        property Default;

        property MouseContinuouslyDownInterval;
        property Action;
        property Caption;
        property Font;
        property Enabled;
        property TabOrder;
        property Transparent;
        property ModalResult;
        property AutoSize;

        property OnClick;
        property OnMouseMove;
        property OnMouseDown;
        property OnMouseUp;
        property OnKeyDown;
        property OnKeyUp;
        property OnKeyPress;
        property OnMouseEnter;
        property OnMouseExit;
        property OnMouseContinuouslyDown;
    end;

    TsuiControlButton = class(TsuiCustomButton)
    private
        m_PicIndex : Integer;
        m_PicCount : Integer;
        m_ThemeID : Integer;

        procedure SetThemeID(const Value: Integer);
        procedure SetPicIndex(const Value: Integer);
        procedure SetPicCount(const Value: Integer);
        procedure WMERASEBKGND(var Msg : TMessage); message WM_ERASEBKGND;

    protected
        procedure PaintButtonNormal(Buf : TBitmap); override;
        procedure PaintButtonMouseOn(Buf : TBitmap); override;
        procedure PaintButtonMouseDown(Buf : TBitmap); override;
        procedure PaintButtonDisabled(Buf : TBitmap); override;

        procedure PaintPic(ACanvas : TCanvas; Bitmap : TBitmap); override;

    public
        constructor Create(AOwner : TComponent); override;

    published
        property UIStyle;
        property FileTheme;
        property ThemeID : Integer read m_ThemeID write SetThemeID;
        property PicIndex : Integer read m_PicIndex write SetPicIndex;
        property PicCount : Integer read m_PicCount write SetPicCount;
        property PicTransparent;

        property MouseContinuouslyDownInterval;
        property Action;
        property Caption;
        property Font;
        property Enabled;
        property TabOrder;
        property Transparent;
        property ModalResult;
        property AutoSize;

        property OnClick;
        property OnMouseMove;
        property OnMouseDown;
        property OnMouseUp;
        property OnKeyDown;
        property OnKeyUp;
        property OnKeyPress;
        property OnMouseEnter;
        property OnMouseExit;
        property OnMouseContinuouslyDown;
    end;

    TsuiToolBarSpeedButton = class(TCustomPanel)
    private
        m_MouseIn : Boolean;
        m_Glyph : TBitmap;
        m_ToColor : TColor;        
        
        procedure MouseLeave(var Msg : TMessage); message CM_MOUSELEAVE;
        procedure MouseEnter(var Msg : TMessage); message CM_MOUSEENTER;
        procedure SetGlyph(const Value: TBitmap);
        procedure WMERASEBKGND(var Msg : TMessage); message WM_ERASEBKGND;

    protected
        procedure Paint(); override;

    public
        constructor Create(AOwner : TComponent); override;
        destructor Destroy(); override;    

    published
        property Glyph : TBitmap read m_Glyph write SetGlyph;
        property Color;
        property ToColor : TColor read m_ToColor write m_ToColor;        
        property OnClick;
    end;

    TsuiButton = class(TsuiCustomButton)
    private
        m_Glyph : TBitmap;
        m_Layout : TButtonLayout;
        m_TextPoint : TPoint;
        m_Spacing : Integer;

        procedure SetGlyph(const Value: TBitmap);
        procedure SetLayout(const Value: TButtonLayout);
        procedure SetSpacing(const Value: Integer);
        function GetResHandle: Cardinal;
        procedure SetResHandle(const Value: THandle);        

    protected
        procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override;

        procedure PaintPic(ACanvas : TCanvas; Bitmap : TBitmap); override;
        procedure PaintText(ACanvas : TCanvas; Text : String); override;
        procedure PaintFocus(ACanvas : TCanvas); override;

        procedure UIStyleChanged(); override;

    public
        constructor Create(AOwner : TComponent); override;
        destructor Destroy(); override;

    published
        property FileTheme;
        property UIStyle;
        property Cancel;
        property Default;
        property Action;
        property Caption;
        property Font;
        property Enabled;
        property TabOrder;
        property Transparent;
        property ModalResult;
        property AutoSize;
        property FocusedRectMargin;
        property Glyph : TBitmap read m_Glyph write SetGlyph;
        property Layout : TButtonLayout read m_Layout write SetLayout;
        property Spacing : Integer read m_Spacing write SetSpacing;
        property MouseContinuouslyDownInterval;

        property OnClick;
        property OnMouseMove;
        property OnMouseDown;
        property OnMouseUp;
        property OnKeyDown;
        property OnKeyUp;
        property OnKeyPress;
        property OnMouseEnter;
        property OnMouseExit;
        property OnMouseContinuouslyDown;

        // no use, keep for compatible with V3
        property ResHandle : Cardinal read GetResHandle write SetResHandle;
    end;

    // -------------- TsuiCheckBox (Button for CheckBox)-----------
    TsuiCheckBox = class(TCustomControl)
    private
        m_Checked : Boolean;
        m_UIStyle : TsuiUIStyle;
        m_FileTheme : TsuiFileTheme;
        m_Transparent : Boolean;
        m_AutoSize : Boolean;
        m_OnClick : TNotifyEvent;

        function GetState: TCheckBoxState;
        procedure SetState(const Value: TCheckBoxState);
        procedure SetFileTheme(const Value: TsuiFileTheme);
        procedure SetUIStyle(const Value: TsuiUIStyle);
        procedure SetChecked(const Value: Boolean);
        procedure SetTransparent(const Value: Boolean);
        procedure SetAutoSize2(const Value: Boolean);

        procedure CMFONTCHANGED(var Msg : TMessage); message CM_FONTCHANGED;
        procedure WMERASEBKGND(var Msg : TMessage); message WM_ERASEBKGND;
        procedure CMDialogChar (var Msg : TCMDialogChar); message CM_DIALOGCHAR;
        procedure WMKillFocus (var Msg : TWMKillFocus); message WM_KILLFOCUS;
        procedure WMSetFocus (var Msg: TWMSetFocus); message WM_SETFOCUS;
        procedure CMFocusChanged(var Msg: TCMFocusChanged); message CM_FOCUSCHANGED;
        procedure WMKeyUp (var Msg : TWMKeyUp); message WM_KEYUP;
        procedure CMTextChanged(var Msg : TMessage); message CM_TEXTCHANGED;

    protected
        procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
        function NeedDrawFocus() : Boolean; virtual;
        procedure Paint(); override;
        function GetPicTransparent() : Boolean; virtual;
        function GetPicThemeIndex() : Integer; virtual;
        function GetPicThemeIndexOuter() : Tsk2SkinBitmapElement; virtual;

        procedure CheckStateChanged(); virtual;
        procedure Notification(AComponent: TComponent; Operation: TOperation); override;
        
        procedure Toggle; virtual;
        procedure DoClick(); virtual;
        function WantKeyUp() : Boolean; virtual;
        procedure SetEnabled(Value : Boolean); override;

    public
        constructor Create(AOwner : TComponent); override;
        procedure Click(); override;

    published
        property UIStyle : TsuiUIStyle read m_UIStyle write SetUIStyle;
        property FileTheme : TsuiFileTheme read m_FileTheme write SetFileTheme;

        property BiDiMode;
        property Anchors;
        property PopupMenu;
        property ShowHint;
        property Visible;
        property ParentShowHint;
        property ParentBiDiMode;
        property ParentFont;
        property AutoSize : Boolean read m_AutoSize write SetAutoSize2;
        property Checked : Boolean read m_Checked write SetChecked;
        property Caption;
        property Enabled;
        property Font;
        property Color;
        property TabOrder;
        property TabStop;
        property ParentColor;
  
        property State : TCheckBoxState read GetState write SetState;
        property Transparent : Boolean read m_Transparent write SetTransparent;

        property OnClick read m_OnClick write m_OnClick;
        property OnDblClick;
        property OnMouseMove;
        property OnMouseDown;
        property OnMouseUp;
        property OnKeyDown;
        property OnKeyUp;
        property OnKeyPress;        
        property OnContextPopup;
        property OnDragDrop;
        property OnDragOver;
        property OnEndDock;
        property OnEndDrag;
        property OnEnter;
        property OnExit;
        property OnStartDock;
        property OnStartDrag;

    end;


    // -------------- TsuiRadioButton (Button for RadioButton)-----------
    TsuiRadioButton = class(TsuiCheckBox)
    private
        m_GroupIndex : Integer;

        procedure UnCheckGroup();
        procedure WMSetFocus (var Msg: TWMSetFocus); message WM_SETFOCUS;

    protected
        function WantKeyUp() : Boolean; override;
        procedure DoClick(); override;
        function GetPicTransparent() : Boolean; override;
        function GetPicThemeIndex() : Integer; override;
        function GetPicThemeIndexOuter() : Tsk2SkinBitmapElement; override;
        procedure CheckStateChanged(); override;

    public
        constructor Create(AOwner : TComponent); override;

    published
        property GroupIndex : Integer read m_GroupIndex write m_GroupIndex;

    end;

    TsuiArrowButtonType = (suiUp, suiDown);
    
    TsuiArrowButton = class(TsuiCustomButton)
    private
        m_Arrow: TsuiArrowButtonType;
        procedure SetArrow(const Value: TsuiArrowButtonType);

    protected
        procedure UIStyleChanged(); override;
        procedure PaintPic(ACanvas : TCanvas; Bitmap : TBitmap); override;
        procedure PaintText(ACanvas : TCanvas; Text : String); override;

    published
        property Arrow: TsuiArrowButtonType read m_Arrow write SetArrow;
        property FileTheme;
        property UIStyle;
        property MouseContinuouslyDownInterval;

        property OnClick;
        property OnMouseMove;
        property OnMouseDown;
        property OnMouseUp;
        property OnKeyDown;
        property OnKeyUp;
        property OnKeyPress;
        property OnMouseEnter;
        property OnMouseExit;
        property OnMouseContinuouslyDown;
    end;


implementation

uses SUIResDef, SUIToolBar, SUIPublic{$IFDEF DB}, SUIDBCtrls{$ENDIF};

{ TsuiCustomButton }

constructor TsuiCustomButton.Create(AOwner: TComponent);
begin
    inherited;

    ControlStyle := ControlStyle - [csDoubleClicks];
    ControlStyle := ControlStyle - [csAcceptsControls];

    m_Timer := nil;
    m_MouseContinuouslyDownInterval := 100;
    m_BoldFont := false;

    inherited OnClick := nil;

⌨️ 快捷键说明

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