{
Example for the use of EnumFontFamilies. This example requires two
listboxes on a form.
Beispiel für die Verwendung vo EnumFontFamilies. Das Beispiel benötigt
2 Listboxen auf der Form.
}
procedure TForm1.FormCreate(Sender: TObject);
begin
Listbox1.Items.Assign(Screen.Fonts);
end;
function EnumProc(var elf: TEnumLogFont;
var ntm: TNewTextmetric;
FontType: Integer;
listbox: TListbox): Integer; stdcall;
var
S: string;
begin
if fonttype = TRUETYPE_FONTTYPE then
begin
listbox.Items.Add(Format('Name: %s', [elf.elfFullName]));
listbox.Items.Add(Format('Style: %s', [elf.elfStyle]));
end
else
listbox.Items.Add(Format('Name: %s', [elf.elfLogfont.lfFacename]));
listbox.Items.Add(Format('Size: %d', [elf.elfLogFont.lfHeight]));
listbox.Items.Add(Format('Weight: %d', [elf.elfLogFont.lfWeight]));
if elf.elfLogFont.lfItalic <> 0 then
listbox.Items.Add('This font is italic');
case FontType of
DEVICE_FONTTYPE: S := 'device font';
RASTER_FONTTYPE: S := 'raster font';
TRUETYPE_FONTTYPE: S := 'truetype font'
else
S := 'unknown font type';
end;
listbox.Items.Add(Format('This is a %s', [S]));
Result := 1;
end;
procedure TForm1.ListBox1Click(Sender: TObject);
begin
listbox2.Clear;
with listbox1 do
if ItemIndex >= 0 then
EnumFontFamilies(Self.Canvas.Handle, PChar(Items[ItemIndex]),
@EnumProc, Longint(Listbox2));
end;
|
