How to make custom BitBtn? - delphi

Question

How to make custom BitBtn with color property?
I have found one solution here, but it is a TButton not TBitBtn so I have edited the code as follows :
unit ColorBitBtn;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, StdCtrls, Buttons, ExtCtrls;
type
TColorBitBtn = class(TBitBtn)
private
ShowBackColor : Boolean;
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);
protected
procedure CreateParams(var Params: TCreateParams); override;
procedure WndProc(var Message : TMessage); override;
procedure SetBitBtnStyle(Value: Boolean);
procedure DrawBitBtn(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 TColorBitBtn.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
ShowBackColor := True;
FCanvas := TCanvas.Create;
BackColor := clBtnFace;
ForeColor := clBtnText;
HoverColor := clBtnFace;
end;
destructor TColorBitBtn.Destroy;
begin
FreeAndNil(FCanvas);
inherited Destroy;
end;
procedure TColorBitBtn.WndProc(var Message : TMessage);
begin
if (Message.Msg = CM_MOUSELEAVE) then
begin
ShowBackColor := True;
Invalidate;
end;
if (Message.Msg = CM_MOUSEENTER) then
begin
ShowBackColor := False;
Invalidate;
end;
inherited;
end;
procedure TColorBitBtn.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams(Params);
with Params do
Style := Style or BS_OWNERDRAW;
end;
procedure TColorBitBtn.SetBitBtnStyle(Value: Boolean);
begin
if Value <> IsFocused then
begin
IsFocused := Value;
Invalidate;
end;
end;
procedure TColorBitBtn.CNMeasureItem(var Message: TWMMeasureItem);
begin
with Message.MeasureItemStruct^ do
begin
itemWidth := Width;
itemHeight := Height;
end;
end;
procedure TColorBitBtn.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;
DrawBitBtn(rcItem, itemState);
finally
FCanvas.Handle := 0;
FCanvas.Unlock;
RestoreDC(hDC, SaveIndex);
end;
end;
Message.Result := 1;
end;
procedure TColorBitBtn.CMEnabledChanged(var Message: TMessage);
begin
inherited;
Invalidate;
end;
procedure TColorBitBtn.CMFontChanged(var Message: TMessage);
begin
inherited;
Invalidate;
end;
procedure TColorBitBtn.SetBackColor(const Value: TColor);
begin
if FBackColor <> Value then
begin
FBackColor:= Value;
Invalidate;
end;
end;
procedure TColorBitBtn.SetForeColor(const Value: TColor);
begin
if FForeColor <> Value then
begin
FForeColor:= Value;
Invalidate;
end;
end;
procedure TColorBitBtn.SetHoverColor(const Value: TColor);
begin
if FHoverColor <> Value then
begin
FHoverColor:= Value;
Invalidate;
end;
end;
procedure TColorBitBtn.DrawBitBtn(Rect: TRect; State: UINT);
var Flags, OldMode: Longint;
IsDown, IsDefault, IsDisabled: Boolean;
OldColor: TColor;
OrgRect: TRect;
NewCaption : string;
begin
NewCaption := Caption;
OrgRect := Rect;
Flags := DFCS_BUTTONPUSH or DFCS_ADJUSTRECT;
IsDown := State and ODS_SELECTED <> 0;
IsDisabled := State and ODS_DISABLED <> 0;
IsDefault := State and ODS_FOCUS <> 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
begin
DrawFrameControl(FCanvas.Handle, Rect, DFC_BUTTON, Flags);
end;
if IsDown then OffsetRect(Rect, 1, 1);
OldColor := FCanvas.Brush.Color;
if ShowBackColor then
FCanvas.Brush.Color := BackColor
else
FCanvas.Brush.Color := HoverColor;
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(NewCaption), 0,
((Rect.Right - Rect.Left) - FCanvas.TextWidth(NewCaption)) div 2,
((Rect.Bottom - Rect.Top) - FCanvas.TextHeight(NewCaption)) div 2,
0, 0, DST_TEXT or DSS_DISABLED)
else
begin
InflateRect(Rect, -4, -4);
DrawText(FCanvas.Handle, PChar(NewCaption), - 1, Rect, DT_WORDBREAK or DT_CENTER);
end;
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;
procedure Register;
begin
RegisterComponents('Standard', [TColorBitBtn]);
end;
initialization
RegisterClass(TColorBitBtn); // needed for persistence at runtime
end.
After doing the same. it compiles perfectly without any error. But the Font.Color does not get changed on any event like OnClick, OnMouseDown etc and another problem is not look like Button or BitBtn after enabling Theme Manifest like the following picture
Here the first is Standard Button, Standard BitBtn followed by Custom BitBtn created by the above code after adding Theme Manifest.