标签：tco alt map tno als ntc tran invalid 指定
效果如图，支持普通、移上去、按下、弹起、禁用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
标签：tco alt map tno als ntc tran invalid 指定
原文地址：http://www.cnblogs.com/findumars/p/6711194.html
