How to get a list of all available Truetype fonts

Problem/Question/Abstract:

I have a situation where I'd like to loop through about 100 font files and extract their friendly name from the file. Has anyone ever done this?

Answer:

Assuming that all fonts are already installed, you need to use EnumFontFamilies and a callback function:

{the callback function prototype}

function FontEnumProc(LogFont: PEnumLogFont; TextMetrics: PNewTextMetric;
  FontType: Integer; lParam: LPARAM): Integer; stdcall;

implementation

function FontEnumProc(LogFont: PEnumLogFont; TextMetrics: PNewTextMetric;
  FontType: Integer; lParam: LPARAM): Integer; stdcall;
begin
  {add the font name and its font type to a list box}
  Form1.ListBox1.Items.AddObject(TEnumLogFont(LogFont^).elfLogFont.lfFaceName,
    TObject(FontType);
    {continue enumeration}
    Result := 1;
end;

procedure TForm1.FormClick(Sender: TObject);
begin
  EnumFontFamilies(Form1.Canvas.Handle, nil, @FontEnumProc, 0);
end;

If the fonts are not installed, you can install them temporarely.