//继承IMAGE控件
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.