Canvas Texte verschiedener Größen auf einer Linie ausgeben?

[Popov]

Wie der Titel schon aussagt, ich möchte Texte mit verschiedenen Größen auf einer Grundlinie ausgeben, also wie es jede beliebige Textverarbeitung auch macht. Die Standardmöglichkeiten bieten nur die Möglichkeit die Texte auf gleicher Höhe auszugeben.

Delphi-Quellcode:

procedure TForm1.Button1Click(Sender: TObject);
begin
  Canvas.Font.Size := 10;
  Canvas.TextOut(100, 100, 'Hallo');

  Canvas.Font.Size := 28;
  Canvas.TextOut(150, 100, 'Welt');
end;

Ich hab momentan keine Idee wie ich das anstellen kann.

Also in etwa so:

Hallo Welt

[MeierZwoo]

SetTextAlign mit TA_BASELINE or TA_LEFT

[Popov]

Danke, kam gerade durch stöbern in der Api auch auf SetTextAlign. Insoweit klappt es jetzt. Wobei wir dann aber beim nächsten Problem wären, denn einerseits soll der Text auf der gleichen Grundlinie sein, auf der anderen Seite hat es eine Oberkannte. Somit müsste ich jetzt die Höhe haben...

Delphi-Quellcode:

procedure TForm1.Button1Click(Sender: TObject);
  procedure TextRect(ACanvas: TCanvas; X, Y: Integer; Txt: String);
  var
    Size: TSize;
  begin
    ACanvas.Brush.Style := bsClear;
    ACanvas.Pen.Color := clRed;
    Size := ACanvas.TextExtent(Txt);
    ACanvas.Rectangle(Rect(X, Y, X + Size.cx, Y - Size.cy));
  end;

var
  d: Integer;
begin
  Canvas.Font.Name := 'Arial';

  SetTextAlign(Canvas.Handle, TA_BASELINE);

  Canvas.Font.Size := 10;
  Canvas.TextOut(100, 100, 'Hallo');
  TextRect(Canvas, 100, 100, 'Hallo');

  Canvas.Font.Size := 28;
  Canvas.TextOut(150, 100, 'Welt');
  TextRect(Canvas, 150, 100, 'Welt');
end;

... ich versuche mal was.

[Popov]

Ok, vielen Dank. Die offene Frage habe ich mir anscheinend schon vorher selbst beantwortet. Die größte Schrift bildet die Oberkannte, womit man nur die Höhe der der größte Schrift ermitteln muss und die dann abziehen. So kann man dann auch die Oberkannte einhalten.

Delphi-Quellcode:

procedure TForm1.Button3Click(Sender: TObject);
  procedure TextRect(ACanvas: TCanvas; X, Y: Integer; Txt: String);
  var
    Size: TSize;
  begin
    ACanvas.Brush.Style := bsClear;
    ACanvas.Pen.Color := clRed;
    Size := ACanvas.TextExtent(Txt);
    ACanvas.Rectangle(Rect(X, Y, X + Size.cx, Y - Size.cy));
  end;

var
  d: Integer;
begin
  Canvas.Font.Name := 'Arial';

  Canvas.Font.Size := 28;
  d := Canvas.TextHeight('X');

  SetTextAlign(Canvas.Handle, TA_BASELINE);

  Canvas.Font.Size := 10;
  Canvas.TextOut(100, 100 + d, 'Hallo');
  TextRect(Canvas, 100, 100 + d, 'Hallo');

  Canvas.Font.Size := 28;
  Canvas.TextOut(150, 100 + d, 'Welt');
  TextRect(Canvas, 150, 100 + d, 'Welt');

  Canvas.Pen.Color := clBlue;
  Canvas.MoveTo(0, 100); Canvas.LineTo(300, 100);
end;

EDIT:

Und danke noch mal an MeierZwoo.

[MeierZwoo]

Die Oberkante und Unterlänge beziehen sich auf den Schriftkegel, in der Delphihilfe als Boundingbox bezeichnet.

D.h. Oberkante (TA_TOP) ist Versalhöhe PLUS Versalakzent, bei kleinen Schriftgrößen kaum zu unterscheiden.

Die Unterlänge (TA_BOTTOM) ebenso Kegel (Boundingbox), d.h. Unterlänge PLUS Mindestdurchschuß (compress), bei kleinen Schriftgrößen auch kaum zu unterscheiden.

Nur die BaseLine bezieht sich wirklich auf die Schrift (den Buchstaben) selbst.

[Popov]

Ok, ich hab noch ein Problem. Was ich mache könnte man fast mit Zeilen in einem Textverarbeitungsprogramm zu vergleichen. Zeilen werden von oben nach unten aneinander gedeiht, eben wie auch in einem TVP. Das Problem ist aber, dass die Schrift auch ganz groß werden kann, u. U. auch 200pt. Was nun bei kleinem Schriftgrad kaum auffällt, macht hier schon paar hundert Pixel aus (siehe Bild).

