How to create a custom BitBtn with a color property?
I found one solution here , but this is TButton not TBitBtn , so I 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.
Thereafter. It compiles without errors. But Font.Color does not change in any event, like OnClick , OnClick , etc., And the other problem does not look like Button or BitBtn after enabling Theme Manifest, as shown in the following figure
Here's the first standard button, Standard BitBtn, and then Custom BitBtn, created by the above code, after adding Theme Manifest .