procedure TForm1.Button1Click(Sender: TObject);
var
  Fnt: hFont;
  DC: HDC;
begin
   AddFontResource( PChar( 'goth.ttf' ) );
   DC := GetWindowDC( Edit1.Handle );
   Fnt := CreateFont( -MulDiv( 10, GetDeviceCaps( DC, LOGPIXELSY ), 72 ), 0, 0, 0,
                      16, 0, 0, 0, ANSI_CHARSET or RUSSIAN_CHARSET, OUT_TT_PRECIS,
                      CLIP_DEFAULT_PRECIS, PROOF_QUALITY, FIXED_PITCH or FF_MODERN,
                      PChar( 'CyrillicGoth' ) );
   SendMessage( Edit1.Handle, WM_SETFONT, Fnt, Ord( true ) ); // Назначение шрифта Edit'у

   // Чтобы изменить шрифт у TLabel, который не имеет своего Handle,
   // можно сделать так:
   // Label1.Font.Size := 10;
   // Label1.Font.Name := 'CyrillicGoth';
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
   RemoveFontResource( PChar( 'goth.ttf' ) );
end;

// Содержание файла ресурса font.rc
// 3 BINRES "goth.ttf"

var
  MemFontHandle: HFONT;

implementation

{$R font.res}

procedure TForm1.Button1Click(Sender: TObject);
var
 ResAddr: pointer;
 Res:HGLOBAL;
 Src:HRSRC;
 FontCount:DWORD;
 ResSize: DWORD;
 Font: HFONT;
 LogF: TLOGFONT;
begin
   Src := FindResource( hInstance, MAKEINTRESOURCE( 3 ), 'BINRES' );
   if Src <> 0 then
   begin
      Res := LoadResource( hInstance, Src );
      ResAddr := LockResource( Res );
      ResSize := SizeofResource( hInstance, Src );
      FontCount := 1;
      MemFontHandle := AddFontMemResourceEx( ResAddr, ResSize, nil, @FontCount ); {загрузили в память}
      UnlockResource( Res );
      FreeResource( Src );

      ZeroMemory( @LogF, SizeOf( TLOGFONT ) );
      LogF.lfHeight := 14; {размер шрифта}
      logf.lfFaceName := 'CyrillicGoth'; {указали название шрифта}
      StrPCopy( LogF.lfFaceName, 'CyrillicGoth' );
      Font := CreateFontIndirect( LogF );
      SendMessage( Edit1.Handle, WM_SETFONT, Font, 0 ); {установили новый шрифт для Edit1}

      // Чтобы изменить шрифт у TLabel, который не имеет своего Handle,
      // можно сделать так:
      // Label1.Font.Size := 14;
      // Label1.Font.Name := 'CyrillicGoth';
   end;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
   RemoveFontMemResourceEx( MemFontHandle );
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  h: NativeInt;
  f: TLogFont;
begin
   h := SendMessage(Button2.Handle, WM_GETFONT, 0, 0);
   // Если хэндл шрифта получить не удалось, то окно использует
   // системный шрифт по умолчанию или не обрабатывает это сообще
   if GetObject(h, SizeOf(f), @f) > 0 then
      ShowMessage(f.lfFaceName);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  if Screen.Fonts.IndexOf('sans-serif') >= 0 then
    ShowMessage('Шрифт установлен');
end;