TFont Full path

[CanineQwer]

I have TFont.
How to get the full path to the font storage location?
Now I take TFont.Name and use it on the command line along with "fc-list" and "grep".
Please suggest a better solution.

*Linux.

[wp]

There is no cross-platform solution. In TAChart, I use this code:

Code: Pascal  [Select][+][-]

1. procedure PopulateFontDirList(AList: TStrings);
2. const
3.   CSIDL_FONTS = 20;
4. var
5.   s: String;
6. begin
7.   if AList = nil then
8.     raise Exception.Create('PopulateFontDirList: list not allocated.');
9.  
10.  {$IFDEF WINDOWS}
11.   s := SHGetFolderPathUTF8(CSIDL_FONTS);
12.   if s <> '' then
13.     AList.Add(s);
14.  {$ENDIF}
15.  {$IFDEF linux}
16.   AList.Add('/usr/share/cups/fonts/');
17.   AList.Add('/usr/share/fonts/truetype/');
18.   AList.Add('/usr/local/lib/X11/fonts/');
19.   AList.Add(GetUserDir + '.fonts/');
20.  {$ENDIF}
21.  {$IFDEF LCLCarbon}
22.   AList.Add('/Library/Fonts/');
23.   AList.Add('/System/Library/Fonts/');
24.   AList.Add('/Network/Library/Fonts/');
25.   AList.Add('~/Library/Fonts/');
26.  {$ENDIF}
27.  {$IFDEF LCLCocoa}
28.   AList.Add('/Library/Fonts/');
29.   AList.Add('/System/Library/Fonts/');
30.   AList.Add('/Network/Library/Fonts/');
31.   AList.Add('~/Library/Fonts/');
32.  {$ENDIF}
33. end;
34.  

[CanineQwer]

I do not need cross-platform.
I specifically need Linux.
It is possible and specifically GTK.

[winni]

Hi!

For what reasons do you need the path to the font files?

The is the var screen.fonts which is a list of all fonts that Lazarus knows.

And for assigning a font to a component you dont need the path:

MyComponent.Font.Name := 'Arial' ;

Winni

[CanineQwer]

I know that to use a font, the path is optional.
But I need a font file to transfer it to other people.
So just searching for it manually, as @wp suggested?
Is this the best solution?

[winni]

Hi!

Okay, Linux only:

Look in /etc/fonts/fonts.conf

In the first lines there are the font directories of your system.
For Suse Linux it is:

Code: Text  [Select][+][-]

1. <!-- Font directory list -->
2.  
3.         <dir>/usr/share/fonts</dir>
4.         <dir>/usr/X11R6/lib/X11/fonts</dir>
5.         <dir>/opt/kde3/share/fonts</dir>
6.          <dir>/usr/local/share/fonts</dir>
7.         <dir prefix="xdg">fonts</dir>
8.         <!-- the following element will be removed in the future -->
9.         <dir>~/.fonts</dir>
10.  
11.  

As you see it is XML.

Keep on hacking!
Winni

[alanphys]

Hi

You can use unit fpTTF in fcl-pdf.

Code: Pascal  [Select][+][-]

1. function GetFontFile(fName:string):string;
2. var lFC:TFPFontCacheItem;
3. begin
4. gTTFontCache.ReadStandardFonts;
5. lFC := gTTFontCache.Find(fName, fBold, fItalic);
6. Result := lFC.FileName;
7. end;
8.  

My problem is gTTFontCache does not include font aliases. So the component 'default' font's name on my Fedora system is Sans Serif. If I look at the /usr/share/fonts directory there is no Sans Serif font. fc-match gives the Sans Serif font as Bitstream Vera Sans.

Listing Screen.fonts does list the Sans Serif font but I can't get the path to it.

There is an example under lazarus/examples/fontenum that lists the fonts including Serif and Sans Serif but doesn't appear to show how to get file info.

Perhaps the author of fpTTF @Graeme Geldenhys can help.

