Отображение списка шрифтов

//With a Callback function: 
//************************ 

function
 EnumFontClBack(var
 lp: TEnumLogFont;
   var
 tm: TNewTextMetric;
   dwType: DWORD;
   lpData: lParam): Integer; stdcall
;
 begin

   Result := 1;
   with
 TForm1(lpData), Combobox1 do

   begin

     Items.Add(lp.elfLogFont.lfFaceName);
   end
;
 end
;


 procedure
 TForm1.FormShow(Sender: TObject);
 begin

   EnumFontFamilies(Canvas.Handle, nil
, @EnumFontClBack, Integer(Self));
 end
;

 procedure
 TForm1.ComboBox1Change(Sender: TObject);
 begin

   label1.Font.Name := Combobox1.Text;
 end
;


 // Easier Way: 
//***************************************** 

{ 
 To show the items in the corresponding font 
 The Style of the Listbox should be lbOwnerDrawVariable 
}


     procedure
 TForm1.ListBox1DrawItem(Control: TWinControl; Index
: Integer;
   Rect: TRect; State: TOwnerDrawState);
 begin

   with
 ListBox1 do

   begin

     Canvas.fillrect(rect);
     Canvas.Font.Style := [fsbold];
     Canvas.Font.Name  := Listbox1.Items[Index
];
     Canvas.textout(rect.Left, rect.Top, Listbox1.Items[Index
]);
   end
;
 end
;

 procedure
 TForm1.FormCreate(Sender: TObject);
 begin

   ComboBox1.Items := Screen.Fonts;
 end
;

 procedure
 TForm1.ComboBox1Change(Sender: TObject);
 begin

   label1.Font.Name := ComboBox1.Items[ComboBox1.ItemIndex];
 end
;

Другое по теме:

• Как проинсталлировать свои шрифты
• Определение типа используемого шрифта
• PopupComponent и шрифты