• 设为首页
  • 点击收藏
  • 手机版
    手机扫一扫访问
    迪恩网络手机版
  • 关注官方公众号
    微信扫一扫关注
    公众号

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

原作者: [db:作者] 来自: [db:来源] 收藏 邀请
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
  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. 鲜花

    握手

    雷人

    路过

    鸡蛋
    该文章已有0人参与评论

    请发表评论

    全部评论

    专题导读
    上一篇:
    matlab 绘图字体大小控制 - Bin的专栏发布时间:2022-07-18
    下一篇:
    matlab中将矩阵按照行打乱顺序的一个例子发布时间:2022-07-18
    热门推荐
    阅读排行榜

    扫描微信二维码

    查看手机版网站

    随时了解更新最新资讯

    139-2527-9053

    在线客服(服务时间 9:00~18:00)

    在线QQ客服
    地址:深圳市南山区西丽大学城创智工业园
    电邮:jeky_zhao#qq.com
    移动电话:139-2527-9053

    Powered by 互联科技 X3.4© 2001-2213 极客世界.|Sitemap