Изменение шрифта Delphi TLabel на Курсив отрубает хвост-почему?

простая демонстрация tlabel по умолчанию с шрифтом, установленным в Arial Regular 16, показана ниже. enter image description here

код при нажатии кнопки:

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

при нажатии на кнопку, последний символ обрезается, а именно:

enter image description here

по умолчанию TLAbel.AutoSize-это правда, так что это должно быть нормально, верно? Это в XE и Delphi 7 то же самое. Это жук?

9
autosize delphi fonts italic tlabel

2 ответов

дополнительное пространство в конце-это быстрая работа для этого.

10

Да, казалось бы (хотя и довольно незначительная ошибка). Возможные обходные пути включают

  • рисование текста самостоятельно, используя функцию Windows API TextOut (или DrawText), и
  • С помощью TStaticText (вместо 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;

образец 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;

и результат таков:

образец 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;

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;

приносящий результат

TLabel с небольшой модификацией http://privat.rejbrand.se/TLabelFixed.png

(но жесткое кодирование магического значения (2) кажется неприятным...)

7