Schriftgröße für optimale Platzausnutzung ermitteln

[fkerber]

Matze stellt hier eine Funktion vor, mit der es möglich ist, für gegebenen Text eine Schriftgröße zu ermitteln, sodass die gegebene Breite und Höhe (in Pixel) optimal ausgenutzt werden kann.

Delphi-Quellcode:

//Hilfsfunktion
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;

Delphi-Quellcode:

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

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

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

Anbei noch 2 Beispielaufrufe:

Delphi-Quellcode:

procedure TForm1.Button1Click(Sender: TObject);
var
  calculatedFontsize: Integer;
begin
  calculatedFontsize := GetFontSizeFromPixels('Dies ist ein Test-Text', 150, 150, 'Verdana',11);
  if calculatedFontsize<>-1 then
    showmessage('Schriftgröße sollte '+inttostr(calculatedFontsize) + ' sein!')
  else
    showmessage('Gewählter Text passt nicht in den zur Verfügung stehenden Bereich (bei gewählter Mindestgröße).')
end;



procedure TForm1.Button2Click(Sender: TObject);
var
  calculatedFontsize: Integer;
begin
  calculatedFontsize := GetFontSizeFromPixels('Dies ist ein Test-Text', 150, 150, 'Verdana');
  if calculatedFontsize<>-1 then
    showmessage('Schriftgröße sollte '+inttostr(calculatedFontsize) + ' sein!')
  else
    showmessage('Gewählter Text passt nicht in den zur Verfügung stehenden Bereich.')
end;

[s.h.a.r.k]

Entsteht in der Hilfsfunktion durch die Zuweisung des Fonts nicht ein Speicherleak?

Delphi-Quellcode:

//Hilfsfunktion
function GetTextSizeInPixels(Text: string; Font: TFont): TPoint;
var
  PxHeight, PxWidth: Integer;
  TmpBmp: TBitmap;
begin
  TmpBmp := TBitmap.Create;
  try
    TmpBmp.Canvas.Font := Font; // <--- diese Zeile meine ich
    PxWidth := TmpBmp.Canvas.TextWidth(Text);
    PxHeight := TmpBmp.Canvas.TextHeight(Text);
  finally
    FreeAndNil(TmpBmp);
  end;

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

[fkerber]

Hi!

Inwiefern?
Es wird doch sowohl die TmpBmp wie auch Font selbst freigegeben?

Reicht das nicht? (Ich bin mir nicht sicher, ich mutmaße da nur )



Grüße, Frederic

[s.h.a.r.k]

Was passiert aber mit dem Font-Objekt, welches das Bitmap TmpBmp nach dem erzeugen hat? Dieses wird ja nicht freigegeben, da nach der Font-Zuweisung ja keine Referenz mehr auf das Objekt existiert. Assign sollte wohl das Problem lösen.