Delphi TCheckbox problems overriding WM_PAINT

318 views Asked by At

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.

0

There are 0 answers