Delphi皮肤之 - 图片按钮

效果如图，支持普通、移上去、按下、弹起、禁用5种状态。

unit BmpBtn;

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,

StdCtrls;

type

TButtonLayout = (blGlyphLeft, blGlyphRight, blGlyphTop, blGlyphBottom);

TDesignType = (dtMenu, dtButton);

TBmpButton = class(TGraphicControl)

private

MOver: TBitmap;

MDown: TBitmap;

MUp: TBitmap;

Bmp: TBitmap;

ActualBmp: TBitmap;

BmpDAble: TBitmap;   // 禁用状态图像

FGlyph: TIcon;

//FTransparentGlyph: Boolean;

FTransparentBmp: Boolean;

FLayout: TButtonLayout;

FSpacing: integer;

FDesignType: TDesignType; //用于菜单还是按钮

//FColorText: TColor;

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);

procedure SetGlyph(Value: TIcon);      //

procedure SetLayout(Value: TButtonLayout);

//procedure SetTransparentGlyph(Value: Boolean);

procedure SetTransparentBmp(Value: Boolean);

procedure SetSpacing(Value: Integer);

// procedure SetColors(Value: TColor);

procedure SetDesignType(Value: TDesignType);

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 TextChanged (var msg: TMessage); message CM_TEXTCHANGED;

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 Glyph: TIcon read FGlyph write SetGlyph; //加入图标属性

property Layout: TButtonLayout read FLayout write SetLayout;  //加入布局属性

//property TransparentGlyph: Boolean read FTransparentGlyph write SetTransparentGlyph; //加入透明度属性(去否去掩码，针对小图标)

property TransparentBmp: Boolean read FTransparentBmp write SetTransparentBmp; //加入透明度属性(去否去掩码，针对背景图像)

property Spacing: integer read FSpacing write SetSpacing; //加入图标和文字的间距属性

property Font;  //加入文字属性

property Caption; //加入文字

// property ColorText: TColor read FColorText write SetColors; //文字颜色

property DesignType: TDesignType read FDesignType write SetDesignType; //指定设计类型

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;

property ParentFont;

property Visible;

end;

procedure Register;

implementation

procedure Register;

begin

RegisterComponents('SkinsDesign', [TBmpButton]);

end;

{ TImageButton }

constructor TBmpButton.Create(AOwner: TComponent);

begin

inherited Create(AOwner);

MOver := TBitmap.Create;

MDown := TBitmap.Create;

MUp := TBitmap.Create;

Bmp := TBitmap.Create;

BmpDAble := TBitmap.Create;

ActualBmp := TBitmap.Create;

FGlyph := TIcon.Create;

//TransparentGlyph := True;

FSpacing := 4;

//FColorText := clBlack;

Width := 75;

Height := 25;

Canvas.Brush.Color := clBtnFace;

ShowHint := true;

end;

procedure TBmpButton.Paint;

var

TempBmp: TBitMap;

CaptionRect: TRect;

GlyphLeft, GlyphTop, TextTop, TextLeft, TextWidth, TextHeight: integer;

//TextColor: TColor;

begin

inherited Paint;

TempBmp := TBitMap.Create;

TempBmp.Width := Width;

TempBmp.Height := Height;

TempBmp.TransparentColor:= clFuchsia;

TempBmp.Transparent := FTransparentBmp;

if ActualBmp.Width = 0 then ActualBmp.Assign(Bmp);

TempBmp.Canvas.FillRect(Rect(0,0,Width,Height));

if Enabled or (BmpDAble.Width = 0) then TempBmp.Canvas.Draw(0,0,ActualBmp)

else begin

Width := BmpDAble.Width;

Height := BmpDAble.Height;

TempBmp.Canvas.Draw(0,0,BmpDAble);

end;

TempBmp.Canvas.Font := Font;

TextWidth := TempBmp.Canvas.TextWidth(Caption);

TextHeight := TempBmp.Canvas.TextHeight(Caption);

TextTop := (Height - TextHeight) div 2;

TextLeft := (Width - TextWidth) div 2;

if not Glyph.Empty then

begin

GlyphLeft:= 0;

case FLayout of

blGlyphLeft:   begin

GlyphTop:= (Height - FGlyph.Height) div 2;

GlyphLeft:= TextLeft - FGlyph.Width div 2;

inc(TextLeft, FGlyph.Width div 2);

if not (Caption = '') then begin

GlyphLeft:= GlyphLeft - FSpacing div 2 - FSpacing mod 2;

inc(TextLeft, FSpacing div 2);

end;

end;

blGlyphRight:  begin

GlyphTop:= (Height - FGlyph.Height) div 2;

GlyphLeft:= TextLeft + TextWidth - FGlyph.Width div 2;

inc(TextLeft, - FGlyph.Width div 2);

if not (Caption = '') then begin

GlyphLeft:= GlyphLeft + FSpacing div 2 + FSpacing mod 2;

inc(TextLeft, - FSpacing div 2);

end;

end;

blGlyphTop:    begin

GlyphLeft:= (Width - FGlyph.Width) div 2;

GlyphTop:= TextTop - FGlyph.Height div 2 - FGlyph.Height mod 2;

inc(TextTop, FGlyph.Height div 2);

if not (Caption = '') then begin

GlyphTop:= GlyphTop - FSpacing div 2 - FSpacing mod 2;

inc(TextTop, + FSpacing div 2);

end;

end;

blGlyphBottom: begin

GlyphLeft:= (Width - FGlyph.Width) div 2;

GlyphTop:= TextTop + TextHeight - Glyph.Height div 2;

inc(TextTop, - FGlyph.Height div 2);

if not (Caption = '') then begin

