"Echte" Ausmaße eines Strings ermitteln

[Popov]

Da ich das solche Infos auch gelegentlich brauche und dann stets mit des Suche neu anfange, habe ich mir für meine Beispiele-Ordner ein Beispiel mit Infos programmiert. Ist ähnlich wie oben, aber auf das Wesentliche reduziert:

Delphi-Quellcode:

procedure CanvInfo(Canv: TCanvas; x, y: Integer; Info: String);
begin
  Canv.Font.Size := 10;
  Canv.TextOut(x, y - Canv.TextHeight(Info), Info);
end;

procedure CanvLine(Canv: TCanvas; x, y, l: Integer);
begin
  Canv.Pen.Color := clBlue;
  Canv.MoveTo(x, y);
  Canv.LineTo(x + l, y);
end;

procedure TForm1.Button1Click(Sender: TObject);
const
  Text = 'Äg';
  LineLen = 30;
  LineSep = 5;
var
  TextH, TextW, TextTop, x: Integer;
  Metrics: TTextMetric;
  s: String;
begin
  with PaintBox1, Canvas do
  begin
    Font.Name := 'Arial';
    Font.Size := 120;

    TextH := TextHeight(Text);
    TextW := TextWidth(Text);
    TextTop := 20; //((ClipRect.Bottom - ClipRect.Top) - TextH) div 2;

    if GetTextMetrics(Canvas.Handle, Metrics) then
    begin
      with Metrics do
      begin
        TextOut(0, TextTop, Text);         //erste Zeile
        TextOut(0, TextTop + TextH, Text); //zweite Zeile

        x := 0;
        CanvInfo(Canvas, x, TextTop, 'A');
        CanvLine(Canvas, x, TextTop, TextW + LineLen);
        CanvLine(Canvas, x, TextTop + tmHeight,LineLen +  TextW);


        x := TextW + LineLen + LineSep;
        CanvInfo(Canvas, x, TextTop, 'B');
        CanvLine(Canvas, x, TextTop, LineLen);
        CanvLine(Canvas, x, TextTop + tmAscent, LineLen);

        x := x + LineLen + LineSep;
        CanvInfo(Canvas, x, TextTop + tmAscent, 'C');
        CanvLine(Canvas, x, TextTop + tmAscent, LineLen);
        CanvLine(Canvas, x, TextTop + tmAscent + tmDescent, LineLen);

        x := x + LineLen + LineSep;
        CanvInfo(Canvas, x, TextTop, 'D');
        CanvLine(Canvas, x, TextTop, LineLen);
        CanvLine(Canvas, x, TextTop + tmInternalLeading, LineLen);

        x := x + LineLen + LineSep;
        CanvInfo(Canvas, x, TextTop + tmHeight, 'E');
        CanvLine(Canvas, x, TextTop + tmHeight, LineLen);
        CanvLine(Canvas, x, TextTop + tmHeight + tmExternalLeading, LineLen);

        s := s + '[A] tmHeight: ' +           IntToStr(tmHeight) + ^j;
        s := s + '[B] tmAscent: ' +           IntToStr(tmAscent) + ^j;
        s := s + '[C] tmDescent: ' +          IntToStr(tmDescent) + ^j;
        s := s + '[D] tmInternalLeading: ' +  IntToStr(tmInternalLeading) + ^j;
        s := s + '[E] tmExternalLeading: ' +  IntToStr(tmExternalLeading) + ^j;
      end;

      ShowMessage(s);
    end
    else
      MessageDlg('Ach herrje, ein Fehler!', mtError, [mbOk], 0);
  end;
end;