Display WYSIWYG fonts in a list box

Problem/Question/Abstract:

You can display the available fonts in a WYSIWYG fashion.

Answer:

Start a new project, add a TListBox, in the Form�s OnCreate event code:

procedure TForm1.FormCreate(Sender: TObject);
begin
  ListBox1.Items := Screen.Fonts;
end;

Set the ListBox�s style property to lbOwnerDrawVariable and finally and the following code to the ListBox�s OnDrawItem and OnMeasureItem events

procedure TForm1.ListBox1MeasureItem(Control: TWinControl; Index: Integer;
  var Height: Integer);
var
  h: integer;
begin
  with Control as TListBox do
  begin
    Canvas.Font.Name := Items[Index];
    h := Canvas.TextHeight(Items[Index]);
  end;
  Height := h;
end;

procedure TForm1.ListBox1DrawItem(Control: TWinControl; Index: Integer;
  Rect: TRect; State: TOwnerDrawState);
begin
  with Control as TListBox do
  begin
    Canvas.Font.Name := Items[Index];
    Canvas.FillRect(Rect);
    Canvas.TextOut(Rect.Left, Rect.Top, Items[Index]);
  end;
end;