Extract fontfilename in Delphi

Using in Delphi EnumFontProc or Screen.Fonts it possible to extract the name of the fonts installed in Windows. It possible to extract files name allocated for fonts, and how?
BujorCristinelAsked:
Who is Participating?
 
SlavakCommented:
You can try registry:

On win 9x:
 HKLM\Software\Microsoft\Windows\CurrentVersion\Fonts

on win nt:
 HKLM\Software\Microsoft\Windows NT\CurrentVersion\Fonts

0
 
SlavakCommented:
Why you cannot just read windows font directory?
0
 
BujorCristinelAuthor Commented:
I have font name.
To find file name in fonts folder it not very good solution to scan all file.
0
Cloud Class® Course: Amazon Web Services - Basic

Are you thinking about creating an Amazon Web Services account for your business? Not sure where to start? In this course you’ll get an overview of the history of AWS and take a tour of their user interface.

 
BujorCristinelAuthor Commented:
Very nice.
I need registry value for Windows 2000 and Windows XP because I have only win 98.
0
 
SlavakCommented:
Windows NT/2000/XP from same line: windows NT
0
 
freshman3kCommented:
Hello!

The following code gets the list of fonts installed ,just place a listbox and a label on a form:

{--------------------}
function EnumFonts(var lp: TEnumLogFont;
  var tm: TNewTextMetric;
  dwType: DWORD;
  lpData: lParam): Integer; stdcall;
begin
  Result := 1;
  with TForm1(lpData), ListBox1 do
  begin
    Items.Add(lp.elfLogFont.lfFaceName);
  end;
end;
{--------------------}
procedure TForm1.FormShow(Sender: TObject);
begin
 EnumFontFamilies(Canvas.Handle,nil,@EnumFonts,Integer(Self));
end;

Good Luck! :-)
0
 
Slick812Commented:
Hello BujorCristinel , Here's some code that will get Installed Font Names and the File Path for those fonts. It get's the names and paths from the registry, please note that the names for the Fonts are NOT the same names used for font creation (Canvas.Font.Name := FontName), the registry font names may have extra info like "Plain", "Bold", "Unicode" or "Italic" since there is only ONE Font Name in font creation and you pick the weight (Bold, normal) and style (Italic). So if you want to use a font name for font creation use the Screen.Fonts names. I use a ListBox to show the Font's names and Paths. You need to get the display fonts also if you want all the fonts.


procedure TForm1.but_GetFontsClick(Sender: TObject);
var
  FontReg: TRegistry;
  FontFiles, SystemFonts: TStringList;
  i: Integer;
  Str1, Str2, FontPath: String;
begin
FontFiles := TStringList.Create;
SystemFonts := TStringList.Create;
try
  FontReg := TRegistry.Create;
  try
    FontReg.RootKey := HKEY_CURRENT_USER;
    if FontReg.OpenKey('\Software\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders', False) then
      begin
      ListBox1.Clear;
      FontPath := FontReg.ReadString('Fonts')+'\';
      FontReg.CloseKey;
      end else Exit;
    FontReg.RootKey := HKEY_LOCAL_MACHINE;
    if FontReg.OpenKey('\Config\0001\Display\Fonts', False) then
      begin
      FontReg.GetValueNames(SystemFonts);
      for i := 0 to SystemFonts.Count -1 do
        begin
        Str2 := FontReg.ReadString(SystemFonts[i]);
        Str1 := SystemFonts[i];
        Delete(Str1,Pos('(',SystemFonts[i])-1,Length(SystemFonts[i]));
        if Pos('\',Str2) = 0 then
          SystemFonts[i] := Str1+' - '+FontPath+ Str2
          else
          SystemFonts[i] := Str1+' - '+ Str2;
        end;
      FontReg.CloseKey;
      end;
    if Win32Platform = VER_PLATFORM_WIN32_NT then
      Str1 := '\Software\Microsoft\Windows NT\CurrentVersion\Fonts'
      else
      Str1 := '\Software\Microsoft\Windows\CurrentVersion\Fonts';
    if FontReg.OpenKey(Str1, False) then
      begin
      FontReg.GetValueNames(ListBox1.Items);
      for i := 0 to ListBox1.Items.Count -1 do
        FontFiles.Add(FontReg.ReadString(ListBox1.Items[i]));
      FontReg.CloseKey;
      end;
    finally
    FontReg.Free;
    end;

  for i := 0 to ListBox1.Items.Count -1 do
    begin
    Str1 := ListBox1.Items[i];
    Delete(Str1,Pos('(',ListBox1.Items.Strings[i])-1,Length(ListBox1.Items.Strings[i]));
    if Pos('\',FontFiles[i]) = 0 then
    Str1 := Str1+ ' - '+ FontPath+FontFiles[i] else
    Str1 := Str1+ ' - '+FontFiles[i];
    ListBox1.Items[i] := Str1;
    end;
  //ListBox1.Items.Add('  DISPLAY (system) FONTS');
  for i := 0 to SystemFonts.Count -1 do
    ListBox1.Items.Add(SystemFonts[i]);
finally
FontFiles.Free;
SystemFonts.Free;
end;
end;


procedure TForm1.but_ScreenFontsClick(Sender: TObject);
begin
ListBox1.Clear;
ListBox1.Items := Screen.Fonts;
end;
0
 
pnh73Commented:
No comment has been added lately, so it's time to clean up this TA.
I will leave a recommendation in the Cleanup topic area that this question is:

Accept answer from Slavak

Please leave any comments here within the next seven days.
 
PLEASE DO NOT ACCEPT THIS COMMENT AS AN ANSWER!
 
Paul (pnh73)
EE Cleanup Volunteer
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.