Delphi TCheckbox problems overriding WM_PAINT

Question

I'm using an old version of Delphi (7), but that shouldn't matter much. Themes are in use. I need to have control over the background and font color of the checkbox and text of a TCheckbox. I have adapted some code found elsewhere which basically works, but the Arial font I'm using throughout the app looks very rough around the edges when painted manually. This is the code.

type
  TCheckBox = class(StdCtrls.TCheckBox)
  private
    procedure WMErase(var Message: TWMEraseBkgnd); message WM_ERASEBKGND;
    procedure WMPaint (var Message: TWMPaint); message WM_PAINT;
  end;

procedure TCheckBox.WMErase(var Message: TWMEraseBkgnd);
var
  canv: TControlCanvas;
begin
  canv := TControlCanvas.Create;
  canv.Control := Self;
  canv.Brush.Color := Self.Color;
  canv.FillRect(canv.ClipRect);
  canv.free;
end;

procedure TCheckBox.WMPaint(var Message: TWMPaint);
const
  SPACE: Integer = 2;
var
  txtW, txtH, txtX, BtnWidth: Integer;
  canv: TControlCanvas;
begin
  //inherited;
  BtnWidth := GetSystemMetrics(SM_CXMENUCHECK);
  canv := TControlCanvas.Create;
  try
    canv.Control := Self;
    canv.Font := Font;
    txtW:= canv.TextWidth(Caption);
    txtH:= canv.TextHeight(Caption);
    if BiDiMode in [bdRightToLeft, bdRightToLeftReadingOnly] then
      txtX:= Width - BtnWidth - SPACE - txtW
    else
      txtX:= BtnWidth + SPACE;
    SetBkMode(canv.Handle,TRANSPARENT);
    StateImages.Draw(canv,0,0,Ord(Self.Checked)); // checkbox
    canv.TextOut(txtX, (Height - txtH) div 2 + 1, Caption);
  finally
    canv.Free;
  end;
end;

If I execute the inherited call above, you can see the original black text under the white text I'm writing over the top, but the white text looks nice with a rounded font. Obviously something in the inherited functions are fixing the text output somehow but I can't really follow it to work out what. Does anyone have any idea how to fix the issue? I can send some screen shots of the result if necessary.

Also, with the code above in place without the inherited call, most of the labels on the window, unrelated to the checkbox, don't get painted unless I minimize and maximize the program. Thank you.

I'd recommend that you don't name your inherited class TCheckBox as you're inheriting from a class with the same name. I don't know if that's causing any problems or what's causing the aliasing issue. — XylemFlow, Apr 23 '21 at 13:58
@XylemFlow "*I'd recommend that you don't name your inherited class TCheckBox as you're inheriting from a class with the same name*" - this is perfectly valid, actually. This is commonly known as a *INTERPOSER* class. If this class is defined in the Form's unit, or in a separate unit that is in the Form's `uses` clause after the `StdCtrls` unit, then all `TCheckBox` controls on the Form, even ones created at design-time, will be replaced with the custom class at runtime. This is actually a feature of Delphi, not a bug. — Remy Lebeau, Apr 23 '21 at 15:06

Delphi TCheckbox problems overriding WM_PAINT

0 Answers0