Delphi: changing the color of a button using the class helper

Question

I need to change the visual style of form delphi controls to show them from a .NET environment. To do this, I need to change the colors of the delphi controls to blue ($ 00FCF5EE). I used TButton controls that do not have the Color property. Therefore, instead of changing the buttons to the speed buttons, I tried a different approach, introducing the parent form and inheriting all other forms from this parent form. In the parent form, I have a class helper for changing the color of buttons. Here is the code: (I am using Delphi 2007)

TButtonHelper=class helper for TButton private procedure doChangeColor; public procedure DrawChangeColor; end; TParentForm = class(TForm) public procedure AfterConstruction; override; end; 

And in the implementation section I have

  procedure TButtonHelper.doChangeColor; var SaveIndex: Integer; FCanvas:TCanvas; rect:TRect; begin if csDestroying in ComponentState then exit; FCanvas:=TCanvas.Create; SaveIndex := SaveDC(Self.Handle); FCanvas.Lock; try FCanvas.Handle := Handle; FCanvas.Font := Font; FCanvas.Brush := self.Brush; FCanvas.Brush.Color:=$00FCF5EE; FCanvas.FillRect(BoundsRect);//Omitting the code to draw the text finally FCanvas.Handle := 0; FCanvas.Unlock; RestoreDC(handle, SaveIndex); FCanvas.Free; end; end; procedure TButtonHelper.DrawChangeColor; begin doChangeColor; self.Repaint; end; procedure TParentForm.AfterConstruction; var i : Integer; wc: TControl; begin inherited; for i := 0 to self.ControlCount - 1 do begin wc:=Controls[i]; if wc is TButton then TButton(wc).DrawChangeColor; end; end; 

But that does not work. Although the doChangeColor method is executed, it does not change the color of the button. Please let me know what I do not see here.

Thanks everyone

Pradeep

Answer 1

here is a class that adds color properties to standard TButton:

 unit u_class_colorbutton; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, StdCtrls, Buttons, ExtCtrls; type TColorButton = class(TButton) 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 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); ShowBackColor := True; FCanvas := TCanvas.Create; BackColor := clBtnFace; ForeColor := clBtnText; HoverColor := clBtnFace; end; destructor TColorButton.Destroy; begin FreeAndNil(FCanvas); inherited Destroy; end; procedure TColorButton.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 TColorButton.CreateParams(var Params: TCreateParams); begin inherited CreateParams(Params); with Params do Style := Style or BS_OWNERDRAW; end; procedure TColorButton.SetButtonStyle(Value: Boolean); begin if Value <> IsFocused then begin IsFocused := Value; Invalidate; end; end; procedure TColorButton.CNMeasureItem(var Message: TWMMeasureItem); begin with Message.MeasureItemStruct^ do begin itemWidth := Width; itemHeight := Height; end; end; 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; procedure TColorButton.CMEnabledChanged(var Message: TMessage); begin inherited; Invalidate; end; procedure TColorButton.CMFontChanged(var Message: TMessage); begin inherited; Invalidate; end; procedure TColorButton.SetBackColor(const Value: TColor); begin if FBackColor <> Value then begin FBackColor:= Value; Invalidate; end; end; procedure TColorButton.SetForeColor(const Value: TColor); begin if FForeColor <> Value then begin FForeColor:= Value; Invalidate; end; end; procedure TColorButton.SetHoverColor(const Value: TColor); begin if FHoverColor <> Value then begin FHoverColor:= Value; Invalidate; end; end; procedure TColorButton.DrawButton(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', [TColorButton]); end; initialization RegisterClass(TColorButton); // needed for persistence at runtime end. 

You can easily hack it in your application: find / replace all TButton links with TColorButton inside your .pas and .dfm files. You can set separate colors for background, font, and hovering.

If you want to add a styling application, it might be better to create a graphical interface with a library that has built-in support, for example DevExpress, TMS, ... Personally, I like DevExpress the most, but it's a matter of personal taste.