Delphi-PRAXiS

Delphi-PRAXiS (https://www.delphipraxis.net/forum.php)
-   GUI-Design mit VCL / FireMonkey / Common Controls (https://www.delphipraxis.net/18-gui-design-mit-vcl-firemonkey-common-controls/)
-   -   "Echte" Ausmaße eines Strings ermitteln (https://www.delphipraxis.net/179504-echte-ausmasse-eines-strings-ermitteln.html)

BigAl 11. Mär 2014 14:55

"Echte" Ausmaße eines Strings ermitteln
 
Hallo zusammen,

bin gerade dabei etwas Text in einer Zeichnung auszugeben. Teilweise auch Symbole. Diese sollen zentrisch sein (horizontal und vertikal). Dabei habe ich folgendes Problem:

Wie kann ich die echte Höhe eines Strings, also nur der Bereich der auch das Zeichen enthält ermitteln bzw. wie kann ich Strings wirklich zentrieren. Canvas.TextHeight z.B. ist da nicht sehr hilfreich, da hierbei immer der leere Platz um den String mit zurückgegeben wird. Ich möchte beispielsweise das Zeichen '~' vertikal zentriert ausgeben. Leider befindet sich dieses dann nicht wirklich im Zentrum, sondern darunter. Bei einer FontSize von z.B. 20 (Font ist Tahoma) erhalte ich für das o.g. Zeichen eine Breite von 20 und eine Höhe von 33. Gebe ich das Zeichen dann mit (Y - TextHeight div 2) aus, dann ist das Zeichen zu tief...

Hat jemand eine Idee?

Vielen Dank schon mal im Voraus

Alex

nuclearping 11. Mär 2014 15:02

AW: "Echte" Ausmaße eines Strings ermitteln
 
Schau dir mal MSDN-Library durchsuchenDrawText an. Da kannst du über DT_CALCRECT die Dimensionen des Texts ermitteln lassen, bzw. wenn du ein eigenes Rect übergibst den Text auch in einen Bereich (mit Zeilenumbruch) zeichnen. hDC ist Canvas.Handle.

himitsu 11. Mär 2014 15:04

AW: "Echte" Ausmaße eines Strings ermitteln
 
Jupp, entweder direkt an die WinAPI wenden, oder in die CodeLib schauen TextHeightTextHeight, oder in die CL schauen und da abgucken. :stupid:

Und man mag es nicht glauben, aber die Forensuche hätte da bestimmt auch geholfen.

BigAl 11. Mär 2014 15:13

AW: "Echte" Ausmaße eines Strings ermitteln
 
Leute ihr seid so krass :-). Habe eben noch schnell die Anfrage abgesetzt weil ich dringend in eine kurze Besprechung musste. Komme zurück und die Antwort steht da.

DANKE!!!

Alex

Medium 11. Mär 2014 15:19

AW: "Echte" Ausmaße eines Strings ermitteln
 
Wirklich an die Größe der tatsächlich gezeichneten Pixel zu bekommen ist gar nicht so einfach. GetGlyphOutline() mit Format "GGO_METRICS" liefert einen Struct, der diese wohl beinhaltet. Es scheint allerdings so, als ginge das eben nur für ein einzelnes Zeichen. Für einen längeren String wird's dann echt fummelig, da Fonts mit Kerning und Getöse aufwarten, wodurch ein Zeichenweises Addieren mit o.g. Methode sicherlich nicht die richtige Gesamtgröße von mehr als einem Zeichen ergeben dürfte. Aber für eine Tilde könnte das klappen.

Popov 11. Mär 2014 16:12

AW: "Echte" Ausmaße eines Strings ermitteln
 
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;

Medium 11. Mär 2014 18:43

AW: "Echte" Ausmaße eines Strings ermitteln
 
TextMetrics geben allerding "nur" die allgemeinen Settings für einen ganzen Font wieder. Wenn z.B. die Tilde bei deinem Font von vorne herein nahe der Grundlinie ansetzt, wird die damit ermittelte Höhe dennoch einiges an Luft beinhalten. Was dir am besten passt ist dann Ermessenssache.

Popov 11. Mär 2014 19:53

AW: "Echte" Ausmaße eines Strings ermitteln
 
Liste der Anhänge anzeigen (Anzahl: 1)
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;


Alle Zeitangaben in WEZ +1. Es ist jetzt 07:57 Uhr.

Powered by vBulletin® Copyright ©2000 - 2022, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2021 by Daniel R. Wolf