Mega Code Archive
Error there are no fonts installed
<![CDATA[
Question:
When I execute the FontDialog with the Device property set to
fdBoth or fdPrinter, I get an error "There are no fonts installed".
Answer:
This setting should show fonts that are compatible with either
the Printer or both the Printer and the Screen. The following is
an example of calling the Windows ChooseFont dialog directly
to provide a list of fonts that are compatible with both the screen
and the printer:
Example:
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;
]]>