unit ColorButton;
{
Article:
TColorButton - button with Color properties
http://delphi.about.com/library/weekly/aa061104a.htm
Full source code of the TColorButton Delphi component,
an extension to the standard TButton control,
with font color, background color and mouse over color properties.
}
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, StdCtrls, Buttons, ExtCtrls;
type
TColorButton = class(TButton)
private
FBackBeforeHoverColor: TColor;
private
FCanvas: TCanvas;
IsFocused: Boolean;
FBackColor: TColor;
FForeColor: TColor;
FHoverColor: TColor;
procedure SetBackColor(const Value: TColor);
procedure SetForeColor(const Value: TColor);
procedure SetHoverColor(const Value: TColor);
property BackBeforeHoverColor : TColor read FBackBeforeHoverColor write FBackBeforeHoverColor;
protected
procedure CreateParams(var Params: TCreateParams); override;
procedure WndProc(var Message : TMessage); override;
procedure SetButtonStyle(Value: Boolean); override;
procedure DrawButton(Rect: TRect; State: UINT);
procedure CMEnabledChanged(var Message: TMessage); message CM_ENABLEDCHANGED;
procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
procedure CNMeasureItem(var Message: TWMMeasureItem); message CN_MEASUREITEM;
procedure CNDrawItem(var Message: TWMDrawItem); message CN_DRAWITEM;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
property BackColor: TColor read FBackColor write SetBackColor default clBtnFace;
property ForeColor: TColor read FForeColor write SetForeColor default clBtnText;
property HoverColor: TColor read FHoverColor write SetHoverColor default clBtnFace;
end;
procedure Register;
implementation
constructor TColorButton.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FCanvas := TCanvas.Create;
BackColor := clBtnFace;
ForeColor := clBtnText;
HoverColor := clBtnFace;
end; (*Create*)
destructor TColorButton.Destroy;
begin
FCanvas.Free;
inherited Destroy;
end; (*Destroy*)
procedure TColorButton.WndProc(var Message : TMessage);
begin
if (Message.Msg = CM_MOUSELEAVE) then
begin
BackColor := BackBeforeHoverColor;
invalidate;
end;
if (Message.Msg = CM_MOUSEENTER) then
begin
BackBeforeHoverColor := BackColor;
BackColor := HoverColor;
invalidate;
end;
inherited;
end; (*WndProc*)
procedure TColorButton.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams(Params);
with Params do Style := Style or BS_OWNERDRAW;
end; (*CreateParams*)
procedure TColorButton.SetButtonStyle(Value: Boolean);
begin
if Value <> IsFocused then
begin
IsFocused := Value;
Invalidate;
end;
end; (*SetButtonStyle*)
procedure TColorButton.CNMeasureItem(var Message: TWMMeasureItem);
begin
with Message.MeasureItemStruct^ do
begin
itemWidth := Width;
itemHeight := Height;
end;
end; (*CNMeasureItem*)
procedure TColorButton.CNDrawItem(var Message: TWMDrawItem);
var
SaveIndex: Integer;
begin
with Message.DrawItemStruct^ do
begin
SaveIndex := SaveDC(hDC);
FCanvas.Lock;
try
FCanvas.Handle := hDC;
FCanvas.Font := Font;
FCanvas.Brush := Brush;
DrawButton(rcItem, itemState);
finally
FCanvas.Handle := 0;
FCanvas.Unlock;
RestoreDC(hDC, SaveIndex);
end;
end;
Message.Result := 1;
end; (*CNDrawItem*)
procedure TColorButton.CMEnabledChanged(var Message: TMessage);
begin
inherited;
Invalidate;
end; (*CMEnabledChanged*)
procedure TColorButton.CMFontChanged(var Message: TMessage);
begin
inherited;
Invalidate;
end; (*CMFontChanged*)
procedure TColorButton.SetBackColor(const Value: TColor);
begin
if FBackColor <> Value then begin
FBackColor:= Value;
Invalidate;
end;
end; (*SetButtonColor*)
procedure TColorButton.SetForeColor(const Value: TColor);
begin
if FForeColor <> Value then begin
FForeColor:= Value;
Invalidate;
end;
end; (*SetForeColor*)
procedure TColorButton.SetHoverColor(const Value: TColor);
begin
if FHoverColor <> Value then begin
FHoverColor:= Value;
Invalidate;
end;
end; (*SetHoverColor*)
procedure TColorButton.DrawButton(Rect: TRect; State: UINT);
var
Flags, OldMode: Longint;
IsDown, IsDefault, IsDisabled: Boolean;
OldColor: TColor;
OrgRect: TRect;
begin
OrgRect := Rect;
Flags := DFCS_BUTTONPUSH or DFCS_ADJUSTRECT;
IsDown := State and ODS_SELECTED <> 0;
IsDefault := State and ODS_FOCUS <> 0;
IsDisabled := State and ODS_DISABLED <> 0;
if IsDown then Flags := Flags or DFCS_PUSHED;
if IsDisabled 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(Rect.Left, Rect.Top, Rect.Right, Rect.Bottom);
InflateRect(Rect, - 1, - 1);
end;
if IsDown then
begin
FCanvas.Pen.Color := clBtnShadow;
FCanvas.Pen.Width := 1;
FCanvas.Brush.Color := clBtnFace;
FCanvas.Rectangle(Rect.Left, Rect.Top, Rect.Right, Rect.Bottom);
InflateRect(Rect, - 1, - 1);
end
else
DrawFrameControl(FCanvas.Handle, Rect, DFC_BUTTON, Flags);
if IsDown then OffsetRect(Rect, 1, 1);
OldColor := FCanvas.Brush.Color;
FCanvas.Brush.Color := BackColor;
FCanvas.FillRect(Rect);
FCanvas.Brush.Color := OldColor;
OldMode := SetBkMode(FCanvas.Handle, TRANSPARENT);
FCanvas.Font.Color := ForeColor;
if IsDisabled then
DrawState(FCanvas.Handle, FCanvas.Brush.Handle, nil, Integer(Caption), 0,
((Rect.Right - Rect.Left) - FCanvas.TextWidth(Caption)) div 2,
((Rect.Bottom - Rect.Top) - FCanvas.TextHeight(Caption)) div 2,
0, 0, DST_TEXT or DSS_DISABLED)
else
DrawText(FCanvas.Handle, PChar(Caption), - 1, Rect,
DT_SINGLELINE or DT_CENTER or DT_VCENTER);
SetBkMode(FCanvas.Handle, OldMode);
if IsFocused and IsDefault then
begin
Rect := OrgRect;
InflateRect(Rect, - 4, - 4);
FCanvas.Pen.Color := clWindowFrame;
FCanvas.Brush.Color := clBtnFace;
DrawFocusRect(FCanvas.Handle, Rect);
end;
end; (*DrawButton*)
procedure Register;
begin
RegisterComponents('delphi.about.com', [TColorButton]);
end;
end.
