Hallo,
das Programm im Anhang verdeutlicht nur den Umstand, dass die Ermittlung der möglichen Schriftgößen einer Schriftart
nicht klappt.
Die Auflistung der Schriftarten ist der RichEdit-Demo entnommen:
Delphi-Quellcode:
function EnumFontsProc(
var LogFont: TLogFont;
var TextMetric: TTextMetric;
FontType: Integer; Data: Pointer): Integer;
stdcall;
begin
TStrings(Data).Add(LogFont.lfFaceName);
Result := 1;
end;
procedure GetFontNames(Items : TStrings);
var
DC: HDC;
begin
DC := GetDC(0);
EnumFonts(
DC,
nil, @EnumFontsProc, Pointer(Items));
ReleaseDC(0,
DC);
end;
und wird wie folgt genutzt:
Delphi-Quellcode:
procedure TForm1.FormCreate(Sender: TObject);
begin
GetFontNames(ComboBox1.Items);
end;
Abhängig von der jeweiligen ausgewählten Schriftart sollen die Schriftgrößen bestimmt werden.
Delphi-Quellcode:
procedure TForm1.ComboBox1Select(Sender: TObject);
begin
ListBox1.Items.Clear;
if CheckBox1.Checked then
ListFonts(ComboBox1.Text, ListBox1.Items)
else
GetFontFamilies(ComboBox1.Text, ListBox1.Items);
end;
Für die Ermittlung der Schriftgrößen verwende ich (mit kleinen Änderungen) den Code von
GetFontFamilies
und
Installierte Schriftarten ermitteln.
Beide haben jedoch den Nachteil, das sie unter XP nicht die richtigen(lt.
MSDN) Strukturen verwenden und wurden
entsprechend angepasst.
Aus dem ersten Beispiel wurde dadurch:
Delphi-Quellcode:
procedure GetFontFamilies(
const FontName :
String; Items : TStrings);
var
FN : PChar;
DC :HDC;
begin
if FontName <> '
'
then FN := PChar(FontName)
else FN :=
nil;
Assert(Assigned(Items));
Items.BeginUpdate;
try
DC := GetDC(0);
if (Win32MajorVersion < 5)
then
EnumFontFamilies(
DC, FN, @EnumFontsizes, Integer(Items))
else
EnumFontFamilies(
DC, FN, @EnumFontsizes2K_XP, Integer(Items));
// <- hier Aufruf ab Windows 2000 und höher
ReleaseDC(0,
DC);
finally
Items.EndUpdate;
end;
end;
die dazu gehörenden Callback-Routinen sehen eigendlich gleich aus, nur die Parameter unterscheiden sich:
Delphi-Quellcode:
function EnumFontSizes(var EnumLogFont: TEnumLogFont;
PTextMetric: PNewTextMetric;
FontType: Integer;
Data: LPARAM): Integer; stdcall;
var
list : TStrings;
begin
if Data <> 0 then
begin
list := TStrings(Data);
list.Add(IntToStr(EnumLogFont.elfLogFont.lfHeight));
Result := 1;
end
else Result := 0;
end;
function EnumFontSizes2K_XP(var EnumLogFont: TEnumLogFontEx;
PTextMetric: PTextMetric;
FontType: Integer;
Data: LPARAM): Integer; stdcall;
var
list : TStrings;
begin
if Data <> 0 then
begin
list := TStrings(Data);
list.Add(IntToStr(EnumLogFont.elfLogFont.lfHeight));
Result := 1;
end
else Result := 0;
end;
Das zweite Beispiel verwendet die
EnumFontFamiliesEx-Routine, mit der gleichen Beschränkung:
Delphi-Quellcode:
procedure ListFonts(
const FontName :
String;
const ADest: TStrings);
var
Log: TLogFont;
DC : HDC;
begin
FillChar(Log, SizeOf(Log), 0);
Log.lfCharSet := Default_Charset;
StrPCopy(Log.lfFaceName, FontName);
Log.lfPitchAndFamily := 0;
DC := GetDC(0);
if (Win32MajorVersion < 5)
then
EnumFontFamiliesEx(
DC, Log, @_EnumFontFamExProc, Integer(ADest), 0)
else
EnumFontFamiliesEx(
DC, Log, @_EnumFontFamExProc2K, Integer(ADest), 0);
// <- hier Aufruf ab Windows 2000 und höher
ReleaseDC(0,
DC);
end;
function _EnumFontFamExProc(EnumLogFontEx: PEnumLogFontEx;
NewTextMetric: PNewTextMetric;
FontType: Longword;
LParam: Longword): integer;
stdcall;
begin
Result := 1;
TStrings(LParam).Add(IntToStr(NewTextMetric.tmHeight));
end;
function _EnumFontFamExProc2K(EnumLogFontExDv: PEnumLogFontExDv;
EnumTextMetric: PEnumTextMetric;
FontType: Longword;
LParam: Longword): integer;
stdcall;
begin
Result := 1;
TStrings(LParam).Add(IntToStr(EnumTextMetric.etmNewTextMetricEx.ntmTm.tmHeight));
end;
Für mich stellt sich nun die Frage warum werden nicht die richtigen Schriftgrößen ermittelt?
Bei der Schrfitart 'Alaska' bekomme ich nur die Größe '40' angezeigt, obwohl Alaska ein TrueTypeFont ist
und somit von 8 -72 skalierbar sein sollte.
Vielleicht ist ja auch im Code ein Fehler, aber wo?
Gruß