GlyphTop:= GlyphTop + FSpacing div 2 + FSpacing mod 2;

inc(TextTop, - FSpacing div 2);

end;

end;

end;

end;

{if FBtnState = bsDown then

begin

inc(GlyphTop, 1);

inc(GlyphLeft, 1);

end; }

//FGlyph.TransparentColor:= FGlyph.Canvas.Pixels[0, 0];

//FGlyph.Transparent:= FTransparentGlyph;

TempBmp.Canvas.Draw(GlyphLeft, GlyphTop, FGlyph);

with CaptionRect do begin

Top:= TextTop;

Left:=TextLeft;

Right:= Left + TextWidth;

Bottom:= Top + TextHeight;

end;

if Caption <> '' then begin

TempBmp.Canvas.Brush.Style:= bsClear;

DrawText(TempBmp.Canvas.Handle,

PChar(Caption),

length(Caption),

CaptionRect,

DT_CENTER or DT_VCENTER or DT_SINGLELINE or DT_NOCLIP);

end;

Canvas.Draw(0, 0, TempBmp);

TempBmp.Free;

end;

procedure TBmpButton.Click;

begin

inherited Click;

Paint;

if Enabled then if Assigned(BtnClick) then BtnClick(Self);

end;

procedure TBmpButton.SetMOver(Value: TBitmap);

begin

MOver.Assign(Value);

Paint;

end;

procedure TBmpButton.SetMDown(Value: TBitmap);

begin

MDown.Assign(Value);

Paint;

end;

procedure TBmpButton.SetMUp(Value: TBitmap);

begin

MUp.Assign(Value);

Paint;

end;

procedure TBmpButton.SetBmp(Value: TBitmap);

begin

Bmp.Assign(Value);

ActualBmp.Assign(Value);

Width := Bmp.Width;

Height := Bmp.Height;

Paint;

end;

procedure TBmpButton.SetBmpDAble(Value: TBitmap);

begin

BmpDAble.Assign(Value);

paint;

end;

procedure TBmpButton.MouseDown(Button: TMouseButton; Shift: TShiftState;

X, Y: Integer);

begin

inherited MouseDown(Button, Shift, X, Y);

if (Button = mbLeft) and Enabled then begin

if Assigned (OnMDown) then OnMDown(Self, Button, Shift, X, Y);

if MDown.Width > 0 then begin

ActualBmp.Assign(MDown);

Width := MDown.Width;

Height := MDown.Height;

Paint;

end;

end;

end;

procedure TBmpButton.MouseUp(Button: TMouseButton; Shift: TShiftState;

X, Y: Integer);

//var MouseOverButton: Boolean;

//    P: TPoint;

begin

Case FDesignType of

dtMenu:

begin

ActualBmp.Assign(MDown);

Paint;

end;

dtButton:

begin

inherited MouseUp(Button, Shift, X, Y);

end;

end;

//if (x>0) and (y>0) and (x<width) and (y<height) then

{if (Button = mbLeft) and Enabled then begin

if Assigned (OnMUp) then OnMUp(Self, Button, Shift, X, Y);

if MUp.Width > 0 then begin

GetCursorPos(P);

MouseOverButton := (FindDragTarget(P, True) = Self);

if MouseOverButton then begin

Width := MUp.Width;

Height := MUp.Height;

Canvas.FillRect(Rect(0,0,Width,Height));

Canvas.Draw(0,0,MUp);

end else begin

Width := bmp.Width;

Height := Bmp.Height;

Canvas.FillRect(Rect(0,0,Width,Height));

Canvas.Draw(0,0,Bmp);

end;

end else begin

if MouseOverButton = false then begin

Width := MOver.Width;

Height := MOver.Height;

Canvas.FillRect(Rect(0,0,Width,Height));

Canvas.Draw(0,0,MOver);

end else begin

Width := bmp.Width;

Height := Bmp.Height;

Canvas.FillRect(Rect(0,0,Width,Height));

Canvas.Draw(0,0,Bmp);

end;

end;

end;  }

end;

procedure TBmpButton.MouseEnter(var Message: TMessage);

begin

if Enabled then begin

if MOver.Width > 0 then begin

ActualBmp.Assign(MOver);

Width := MOver.Width;

Height := MOver.Height;

Paint;

end;

end;

end;

procedure TBmpButton.MouseLeave(var Message: TMessage);

begin

Case FDesignType of

dtMenu:

begin

Exit;

end;

dtButton:

begin

if Enabled then begin

if Bmp.Width > 0 then begin

ActualBmp.Assign(Bmp);

Width := Bmp.Width;

Height := Bmp.Height;

Paint;

end;

end;

end;

end;

end;

procedure TBmpButton.SetGlyph(Value: TIcon);

begin

FGlyph.Assign(Value);

Invalidate;

end;

procedure TBmpButton.SetLayout(Value: TButtonLayout);

begin

FLayout:= Value;

Invalidate;

end;

{procedure TBmpButton.SetTransparentGlyph(Value: Boolean);

begin

FTransparentGlyph:= Value;

Invalidate;

end; }

procedure TBmpButton.SetSpacing(Value: Integer);

begin

FSpacing:= Value;

Invalidate;

end;

{procedure TBmpButton.SetColors(Value: TColor);

begin

FColorText := Value;

Paint;

end;  }

procedure TBmpButton.TextChanged(var msg: TMessage);

begin

Invalidate;

end;

procedure TBmpButton.SetDesignType(Value: TDesignType);

begin

FDesignType := Value;

Invalidate;

end;

procedure TBmpButton.SetTransparentBmp(Value: Boolean);

begin

FTransparentBmp:= Value;

Invalidate;

end;

end.

http://blog.csdn.net/zang141588761/article/details/52287872