delphi自绘按钮源码

转载自网络,我们可以比较清晰的看到自绘步骤,代码:

unit Button1;

interface

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

type
  TButton1 = class(TButton)
  private
    { Private declarations }
    FColor:TColor;
    FCanvas: TCanvas;
    IsFocused: Boolean;
    procedure SetColor(Value:TColor);
    procedure CNDrawItem(var Message:TWMDrawItem);message CN_DRAWITEM;
  protected
    { Protected declarations }
    procedure CreateParams(var Params:TCreateParams);override;
    procedure SetButtonStyle(ADefault:Boolean);override;
  public
    { Public declarations }
    constructor Create(AOwner:TComponent);override;
    destructor Destroy;override;
  published
    { Published declarations }
    property Color:TColor read FColor write SetColor default clWhite;
  end;

procedure Register;

implementation
//*** 构造函数 ***************************************************** 
constructor TButton1.Create(AOwner: TComponent); 
begin 
inherited Create(AOwner); 
FCanvas := TCanvas.Create; 
FColor:=clWhite;//默认颜色 
end; 

//*** 析构函数 ************************************************* 
destructor TButton1.Destroy; 
begin 
FCanvas.Free; 
inherited Destroy; 
end; 

//*** 定义按钮样式,必须将该按钮重定义为自绘式按钮 ************* 
procedure TButton1.CreateParams(var Params: TCreateParams); 
begin 
inherited CreateParams(Params); 
with Params do Style := Style or BS_OWNERDRAW; 
end; 

//*** 属性写方法 ************************************************ 
procedure TButton1.SetColor(Value:TColor); 
begin 
FColor:=Value; 
Invalidate; 
end; 

//*** 设置按钮状态*********************************************** 
procedure TButton1.SetButtonStyle(ADefault: Boolean); 
begin 
if ADefault <> IsFocused then 
begin 
IsFocused := ADefault; 
Refresh; 
end; 
end; 

//*** 绘制按钮 *************************************************** 
procedure TButton1.CNDrawItem(var Message: TWMDrawItem); 
var 
IsDown, IsDefault: Boolean; 
ARect: TRect; 
Flags: Longint; 
DrawItemStruct: TDrawItemStruct; 
wh:TSize; 
begin 
DrawItemStruct:=Message.DrawItemStruct^; 
FCanvas.Handle := DrawItemStruct.hDC; 
ARect := ClientRect; 
with DrawItemStruct do 
begin 
IsDown := itemState and ODS_SELECTED <> 0; 
IsDefault := itemState and ODS_FOCUS <> 0; 
end; 

Flags := DFCS_BUTTONPUSH or DFCS_ADJUSTRECT; 
if IsDown then Flags := Flags or DFCS_PUSHED; 
if DrawItemStruct.itemState and ODS_DISABLED <> 0 then 
Flags := Flags or DFCS_INACTIVE; 

if IsFocused or IsDefault then 
begin 
//按钮得到焦点时的状态绘制 
FCanvas.Pen.Color := clWindowFrame; 
FCanvas.Pen.Width := 1; 
FCanvas.Brush.Style := bsClear; 
FCanvas.Rectangle(ARect.Left, ARect.Top, ARect.Right, ARect.Bottom); 
InflateRect(ARect, -1, -1); 
end; 

FCanvas.Pen.Color := clBtnShadow; 
FCanvas.Pen.Width := 1; 
FCanvas.Brush.Color := FColor; 
if IsDown then begin 
//按钮被按下时的状态绘制 
FCanvas.Rectangle(ARect.Left , ARect.Top, ARect.Right, ARect.Bottom); 
InflateRect(ARect, -1, -1); 
end else 
//绘制一个未按下的按钮 
DrawFrameControl(DrawItemStruct.hDC, ARect, DFC_BUTTON, Flags); 
FCanvas.FillRect(ARect); 

//绘制Caption文本内容 
FCanvas.Font := Self.Font; 
ARect:=ClientRect; 
wh:=FCanvas.TextExtent(Caption); 
FCanvas.Pen.Width := 1; 
FCanvas.Brush.Style := bsClear; 
if not Enabled then 
begin //按钮失效时应多绘一次Caption文本 
FCanvas.Font.Color := clBtnHighlight; 
FCanvas.TextOut((Width div 2)-(wh.cx div 2)+1, 
(height div 2)-(wh.cy div 2)+1, 
Caption); 
FCanvas.Font.Color := clBtnShadow; 
end; 
FCanvas.TextOut((Width div 2)-(wh.cx div 2),(height div 2)-(wh.cy div 2),Caption); 

//绘制得到焦点时的内框虚线 
if IsFocused and IsDefault then 
begin 
ARect := ClientRect; 
InflateRect(ARect, -4, -4); 
FCanvas.Pen.Color := clWindowFrame; 
FCanvas.Brush.Color := FColor; 
DrawFocusRect(FCanvas.Handle, ARect); 
end; 
FCanvas.Handle := 0; 
end; 
//** The End *********************************************************

procedure Register;
begin
  RegisterComponents('Samples', [TButton1]);
end;

end.



评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值