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中是一样的.这是一个错误吗?
是的,它似乎是这样(虽然是一个相当小的错误).可能的解决方法包括
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)似乎很讨厌...)
| 归档时间: |
|
| 查看次数: |
7816 次 |
| 最近记录: |