Mega Code Archive
How to get list of font available and its info
<![CDATA[
Title: How to get list of font available and it's info
Question: How to get list of font available from system,
and it's info / properties ?
Answer:
To get a list of fonts available we have to use EnumFontFamilies or EnumFonts Win32 API functions. For a description of the differences between those two functions please refer to Win32 SDK documentation. I'll use the first one (EnumFontFalimiles) for this example.
Win32 API provides several enumeration functions for various tasks. There are functions capable of enumerating installed fonts, printers and so on. All those enumerating functions require you to pass a callback function, actually the function pointer, as one of its parameters.
A callback function is one function coded and provided to the system by the programmer. The system uses the function, the programmer passes as a parameter to an EnumXXXX function, to pass the requested information back.
Here is how you might code a call to EnumFontFamilies function:
var
DC: HDC;
begin
DC := GetDC(0); { get screen's device context }
try
EnumFontFamilies(DC, nil, @EnumFontsProc, LongInt(ComboBox1));
finally
ReleaseDC(0, DC); { release device context }
end;
end;
The first parameter, DC, is a device context. Check "Device Contexts" topic of the Win32 SDK for more info on device contexts. We are passing screen's device context here since we are interested for screen fonts.
The second parameter is a PChar specifying the family name of the desired fonts. Since we want all the available information we pass nil.
The third parameter is the pointer to the callback function we provide. We didn't actually code it yet. We'll do that in a minute. As you know the "@ operator returns the address of a variable, or of a function, procedure, or method; that is, @ constructs a pointer to its operand" as Delphi's online help states.
The last parameter is a Longint. Anything that could be typecasted as a LongInt could be passed here. It's up to us to decide what to pass.
Remember, an object could be typecasted to a LongInt as
Longint(MyObject)
and then pass it to the function.
Here is how the EnumFontsProc, the callback function provided by the programmer, might look like:
function EnumFontsProc(var EnumLogFont: TEnumLogFont; var TextMetric: TNewTextMetric; FontType: Integer; Data: LPARAM): Integer; stdcall;
var
FontName: string;
CB : TComboBox;
begin
CB := TComboBox(Data);
FontName := StrPas(EnumLogFont.elfLogFont.lfFaceName);
if (CB.Items.IndexOf(FontName) if (FontType = TRUETYPE_FONTTYPE) then
CB.Items.Add(FontName);
Result := 1;
end;
For a complete description of the TEnumLogFont and TNewTextMetric please refer to Win32 SDK. I think it's enough to say that they hold all the info the system could provide us regarding a font. They are declared in Windows.pas.
The FontType could be one of the following integer constants declared in Windows.pas too
RASTER_FONTTYPE = 1;
DEVICE_FONTTYPE = 2;
TRUETYPE_FONTTYPE = 4;
Here is how this mechanism works:
Windows randomly selects one font of each available type family, since we have passed nil as the second parameter to EnumFontFamilies, and passes the available information for that font to your callback function, EnumFontsProc in this case.
The enumeration will continue until either the callback return 0 (we constantly retrun 1) or there are no more fonts to enumerate.
Inside the EnumFontsProc we might examine each font passed and do what we want to do with the available information. In the above code I just add the FontNames to a ComboBox items.
Following is a class I've coded to make the task easier:
type
TFontType = (ftRaster, ftDevice, ftTrueType);
(*----------------------------------------------------------------------------------*)
TFontInfo = class
private
FShortName : string;
FFullName : string;
FStyle : string;
FLF : TLogFont;
FFontType : TFontType;
FTM : TNewTextMetric;
public
property FullName : string read FFullName ;
property ShortName : string read FShortName;
property Style : string read FStyle ;
property FontType : TFontType read FFontType ;
property TM : TNewTextMetric read FTM ;
property LF : TLogFont read FLF ;
end;
(*----------------------------------------------------------------------------------*)
TFontList = class
private
procedure ClearList;
procedure AddFont(EnumLogFont: TEnumLogFont; TextMetric: TNewTextMetric; FontType: Integer);
public
List : TStringList;
constructor Create;
destructor Destroy; override;
procedure RefreshFontInfo;
end;
{ TFontList }
(*----------------------------------------------------------------------------------*)
constructor TFontList.Create;
begin
inherited Create;
List := TStringList.Create;
List.Sorted := True;
end;
(*----------------------------------------------------------------------------------*)
destructor TFontList.Destroy;
begin
ClearList;
inherited Destroy;
end;
(*----------------------------------------------------------------------------------*)
procedure TFontList.ClearList;
begin
while List.Count 0 do
begin
TFontInfo(List.Objects[0]).Free;
List.Delete(0);
end;
end;
(*----------------------------------------------------------------------------------*)
function EnumFontsProc(var EnumLogFont: TEnumLogFont; var TextMetric: TNewTextMetric; FontType: Integer; Data: LPARAM): Integer; stdcall;
var
FontList : TFontList;
begin
FontList := TFontList(Data);
FontList.AddFont(EnumLogFont, TextMetric, FontType);
Result := 1;
end;
(*----------------------------------------------------------------------------------*)
procedure TFontList.AddFont(EnumLogFont: TEnumLogFont; TextMetric: TNewTextMetric; FontType: Integer);
var
FI : TFontInfo;
begin
FI := TFontInfo.Create;
FI.FShortName := StrPas(EnumLogFont.elfLogFont.lfFaceName);
FI.FFullName := StrPas(EnumLogFont.elfFullName);
FI.FStyle := StrPas(EnumLogFont.elfStyle);
FI.FLF := EnumLogFont.elfLogFont;
case FontType of
RASTER_FONTTYPE : FI.FFontType := ftRaster;
DEVICE_FONTTYPE : FI.FFontType := ftDevice;
TRUETYPE_FONTTYPE : FI.FFontType := ftTrueType;
end;
FI.FTM := TextMetric;
List.AddObject(FI.FShortName, FI);
end;
(*----------------------------------------------------------------------------------*)
procedure TFontList.RefreshFontInfo;
var
DC: HDC;
begin
ClearList;
DC := GetDC(0);
try
EnumFontFamilies(DC, nil, @EnumFontsProc, Longint(Self));
finally
ReleaseDC(0, DC);
end;
end;
And here is an example use:
procedure TForm1.Button1Click(Sender: TObject);
var
FontList : TFontList;
begin
ListBox1.Clear;
FontList := TFontList.Create;
try
FontList.RefreshFontInfo;
ListBox1.Items.AddStrings(FontList.List);
finally
FontList.Free;
end;
end;
]]>