Schriftgröße dynamisch anpassen

[Matze]

Hallo,

ist deine Frage nun geklärt und handelt es sich um ein Delphi-Thema? Dann verschiebe ich's.

Du kannst das ganze natürlich auch umgekehrt machen: Die Breite in Pixeln vorgeben und die Schriftgröße berechnen lassen.
Das ist vielleicht nicht super elegant, aber die Demo im Anhang zeigt ein mögliches Vorgehen.
Hierbei werden die Breite und die Höhe berücksichtigt.

Delphi-Quellcode:

function GetTextHeightInPixels(Text: string; Font: TFont): Integer;
var
  PxHeight: Integer;
  TmpBmp: TBitmap;
begin
  TmpBmp := TBitmap.Create;
  try
    TmpBmp.Canvas.Font := Font;
    PxHeight := TmpBmp.Canvas.TextHeight(Text);
  finally
    FreeAndNil(TmpBmp);
  end;

  Result := PxHeight;
end;

function GetTextWidthInPixels(Text: string; Font: TFont): Integer;
var
  PxWidth: Integer;
  TmpBmp: TBitmap;
begin
  TmpBmp := TBitmap.Create;
  try
    TmpBmp.Canvas.Font := Font;
    PxWidth := TmpBmp.Canvas.TextWidth(Text);
  finally
    FreeAndNil(TmpBmp);
  end;

  Result := PxWidth;
end;

function GetFontSizeFromPixels(Text: string; WidthPixels: Integer; HeightPixels: Integer; FontName: string; MinSize: Integer = 1): Integer;
var
  Font: TFont;
  TmpWidthPx, TmpHeightPx: Integer;
begin
  Font := TFont.Create;
  try
    Font.Name := FontName;

    // check if MinSize is ok
    Font.Size := MinSize;
    TmpWidthPx := GetTextWidthInPixels(Text, Font);
    TmpHeightPx := GetTextHeightInPixels(Text, Font);

    if (TmpWidthPx > WidthPixels) or (TmpHeightPx > HeightPixels) then
      Result := -1
    // width at MinSize is smaller than WidthPixels
    else begin
      repeat
        inc(MinSize);
        Font.Size := MinSize;
        TmpWidthPx := GetTextWidthInPixels(Text, Font);
        TmpHeightPx := GetTextHeightInPixels(Text, Font);
      until (TmpWidthPx > WidthPixels) or (TmpHeightPx > HeightPixels);

      Result := MinSize - 1;
    end;
  finally
    FreeAndNil(Font);
  end;
end;

Die Breite und Höhe lässt sich auch mit einer Funktion ermitteln und erfordert so nur ein temporäres Bitmap:

Delphi-Quellcode:

function GetTextSizeInPixels(Text: string; Font: TFont): TPoint;
var
  PxHeight, PxWidth: Integer;
  TmpBmp: TBitmap;
begin
  TmpBmp := TBitmap.Create;
  try
    TmpBmp.Canvas.Font := Font;
    PxWidth := TmpBmp.Canvas.TextWidth(Text);
    PxHeight := TmpBmp.Canvas.TextHeight(Text);
  finally
    FreeAndNil(TmpBmp);
  end;

  Result.X := PxWidth;
  Result.Y := PxHeight;
end;

Grüße, Matze