Имя шрифта, подгруженного из ресурса

unit uFonts;
 
{$R fonts\fonts.res}
 
interface
 
{$REGION 'Info'}
(* Модуль работы со шрифтами.
   Инфа взята отсюда:
     https://delphisources.ru/forum/showthread.php?t=25264
     https://********************/showthread.php?t=180046
     http://users.atw.hu/delphicikk/listaz.php?id=2128&oldal=38
     http://www.undocprint.org/winspool/getfontresourceinfo
     https://forum.lazarus.freepascal.org/index.php?topic=39124.0 *)
{$ENDREGION}
 
{$REGION 'uses'}
uses
  //============================== Модули проекта ==============================
  //==================== Модули проекта с формами и фреймами ===================
  //=============================== Левые модули ===============================
  //=================== Системные модули, добавленные вручную ==================
  Windows, Messages, Classes, SysUtils, Graphics;
{$ENDREGION}
 
// установка всех шрифтов из секции ресурсов FONT
function InitUserFontResources(const SkipInstalled: Boolean = false): int32;
function GetUserFontData(const hf: HFONT; stream: TCustomMemoryStream): boolean;
 
// глобальные переменные
var
  UserFontNames: TStringList;
 
implementation
 
const
  UF_RESOURCE_TYPENAME = 'RT_FONT'; // тип ресурса шрифтов (из RC-файла)
 
// загрузка приватного шрифта из ресурса. Прекрасно работает!
function LoadResourceFont(const ResourceName: string): HFont;
var
  FontsCount : integer;
begin
   var stream:= TResourceStream.Create(hInstance, ResourceName, UF_RESOURCE_TYPENAME);
   try
     result:= AddFontMemResourceEx(stream.Memory, stream.Size, nil, @FontsCount);
   finally
     stream.Free();
   end;
end;
 
// коллбэк для перечисления EnumResourceNames()
function EnumResNameCallback(hModule: NativeUInt; lpszType: LPCTSTR; lpszName: LPTSTR; lParam: LONG_PTR): boolean; stdcall;
var
  list: TStringList absolute lParam;
begin
  var res_name:= string(lpszName);
  assert(res_name <> '');
 
  var hf:= LoadResourceFont(res_name);
  list.AddObject(Format('%s [0x%.8X]', [res_name, hf]), pointer(hf));
  result:= true;
end;
 
// установка всех шрифтов из секции ресурсов FONT
function InitUserFontResources(const SkipInstalled: Boolean): int32;
begin
  // чтение имён ресурсов-шрифтов
  if not EnumResourceNames(0, UF_RESOURCE_TYPENAME, @EnumResNameCallback, LONG_PTR(UserFontNames))
    then exit(-1);
 
  result:= UserFontNames.Count; // возвращает кол-во добавленных шрифтов
  SendMessage(HWND_BROADCAST, WM_FONTCHANGE, 0, 0);
end;
 
// образ файла шрифта по HFont (не работает со шрифтами, установленными из памяти)
function GetUserFontData(const hf: HFONT; stream: TCustomMemoryStream): boolean;
begin
  var dc:= CreateCompatibleDC(0);
 
  if dc = 0
    then exit(false);
 
  try
    SelectObject(dc, hf);
    var size: int32:= GetFontData(dc, 0, 0, nil, 0); // размер данных
    if size <= 0
      then exit(false);
 
    stream.Size:= size;
    result:= GetFontData(dc, 0, 0, stream.Memory, size) = size;
  finally
    DeleteDC(dc);
  end;
end;
 
initialization
  UserFontNames:= TStringList.Create();
 
finalization
  FreeAndNil(UserFontNames);
 
end.