Recent

Author Topic: [Solved] Can I use a font in my app without installing it first?  (Read 1098 times)

EganSolo

  • Sr. Member
  • ****
  • Posts: 274
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.
« Last Edit: May 04, 2023, 12:09:03 am by EganSolo »

rvk

  • Hero Member
  • *****
  • Posts: 5484
Re: Can I use a font in my app without installing it first?
« Reply #1 on: April 18, 2023, 08:18:24 pm »
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

  • Hero Member
  • *****
  • Posts: 1644
  • Fifty shades of code.
    • Delphi & FreePascal
Re: Can I use a font in my app without installing it first?
« Reply #2 on: April 18, 2023, 08:18:38 pm »
Take a look in my demo.
« Last Edit: Tomorrow at 31:76:97 by KodeZwerg »

EganSolo

  • Sr. Member
  • ****
  • Posts: 274
Re: [Solved] Can I use a font in my app without installing it first?
« Reply #3 on: May 04, 2023, 12:09:55 am »
@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.

furious programming

  • Hero Member
  • *****
  • Posts: 766
Re: [Solved] Can I use a font in my app without installing it first?
« Reply #4 on: May 17, 2023, 02:13:52 am »
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.
Lazarus 2.2.6 with FPC 3.2.2, Windows 10 — all 64-bit

Working solo on an acrade, action/adventure game in retro style (pixelart), programming the engine and shell from scratch, using Free Pascal and SDL. Release planned in 2025.

dsiders

  • Hero Member
  • *****
  • Posts: 915
Re: [Solved] Can I use a font in my app without installing it first?
« Reply #5 on: May 17, 2023, 02:51:45 am »
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.
Preview Lazarus 3.99 documentation at: https://dsiders.gitlab.io/lazdocsnext

ASerge

  • Hero Member
  • *****
  • Posts: 2102
Re: [Solved] Can I use a font in my app without installing it first?
« Reply #6 on: May 17, 2023, 07:23:41 pm »
No one can test or use this without the tool.winapi unit.
Replace this unit with JwaWinGDI.

furious programming

  • Hero Member
  • *****
  • Posts: 766
Re: [Solved] Can I use a font in my app without installing it first?
« Reply #7 on: June 07, 2023, 05:29:19 pm »
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).
Lazarus 2.2.6 with FPC 3.2.2, Windows 10 — all 64-bit

Working solo on an acrade, action/adventure game in retro style (pixelart), programming the engine and shell from scratch, using Free Pascal and SDL. Release planned in 2025.

 

TinyPortal © 2005-2018