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

来源:互联网 发布:网络制式有哪些 编辑:程序博客网 时间:2024/03/29 02:49
  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.

原创粉丝点击