// Funktion zum Auslesen
procedure ListFonts(const ADest: TStrings);
var
  Log: TLogFont;

  function _EnumFontFamExProc(EnumLogFontEx: PEnumLogFontEx;
                              NewTextMetric: PNewTextMetric;
                              FontType: Longword;
                              LParam: Longword): integer; stdcall;
  begin
    Result := 1;
    TStrings(LParam).Add(StrPas(EnumLogFontEx.elfFullName));
  end;

var
  DC: HDC;
begin
  FillChar(Log, SizeOf(Log), 0);
  Log.lfCharSet := Default_Charset;
  Log.lfFaceName := '';
  Log.lfPitchAndFamily := 0;
  DC := GetDC(0);
  EnumFontFamiliesEx(DC, Log, @_EnumFontFamExProc, Integer(ADest), 0);
end;

// Beispiel-Aufruf der Funktion
procedure TForm1.btnReadFontsClick(Sender : TObject);
var
  slFonts : TStringList;
begin
  slFonts := TStringList.Create;
  try
    ListFonts(slFonts);
    slFonts.SaveToFile('C:\Temp\InstalledFonts.txt');
  finally
    slFonts.Free;
  end;
end;