Changing the font of a Delphi TLabel to Italic chops off the tail - why?

Question

A simple demo of a default TLabel with font set to Arial Regular 16 is shown below.

The code when the button is clicked is:

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

When you click the button, the last character is truncated viz:

By default, TLAbel.AutoSize is true so this should be ok, right? This is in XE and Delphi 7 is the same. Is this a bug?

Answer 1

An extra space at the end is a quick work around for this.

Answer 2

Yes, it would seem so (although a rather minor bug). Possible work-arounds include

• drawing the text yourself, using the Windows API function TextOut (or DrawText), and
• using a TStaticText (instead of a TLabel), which is merely a wrapper for a Windows static control (in text mode). Of course, Windows draws the text correctly.

Using TextOut

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

Using a static control (TStaticText)

I would guess that this is not a problem in the Microsoft Windows operating system, but only in the VCL TLabel control.

Update

I tried

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;

and the result is this:

Thus, this is a problem in the Microsoft Windows operating system (or the Arial font), after all.

A workaround is to add the DT_NOCLIP flag:

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;

Update 2

A light-weight fix might be

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;

yielding the result

(But hard-coding a magic value (2) seems nasty...)