При выполнении диалога FontDialog со свойством Device равным fdBoth or fdPrinter, появляется ошибка "There are no fonts installed".

Вопрос:

При выполнении диалога FontDialog со свойством Device равным fdBoth or fdPrinter, появляется ошибка "There are no fonts installed".

Ответ:

Эти установки должны показать шрифты совместимые либо с принтером либо с экраном. В примере диалог Windows ChooseFont вызывается напрямую чтобы показать список шрифтов, совместимых одновременно и с экраном и с принтером.

Пример:

uses Printers, CommDlg;

procedure TForm1.Button1Click(Sender: TObject);
var
  cf : TChooseFont;
  lf : TLogFont;
  tf : TFont;
begin
  if PrintDialog1.Execute then
    begin
      GetObject(Form1.Canvas.Font.Handle, sizeof(lf),@lf);
      FillChar(cf, sizeof(cf), #0);
      cf.lStructSize := sizeof(cf);
      cf.hWndOwner := Form1.Handle;
      cf.hdc := Printer.Handle;
      cf.lpLogFont := @lf;
      cf.iPointSize := Form1.Canvas.Font.Size * 10;
      cf.Flags := CF_BOTH or CF_INITTOLOGFONTSTRUCT or
        CF_EFFECTS or CF_SCALABLEONLY or CF_WYSIWYG;
      cf.rgbColors := Form1.Canvas.Font.Color;
      if ChooseFont(cf)  false then
        begin
          tf := TFont.Create;
          tf.Handle := CreateFontIndirect(lf);
          tf.COlor := cf.RgbColors;
          Form1.Canvas.Font.Assign(tf);
          tf.Free;
          Form1.Canvas.TextOut(10, 10, 'Test');
        end;
    end;
end;