Darstellbare Zeichenhöhen eines "Fixed-Font"?

[taaktaak]

Moin, Moin,

auch wenn das Thema aktuell kein Interesse findet, möchte ich die in meinem letzten Beitrag beschriebene Abweichung aufklären: Usache ist der (unnötige) und falsche "Nachbau" der Funktion MulDiv(a,b,d). Hier die zum Thema des Threads gehörende Prozedur, die für alle Fonts (also auch die non-fixed Fonts) die verfügbaren Zeichenhöhen ermittelt.

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));
        //
        // folgende "Übersetzung" berechnet für Courier, 10 pts das falsche Ergebnis 9 pts
        // ist also NICHT äquivalent zu MulDiv()
        //
        // H:=((tmHeight-tmInternalLeading)*72) div 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.

• Die wiederholte Ermittlung von GetDeviceCaps in der CallBack-Funktion ist sicherlich nicht clever, da sich dieser Wert ja nicht ständig ändert. Die Ermittlung dieser quasi Konstanten sollte wohl ausgelagert werden!

• 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).

Gruß Ralph (hihihi, der letzte verfügbare Weihnachtsmann - ist der vergessen worden???)

// edit: Wer sich über die Zuweisung von Min an iMin und Max an iMax wundert >> iMin und iMax sind lokal in der Unit deklariert, damit die CallBack-Funktion darauf zugreifen kann.