![]() |
Darstellbare Zeichenhöhe eines Fonts ermitteln
taaktaak stellt
![]()
Delphi-Quellcode:
Anmerkungen:
procedure GetSizes(List:TStrings;FontName:String;Min,Max:Integer);
var DC : HDC; LF : TLogFont; function EnumSize(var LogFont:TLogFont;var TextMetric:TTextMetric; FontType:Integer;Data:LParam):Integer; stdcall; const TTSizes : Array[0..15] of Integer = (8,9,10,11,12,14,16,18,20,22,24,26,28,36,48,72); var i,H : Integer; DC : HDC; begin if FontType=TrueType_FontType then begin // get sizes from const array for i:=0 to High(TTSizes) do if TTSizes[i]>=iMin then if TTSizes[i]<=iMax then TStrings(Data).Add(IntToStr(TTSizes[i])); Result:=0; end else begin // get sizes from WinAPI DC:=GetDC(0); try with TextMetric do H:=MulDiv(tmHeight-tmInternalLeading,72,GetDeviceCaps(DC,LogPixelsY)); if H>=TTSizes[0] then // no smaller size than MinSize of TrueType if H>=iMin then if H<=iMax then if TStrings(Data).IndexOf(IntToStr(H))<0 then TStrings(Data).Add(IntToStr(H)); Result:=1; finally ReleaseDC(0,DC); end; end; end; procedure SortList; var i : Integer; t : String; Done : Boolean; begin repeat Done:=true; for i:=0 to List.Count-2 do if StrToInt(List[i])>StrToInt(List[i+1]) then begin t :=List[i]; List[i] :=List[i+1]; List[i+1]:=t; Done :=false; end; until Done end; begin DC:=GetDC(0); iMin:=Min; iMax:=Max; if iMax=0 then iMax:=999; try fillchar(LF,SizeOf(LF),0); LF.lfCharSet:=Default_CharSet; Move(FontName[1],LF.lfFaceName,length(FontName)); List.BeginUpdate; List.Clear; EnumFontFamiliesEx(DC,LF,@EnumSize,LParam(List),0); Sortlist; List.EndUpdate; finally ReleaseDC(0,DC); end; end;
|
Alle Zeitangaben in WEZ +1. Es ist jetzt 21:54 Uhr. |
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024-2025 by Thomas Breitkreuz