Delphi自写组件：可设置颜色的按钮

unit ColorButton;
interface
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls,
  StdCtrls;
type
  TColorButton = class(TButton)
  private
    //添加Color属性，默认clWhite
    { 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
//**********************************
//*** Borland/Delphi7/Source/Vcl/checklst.pas 可做参考
//**********************************
//系统自动添加的注册函数
procedure Register;
begin
  RegisterComponents('Additional', [TColorButton]);
end;
//*********添加构造函数***************
constructor TColorButton.Create(AOwner:TComponent);
begin
  inherited Create(AOwner);
  FCanvas:=TCanvas.Create;
  FColor:=clWhite; //设置默认颜色
end;
//*********添加析构函数***************
destructor TColorButton.Destroy;
begin
  FCanvas.Free;
  inherited Destroy;
end;
//****定义按钮样式，必须将该按钮重定义为自绘式按钮*****
procedure TColorButton.CreateParams(var Params:TCreateParams);
begin
  inherited CreateParams(Params);
  with Params do Style:=Style or BS_OWNERDRAW;
end;
//****属性写方法*****
procedure TColorButton.SetColor(Value:TColor);
begin
  FColor:=Value;
  Invalidate;     //完全重画控件
end;
//****设置按钮状态*****
procedure TColorButton.SetButtonStyle(ADefault:Boolean);
begin
  if ADefault<>IsFocused then
  begin
    IsFocused:=ADefault;
    Refresh;
  end;
end;
//****绘制按钮*****
procedure TColorButton.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;
end.

 

1. unit ColorButton;
2. interface
3. uses
4.   Windows, Messages, SysUtils, Classes, Graphics, Controls,
5.   StdCtrls;
6. type
7.   TColorButton = class(TButton)
8.   private
9.     //添加Color属性，默认clWhite
10.     { Private declarations }
11.     FColor:TColor;
12.     FCanvas:TCanvas;
13.     IsFocused:Boolean;
14.     procedure SetColor(Value:Tcolor);
15.     procedure CNDrawItem(var Message:TWMDrawItem);message CN_DRAWITEM;
16.   protected
17.     { Protected declarations }
18.     procedure CreateParams(var Params:TCreateParams);override;
19.     procedure SetButtonStyle(ADefault:Boolean);override;
20.   public
21.     { Public declarations }
22.     constructor Create(AOwner:TComponent);override;
23.     destructor Destroy;override;
24.   published
25.     { Published declarations }
26.     property Color:TColor read FColor write SetColor default clWhite;
27.   end;
28. procedure Register;
29. implementation
31. //**********************************
32. //*** Borland/Delphi7/Source/Vcl/checklst.pas 可做参考
33. //**********************************
35. //系统自动添加的注册函数
36. procedure Register;
37. begin
38.   RegisterComponents('Additional', [TColorButton]);
39. end;
40. //*********添加构造函数***************
41. constructor TColorButton.Create(AOwner:TComponent);
42. begin
43.   inherited Create(AOwner);
44.   FCanvas:=TCanvas.Create;
45.   FColor:=clWhite; //设置默认颜色
46. end;
47. //*********添加析构函数***************
48. destructor TColorButton.Destroy;
49. begin
50.   FCanvas.Free;
51.   inherited Destroy;
52. end;
53. //****定义按钮样式，必须将该按钮重定义为自绘式按钮*****
54. procedure TColorButton.CreateParams(var Params:TCreateParams);
55. begin
56.   inherited CreateParams(Params);
57.   with Params do Style:=Style or BS_OWNERDRAW;
58. end;
59. //****属性写方法*****
60. procedure TColorButton.SetColor(Value:TColor);
61. begin
62.   FColor:=Value;
63.   Invalidate;     //完全重画控件
64. end;
65. //****设置按钮状态*****
66. procedure TColorButton.SetButtonStyle(ADefault:Boolean);
67. begin
68.   if ADefault<>IsFocused then
69.   begin
70.     IsFocused:=ADefault;
71.     Refresh;
72.   end;
73. end;
74. //****绘制按钮*****
75. procedure TColorButton.CNDrawItem(var Message: TWMDrawItem);
76. var
77.   IsDown,IsDefault:Boolean;
78.   ARect:TRect;
79.   Flags:Longint;
80.   DrawItemStruct:TDrawItemStruct;
81.   wh:TSize;
82. begin
83. /////////////////////////////////////////
84.   DrawItemStruct:=Message.DrawItemStruct^;
85.   FCanvas.Handle := DrawItemStruct.hDC;
86.   ARect := ClientRect;
87.   with DrawItemStruct do
88.   begin
89.     IsDown := itemState and ODS_SELECTED <> 0;
90.     IsDefault := itemState and ODS_FOCUS <> 0;
91.   end;
92.   Flags := DFCS_BUTTONPUSH or DFCS_ADJUSTRECT;
93.   if IsDown then Flags := Flags or DFCS_PUSHED;
94.   if DrawItemStruct.itemState and ODS_DISABLED <> 0 then
95.      Flags := Flags or DFCS_INACTIVE;
96.   if IsFocused or IsDefault then
97.   begin
98.     //按钮得到焦点时的状态绘制
99.     FCanvas.Pen.Color := clWindowFrame;
100.     FCanvas.Pen.Width := 1;
101.     FCanvas.Brush.Style := bsClear;
102.     FCanvas.Rectangle(ARect.Left, ARect.Top, ARect.Right, ARect.Bottom);
103.     InflateRect(ARect, -1, -1);
104.   end;
105.   FCanvas.Pen.Color := clBtnShadow;
106.   FCanvas.Pen.Width := 1;
107.   FCanvas.Brush.Color := FColor;
108.   if IsDown then begin
109.     //按钮被按下时的状态绘制
110.      FCanvas.Rectangle(ARect.Left , ARect.Top, ARect.Right, ARect.Bottom);
111.      InflateRect(ARect, -1, -1);
112.   end else
113.      //绘制一个未按下的按钮
114.      DrawFrameControl(DrawItemStruct.hDC, ARect, DFC_BUTTON, Flags);
115.   FCanvas.FillRect(ARect);
116.   //绘制Caption文本内容
117.   FCanvas.Font := Self.Font;
118.   ARect:=ClientRect;
119.   wh:=FCanvas.TextExtent(Caption);
120.   FCanvas.Pen.Width := 1;
121.   FCanvas.Brush.Style := bsClear;
122.   if not Enabled then
123.   begin //按钮失效时应多绘一次Caption文本
124.      FCanvas.Font.Color := clBtnHighlight;
125.      FCanvas.TextOut((Width div 2)-(wh.cx div 2)+1,
126.                      (height div 2)-(wh.cy div 2)+1,
127.                       Caption);
128.      FCanvas.Font.Color := clBtnShadow;
129.   end;
130.   FCanvas.TextOut((Width div 2)-(wh.cx div 2),(height div 2)-(wh.cy div 2),Caption);
131.   //绘制得到焦点时的内框虚线
132.   if IsFocused and IsDefault then
133.   begin
134.      ARect := ClientRect;
135.      InflateRect(ARect, -4, -4);
136.      FCanvas.Pen.Color := clWindowFrame;
137.      FCanvas.Brush.Color := FColor;
138.      DrawFocusRect(FCanvas.Handle, ARect);
139.   end;
140.   FCanvas.Handle := 0;
141. end;
     
143. end.