将 Delphi TLabel 的字体更改为斜体会砍掉尾巴 - 为什么？答案

【问题标题】：Changing the font of a Delphi TLabel to Italic chops off the tail - why?将 Delphi TLabel 的字体更改为斜体会砍掉尾巴 - 为什么？
【发布时间】：2011-09-02 17:40:11
【问题描述】：

字体设置为 Arial Regular 16 的默认 TLabel 的简单演示如下所示。

点击按钮时的代码为：

procedure TForm1.Button1Click(Sender: TObject);
begin
  Label1.Font.Style := Label1.Font.Style + [fsItalic];
end;

当您单击按钮时，最后一个字符被截断，即：

默认情况下，TLAbel.AutoSize 为 true，所以应该没问题，对吧？这在 XE 和 Delphi 7 中是一样的。这是一个错误吗？

【问题讨论】：

我不相信这是一个 Delphi 错误，因为它只会影响 Arial。至少它不会影响更常用的 UI 字体的 Tahoma 或 Segoe UI。我的猜测是问题出在 Windows 或字体本身。
@Brian：请注意，您无需在运行时添加fsItalic 即可显示此问题。您可以在 IDE 中将 FontStyle 设置为 [fsItalic]。
@andreas：我知道，谢谢。这是为了实现我使用的主题例程。
它看起来确实像 Windows 中的一个错误，因为当 AutoSize 为 true 时，Delphi 会要求操作系统扩展文本。结果似乎是错误的。
@Uwe：信不信由你，我认为你是对的。请参阅下面的实验。

标签： delphi fonts autosize italic tlabel

【解决方案1】：

是的，看起来是这样（虽然是一个相当小的错误）。可能的解决方法包括

自己绘制文本，使用 Windows API 函数TextOut（或DrawText），以及
使用TStaticText（而不是TLabel），它只是Windows static control（在文本模式下）的包装。当然，Windows 可以正确绘制文本。

使用TextOut

procedure TForm4.FormPaint(Sender: TObject);
const
  S = 'This is a test';
begin
  TextOut(Canvas.Handle,
    10,
    10,
    PChar(S),
    length(S));
end;

使用静态控件 (TStaticText)

我猜这在 Microsoft Windows 操作系统中不是问题，而只是在 VCL TLabel 控件中。

更新

我试过了

procedure TForm4.FormPaint(Sender: TObject);
const
  S = 'This is a test';
var
  r: TRect;
begin
  r.Left := 10;
  r.Top := 10;
  r.Bottom := r.Top + DrawText(Canvas.Handle,
    PChar(S),
    length(S),
    r,
    DT_SINGLELINE or DT_LEFT or DT_CALCRECT);
  DrawText(Canvas.Handle,
    PChar(S),
    length(S),
    r,
    DT_SINGLELINE or DT_LEFT);
end;

结果是这样的：

因此，这毕竟是 Microsoft Windows 操作系统（或 Arial 字体）的问题。

一种解决方法是添加DT_NOCLIP 标志：

procedure TForm4.FormPaint(Sender: TObject);
const
  S = 'This is a test';
var
  r: TRect;
begin
  r.Left := 10;
  r.Top := 10;
  r.Bottom := r.Top + DrawText(Canvas.Handle,
    PChar(S),
    length(S),
    r,
    DT_SINGLELINE or DT_LEFT or DT_CALCRECT);
  DrawText(Canvas.Handle,
    PChar(S),
    length(S),
    r,
    DT_SINGLELINE or DT_LEFT or DT_NOCLIP);
end;

更新 2

一个轻量级的修复可能是

type
  TLabel = class(StdCtrls.TLabel)
  protected
    procedure DoDrawText(var Rect: TRect; Flags: Integer); override;
  end;

...

{ TLabel }

procedure TLabel.DoDrawText(var Rect: TRect; Flags: Integer);
begin
  inherited;
  if (Flags and DT_CALCRECT) <> 0 then
    Rect.Right := Rect.Right + 2;
end;

产生结果

（但是硬编码一个神奇的值（2）似乎很讨厌......）

【讨论】：

TStaticText 是解决此问题的最佳方法。尤其是因为它还可以在调整复杂表单大小时解决闪烁问题。
这是一种记录：“请注意，有明显突出的文本可能会被剪裁，例如，文本字符串中的首字母“W”或斜体文本”。来自DrawText Function。
@David：TStaticText 的缺点是，与TLabel 不同，它使用 Windows 句柄。通常这在 32/64 位 Windows 下不是问题，但在内存/资源可能紧张时需要牢记这一点。
@Ken：是的，但自从世纪之交以来，这一直不是问题。
@TLabel 的缺点是在调整大小时会出现恶魔般的闪烁

【解决方案2】：

最后一个额外的空间可以快速解决这个问题。

【讨论】：

我已经在自动调整大小的网格单元格中使用了该修复程序
+1 并被接受，因为这适用于所有现有代码。 TStaticText 是个好主意，但在 TRzPanel 上不显示透明 :-(