[Solved] Can I use a font in my app without installing it first?

[EganSolo]

I'm writing an app that is required to run on Windows only.

I would like to ship this app with a curated set of fonts that are not standard on Windows.

Question: Is it possible to use the fonts in my app without installing them first in Windows? Perhaps the question could be asked differently: is it possible to load a font into a TFont instance from a file? Trouble is, neither TFont nor TFPCustomFont has a LoadFromFile method which is where I'm stumped...

I looked at the examples project and did not find anything that could point me in the right direction.

[rvk]

Yes, it is even possible to load a font directly from a resource so you wouldn't even need a font-file.

A small snippet (for complete example see below/other post):

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

1. const
2.   C39CodeName = 'Code 3 de 9';
3. var
4.   hC39FontRes: cardinal;
5.  
6. function CheckC39: boolean;
7. var
8.   ResS1: TResourceStream;
9.   FontCount1: cardinal;
10.   FontId: integer;
11. begin
12.   Result := True;
13.   FontId := Screen.Fonts.IndexOf(C39CodeName);
14.   if FontId > 0 then exit;
15.   if hC39FontRes > 0 then exit;
16.  
17.   Result := False;
18.   FontCount1 := 0;
19.   try
20.     ResS1 := TResourceStream.Create(hInstance, 'C39_FONT', 'RT_FONT');
21.     try
22.       if ResS1.Size > 14 then
23.         hC39FontRes := AddFontMemResourceEx(ResS1.Memory, ResS1.Size,
24.           nil, @FontCount1);
25.     finally
26.       ResS1.Free;
27.       Result := (FontCount1 = 1);
28.     end;
29.   except
30.     on E: Exception do
31.       ; //ShowException(E, 'Fout bij laden C39font');
32.   end;
33. end;
34.  
35. // use
36.  
37.   if CheckC39 then
38.   begin
39.     lbCode39.Font.Name := C39CodeName;
40.     lbCode39.Font.Size := 50;
41.     lbCode39.Caption := CodingCode39(edCode39.Text);
42.   end;
43.  

I once posted a complete example project including barcode fonts etc.
See https://forum.lazarus.freepascal.org/index.php/topic,53773.msg398604.html#msg398604
You can change the fonts from barcode to your own custom fonts of course.

If you really want to load it from a file you could use AddFontResourceEx() instead of AddFontMemResourceEx().

[KodeZwerg]

Take a look in my demo.

[EganSolo]

@rvk and @KodeZwerg: Thank you so much for your replies! I got busy with a bunch of other things but I didn't think that your answers were ignored! Much appreciated.

[flowCRANE]

What you are looking for is accomplished with the AddFontResourceExW function. I've successfully used it to load fonts as private to the app and finally unregister them using the RemoveFontResourceExW function. Below is the code of a small class that searches for fonts from a given location (local subdirectory of the application). It is copied from one of my project, has few years but worked on Win7 and Win10.

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

1. unit Tool.Fonts;
2.  
3. {$MODE OBJFPC}{$LONGSTRINGS ON}
4.  
5. interface
6.  
7. uses
8.   FGL;
9.  
10. type
11.   TFontsMap = class(specialize TFPGMap<WideString, LongInt>)
12.   private
13.     function IsFontFile(const AFileName: String): Boolean;
14.     procedure ListFonts(const APath: String);
15.   public
16.     procedure LoadFonts();
17.     procedure UnloadFonts();
18.   end;
19.  
20. implementation
21.  
22. uses
23.   LazUTF8,
24.   SysUtils,
25.   Tool.WinAPI;
26.  
27.  
28. function TFontsMap.IsFontFile(const AFileName: String): Boolean;
29. var
30.   Extension: String;
31. begin
32.   Extension := ExtractFileExt(AFileName);
33.   Result := Extension.ToLower().IndexOfAny(['.ttf', '.otf']) <> -1;
34. end;
35.  
36.  
37. procedure TFontsMap.ListFonts(const APath: String);
38. var
39.   FoundItem: TSearchRec;
40.   FontName: WideString;
41. begin
42.   if FindFirst(APath + '*', faAnyFile, FoundItem) = 0 then
43.   try
44.     repeat
45.       if (FoundItem.Name = '.') or (FoundItem.Name = '..') then Continue;
46.  
47.       if FoundItem.Attr and faDirectory = faDirectory then
48.         ListFonts(APath + FoundItem.Name + '\')
49.       else
50.         if IsFontFile(FoundItem.Name) then
51.         begin
52.           FontName := UTF8ToUTF16(APath + FoundItem.Name);
53.           Add(FontName, 0);
54.         end;
55.     until FindNext(FoundItem) <> 0;
56.   finally
57.     FindClose(FoundItem);
58.   end;
59. end;
60.  
61.  
62. procedure TFontsMap.LoadFonts();
63. var
64.   FontIndex: Integer;
65.   FontName: WideString;
66.   FontsCount: LongInt;
67. begin
68.   for FontIndex := 0 to Count - 1 do
69.   begin
70.     FontName := Keys[FontIndex];
71.     FontsCount := AddFontResourceExW(PWideChar(FontName), FR_PRIVATE, nil);
72.  
73.     Data[FontIndex] := FontsCount;
74.   end;
75. end;
76.  
77.  
78. procedure TFontsMap.UnloadFonts();
79. var
80.   FontIndex: Integer;
81.   FontName: WideString;
82. begin
83.   for FontIndex := 0 to Count - 1 do
84.     if Data[FontIndex] <> 0 then
85.     begin
86.       FontName := Keys[FontIndex];
87.       RemoveFontResourceExW(PWideChar(FontName), FR_PRIVATE, nil);
88.     end;
89. end;
90.  
91.  
92. end.

[dsiders]

What you are looking for is accomplished with the AddFontResourceExW function. I've successfully used it to load fonts as private to the app and finally unregister them using the RemoveFontResourceExW function. Below is the code of a small class that searches for fonts from a given location (local subdirectory of the application). It is copied from one of my project, has few years but worked on Win7 and Win10.

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

1. unit Tool.Fonts;
2.  
3. {$MODE OBJFPC}{$LONGSTRINGS ON}
4.  
5. interface
6.  
7. uses
8.   FGL;
9.  
10. type
11.   TFontsMap = class(specialize TFPGMap<WideString, LongInt>)
12.   private
13.     function IsFontFile(const AFileName: String): Boolean;
14.     procedure ListFonts(const APath: String);
15.   public
16.     procedure LoadFonts();
17.     procedure UnloadFonts();
18.   end;
19.  
20. implementation
21.  
22. uses
23.   LazUTF8,
24.   SysUtils,
25.   Tool.WinAPI;
26.  
27.  
28. function TFontsMap.IsFontFile(const AFileName: String): Boolean;
29. var
30.   Extension: String;
31. begin
32.   Extension := ExtractFileExt(AFileName);
33.   Result := Extension.ToLower().IndexOfAny(['.ttf', '.otf']) <> -1;
34. end;
35.  
36.  
37. procedure TFontsMap.ListFonts(const APath: String);
38. var
39.   FoundItem: TSearchRec;
40.   FontName: WideString;
41. begin
42.   if FindFirst(APath + '*', faAnyFile, FoundItem) = 0 then
43.   try
44.     repeat
45.       if (FoundItem.Name = '.') or (FoundItem.Name = '..') then Continue;
46.  
47.       if FoundItem.Attr and faDirectory = faDirectory then
48.         ListFonts(APath + FoundItem.Name + '\')
49.       else
50.         if IsFontFile(FoundItem.Name) then
51.         begin
52.           FontName := UTF8ToUTF16(APath + FoundItem.Name);
53.           Add(FontName, 0);
54.         end;
55.     until FindNext(FoundItem) <> 0;
56.   finally
57.     FindClose(FoundItem);
58.   end;
59. end;
60.  
61.  
62. procedure TFontsMap.LoadFonts();
63. var
64.   FontIndex: Integer;
65.   FontName: WideString;
66.   FontsCount: LongInt;
67. begin
68.   for FontIndex := 0 to Count - 1 do
69.   begin
70.     FontName := Keys[FontIndex];
71.     FontsCount := AddFontResourceExW(PWideChar(FontName), FR_PRIVATE, nil);
72.  
73.     Data[FontIndex] := FontsCount;
74.   end;
75. end;
76.  
77.  
78. procedure TFontsMap.UnloadFonts();
79. var
80.   FontIndex: Integer;
81.   FontName: WideString;
82. begin
83.   for FontIndex := 0 to Count - 1 do
84.     if Data[FontIndex] <> 0 then
85.     begin
86.       FontName := Keys[FontIndex];
87.       RemoveFontResourceExW(PWideChar(FontName), FR_PRIVATE, nil);
88.     end;
89. end;
90.  
91.  
92. end.

No one can test or use this without the tool.winapi unit.

[ASerge]

No one can test or use this without the tool.winapi unit.

Replace this unit with JwaWinGDI.

[flowCRANE]

Sorry, I didn't notice that this module is attached. It simply contain WinAPI function imports:

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

1. uses
2.   Windows;
3.  
4. const
5.   FR_PRIVATE  = $00000010;
6.   FR_NOT_ENUM = $00000020;
7.  
8.   function AddFontResourceExW(name: LPCWSTR; fl: DWORD; res: PVOID): LongInt; stdcall external 'gdi32.dll';
9.   function RemoveFontResourceExW(name: LPCWSTR; fl: DWORD; pdv: PVOID): BOOL; stdcall external 'gdi32.dll';

You can use these constants and imports or find a unit with them (like JwaWinGDI).