SetTextAlign(Canvas.Handle, TA_BASELINE) erfüllt seinen Zweck, d. h. alle Texte werden auf der Grundlinie ausgerichtet, aber dabei entsteht oben eine Lücke. Bei großer Schrift ist die Lücke gewaltig, und das erkennt man auch. Das müsste ich nun ausgleichen, die Frage ist nur wie. Das rote Rechteck zeigt die Grenzen die Canvas.TextExtent liefert. Die weiße Hintergrundfarbe zeigt die Fläche die der Text eigentlich ausfüllt. Da ist eine Lücke. Wüßte ich die zweite Unterkannte (die erste kenne ich), könnte ich es ausgleichen. Was mir also fehlt ist der Abstand zwischen der Grundlinie und der Unterkante. Weiß einer wie man sowas über die Schrift erfahren kann?

[Popov]

Ok, ich hab weiter in der Api gestöbert und GetTextMetrics gefunden. Ich denke tmAscent und tmDescent liefern das was ich brauche. tmDescent ist die Unterlänge und entspricht dabei der Lücke die mir Probleme bereitete.

Falls es später einem auch mal interessiert, hier die Prozedur mit der ich etwas experimentiert habe:

Delphi-Quellcode:

procedure TForm1.Button1Click(Sender: TObject);
  procedure TextRect(ACanvas: TCanvas; X, Y: Integer; Txt: String);
  var
    Size: TSize;
    bs: TBrushStyle;
    tm: TTextMetric;
  begin
    bs := ACanvas.Brush.Style;
    ACanvas.Brush.Style := bsClear;
    Size := ACanvas.TextExtent(Txt);
    GetTextMetrics(Canvas.Handle, tm);
    ACanvas.Rectangle(Rect(X, Y + tm.tmDescent, X + Size.cx, Y - Size.cy + tm.tmDescent));
    ACanvas.Brush.Style := bs;
  end;

var
  d: Integer;
  Metrics: TTextMetric;
  sl: TStringList;
begin
  Canvas.Font.Name := 'Arial';
  Canvas.Pen.Color := clRed;
  Canvas.Brush.Color := clWhite;

  Canvas.Font.Size := 28;
  d := Canvas.TextHeight('X');

  SetTextAlign(Canvas.Handle, TA_BASELINE);

  Canvas.Font.Size := 10;
  Canvas.TextOut(100, 100 + d, 'Hallo');
  TextRect(Canvas, 100, 100 + d, 'Hallo');

  Canvas.Font.Size := 28;
  Canvas.TextOut(150, 100 + d, 'Welt');
  TextRect(Canvas, 150, 100 + d, 'Welt');

  Canvas.Pen.Color := clBlue;
  Canvas.MoveTo(0, 100); Canvas.LineTo(300, 100);

  //----------------------------------------------------------------------------

  if GetTextMetrics(Canvas.Handle, Metrics) then
  begin
    sl := TStringList.Create;
    try
      sl.Add('tmHeight: ' + IntToStr(Metrics.tmHeight));
      sl.Add('tmAscent: ' + IntToStr(Metrics.tmAscent));
      sl.Add('tmDescent: ' + IntToStr(Metrics.tmDescent));
      sl.Add('tmInternalLeading: ' + IntToStr(Metrics.tmInternalLeading));
      sl.Add('tmExternalLeading: ' + IntToStr(Metrics.tmExternalLeading));
      sl.Add('tmAveCharWidth: ' + IntToStr(Metrics.tmAveCharWidth));
      sl.Add('tmMaxCharWidth: ' + IntToStr(Metrics.tmMaxCharWidth));
      sl.Add('tmWeight: ' + IntToStr(Metrics.tmWeight));
      sl.Add('tmOverhang: ' + IntToStr(Metrics.tmOverhang));
      sl.Add('tmDigitizedAspectX: ' + IntToStr(Metrics.tmDigitizedAspectX));
      sl.Add('tmDigitizedAspectY: ' + IntToStr(Metrics.tmDigitizedAspectY));
      sl.Add('tmItalic: ' + IntToStr(Metrics.tmItalic));
      sl.Add('tmUnderlined: ' + IntToStr(Metrics.tmUnderlined));
      sl.Add('tmStruckOut: ' + IntToStr(Metrics.tmStruckOut));
      sl.Add('tmPitchAndFamily: ' + IntToStr(Metrics.tmPitchAndFamily));
      sl.Add('tmCharSet: ' + IntToStr(Metrics.tmCharSet));
      sl.Add('tmFirstChar: "' + Metrics.tmFirstChar + '"');
      sl.Add('tmLastChar: "' + Metrics.tmLastChar + '"');
      sl.Add('tmDefaultChar: "' + Metrics.tmDefaultChar + '"');
      sl.Add('tmBreakChar: "' + Metrics.tmBreakChar + '"');

      ShowMessage(sl.Text);
    finally
      sl.Free;
    end;
  end
  else
    MessageDlg('Irgend so ein Fehler!', mtError, [mbOk], 0);
end;