procedure TForm1.FormCreate(Sender:
TObject);
begin
Listbox1.Items := Screen.Fonts;
end;
procedure TForm1.ListBox1Click(Sender:
TObject);
begin
FontLabel.Caption := ListBox1.Items[ListBox1.ItemIndex];
end;
procedure TForm1.DrawItem(Control:
TWinControl; Index: Integer;
Rect: TRect; State: TOwnerDrawState);
begin
with ListBox1.Canvas do
begin
FillRect(Rect);
Font.Name := ListBox1.Items[Index];
Font.Size := 0; // use font's preferred size
TextOut(Rect.Left+1, Rect.Top+1, ListBox1.Items[Index]);
end;
end;
procedure TForm1.ListBox1MeasureItem(Control:
TWinControl; Index: Integer;
var Height: Integer);
begin
with ListBox1.Canvas do
begin
Font.Name := Listbox1.Items[Index];
Font.Size := 0; // use font's preferred size
Height := TextHeight('Wg') + 2; // measure ascenders and descenders
end;
end;
|