首页 > 解决方案 > 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;

如果我执行上面的继承调用,您可以在我写在顶部的白色文本下看到原始的黑色文本,但是白色文本看起来不错,带有圆角字体。显然,继承函数中的某些内容正在以某种方式修复文本输出,但我无法真正按照它来解决问题。有谁知道如何解决这个问题?如有必要,我可以发送一些结果的屏幕截图。

此外,在没有继承调用的情况下使用上面的代码,窗口上的大多数标签,与复选框无关,除非我最小化和最大化程序,否则不会被绘制。谢谢你。

标签: delphidelphi-7wm-painttcheckbox

解决方案


推荐阅读