playicq.com上的：
unit ColorButton;
interface
uses
SysUtils, Classes, Controls, StdCtrls,Graphics,Messages,windows;
type
TClrButton = class(TButton)
private
{ Private declarations }
IsFocused : Boolean;
FCanvas : TCanvas;
procedure CNDrawItem(var Msg : TWMDrawItem);message CN_DRAWITEM;
procedure CMFontChanged(var Msg : TMessage);message CM_FONTCHANGED;
procedure CMEnabledChanged(var Msg : TMessage);message CM_ENABLEDCHANGED;
procedure WMLButtonDblClk(var Msg : TWMLButtonDblClk);message WM_LBUTTONDBLCLK;
protected
{ Protected declarations }
procedure SetBounds(ALeft,ATop,AWidth,AHeight : integer);override;
procedure CreateParams(var Params : TCreateParams);override;
procedure CreateWnd;override;
procedure SetButtonStyle(ADefault : Boolean);override;
public
{ Public declarations }
constructor Create(AOwner : TComponent);override;
destructor Destroy;override;
published
{ Published declarations }
property Color;
property Width default 75;
property Height default 25;
property ParentshowHint;
property ShowHint;
property TabOrder;
property Visible;
property OnEnter;
property OnExit;
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('Samples', [TClrButton]);
end;
constructor TClrButton.Create(AOwner : TComponent);
begin
inherited Create(AOwner);
SetBounds(Left,Top,75,25);
FCanvas := TCanvas.Create;
end;
destructor TClrButton.Destroy;
begin
inherited Destroy;
FCanvas.Free;
end;
procedure TClrButton.CreateParams(var Params : TCreateParams);
begin
inherited CreateParams(Params);
with Params do
Style := Style or bs_OwnerDraw;
end;
procedure TClrButton.CreateWnd;
var
hRegin : THandle;
begin
inherited CreateWnd;
hRegin := CreateRectRgn(0,0,Width,Height);
SetWindowRgn(Handle,hRegin,true);
end;
procedure TClrButton.SetBounds(ALeft,ATop,AWidth,AHeight : integer);
var
hRegin : THandle;
begin
inherited SetBounds(ALeft,ATop,AWidth,AHeight);
if HandleAllocated then
begin
hRegin := CreateRectRgn(0,0,Width,Height);
SetWindowRgn(Handle,hRegin,true);
end;
end;
procedure TClrButton.CNDrawItem(var Msg : TWMDrawItem);
var
OdsDown,OdsFocus,ActionFocus : Boolean;
Rect : TRect;
begin
FCanvas.Handle := Msg.DrawItemStruct^.hDC;
Rect := ClientRect;
Dec(Rect.Right);
Dec(Rect.Bottom);
with Msg.DrawItemStruct^ do
begin
OdsDown := ItemState and ODS_SELECTED <> 0;
OdsFocus := ItemState and ODS_FOCUS <> 0;
ActionFocus := ItemAction = ODA_FOCUS;
end;
with FCanvas do
begin
Brush.Color := Color;
if not ActionFocus then
begin
Brush.Style := bsSolid;
FillRect(Rect);
end
end;
if OdsDown then
begin
FCanvas.Pen.Color := clBtnshadow;
if not ActionFocus then
FCanvas.Rectangle(Rect.Left,Rect.top,Rect.Right,Rect.Bottom);
end
else if not ActionFocus then
begin
FCanvas.Pen.color := clWindowFrame;
FCanvas.Rectangle(Rect.Left,Rect.top,Rect.Right,Rect.Bottom);
FCanvas.Pen.Color := clWhite;
FCanvas.MoveTo(Rect.Left,Rect.Bottom-1);
FCanvas.LineTo(Rect.Left,Rect.Top);
FCanvas.LineTo(Rect.Right-1,Rect.Top);
FCanvas.Pen.Color := clBtnShadow;
InflateRect(Rect,-1,-1);
FCanvas.MoveTo(Rect.Right,Rect.Top);
FCanvas.LineTo(Rect.Right,Rect.Bottom);
FCanvas.LineTo(Rect.Left,Rect.Bottom);
end;
InflateRect(Rect,-2,-2);
if OdsDown then
begin
inc(Rect.Left);
inc(Rect.Top);
end;
font := Self.Font;
if not ActionFocus then
DrawText(FCanvas.Handle,PChar(Caption),-1,Rect,dt_SingleLine or dt_Center or dt_VCenter);
FCanvas.Brush.Style := bssolid;
FCanvas.Pen.color := clBlack;
FCanvas.Brush.color := clWhite;
if IsFocused or OdsFocus or ActionFocus then
FCanvas.DrawFocusRect(Rect);
end;
procedure TClrButton.CMFontChanged(var Msg : TMessage);
begin
inherited;
invalidate;
end;
procedure TClrButton.CMEnabledChanged(var Msg : TMessage);
begin
inherited;
invalidate;
end;
procedure TClrButton.WMLButtonDblClk(var Msg : TWMLButtonDblClk);
begin
Perform(WM_LBUTTONDOWN,Msg.Keys,LongInt(Msg.Pos));
end;
procedure TClrButton.SetButtonStyle(ADefault : Boolean);
begin
if ADefault<>IsFocused then
begin
IsFocused := ADefault;
invalidate;
end;
end;
end.
