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