TComboBox Schriftart ändern

[Delphi.Narium]

Bin mal ein bisserl auf die Suche gegangen, dabei rausgekommen ist dann dashier:

Delphi-Quellcode:

procedure TForm1.ComboBox1DrawItem(Control: TWinControl; Index: Integer; Rect: TRect; State: TOwnerDrawState);
begin
  if odSelected in State then begin
    ComboBox1.Canvas.Brush.Style := bsSolid;
    ComboBox1.Canvas.Brush.Color := $00EEEEEE;
    ComboBox1.Canvas.FillRect(Rect);
    ComboBox1.Canvas.Brush.Color := $00DDDDDD;
    ComboBox1.Canvas.Rectangle(10,Rect.Top + 8,20,Rect.Top + 18);
    ComboBox1.Canvas.Font.Color := $00BEBEBE;
    ComboBox1.Canvas.Font.Style := [fsBold];
    ComboBox1.Canvas.Brush.Style := bsClear;
  end else begin
    ComboBox1.Canvas.Brush.Style := bsSolid;
    if Index mod 2 = 0 then ComboBox1.Canvas.Brush.Color := $00D7D7D7
    else ComboBox1.Canvas.Brush.Color := $00DBDBDB;
    ComboBox1.Canvas.FillRect(Rect);
    ComboBox1.Canvas.Font.Color := clBlack;
    ComboBox1.Canvas.Font.Style := [];
    ComboBox1.Canvas.Brush.Style := bsClear;
   end;

   Rect.Top   := Rect.Top + 2;
   Rect.Left  := 5;
   Rect.Right := 150;

   ComboBox1.Canvas.Font.Name := 'Tahoma';
   DrawText(ComboBox1.Canvas.Handle,
            PChar(Screen.Fonts.Strings[Index]),-1,
            Rect,DT_RIGHT or DT_SINGLELINE or DT_VCENTER);

   ComboBox1.Canvas.MoveTo(155,Rect.Top - 2);
   ComboBox1.Canvas.LineTo(155,Rect.Top + ComboBox1.ItemHeight + 2);

   ComboBox1.Canvas.Font.Name := ComboBox1.Items[Index];
   ComboBox1.Canvas.Font.Size := 12;
   Rect.Left := Rect.Left + 160;
   Rect.Right := 500;
   DrawText(ComboBox1.Canvas.Handle,
            PChar(Screen.Fonts.Strings[Index]),-1,
            Rect,DT_SINGLELINE or DT_VCENTER);
end;

(Und meine erste Idee war (mal wieder) etwas vorschnell und unüberlegt )