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.