TButton: change font color

[davornik 4]

I am trying to use TButton, but with changed caption Font.Color. Remy suggested to use BS_OWNERDRAW and intercept WM_DRAWITEM.

and here also to subclass:

 

https://stackoverflow.com/a/23125580

 

I tried it to use like this but no success, font color does not change.

...
type
  TMyButton = class(TButton)
  protected
    procedure CreateParams(var Params: TCreateParams); override;
  end;

function ButtonSubclassProc(hWnd: HWND; uMsg: UINT; wParam: WPARAM; lParam: LPARAM; uIdSubclass: UINT_PTR; dwRefData: DWORD_PTR): LRESULT; stdcall;

var
  btnFntClr: TMyButton;
...

function ButtonSubclassProc(hWnd: HWND; uMsg: UINT; wParam: WPARAM; lParam: LPARAM; uIdSubclass: UINT_PTR; dwRefData: DWORD_PTR): LRESULT; stdcall;
begin
  case uMsg of
    WM_DRAWITEM: TMyButton(dwRefData).Font.Color := clRed;
    WM_NCDESTROY: RemoveWindowSubclass(hWnd, @ButtonSubclassProc, uIdSubclass);
  end;
  Result := DefSubclassProc(hWnd, uMsg, wParam, lParam);
end;

procedure TMyButton.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);
  with Params do Style := Style or BS_OWNERDRAW;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  btnFntClr.Free;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  btnFntClr:=TMyButton.Create(Form1);
  btnFntClr.Parent:=Form1;
  btnFntClr.Style:=TCustomButton.TButtonStyle.bsSplitButton;
  btnFntClr.Caption:='Options';
  with btnFntClr do begin
    Left:=10;
    Top:=10;
    Width:=120;
  end;
  SetWindowSubclass(btnFntClr.Handle, @ButtonSubclassProc, 1, DWORD_PTR(btnFntClr));
end;

How to properly change font color in TButton?

[dummzeuch 1622]

You could use TBitBtn instead, if that's an option.

[PeaShooter_OMO 34]

@davornik

 

BS_OWNERDRAW means you must do the drawing of the button yourself. You must also detect user interactions and state changes and respond to them visually.

 

Here is an exmple of such a button (as @Remy Lebeau pointed out on Stack Overflow) :  Delphi - Pascal Windows Color Button

[davornik 4]

On 2/21/2025 at 11:19 AM, dummzeuch said:

You could use TBitBtn instead, if that's an option.

Unfortunatelly, TButton is exactly what I need because TCustomButton.TButtonStyle.bsSplitButton State.

[davornik 4]

On 2/21/2025 at 11:27 AM, PeaShooter_OMO said:

@davornik

 

BS_OWNERDRAW means you must do the drawing of the button yourself. You must also detect user interactions and state changes and respond to them visually.

 

Here is an exmple of such a button (as @Remy Lebeau pointed out on Stack Overflow) :  Delphi - Pascal Windows Color Button

I have seen this example.

Is there any way to just change font color without drawing a complete button?

[PeterBelow 250]

1 hour ago, davornik said:

I have seen this example.

Is there any way to just change font color without drawing a complete button?

Not if you use the standard Windows style. If you configure the app to use one of the custom styles (like Windows 10) you can set the StyleElements.seFont property element to false and it will then use the font.color you set and not the Windows default.

[davornik 4]

What I like about Delphi and Windows is that there is always some way for a workaround 🙂

I have tried to do drawtext over text on TButton and it works partially.

var
  aCaption: string;

procedure DrawColoredTxt(aBtn: TButton);
var
  Canvas: TCanvas;
  R: TRect;
begin
  // Bckp Caption
  if aCaption = '' then
    begin
      aCaption:=aBtn.Caption;
      aBtn.Caption := ''; // Hide default caption to avoid overlap
    end;
  //DoDraw
  Canvas := TCanvas.Create;
  try
    Canvas.Handle := GetDC(aBtn.Handle);
    try
      R := aBtn.ClientRect;
      Inc(R.Left, -15);  //move to left for width of dropsplitbtn
      //Canvas.Brush.Style := bsClear;
      Canvas.Font.Color := clRed;  // Change font color
      DrawText(Canvas.Handle, PChar(aCaption), -1, R, DT_CENTER or DT_VCENTER or DT_SINGLELINE);
    finally
      ReleaseDC(aBtn.Handle, Canvas.Handle);
    end;
  finally
    Canvas.Free;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  DrawColoredTxt(Button2);
end;

I get changed font color like this:

 

 

But when I move the mouse into Button2 everything falls apart 😞

Is there any way to fix this to have properly painted text in Button2?