Delphi 三态按钮

unit XPButton;

interface

uses

  SysUtils, Classes,forms, Controls, ExtCtrls,Graphics,windows,Messages,dialogs,StdCtrls;

type

  TXPButton = class(TImage)

  constructor Create(AOwner:TComponent);override;

  destructor destroy;override;

  procedure SetText(AValue: string);

  procedure XPMouseLeave(var Msg:TMessage); message CM_MOUSELEAVE;

  procedure XPMouseHover(var Msg:TMessage); message CM_MOUSEENTER;

  procedure SetPictureHover(ABitmap: Graphics.TBitmap);

  procedure SetPictureDown(ABitmap: Graphics.TBitmap);

  procedure SetPictureOut (ABitmap: Graphics.TBitmap);

  procedure XPMouseDown (Sender: TObject; Button: TMouseButton;

  Shift: TShiftState; X, Y: Integer);

  procedure XPMouseUp(Sender: TObject; Button: TMouseButton;

  Shift: TShiftState; X, Y: Integer);

  procedure XPClick(Sender: TObject);

  procedure XPMouseMove(Sender: TObject; Shift: TShiftState; X,

  Y: Integer);

  private

    { Private declarations }

   FText:string;

   mousestate:integer; //0 0ut ,1 hover ,2 down,3up,

  protected

    { Protected declarations }

  public

   FHoverBitmap:Graphics.TBitmap;

   FOutBitmap:Graphics.TBitmap;

   FDownBitmap:Graphics.TBitmap;

    { Public declarations }

  published

    { Published declarations }

  property Text:String read FText write SetText;

  property PictureHover: Graphics.TBitmap read FHoverBitmap write SetPictureHover;

  property PictureDown: Graphics.TBitmap read FDownBitmap write SetPictureDown;

  property PictureOut:Graphics.TBitmap read FOutBitmap write SetPictureOut;

  end;

procedure Register;

implementation

constructor TXPButton.Create(AOwner:TComponent);

begin

inherited Create(AOwner);

self.AutoSize:=true;

FHoverBitmap:=Graphics.TBitmap.Create;

FOutBitmap:=Graphics.TBitmap.Create;

FDownBitmap:=Graphics.TBitmap.Create;

self.OnMouseDown:=self.XPMouseDown;

self.OnMouseUp:=self.XPMouseUp;

self.Picture.Assign(foutbitmap);

mousestate:= 0;

end;

destructor TXPButton.destroy;

begin

FDownBitmap.Free;

FOutBitmap.free;

FHoverBitmap.free;

inherited;

end;

procedure TXPButton.SetText(AValue: string);

var X,Y:integer;

begin

FText:=AValue;

if  (csDesigning in self.ComponentState) and not (csReading in self.ComponentState)  then

begin

X:=(Width-Canvas.TextWidth(FText))div 2;

Y:=(Height-Canvas.TextHeight(FText))div 2;

canvas.Brush.Style:=bsSolid;

self.Picture.Assign(self.PictureOut);

canvas.Brush.Style:=bsclear;

self.Canvas.TextOut(x,y,Ftext);

end;

end;

procedure TXPButton.SetPictureOut (ABitmap: Graphics.TBitmap);

var X,Y:integer;

begin

X:=(Width-Canvas.TextWidth(Ftext))div 2;

Y:=(Height-Canvas.TextHeight(Ftext))div 2;

foutbitmap.Assign(abitmap);

self.Picture.Assign(foutbitmap);

canvas.Brush.Style:=bsclear;

self.Canvas.TextOut(x,y,Ftext);

end;

procedure TXPButton.SetPictureHover(ABitmap: Graphics.TBitmap);

begin

fhoverbitmap.Assign(abitmap);

end;

procedure TXPButton.SetPictureDown(ABitmap: Graphics.TBitmap);

begin

fdownbitmap.Assign(abitmap);

end;

procedure TXPButton.XPMouseLeave(var Msg:TMessage);

var X,Y:integer;

begin

X:=(Width-Canvas.TextWidth(Ftext))div 2;

Y:=(Height-Canvas.TextHeight(Ftext))div 2;

self.Picture.Assign(foutbitmap);

canvas.Brush.Style:=bsclear;

self.Canvas.TextOut(x,y,Ftext);

mousestate:=0;

end;

procedure TXPButton.XPMouseHover(var Msg:TMessage);

var X,Y:integer;

begin

if not (csDesigning in self.ComponentState) then

begin

//showmessage('悬浮');

X:=(Width-Canvas.TextWidth(Ftext))div 2;

Y:=(Height-Canvas.TextHeight(Ftext))div 2;

self.Picture.Assign(fhoverbitmap);

canvas.Brush.Style:=bsclear;

self.Canvas.TextOut(x,y,Ftext);

mousestate:=1;

end;

end;

procedure TXPButton.XPMouseDown (Sender: TObject; Button: TMouseButton;

  Shift: TShiftState; X, Y: Integer);

  var xx,yy:integer;

begin

xx:=(Width-Canvas.TextWidth(Ftext))div 2;

yy:=(Height-Canvas.TextHeight(Ftext))div 2;

self.Picture.Assign(FDownBitmap);

canvas.Brush.Style:=bsclear;

self.Canvas.TextOut(xx,yy,Ftext);

end;

procedure TXPButton.XPMouseUp(Sender: TObject; Button: TMouseButton;

Shift: TShiftState; X, Y: Integer);

  var xx,yy:integer;

begin

xx:=(Width-Canvas.TextWidth(Ftext))div 2;

yy:=(Height-Canvas.TextHeight(Ftext))div 2;

if mousestate=1 then

self.Picture.Assign(FHoverBitmap)

else

self.Picture.Assign(FOutBitmap);

canvas.Brush.Style:=bsclear;

self.Canvas.TextOut(xx,yy,Ftext);

end;

procedure TXPButton.XPClick(Sender: TObject);

begin

end;

procedure TXPButton.XPMouseMove(Sender: TObject; Shift: TShiftState; X,

  Y: Integer);

begin

end;

procedure Register;

begin

  RegisterComponents('ActiveX', [TXPButton]);

end;

end.

 

本文来自CSDN博客，转载请标明出处：http://blog.csdn.net/my_c_s_d_n/archive/2010/03/23/5408909.aspx