Delphi自写组件:可设置颜色的按钮(改成BS_OWNERDRAW风格,然后CN_DRAWITEM)

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.

http://blog.csdn.net/aroc_lo/article/details/3070530

http://www.fx114.net/qa-183-149306.aspx

posted @ 2016-04-01 20:13  findumars  Views(1495)  Comments(0Edit  收藏  举报