![]() |
|
|
Регистрация | << Правила форума >> | FAQ | Пользователи | Календарь | Поиск | Сообщения за сегодня | Все разделы прочитаны |
|
Опции темы | Поиск в этой теме | Опции просмотра |
#1
|
|||
|
|||
![]() Добрый день. Я начну.
Необходимо сделать список шрифтов в виде самих шрифтов. Вот в нете нашел такой вот код: Код:
unit Fontlist; interface uses Windows, Classes, Graphics, Forms, Controls, StdCtrls; type TForm1 = class(TForm) ListBox1: TListBox; Label1: TLabel; FontLabel: TLabel; procedure FormCreate(Sender: TObject); procedure ListBox1Click(Sender: TObject); procedure DrawItem(Control: TWinControl; index: Integer; Rect: TRect; State: TOwnerDrawState); procedure ListBox1MeasureItem(Control: TWinControl; index: Integer; var Height: Integer); private { Private declarations } public { Public declarations } end; var Form1: TForm1; implementation {$R *.DFM} 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; end. Но как бы он не работает... Иии тут Listbox я вообще делаю через ComboBox но и так и так вообще не выходит... Иии тут написано процедура TForm1.DrawItem но такой нет она же только или в ListBox или в ComboBox на Form её нет...я делал через TForm1.ListBox1DrawItem но всё равно результат нулевой... Помогите кто чем может) |