Изменение шрифта Delphi TLabel на курсив отрубает хвост - почему? - PullRequest
Новая
       57

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

9 голосов
/ 26 мая 2011

Простая демонстрация 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 имеет значение true, поэтому все должно быть в порядке, верно?Это в XE и Delphi 7 одинаково.Это ошибка?

Ответы [ 2 ]

10 голосов
/ 26 мая 2011

Дополнительный пробел в конце - это быстрое решение проблемы.

7 голосов
/ 26 мая 2011

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

  • рисование текста самостоятельно с использованием функции 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) кажется мерзким ...)

...