![]() |
![]() ![]() ![]() ![]() |
|
Использовать EnumFontFamiliesDelphi , Графика и Игры , ШрифтыИспользовать EnumFontFamilies
Оформил: DeeCo
{
Example for the use of EnumFontFamilies. This example requires two
listboxes on a form.
Beispiel fur die Verwendung vo EnumFontFamilies. Das Beispiel benotigt
2 Listboxen auf der Form.
}
procedure TForm1.FormCreate(Sender: TObject);
begin
Listbox1.Items.Assign(Screen.Fonts);
end;
function EnumProc(var elf: TEnumLogFont;
var ntm: TNewTextmetric;
FontType: Integer;
listbox: TListbox): Integer; stdcall;
var
S: string;
begin
if fonttype = TRUETYPE_FONTTYPE then
begin
listbox.Items.Add(Format('Name: %s', [elf.elfFullName]));
listbox.Items.Add(Format('Style: %s', [elf.elfStyle]));
end
else
listbox.Items.Add(Format('Name: %s', [elf.elfLogfont.lfFacename]));
listbox.Items.Add(Format('Size: %d', [elf.elfLogFont.lfHeight]));
listbox.Items.Add(Format('Weight: %d', [elf.elfLogFont.lfWeight]));
if elf.elfLogFont.lfItalic <> 0 then
listbox.Items.Add('This font is italic');
case FontType of
DEVICE_FONTTYPE: S := 'device font';
RASTER_FONTTYPE: S := 'raster font';
TRUETYPE_FONTTYPE: S := 'truetype font'
else
S := 'unknown font type';
end;
listbox.Items.Add(Format('This is a %s', [S]));
Result := 1;
end;
procedure TForm1.ListBox1Click(Sender: TObject);
begin
listbox2.Clear;
with listbox1 do
if ItemIndex >= 0 then
EnumFontFamilies(Self.Canvas.Handle, PChar(Items[ItemIndex]),
@EnumProc, Longint(Listbox2));
end;
Пример использования функции Процедура FormCreate
Процедура Функция EnumProc
Функция
Функция выполняет следующие действия:
Функция возвращает значение Процедура ListBox1Click
Когда пользователь выбирает элемент в первом списке ( Альтернативное решение
Если вы хотите отображать более детализированную информацию о каждом семействе фонтов, можно модифицировать функцию В целом, это пример демонстрирует использование В статье описывается пример использования функции EnumFontFamilies в Delphi для перебора списка доступных шрифтов на компьютере и отображения информации о них в списке. Комментарии и вопросыПолучайте свежие новости и обновления по Object Pascal, Delphi и Lazarus прямо в свой смартфон. Подпишитесь на наш
|
||||
©KANSoftWare (разработка программного обеспечения, создание программ, создание интерактивных сайтов), 2007 | ||||