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

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;

type TFontInfo = record
  Pitch: Boolean;
  Name: String;
end;
 
function GetFontInfoFromMemory(m_addr: Pointer; m_size: DWORD): TFontInfo;
var
  _name: array[0..31] of Char;
  _pich: Byte;
begin
  ZeroMemory(@_name, 32);
 
  asm
      jmp @start
 
  @str:
      db 'name'
      db 'post'
 
  @start:
      push esi
      push edi
      mov edx,m_size
      mov eax,m_addr
  @next_0:
      lea edi,@str
      mov esi,eax
      mov ecx,$04
      cld
      rep cmpsb
      jz @find_name
      inc eax
      dec edx
      jnz @next_0
      jmp @exit
  @find_name:
      xor eax,eax
      mov ah,[esi+$04]      // 4 байта смещения к таблице 'name'
      mov al,[esi+$05]
      rol eax,16
      mov ah,[esi+$06]
      mov al,[esi+$07]
      add eax,m_addr        // EAX = адрес таблицы 'name'
 
      xor ecx,ecx
      mov edi,eax
      mov ch,[edi+$04]
      mov cl,[edi+$05]
      add edi,ecx           // EDI = начало 'текстов'
 
      mov esi,eax
      xor ecx,ecx
      mov ch,[esi+$02]
      mov cl,[esi+$03]      // ECX = кол-во таблиц
      add esi,$06           // ESI = начало таблиц по 12 байт
 
  @next_1:
      cmp BYTE[esi+$01],$01 // ищем ID = 01-01
      jz @find_1
  @next_2:
      add esi,$0C           // переход на следующую таблицу
      dec ecx
      jnz @next_1
      jmp @exit
  @find_1:
      cmp BYTE[esi+$07],$01
      jnz @next_2
 
      xor ecx,ecx
      xor edx,edx
      mov cl,[esi+$09]      // длина имени
      mov dh,[esi+$0A]      // 2 байта смещение к имени
      mov dl,[esi+$0B]
      add edi,edx
      lea esi,_name         // получатель массив, длина уже в ECX
      xchg esi,edi
      cld
      rep movsb             // копируем
 
      mov edx,m_size
      mov eax,m_addr
  @next_3:
      lea edi,@str+$04
      mov esi,eax
      mov ecx,$04
      cld
      rep cmpsb
      jz @find_post
      inc eax
      dec edx
      jnz @next_3
      jmp @exit
  @find_post:
      xor eax,eax
      mov ah,[esi+$04]      // берем 4 байта смещения к таблице 'post'
      mov al,[esi+$05]
      rol eax,16
      mov ah,[esi+$06]
      mov al,[esi+$07]
      add eax,m_addr        // EAX = адрес таблицы 'post'
      add eax,$0F           // пропустить 4+4+2+2 и 3 старших байта isFixedPitch
      mov al,[eax]
      and al,$03
      mov _pich,al
 
  @exit:
      pop edi
      pop esi
    end;
 
  SetLength(Result.Name,32);
  Result.Name := Copy(_name,0,32);
  Result.Pitch := (_pich = 0);
end;
 
function LoadFontFromResource(const ResourceName: string; ResourceType: PChar): TFontInfo;
var
  ResStream: TResourceStream;
  FontsCount: DWORD;
begin
  ResStream := TResourceStream.Create(hInstance, ResourceName, ResourceType);
  try
    if (AddFontMemResourceEx(ResStream.Memory, ResStream.Size, nil, @FontsCount) <> 0) then
      Result := GetFontInfoFromMemory(ResStream.Memory,ResStream.Size);
  finally
    ResStream.Free;
  end;
end;

var fi: TFontInfo;
 
fi := LoadFontFromResource('FONT_1','RT_FONT');
Label1.Font.Name := fi.Name;