suibutton.pas

新颖按钮控件

////////////////////////////////////////////////////////////////////////////////
//
//
//  FileName    :   SUIButton.pas
//  Creator     :   Shen Min
//  Date        :   2002-05-30
//  Comment     :
//
//  Copyright (c) 2002-2003 Sunisoft
//  http://www.sunisoft.com
//  Email: [e-mail]
//
////////////////////////////////////////////////////////////////////////////////

unit SUIButton;

interface

uses Windows, Messages, SysUtils, Classes, Controls, ExtCtrls, Graphics,
     Forms, StdCtrls, Buttons, Math, Imglist,
     SUIImagePanel, SUIThemes;

type
    TsuiCustomButton = class(TCustomControl)
    private
        m_PicNormal : String;
        m_PicMouseDown : String;
        m_PicMouseOn : String;

        m_AutoSize : Boolean;
        m_Caption : TCaption;
        m_TabStop : Boolean;
        m_Transparent : Boolean;
        m_ModalResult : TModalResult;
        m_UIStyle : TsuiUIStyle;
        m_PicTransparent: Boolean;

        m_MouseIn : Boolean;
        m_MouseDown : Boolean;
        m_MouseUp : Boolean;

        m_hDLL : THandle;

        m_OnClick : TNotifyEvent;
        m_OnMouseEnter : TNotifyEvent;
        m_OnMouseExit : TNotifyEvent;

        procedure MouseLeave(var Msg : TMessage); message CM_MOUSELEAVE;
        procedure MouseEnter(var Msg : TMessage); message CM_MOUSEENTER;
        procedure CMFONTCHANGED(var Msg : TMessage); message CM_FONTCHANGED;
        procedure FSetAutoSize(const Value: Boolean);
        procedure FSetCaption(const Value : TCaption);
        procedure SetTabStop(const Value : Boolean);
        procedure WMERASEBKGND(var Msg : TMessage); message WM_ERASEBKGND;
        function GetResHandle: THandle;
        procedure SetUIStyle(const Value : TsuiUIStyle);
        procedure SetPicTransparent(const Value: Boolean);

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

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

        procedure SetPicMouseDown(const Value: string); virtual;
        procedure SetPicMouseOn(const Value: string); virtual;
        procedure SetPicNormal(const Value: string); virtual;
        function GetPicMouseDown: String; virtual;
        function GetPicMouseOn: String; virtual;
        function GetPicNormal: String; virtual;

        procedure SetResHandle(const Value: THandle); virtual;

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

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

        procedure SetTransparent(const Value: Boolean);

        procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
        procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
        procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;

        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 SetButtonPic(var UIStyle : TsuiUIStyle); virtual; abstract;

        procedure SetEnabled(Value : Boolean); override;
        procedure Click(); override;

        property TabStop read m_TabStop write SetTabStop stored true;
        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 OnClick read m_OnClick write m_OnClick;

    public
        constructor Create(AOwner : TComponent); override;

        property ResHandle : THandle read GetResHandle write SetResHandle;
        property PicNormalResName : String read GetPicNormal write SetPicNormal;
        property PicMouseDownResName : String read GetPicMouseDown write SetPicMouseDown;
        property PicMouseOnResName : String read GetPicMouseOn write SetPicMouseOn;

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

    published
        property BiDiMode;
        property Anchors;
        property ParentColor;
        property UIStyle : TsuiUIStyle read m_UIStyle write SetUIStyle;
        property Font;
        property PopupMenu;
        property ShowHint;
        property Caption : TCaption read m_Caption write FSetCaption stored true;
        property AutoSize : Boolean read m_AutoSize write FSetAutoSize;
        property Visible;
        property ParentShowHint;
        property ParentBiDiMode;
        property ParentFont;

        property OnEnter;
        property OnExit;
    end;

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

        procedure SetPicDisabledF(const Value: TPicture);
        procedure SetPicMouseDownF(const Value: TPicture);
        procedure SetPicMouseOnF(const Value: TPicture);
        procedure SetPicNormalF(const Value: TPicture);

    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 SetButtonPic(var UIStyle : TsuiUIStyle); override;
        procedure PaintPic(ACanvas : TCanvas; Bitmap : TBitmap); override;        

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

    published
        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 Action;
        property Caption;
        property Font;
        property Enabled;
        property TabStop;
        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;
    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);

    protected
        procedure SetPicMouseDown(const Value: string); override;
        procedure SetPicMouseOn(const Value: string); override;
        procedure SetPicNormal(const Value: string); override;

        function GetPicMouseDown: String; override;
        function GetPicMouseOn: String; override;
        function GetPicNormal: String; override;

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

        procedure SetButtonPic(var UIStyle : TsuiUIStyle); override;

        function CanResize(var NewWidth, NewHeight: Integer): Boolean; override;
        procedure UIStyleChanged(); override;

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

    published
        property Action;
        property Caption;
        property Font;
        property Enabled;
        property TabStop;
        property TabOrder;
        property Transparent;
        property ModalResult;
        property UIStyle;
        property AutoSize;
        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 ResHandle;
        property PicNormalResName;
        property PicMouseDownResName;
        property PicMouseOnResName;

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

    end;


    // -------------- TsuiCustomButtonEx (Button for Two State) ------------
    TsuiCustomButtonEx = class(TsuiCustomButton)
    private
        m_Checked : Boolean;
        m_TextRect : TRect;

        procedure CMDialogChar (var Msg : TCMDialogChar); message CM_DIALOGCHAR;
        procedure WMKeyUp (var Msg : TWMKeyUp); message WM_KEYUP;

    protected
        procedure DoClick(); virtual;

        procedure Resize; override;
        procedure SetChecked(const Value: Boolean);
        procedure AutoSizeChanged(); override;
        procedure FontChanged(); override;

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

        procedure CheckStateChanged(); virtual;
        procedure UIStyleChanged(); override;
        procedure CaptionChanged(); override;

        function GetPicWidth() : Integer; virtual; abstract;
        function GetPicHeight() : Integer; virtual; abstract;

        procedure ReplaceControl();

        procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;

    public
        constructor Create(AOwner : TComponent); override;

    published
        property Checked : Boolean read m_Checked write SetChecked;
        property Caption;
        property Enabled;
        property Font;
        property Color;
        property Transparent;
        property TabStop;
        property TabOrder;

        property OnClick;
        property OnDblClick;
        property OnMouseMove;
        property OnMouseDown;
        property OnMouseUp;
        property OnKeyDown;
        property OnKeyUp;
        property OnKeyPress;
    end;


    // -------------- TsuiCheckBox (Button for CheckBox)-----------
    TsuiCheckBox = class(TsuiCustomButtonEx)
    private
        function GetState: TCheckBoxState;
        procedure SetState(const Value: TCheckBoxState);

    protected
        procedure Toggle; virtual;
        procedure DoClick(); override;

        procedure SetButtonPic(var UIStyle : TsuiUIStyle); override;
        procedure UIStyleChanged(); override;
        procedure CheckStateChanged(); override;
        procedure EnableChanged(); override;

        function GetPicWidth() : Integer; override;
        function GetPicHeight() : Integer; override;

        procedure TransparentChanged(); override;

        property State : TCheckBoxState read GetState write SetState;

    public
        constructor Create(AOwner : TComponent); override;

        procedure UpdateCheckState();

    end;


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

        procedure UnCheckGroup();

    protected
        procedure DoClick(); override;
        
        procedure SetButtonPic(var UIStyle : TsuiUIStyle); override;
        procedure TransparentChanged(); override;
        procedure CheckStateChanged(); override;

    public
        constructor Create(AOwner : TComponent); override;

    published
        property GroupIndex : Integer read m_GroupIndex write m_GroupIndex;

    end;