Regards

[jipété]

Hello,

You can use unit fpTTF in fcl-pdf.

I tried to use your code in lazarus/examples/fontenum with a little change, like that :

Code: Pascal  [Select][+][-]

1. function GetFontFile(fName:string): string; // no help available :-(
2. var
3.   lFC: TFPFontCacheItem;
4. begin
5.   //gTTFontCache.ReadStandardFonts; // moved in FormShow
6.   lFC := gTTFontCache.FindFont(fName);
7.   Result := lFC.FileName;
8. end;
9.  
10. procedure TfrmMain.FormShow(Sender: TObject);
11. begin
12.   gTTFontCache.ReadStandardFonts; // jpt
13.   ...
14.  
15. procedure TfrmMain.SelectFont;
16. var
17.   F: TFont;
18.   i: integer;
19.   TTFS: TTrueTypeFontStyles; // set of TTrueTypeFontStyle -- added 19/06/2023 by jpt
20.  
21.   function GetFontSize(s: string): Integer;
22.   begin
23.     i := pos('*',s);
24.     if i<>0 then result := StrToInt(Copy(S, 1, i-1)) else result := StrToInt(s);
25.   end;
26. begin
27.   if lbFamily.ItemIndex>=0 then
28.     if lbCharSet.ItemIndex>=0 then
29.       if lbStyles.ItemIndex>=0 then
30.         if lbSizes.ItemIndex>=0 then
31.         begin
32.           F := TFont.Create;
33.           try
34.             F.Name := lbFamily.Items[lbFamily.ItemIndex];
35.             F.CharSet := TFontCharSet(ptrint(lbCharSet.Items.Objects[lbCharset.ItemIndex]));
36.             F.Size := GetFontSize(lbSizes.Items[lbSizes.ItemIndex]);
37.             // jpt : added edtFullFileName, a TEdit with Align: Bottom
38.             edtFullFileName.Text := ' Filename = ' + GetFontFile(lbFamily.Items.Strings[lbFamily.ItemIndex]); // jpt
39.             i := ptrint(lbStyles.Items.Objects[lbStyles.ItemIndex]);
40.             F.Style := [];
41.             TTFS := []; // jpt : added for fpTTF
42. //jpt            if i and 1 <> 0 then F.Style := F.Style + [fsItalic];
43. //jpt            if i and 2 <> 0 then F.Style := F.Style + [fsBold];
44.             if i and 1 <> 0 then TTFS := TTFS + [fsItalic]; // new by jpt
45.             if i and 2 <> 0 then TTFS := TTFS + [fsBold]; // new by jpt
46.             if chkUnderLine.Checked then F.Style := F.Style + [fsUnderline];
47.             if chkStrike.Checked then F.Style := F.Style + [fsStrikeOut];
48.             UpdateFont(F);
49.             SaveSelection;
50.           finally
51.             F.Free;
52.           end;
53.         end;
54. end;
55.  

Dont't forget :

Code: Pascal  [Select][+][-]

1. uses
2.   fpTTF;  // jpt for GetFontFile
3.  

For the fun, a missing line in RestoreSelection :

Code: Pascal  [Select][+][-]

1.       ...
2.       if i<>Sender.ItemIndex then Sender.ItemIndex := i;
3.       Sender.TopIndex := Sender.ItemIndex // jpt, to display the selected line at power-up;
4.     end;
5.   end;
6. end;
7.  

And now the problem : if I use fontenum without the changes for getting the full filename (= original fontenumeration), everything works fine.
But if I setup things for retrieval of full filenames using fpTTF unit, some fonts (System-ui) hang program with SIGSEGV.

Linux Debian 11.7 FPC 3.2.2 Laz 2.2.6

Step-by-step for debugging is not available in fpTTF.pp, I don't know why (works fine in mainunit.pas).

AIRFOIL.TTF (in edtFullFileName.Text bottom image) is the first one in my fonts' folder.

Any help welcome, thanks.