将Delphi TLabel的字体更改为Italic会拖尾 - 为什么?

Bri*_*ost 9 delphi fonts tlabel autosize italic

下面显示了字体设置为Arial Regular 16的默认TLabel的简单演示. 在此输入图像描述

单击按钮时的代码是:

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

单击该按钮时,最后一个字符将被截断,即:

在此输入图像描述

默认情况下,TLAbel.AutoSize是真的所以这应该没问题吧?这是在XE和Delphi 7中是一样的.这是一个错误吗?

Tim*_*Tim 10

最后一个额外的空间是一个快速的解决方案.


And*_*and 7

是的,它似乎是这样(虽然是一个相当小的错误).可能的解决方法包括

  • 使用Windows API函数TextOut(或DrawText)自己绘制文本
  • 使用TStaticText(而不是a TLabel),它只是Windows 静态控件的包装器(在文本模式下).当然,Windows正确地绘制文本.

运用 TextOut

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

TextOut示例http://privat.rejbrand.se/WindowsTextOut.png

使用静态控件(TStaticText)

静态控制样本http://privat.rejbrand.se/WindowsStaticText.png

我猜这不是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;
Run Code Online (Sandbox Code Playgroud)

结果如下:

DrawText示例http://privat.rejbrand.se/WindowsDrawTextClipProblem.png

因此,这毕竟是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;
Run Code Online (Sandbox Code Playgroud)

DrawText与DT_NOCLIP示例http://privat.rejbrand.se/WindowsDrawTextNoClip.png

更新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;
Run Code Online (Sandbox Code Playgroud)

产生结果

TLabel略有修改http://privat.rejbrand.se/TLabelFixed.png

(但硬编码一个神奇的价值(2)似乎很讨厌...)

  • 它有点记录:*"请注意,可能会剪切具有重要悬垂的文本,例如,文本字符串中的初始"W"或斜体字"*".来自[DrawText Function](http://msdn.microsoft.com/en-us/library/dd162498%28v=vs.85%29.aspx). (3认同)