Delphi-PRAXiS

Delphi-PRAXiS (https://www.delphipraxis.net/forum.php)
-   Library: Sonstiges (https://www.delphipraxis.net/45-library-sonstiges/)
-   -   Darstellbare Zeichenhöhe eines Fonts ermitteln (https://www.delphipraxis.net/119392-darstellbare-zeichenhoehe-eines-fonts-ermitteln.html)

fkerber 25. Aug 2008 20:57


Darstellbare Zeichenhöhe eines Fonts ermitteln
 
taaktaak stellt hier vor, wie man die darstellbare Zeichenhöhe eines Fonts ermitteln kann.


Delphi-Quellcode:
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;
Anmerkungen:
  • Mit den Parametern Min/Max kann die Auswahl der Schriftgrößen eingegrenzt werden (vgl. auch die gleichnamigen Properties im FontDialog) Mit Angabe 0/0 werden ALLE Werte an TStrings übergeben.
  • Für TrueType-Fonts sind die "üblichen" Werte als Konstanten-Array vorgegeben, natürlich ist diese Vorgabe grundsätzlich nicht bindend.
  • Aufgrund der sehr geringen Anzahl der Werte wurde eine sehr einfache Sortprozedur verwendet (die "Empfänger der Werte, z.B. List- oder ComboBox sollten NICHT sortiert sein, da die Zahlen sonst in falscher Reihenfolge dargestellt werden).


Alle Zeitangaben in WEZ +1. Es ist jetzt 12:07 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