buttoncomps.pas

一组个delphi按钮控件的代码

unit ButtonComps;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls;

type
  TEncartaButton = class(TGraphicControl)
  private
    Cap : string;
    Col : TColor;
    Border: TColor;
    OverFColor: TColor;
    OverColor: TColor;
    DownColor: TColor;
    MDown: TMouseEvent;
    MUp: TMouseEvent;
    MEnter : TNotifyEvent;
    MLeave : TNotifyEvent;
    Enab: Boolean;
    Bmp: TBitmap;
    SCap: Boolean;
    BtnClick: TNotifyEvent;
    procedure SetCol(Value: TColor);
    procedure SetBorder(Value: TColor);
    procedure SetCap(Value: string);
    procedure SetBmp(Value: TBitmap);
    procedure SetSCap(Value: Boolean);
  protected
    procedure Paint; override;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); override;
    procedure MouseEnter(var Message: TMessage); message CM_MOUSEENTER;
    procedure MouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
    procedure Click; override;
    procedure SetParent(Value: TWinControl); override;
  public
    constructor Create(AOwner: TComponent); override;
  published
    property Caption : string read Cap write SetCap;
    property Color : TColor read Col write SetCol;
    property ColorBorder : TColor read Border write SetBorder;
    property Enabled : Boolean read Enab write Enab;
    property OnMouseDown: TMouseEvent read MDown write MDown;
    property OnMouseUp: TMouseEvent read MUp write MUp;
    property OnMouseEnter: TNotifyEvent read MEnter write MEnter;
    property OnMouseLeave: TNotifyEvent read MLeave write MLeave;
    property OnClick: TNotifyEvent read BtnClick write BtnClick;
    property Glyph: TBitmap read Bmp write SetBmp;
    property ColorOverCaption: TColor read OverFColor write OverFColor;
    property ColorOver: TColor read OverColor write OverColor;
    property ColorDown: TColor read DownColor write DownColor;
    property ShowCaption: Boolean read SCap write SetSCap;
    property ShowHint;
    property ParentShowHint;
    property OnMouseMove;
    property Font;
  end;

  TAOLButton = class(TGraphicControl)
  private
    Cap : string;
    Col : TColor;
    RaiseCol: TColor;
    MDown: TMouseEvent;
    MUp: TMouseEvent;
    MLeave : TNotifyEvent;
    Enab: Boolean;
    BtnClick: TNotifyEvent;
    procedure SetCol(Value: TColor);
    procedure SetCap(Value: string);
    procedure SetRaiseCol(Value: TColor);
  protected
    procedure Paint; override;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); override;
    procedure MouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
    procedure Click; override;
    procedure SetParent(Value: TWinControl); override;
  public
    constructor Create(AOwner: TComponent); override;
  published
    property Caption : string read Cap write SetCap;
    property Color : TColor read Col write SetCol;
    property RaiseColor : TColor read RaiseCol write SetRaiseCol;
    property Enabled : Boolean read Enab write Enab;
    property OnMouseDown: TMouseEvent read MDown write MDown;
    property OnMouseUp: TMouseEvent read MUp write MUp;
    property OnMouseLeave: TNotifyEvent read MLeave write MLeave;
    property OnClick: TNotifyEvent read BtnClick write BtnClick;
    property ShowHint;
    property ParentShowHint;
    property OnMouseMove;
    property Font;
  end;

  TImageButton = class(TGraphicControl)
  private
    MOver: TBitmap;
    MDown: TBitmap;
    MUp: TBitmap;
    Bmp: TBitmap;
    ActualBmp: TBitmap;
    BmpDAble: TBitmap;
    BtnClick: TNotifyEvent;
    OnMDown: TMouseEvent;
    OnMUp: TMouseEvent;
    OnMEnter: TNotifyEvent;
    OnMLeave: TNotifyEvent;
    procedure SetMOver(Value: TBitmap);
    procedure SetMDown(Value: TBitmap);
    procedure SetMUp(Value: TBitmap);
    procedure SetBmp(Value: TBitmap);
    procedure SetBmpDAble(Value: TBitmap);
  protected
    procedure Paint; override;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); override;
    procedure MouseEnter(var Message: TMessage); message CM_MOUSEENTER;
    procedure MouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
    procedure Click; override;
  public
    constructor Create(AOwner: TComponent); override;
  published
    property BitmapOver: TBitmap read MOver write SetMOver;
    property BitmapDown: TBitmap read MDown write SetMDown;
    property BitmapUp: TBitmap read MUp write SetMUp;
    property BitmapDisabled: TBitmap read BmpDAble write SetBmpDAble;
    property Bitmap: TBitmap read Bmp write SetBmp;
    property OnClick: TNotifyEvent read BtnClick write BtnClick;
    property OnMouseDown: TMouseEvent read OnMDown write OnMDown;
    property OnMouseUp: TMouseEvent read OnMUp write OnMUp;
    property OnMouseEnter: TNotifyEvent read OnMEnter write OnMEnter;
    property OnMouseLeave: TNotifyEvent read OnMLeave write OnMLeave;
    property Enabled;
    property ShowHint;
    property ParentShowHint;
  end;

  TSelButton = class(TGraphicControl)
  private
    Cap : string;
    Col : TColor;
    Border: TColor;
    OverFColor: TColor;
    OverColor: TColor;
    DownColor: TColor;
    MDown: TMouseEvent;
    MUp: TMouseEvent;
    MEnter : TNotifyEvent;
    MLeave : TNotifyEvent;
    Enab: Boolean;
    BtnClick: TNotifyEvent;
    Alment: TAlignment;
    BWidth: Longint;
    procedure SetCol(Value: TColor);
    procedure SetBorder(Value: TColor);
    procedure SetCap(Value: string);
    procedure SetAlment(Value: TAlignment);
    procedure SetBWidth(Value: Longint);
  protected
    procedure Paint; override;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); override;
    procedure MouseEnter(var Message: TMessage); message CM_MOUSEENTER;
    procedure MouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
    procedure Click; override;
    procedure SetParent(Value: TWinControl); override;
  public
    constructor Create(AOwner: TComponent); override;
  published
    property Caption : string read Cap write SetCap;
    property Color : TColor read Col write SetCol;
    property ColorBorder : TColor read Border write SetBorder;
    property Enabled : Boolean read Enab write Enab;
    property OnMouseDown: TMouseEvent read MDown write MDown;
    property OnMouseUp: TMouseEvent read MUp write MUp;
    property OnMouseEnter: TNotifyEvent read MEnter write MEnter;
    property OnMouseLeave: TNotifyEvent read MLeave write MLeave;
    property OnClick: TNotifyEvent read BtnClick write BtnClick;
    property ColorOverCaption: TColor read OverFColor write OverFColor;
    property ColorOver: TColor read OverColor write OverColor;
    property ColorDown: TColor read DownColor write DownColor;
    property Alignment: TAlignment read Alment write SetAlment;
    property BorderWidth: Longint read BWidth write SetBWidth;
    property ShowHint;
    property ParentShowHint;
    property OnMouseMove;
    property Font;
  end;

  TSquareButton = class(TGraphicControl)
  private
    Cap : string;
    Col : TColor;
    Border: TColor;
    OverFColor: TColor;
    OverBorderCol: TColor;
    DownBorderCol: TColor;
    MDown: TMouseEvent;
    MUp: TMouseEvent;
    MEnter : TNotifyEvent;
    MLeave : TNotifyEvent;
    Enab: Boolean;
    BtnClick: TNotifyEvent;
    Alment: TAlignment;
    BWidth: Longint;
    procedure SetCol(Value: TColor);
    procedure SetBorder(Value: TColor);
    procedure SetCap(Value: string);
    procedure SetAlment(Value: TAlignment);
    procedure SetBWidth(Value: Longint);
  protected
    procedure Paint; override;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); override;
    procedure MouseEnter(var Message: TMessage); message CM_MOUSEENTER;
    procedure MouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
    procedure Click; override;
    procedure SetParent(Value: TWinControl); override;
  public
    constructor Create(AOwner: TComponent); override;
  published
    property Caption : string read Cap write SetCap;
    property Color : TColor read Col write SetCol;
    property ColorBorder : TColor read Border write SetBorder;
    property Enabled : Boolean read Enab write Enab;
    property OnMouseDown: TMouseEvent read MDown write MDown;
    property OnMouseUp: TMouseEvent read MUp write MUp;
    property OnMouseEnter: TNotifyEvent read MEnter write MEnter;
    property OnMouseLeave: TNotifyEvent read MLeave write MLeave;
    property OnClick: TNotifyEvent read BtnClick write BtnClick;
    property ColorOverCaption: TColor read OverFColor write OverFColor;
    property Alignment: TAlignment read Alment write SetAlment;
    property ColorOverBorder: TColor read OverBorderCol write OverBorderCol;
    property BorderWidth: Longint read BWidth write SetBWidth;
    property DownBorderColor: TColor read DownBorderCol write DownBorderCol;
    property ShowHint;
    property ParentShowHint;
    property OnMouseMove;
    property Font;
  end;


procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('Buttons', [TEncartaButton, TAOLButton, TImageButton, TSelButton,
    TSquareButton]);
end;

constructor TEncartaButton.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  Width := 86;
  Height := 22;
  Col := clBtnFace;
  OverFColor := clBlack;
  OverColor := $000ABED8;
  DownColor := $000ABED8;
  Canvas.Brush.Color := clBlack;
  Border := $00828F99;
  Font.Name := 'Arial';
  Font.Color := clBlack;
  Enab := true;
  Bmp := TBitmap.Create;
  ShowHint := true;
  SCap := true;
end;

procedure TEncartaButton.SetParent(Value: TWinControl);
begin
  inherited;
  if Value <> nil then Cap := Name;
end;

procedure TEncartaButton.Paint;
var TextWidth, TextHeight : Longint;
begin
  inherited Paint;
  Canvas.Font := Font;
  Canvas.Brush.Color := Col;
  Canvas.FillRect(Rect(1,1,Width-1,Height-1));
  TextWidth := Canvas.TextWidth(Cap);
  TextHeight := Canvas.TextHeight(Cap);
  Canvas.Font.Color := $00D6E0E0;
  if Bmp.Empty = false then begin
     if SCap = true then begin
        Canvas.BrushCopy(Rect(Width div 2 - (Bmp.Width+TextWidth) div 2-1,Height div 2 - Bmp.Height div 2,
               bmp.width+Width div 2 - (Bmp.Width+TextWidth) div 2,bmp.height+Height div 2 - Bmp.Height div 2),
               bmp,Rect(0,0,bmp.width,bmp.height),bmp.Canvas.pixels[0,0]);
        Canvas.Font.Color := Font.Color;
        Canvas.TextOut(Width div 2 + (Bmp.Width-TextWidth) div 2+5-1,Height div 2-TextHeight div 2,Cap);
     end else Canvas.BrushCopy(Rect(Width div 2-Bmp.Width div 2,Height div 2-Bmp.Height div 2,
                     bmp.width+Width div 2-Bmp.Width div 2,bmp.height+Height div 2-Bmp.Height div 2),
                     bmp,Rect(0,0,bmp.width,bmp.height),bmp.Canvas.pixels[0,0]);
  end else begin
     Canvas.Font.Color := Font.Color;
     if SCap = true then Canvas.TextOut(Width div 2 - TextWidth div 2,Height div 2-TextHeight div 2,Cap);
  end;
  Canvas.Brush.Color := Border;
  Canvas.FrameRect(Rect(0,0,Width,Height));
end;

procedure TEncartaButton.Click;
begin
  inherited Click;
  Paint;
  if Enab then if Assigned(BtnClick) then BtnClick(Self);
end;

procedure TEncartaButton.SetCol(Value: TColor);
begin
  Col := Value;
  Paint;
end;

procedure TEncartaButton.SetBorder(Value: TColor);
begin
  Border := Value;
  Paint;
end;

procedure TEncartaButton.SetCap(Value: string);
begin
  Cap := value;
  Paint;
end;

procedure TEncartaButton.SetBmp(Value: TBitmap);
begin
  Bmp.Assign(value);
  invalidate;
end;

procedure TEncartaButton.SetSCap(value: Boolean);
begin
  SCap := Value;
  Paint;
end;

procedure TEncartaButton.MouseDown(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
var TextWidth, TextHeight : Longint;
begin
  inherited MouseDown(Button, Shift, X, Y);
  TextWidth := Canvas.TextWidth(Cap);