procedure TForm1.FormCreate(Sender: TObject); 
var 
  x: integer; 
begin 
  with Combobox1 do begin 
    clear; 
    Style := csOwnerdrawVariable; 
    for x := 0 to Screen.Fonts.Count - 1 do 
      Items.Add(Screen.Fonts.Strings[x]); 
    width := 400; 
    Itemindex := 0; 
    Font.size := 12; 
    ParentFont := false; 
  end; 
end; 
 
procedure TForm1.ComboBox1DrawItem(Control: TWinControl; Index: Integer; 
  Rect: TRect; State: TOwnerDrawState); 
const txt = 'ABCabcÄÖÜäöüß123'; 
begin 
  with TComboBox(Control) do 
  begin 
    canvas.FillRect(Rect); 
    canvas.Font.Name := 'Arial'; 
    canvas.TextOut(Rect.Left, Rect.Top, Items[Index] + ':  '); 
    canvas.Font.Name := Items[Index]; 
    canvas.TextOut(canvas.penpos.x, Rect.Top, txt); 
  end; 
end; 
 
procedure TForm1.ComboBox1MeasureItem(Control: TWinControl; Index: Integer; 
  var Height: Integer); 
begin 
  height := 20; 
end; 
 
 
// Beispielaufruf 
 
procedure TForm1.ComboBox1Change(Sender: TObject); 
begin 
  with TCombobox(Sender) do 
    Form1.Font.Name := Items[ItemIndex]; 
end;