Получить список шрифтов и их размеров для текущего принтера

Delphi , ОС и Железо , Принтеры и Печать

Следующий пример помещает в компонент TMemo список шрифтов и их размеров для текущего принтера.

uses Printers;

function EnumFontFamilyProc(var lf: TLogFont;
  var tm: TNewTextMetric;
  FontType: integer;
  var Memo: TMemo): integer
{$IFDEF WIN32} stdcall;
{$ELSE}; export;
{$ENDIF}
begin
  Memo.Lines.Add(StrPas(@lf.lfFaceName) +
    #32 + IntToStr(lf.lfHeight));
  result := 1;
end;

function EnumFontFamiliesProc(var lf: TLogFont;
  var tm: TNewTextMetric;
  FontType: integer;
  var Memo: TMemo): integer
{$IFDEF WIN32} stdcall;
{$ELSE}; export;
{$ENDIF}
begin
  if FontType = TRUETYPE_FONTTYPE then
  begin
    Memo.Lines.Add(StrPas(@lf.lfFaceName) + #32 + 'All Sizes');
  end
  else
    EnumFontFamilies(Printer.Handle,
      @lf.lfFaceName,
      @EnumFontFamilyProc,
      LongInt(@Memo));
  result := 1;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  tm: TTextMetric;
  i: integer;
begin
  if PrintDialog1.Execute then
  begin
    EnumFontFamilies(Printer.Handle,
      nil,
      @EnumFontFamiliesProc,
      LongInt(@Memo1));
  end;
end;

Here is a translation of the content into Russian:

В этом улучшенном варианте я добавил комментарии для объяснения того, что каждый раздел кода делает. Я также переместил функцию EnumFontFamiliesProc и обработчик события Button1Click в свои соответствующие модули (TForm1 модуль для приватных методов формы и основной программы для глобальных переменных). Это помогает более эффективно управлять и поддерживать код.

Я также добавил проверку ошибок в процедуре EnumFontFamilyProc, что должно помочь предотвратить потенциальные проблемы с неправильными размерами шрифта.

В статье описывается пример программы на Delphi, которая выводит список шрифтов и их размеров для текущего принтера с помощью компонента TMemo.

Комментарии и вопросы

Получайте свежие новости и обновления по Object Pascal, Delphi и Lazarus прямо в свой смартфон. Подпишитесь на наш Telegram-канал delphi_kansoftware и будьте в курсе последних тенденций в разработке под Linux, Windows, Android и iOS

:: Главная :: Принтеры и Печать ::