delphi - Delphi TCheckbox 问题覆盖 WM_PAINT
问题描述
我使用的是旧版本的 Delphi (7),但这并不重要。主题正在使用中。我需要控制复选框的背景和字体颜色以及 TCheckbox 的文本。我已经改编了一些在其他地方找到的基本上可以工作的代码,但是我在整个应用程序中使用的 Arial 字体在手动绘制时看起来非常粗糙。这是代码。
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;
如果我执行上面的继承调用,您可以在我写在顶部的白色文本下看到原始的黑色文本,但是白色文本看起来不错,带有圆角字体。显然,继承函数中的某些内容正在以某种方式修复文本输出,但我无法真正按照它来解决问题。有谁知道如何解决这个问题?如有必要,我可以发送一些结果的屏幕截图。
此外,在没有继承调用的情况下使用上面的代码,窗口上的大多数标签,与复选框无关,除非我最小化和最大化程序,否则不会被绘制。谢谢你。
解决方案
推荐阅读
- .net-core - 添加范围后未加载实体框架核心默认值
- mysql - H2 jdbc 异常 - 具有奇数个字符的十六进制字符串
- powershell - retrieve users of a group by group sid
- php - PHP 7.2 : how to check if in static mode
- c# - How detect send email failure on Exchange C#
- javascript - Vimeo Player JS error when creating player
- css - I cannot get grid-template-columns to work in IE
- javascript - 节点:如何将对象作为哈希对象的键?
- java - 如何在 HashMap 中放置两个 Web 元素列表?
- dynamics-crm - Dynamics CRM 2011: Increase SQL connection pool size