Schriftgröße für optimale Platzausnutzung ermitteln
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:
Anbei noch 2 Beispielaufrufe:
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;
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; |
Re: Schriftgröße für optimale Platzausnutzung ermitteln
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; |
Re: Schriftgröße für optimale Platzausnutzung ermitteln
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 |
Re: Schriftgröße für optimale Platzausnutzung ermitteln
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.
|
Alle Zeitangaben in WEZ +1. Es ist jetzt 04:49 Uhr. |
Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz