一个Button控件

unit MyButton;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls;

type
  TMyButton = class(TButton)
  private
    FCanvas:TCanvas;
    drawColor:TColor;
    FIsMouseOver:Boolean;
    procedure CNMeasureItem(var Msg: TWMMeasureItem); message CN_MEASUREITEM;
    procedure CNDrawItem(var Msg: TWMDrawItem); message CN_DRAWITEM;
    procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
    procedure CMEnabledChanged(var Message: TMessage); message CM_ENABLEDCHANGED;
    procedure WMLButtonDblClk(var Message: TWMLButtonDblClk); message WM_LBUTTONDBLCLK;
    procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
    procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
    procedure DrawItem(const DrawItemStruct: TDrawItemStruct);
  protected
    procedure CreateParams(var Params: TCreateParams); override;
    procedure SetButtonStyle(ADefault: Boolean); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property UserColor:TColor read drawColor write drawColor;
  end;

procedure Register;

implementation

procedure ColorFul(_Sender:TCanvas;_C1,_C2:TColor;_Width,_Height:Integer;_Mode:Integer);
var
  i:Integer;
  Rct:TRect;
  R1,G1,B1,R2,G2,B2,R3,G3,B3:Byte;
begin
  with TCanvas(_Sender) do begin
    R1:=Byte(_C1);
    G1:=Byte(_C1 shr 8);
    B1:=Byte(_C1 shr 16);
    R2:=Byte(_C2);
    G2:=Byte(_C2 shr 8);
    B2:=Byte(_C2 shr 16);
    case _Mode of
    1:begin
      for i:=0 to _Width do begin
        if R1>R2 then R3:=R1-MulDiv(i,R1-R2,_Width) else R3:=R1+MulDiv(i,R2-R1,_Width);
        if G1>G2 then G3:=G1-MulDiv(i,G1-G2,_Width) else G3:=G1+MulDiv(i,G2-G1,_Width);
        if B1>B2 then B3:=B1-MulDiv(i,B1-B2,_Width) else B3:=B1+MulDiv(i,B2-B1,_Width);
        Brush.Color:=RGB(R3,G3,B3);
        Rct:=Rect(i,0,i+1,_Height);
        FillRect(Rct);
      end;
    end;
    2:begin
      for i:=0 to _Height do begin
        if R1>R2 then R3:=R1-MulDiv(i,R1-R2,_Height) else R3:=R1+MulDiv(i,R2-R1,_Height);
        if G1>G2 then G3:=G1-MulDiv(i,G1-G2,_Height) else G3:=G1+MulDiv(i,G2-G1,_Height);
        if B1>B2 then B3:=B1-MulDiv(i,B1-B2,_Height) else B3:=B1+MulDiv(i,B2-B1,_Height);
        Brush.Color:=RGB(R3,G3,B3);
        Rct:=Rect(0,i,_Width,i+1);
        FillRect(Rct);
      end;
    end;
    end;
    SetBkMode(Handle,Windows.TRANSPARENT);
  end;
end;

constructor TMyButton.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FCanvas:=TCanvas.Create;
  FIsMouseOver:=False;
  Width:=75;  Height:=25;  drawColor:=clSilver;
end;

destructor TMyButton.Destroy;
begin
  FCanvas.Free;
  inherited Destroy;
end;

procedure TMyButton.CMMouseEnter(var Message: TMessage);
begin
  if (not FIsMouseOver) then Invalidate;
end;

procedure TMyButton.CMMouseLeave(var Message: TMessage);
begin
  if (FIsMouseOver) then Invalidate;
end;

procedure TMyButton.CNMeasureItem(var Msg: TWMMeasureItem);
begin
  with Msg.MeasureItemStruct^ do begin
    itemWidth:=Width;  itemHeight:=Height;
  end;
  Msg.Result:=1;
end;

procedure TMyButton.CNDrawItem(var Msg: TWMDrawItem);
begin
  DrawItem(Msg.DrawItemStruct^);
  Msg.Result:=1;
end;

procedure TMyButton.DrawItem(const DrawItemStruct: TDrawItemStruct);
var
  isDown,isDefault:Boolean;
  R,BtnRect:TRect;
  cursorPos:TPoint;
begin
  FCanvas.Handle:=DrawItemStruct.hDC;
  try
    R:=ClientRect;
    with DrawItemStruct do begin
      IsDown:=(itemState and ODS_SELECTED)<>0;
      IsDefault:=itemState<>0;
    end;
    GetCursorPos(CursorPos);
    BtnRect.TopLeft:=Parent.ClientToScreen(Point(Left, Top));
    BtnRect.BottomRight:=Parent.ClientToScreen(Point(Left+Width,Top+Height));
    FIsMouseOver:=PtInRect(BtnRect,CursorPos);
    FCanvas.Brush.Color:=clBtnFace;
    FCanvas.FillRect(R);
    if FIsMouseOver then begin
      ColorFul(FCanvas,drawColor,clWhite,Width,Height,2);
      FCanvas.Pen.Color:=clBlack;  FCanvas.Brush.Style:=bsClear;
      FCanvas.Rectangle(R);
    end else begin
      FCanvas.Pen.Color:=clBlack;
      FCanvas.Rectangle(R);
    end;
    if IsDown then begin
      ColorFul(FCanvas,clWhite,drawColor,Width,Height,2);
      FCanvas.Pen.Color:=clBlack;  FCanvas.Brush.Style:=bsClear;
      FCanvas.Rectangle(R);
    end;
    with FCanvas do begin
      FCanvas.Font:=Self.Font;  Brush.Style:=bsClear;  Font.Color:=clBtnText;
      if Enabled or ((DrawItemStruct.itemState and ODS_DISABLED) = 0) then begin
        DrawText(Handle, PChar(Caption), Length(Caption), R,
          DT_CENTER or DT_VCENTER or DT_SINGLELINE);
      end else begin
        OffsetRect(R, 1, 1);
        Font.Color:=clBtnHighlight;
        DrawText(Handle,PChar(Caption),Length(Caption),R,
          DT_CENTER or DT_VCENTER or DT_SINGLELINE);
        OffsetRect(R, -1, -1);
        Font.Color:=clBtnShadow;
        DrawText(Handle,PChar(Caption),Length(Caption),R,
          DT_CENTER or DT_VCENTER or DT_SINGLELINE);
      end;
    end;
  finally
    FCanvas.Handle:=0;
  end;
end;

procedure TMyButton.CMFontChanged(var Message: TMessage);
begin
  inherited;
  Invalidate;
end;

procedure TMyButton.CMEnabledChanged(var Message: TMessage);
begin
  inherited;
  Invalidate;
end;

procedure TMyButton.WMLButtonDblClk(var Message: TWMLButtonDblClk);
begin
  Perform(WM_LBUTTONDOWN, Message.Keys, Longint(Message.Pos));
end;

procedure TMyButton.SetButtonStyle(ADefault: Boolean);
begin
  Refresh;
end;

procedure TMyButton.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);
  Params.Style:=Params.Style or BS_OWNERDRAW;
end;

procedure Register;
begin
  RegisterComponents('User', [TMyButton]);
end;

end.