Sources
Delphi Russian Knowledge Base
DRKB - это самая большая и удобная в использовании база знаний по Дельфи в рунете, составленная Виталием Невзоровым

Получить список шрифтов и их размеров для текущего принтера

01.01.2007

Следующий пример помещает в компонент TMemo список шрифтов и их размеров для текущего принтера.

uses Printers;
 
function EnumFontFamilyProc(var lf: TLogFont;
 
var tm: TNewTextMetric;
 
FontType: integer;
 
var Memo: TMemo): integer
{$IFDEF WIN32} stdcall;
{$ELSE}; export;
{$ENDIF}
begin
 
Memo.Lines.Add(StrPas(@lf.lfFaceName) +
   
#32 + IntToStr(lf.lfHeight));
  result
:= 1;
end;
 
function EnumFontFamiliesProc(var lf: TLogFont;
 
var tm: TNewTextMetric;
 
FontType: integer;
 
var Memo: TMemo): integer
{$IFDEF WIN32} stdcall;
{$ELSE}; export;
{$ENDIF}
begin
 
if FontType = TRUETYPE_FONTTYPE then
 
begin
   
Memo.Lines.Add(StrPas(@lf.lfFaceName) + #32 + 'All Sizes');
 
end
 
else
   
EnumFontFamilies(Printer.Handle,
      @lf
.lfFaceName,
     
@EnumFontFamilyProc,
     
LongInt(@Memo));
  result
:= 1;
end;
 
procedure TForm1
.Button1Click(Sender: TObject);
var
  tm
: TTextMetric;
  i
: integer;
begin
 
if PrintDialog1.Execute then
 
begin
   
EnumFontFamilies(Printer.Handle,
     
nil,
     
@EnumFontFamiliesProc,
     
LongInt(@Memo1));
 
end;
end;

Взято с https://delphiworld.narod.ru