2010. december 24., péntek
How to enum font sizes like TFontDialog does
Problem/Question/Abstract:
I would like to get all font sizes for the given font like TFontDialog does. Minimum and maximum font size would be nice, too.
Answer:
Note that the list of font sizes for Truetype fonts is just an arbitrary selection of often-used sizes, you can scale these fonts to nearly any size.
Example for the use of EnumFontFamilies. Project requires two listboxes on the form, nothing else.
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls;
type
TForm1 = class(TForm)
ListBox1: TListBox;
ListBox2: TListBox;
procedure FormCreate(Sender: TObject);
procedure ListBox1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
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;
end.
Feliratkozás:
Megjegyzések küldése (Atom)
Nincsenek megjegyzések:
Megjegyzés küldése