"Echte" Ausmaße eines Strings ermitteln

[Popov]

Wenn dich noch Unterlänge stört (also alles was unter der Grundlinie liegt, wie bei Buchstaben wie g, j, p, usw.), kannst du mit SetTextAlign etwas experimentieren. Zwar gibt es hier keinen direkten Wert, aber durch Wechsel zwischen TA_BASELINE, TA_BOTTOM, TA_TOP und etwas Subtraktion, kann man grob die Höhe über Grundline und die darunter ermitteln.

Will man mehr über den aktuellen Font erfahren, u. a. weil man z. B. den Ascent oder Descent wissen will, kann man das mit GetTextMetrics machen:

http://upload.wikimedia.org/wikipedi..._Terms.svg.png

Delphi-Quellcode:

var
  Metrics: TTextMetric;
  s: String;
begin
  Canvas.Font.Name := 'Arial';
  Canvas.Font.Size := 28;

  if GetTextMetrics(Canvas.Handle, Metrics) then
  //GetTextMetrics(DC: HDC; var Metrics: TTextMetric): Bool;
  begin
    s := 'Texthöhe nach Delphi: ' + IntToStr(Canvas.TextHeight('X')) + ^j^j;

    with Metrics do
    begin
      s := s + 'tmHeight: ' +           IntToStr(tmHeight) + ^j;
      s := s + 'tmAscent: ' +           IntToStr(tmAscent) + ^j;
      s := s + 'tmDescent: ' +          IntToStr(tmDescent) + ^j;
      s := s + 'tmInternalLeading: ' +  IntToStr(tmInternalLeading) + ^j;
      s := s + 'tmExternalLeading: ' +  IntToStr(tmExternalLeading) + ^j;
      s := s + 'tmAveCharWidth: ' +     IntToStr(tmAveCharWidth) + ^j;
      s := s + 'tmMaxCharWidth: ' +     IntToStr(tmMaxCharWidth) + ^j;
      s := s + 'tmWeight: ' +           IntToStr(tmWeight) + ^j;
      s := s + 'tmOverhang: ' +         IntToStr(tmOverhang) + ^j;
      s := s + 'tmDigitizedAspectX: ' + IntToStr(tmDigitizedAspectX) + ^j;
      s := s + 'tmDigitizedAspectY: ' + IntToStr(tmDigitizedAspectY) + ^j;
      s := s + 'tmItalic: ' +           IntToStr(tmItalic) + ^j;
      s := s + 'tmUnderlined: ' +       IntToStr(tmUnderlined) + ^j;
      s := s + 'tmStruckOut: ' +        IntToStr(tmStruckOut) + ^j;
      s := s + 'tmPitchAndFamily: ' +   IntToStr(tmPitchAndFamily) + ^j;
      s := s + 'tmCharSet: ' +          IntToStr(tmCharSet) + ^j;
      s := s + 'tmFirstChar: "' +       tmFirstChar + '"' + ^j;
      s := s + 'tmLastChar: "' +        tmLastChar + '"' + ^j;
      s := s + 'tmDefaultChar: "' +     tmDefaultChar + '"' + ^j;
      s := s + 'tmBreakChar: "' +       tmBreakChar + '"' + ^j;
    end;

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