implementation

uses SUIResDef, SUIPublic;

{ TsuiCustomButton }

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

    ResHandle := 0;

    inherited OnClick := nil;
    inherited Caption := '';

    m_MouseIn := false;
    m_MouseUp := false;
    m_MouseDown := false;

    ModalResult := mrNone;
    m_AutoSize := false;
end;

procedure TsuiCustomButton.MouseDown(Button: TMouseButton; Shift: TShiftState; X,
  Y: Integer);
begin
    if Button = mbLeft then
    begin
        m_MouseDown := true;
        Repaint();
    end;

    inherited;    
end;

procedure TsuiCustomButton.MouseUp(Button: TMouseButton; Shift: TShiftState; X,
  Y: Integer);
begin
    if (Button = mbLeft) and m_MouseDown then
    begin
        m_MouseUp := true;

        m_MouseDown := false;
        Repaint();
        Click();

        m_MouseUp := false;
    end;

    inherited;
end;

procedure TsuiCustomButton.MouseEnter(var Msg: TMessage);
begin
    inherited;

    if csDesigning in ComponentState then
        Exit;

    m_MouseIn := true;
    Repaint();

    if Assigned(m_OnMouseEnter) then
        m_OnMouseEnter(self);
end;

procedure TsuiCustomButton.MouseLeave(var Msg: TMessage);
begin
    inherited;

    m_MouseIn := false;
    Repaint();

    if Assigned(m_OnMouseExit) then
        m_OnMouseExit(self);
end;

procedure TsuiCustomButton.Paint;
var
    Buf : TBitmap;
    BufImage : TBitmap;
begin
    Buf := TBitmap.Create();
    BufImage := TBitmap.Create();

    try
        if not Enabled then
            PaintButtonDisabled(BufImage)
        else if m_MouseDown then
            PaintButtonMouseDown(BufImage)
        else if not m_MouseIn then
            PaintButtonNormal(BufImage)
        else
            PaintButtonMouseOn(BufImage);
    except
        BufImage.Width := 74;
        BufImage.Height := 21;
    end;

    Buf.PixelFormat := pfDevice;
    Buf.Width := Width;
    Buf.Height := Height;

    if m_Transparent then
        DoTrans(Buf.Canvas, self)
    else
    begin
        Buf.Canvas.Brush.Color := Color;
        Buf.Canvas.FillRect(ClientRect);
    end;

    PaintPic(Buf.Canvas, BufImage);

    BufImage.Free();

    if Focused and TabStop then
        PaintFocus(Buf.Canvas);

    Buf.Canvas.Font := Font;
    Canvas.Font := Font;
    if Trim(m_Caption) <> '' then
        PaintText(Buf.Canvas, m_Caption);

    Canvas.CopyRect(ClientRect, Buf.Canvas, ClientRect);

    Buf.Free();
end;

procedure TsuiCustomButton.FSetAutoSize(const Value: Boolean);
begin
    m_AutoSize := Value;
    AutoSizeChanged();
    RePaint();
end;

procedure TsuiCustomButton.SetPicMouseDown(const Value: string);
begin
    m_PicMouseDown := Value;

    Repaint();
end;

procedure TsuiCustomButton.SetPicMouseOn(const Value: string);
begin
    m_PicMouseOn := Value;

    Repaint();
end;

procedure TsuiCustomButton.SetPicNormal(const Value: string);
begin
    m_PicNormal := Value;
    AutoSizeChanged();
    Repaint();
end;

procedure TsuiCustomButton.CMDialogChar(var Msg: TCMDialogChar);
begin