load font

https://tipsfordev.com/firemonkey-load-alternative-font

FIREMONKEY - load alternative font

I would like to load an external font in a Delphi Firemonkey application.

Is there any information how to do that?


Not sure if it works for FireMonkey, but this code worked for me when I wanted to load custom fonts to my standard Delphi applications.
 
uses
  Windows, SysUtils, Messages, Classes, Generics.Collections;

type
  { .: TExternalFonts :. }
  TExternalFonts = class sealed(TList<HFONT>);

var
  ExternalFonts: TExternalFonts;

function AddExternalFont(const AFileName: String): HFONT; overload;
function AddExternalFont(const AStream: TStream): HFONT; overload;

implementation

{ .: DoCleanup :. }
procedure DoCleanup();
var
  I: Integer;
begin
  for I := ExternalFonts.Count -1 downto 0 do
  begin
    RemoveFontMemResourceEx(ExternalFonts[I]);
    ExternalFonts.Delete(I);
    //SendMessage(HWND_BROADCAST, WM_FONTCHANGE, 0, 0);
  end;
end;

{ .: AddExternalFont :. }
function AddExternalFont(const AFileName: String): HFONT; overload;
var
  FS: TFileStream;
begin
  Result := 0;

  if not FileExists(AFileName) then
    exit;

  FS := TFileStream.Create(AFileName, fmOpenRead + fmShareExclusive);
  try
    Result := AddExternalFont(FS);
  finally
    FS.Free();
  end;
end;

{ .: AddExternalFont :. }
function AddExternalFont(const AStream: TStream): HFONT; overload;
var
  MS: TMemoryStream;
  Temp: DWORD;
begin
  Result := 0;

  if not Assigned(AStream) then
    exit;

  Temp := 1;
  MS := TMemoryStream.Create();
  try
    MS.CopyFrom(AStream, 0);

    Result := AddFontMemResourceEx(MS.Memory, MS.Size, nil, @Temp);
    if (Result <> 0) then
      ExternalFonts.Add(Result);
    //SendMessage(HWND_BROADCAST, WM_FONTCHANGE, 0, 0);
  finally
    MS.Free();
  end;
end;

initialization
  ExternalFonts := TExternalFonts.Create();

finalization
  DoCleanup();
  ExternalFonts.Free();

end.