mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-08-30 20:30:41 +02:00
Printers, implements printer.fonts (windows), issue #17122
git-svn-id: trunk@43184 -
This commit is contained in:
parent
354c863fdb
commit
e0905893f5
@ -1169,6 +1169,37 @@ begin
|
|||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
function PrinterEnumFontsProc(
|
||||||
|
var ELogFont: LCLType.TEnumLogFontEx;
|
||||||
|
var Metric: LCLType.TNewTextMetricEx;
|
||||||
|
FontType: Longint;
|
||||||
|
Data:LParam):Longint; stdcall;
|
||||||
|
var
|
||||||
|
S: string;
|
||||||
|
Lst: TStrings;
|
||||||
|
begin
|
||||||
|
s := StrPas(ELogFont.elfLogFont.lfFaceName);
|
||||||
|
Lst := TStrings(PtrInt(Data));
|
||||||
|
if Lst.IndexOf(S)<0 then
|
||||||
|
Lst.AddObject(S, TObject(PtrInt(FontType)));
|
||||||
|
result := 1;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TWinPrinter.DoEnumFonts(Lst: TStrings);
|
||||||
|
var
|
||||||
|
Lf: TLogFont;
|
||||||
|
begin
|
||||||
|
if (Lst=nil) then
|
||||||
|
exit;
|
||||||
|
Lst.Clear;
|
||||||
|
if Printers.Count>0 then begin
|
||||||
|
Lf.lfFaceName := '';
|
||||||
|
Lf.lfCharSet := DEFAULT_CHARSET;
|
||||||
|
Lf.lfPitchAndFamily := 0;
|
||||||
|
LCLIntf.EnumFontFamiliesEx(Canvas.Handle, @Lf, @PrinterEnumFontsProc, PtrInt(Lst), 0);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
initialization
|
initialization
|
||||||
Printer:=TWinPrinter.Create;
|
Printer:=TWinPrinter.Create;
|
||||||
|
|
||||||
|
@ -60,6 +60,7 @@ Type
|
|||||||
function DoGetDefaultBinName: string; override;
|
function DoGetDefaultBinName: string; override;
|
||||||
function DoGetBinName: string; override;
|
function DoGetBinName: string; override;
|
||||||
procedure DoSetBinName(aName: string); override;
|
procedure DoSetBinName(aName: string); override;
|
||||||
|
procedure DoEnumFonts(Lst: TStrings); override;
|
||||||
|
|
||||||
function DoSetPrinter(aName : string): Integer; override;
|
function DoSetPrinter(aName : string): Integer; override;
|
||||||
|
|
||||||
|
@ -717,6 +717,7 @@ begin
|
|||||||
else
|
else
|
||||||
raise EPrinter.Create('Printer index out of range!');
|
raise EPrinter.Create('Printer index out of range!');
|
||||||
SetPrinter(aName);
|
SetPrinter(aName);
|
||||||
|
DoResetFontsList;
|
||||||
end
|
end
|
||||||
else
|
else
|
||||||
raise EPrinter.Create('No printers defined!');
|
raise EPrinter.Create('No printers defined!');
|
||||||
@ -772,7 +773,8 @@ end;
|
|||||||
|
|
||||||
procedure TPrinter.DoResetFontsList;
|
procedure TPrinter.DoResetFontsList;
|
||||||
begin
|
begin
|
||||||
//Override this method
|
if fFonts<>nil then
|
||||||
|
fFonts.Clear;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
//Initialize the Lst with all definied printers
|
//Initialize the Lst with all definied printers
|
||||||
|
Loading…
Reference in New Issue
Block a user