Display WYSIWYG fonts in a list box (Views: 30)
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; |