1{%MainUnit ../osprinters.pas}
2{
3 ***************************************************************************
4                                cupsprinters_h.inc
5                                ------------
6                               Printer object
7                     Initial Revision  : Mon Nov 05 2002
8
9 ***************************************************************************
10
11 *****************************************************************************
12  This file is part of the Lazarus Component Library (LCL)
13
14  See the file COPYING.modifiedLGPL.txt, included in this distribution,
15  for details about the license.
16 *****************************************************************************
17
18  Author: Tony Maro (printers.pas)
19          Olivier Guilbaud (cupsprinters.pas for CUPS implementation)
20
21  Abstract :
22    CUPS support :
23      With this code, you can select an printer, modify its options (copies,
24      format paper, orientation, job priority, ...)
25      The height and with of the selected paper it's used for initialize the
26      height and width of PostScript canvas (idem for orientation).
27
28      see samples for uses.
29
30  history
31    nov   04 2003 OG - Add CUPS support
32    mars  09 2004 OG - Add SetJobState methode for initialize a state of job
33    apr   21 2004 OG - Fixe crash with second call of Printer.ExecuteSetup;
34    sept  07 2004 OG - Add Media property
35    sept  12 2004 OG - Fix EndDoc bug , second bug :o(
36                     - Modify cupsPrintFile methode. If aFineName it's not
37                       specified. The filename it's OutputName
38                     - Delete TestAll methode
39    sept  29 2004 OG - Rebuild object with new Printers unit.
40    mars  08 2005 OG - Rename 2 methods
41                     - Dynlink
42    mars  09 2005 OG - Modifications for Printer4Lazarus pakage
43
44-----------------------------------------------------------------------------}
45
46{ ---------------------------------------------------------------------
47  This code is heavily based on Tony Maro's initial Printers.pas
48  implementation in the LCL, but was adapted to work with CUPS.
49  ---------------------------------------------------------------------}
50
51{$IFNDEF win64}
52  {$DEFINE UseCairo}
53{$ENDIF}
54
55uses
56  Classes, SysUtils, LCLProc, PostScriptCanvas, Printers, Dialogs, Controls,
57  CUPSDyn
58  {$IFDEF UseCairo}
59  ,CairoCanvas
60  {$ENDIF}
61  ;
62
63type
64  TCUPSPrinterState = (
65    cpsDefaultPaperNameValid,
66    cpsOrientationValid,
67    cpsPaperNameValid,
68    cpsCopiesValid,
69    cpsPaperRectValid,
70    cpsResolutionValid,
71    cpsCustomPaperValid
72    );
73  TCUPSPrinterStates = set of TCUPSPrinterState;
74
75  { TCUPSPrinter }
76
77  TCUPSPrinter = Class(TPrinter)
78  private
79     fcupsPrinters: Pcups_dest_t;    //Printers avaible
80     fcupsPrinter : Pcups_dest_t;    //Selected printer
81     fcupsHttp    : Phttp_t;         //Server connection
82     fcupsPPD     : Pppd_file_t;     //PPD file of selected printer
83     fcupsPPDName : String;          //File name of PPD file (temporary copy)
84     fcupsOptions : Pcups_option_t;  //Options selected
85     fcupsNumOpts : Integer;         //Number of Options
86     fStates      : TCUPSPrinterStates;
87     fCachedGetDefaultPaperName: string;
88     fCachedOrientation: TPrinterOrientation;
89     fCachedPaperName: string;
90     fCachedCopies: integer;
91     fCachePaperRectName: string;
92     fCachePaperRect: TPaperRect;
93     fCachePaperRectResult: Integer;
94     fCupsDefaultPaper: string;
95     FBeginDocCount: Integer;
96     fRawModeStream: TMemoryStream;
97     FOutputFilename: string;
98     fCachedResolution: TPoint;
99     fCustomPaperWidth,fCustomPaperHeight: double;
100
101     function GetCupsRequest : Pipp_t;
102     procedure DoCupsConnect;
103     procedure DoCustomPaper;
104
105  private
106     fCupsPapersCount: Integer;
107     function  CupsPapersListValid: boolean;
108     function  InternalGetResolution(ForX: boolean): Integer;
109     {$IFDEF DebugCUPS}
110     procedure DebugCapabilities;
111     procedure DebugPPD;
112     {$ENDIF}
113  protected
114     procedure DoBeginDoc; override;
115     procedure DoEndDoc(aAborted : Boolean); override;
116     procedure DoNewPage; override;
117
118     procedure DoResetPrintersList; override;
119
120     procedure DoEnumPrinters(Lst : TStrings); override;
121     procedure DoEnumPapers(Lst : TStrings); override;
122     function DoSetPrinter(aName : string): Integer; override;
123     function DoGetCopies : Integer; override;
124     procedure DoSetCopies(aValue : Integer); override;
125     function DoGetOrientation: TPrinterOrientation; override;
126     procedure DoSetOrientation(aValue : TPrinterOrientation); override;
127     function DoGetDefaultPaperName: string; override;
128     function DoGetPaperName: string; override;
129     procedure DoSetPaperName(aName : string); override;
130     function DoGetPaperRect(aName : string;
131                             var aPaperRc: TPaperRect): Integer; override;
132     function DoSetPaperRect(aPaperRc: TPaperRect): boolean; override;
133     function DoGetPrinterState: TPrinterState; override;
134     function DoGetDefaultCanvasClass: TPrinterCanvasRef; override;
135
136     function GetPrinterType : TPrinterType; override;
137     function GetCanPrint : Boolean; override;
138
139     function GetXDPI: Integer; override;
140     function GetYDPI: Integer; override;
141
142     procedure DoEnumBins(Lst : TStrings); override;
143     function DoGetDefaultBinName: string; override;
144     function DoGetBinName: string; override;
145     procedure DoSetBinName(aName: string); override;
146
147     {-------------------------------------------------
148         SPECIFIC CUPS METHODS OR PROPERTIES
149     --------------------------------------------------}
150     procedure FreeOptions;
151     procedure SetOptionsOfPrinter;
152
153     procedure GetEnumAttributeString(aName : PChar; Lst : TStrings);
154     function GetAttributeInteger(aName : PChar;DefaultValue : Integer) : Integer;
155     function GetAttributeString(aName: PChar; const DefaultValue : string): string;
156     function GetAttributeBoolean(aName : PChar; DefaultValue : Boolean) : Boolean;
157     function EnumPPDChoice(Lst : TStrings; const aKeyWord : string;
158        OptNames: TStrings = nil) : Integer;
159     function GetPPDAttribute(const aName: string): string;
160
161     procedure cupsAddOption(aName,aValue: string);
162     function GetResolutionOption: string;
163     function IsOptionValueValid(AKeyword,AValue: pchar): boolean;
164     function PPDOptionChoiceFrom(OptionStr, aKeyOrValue: string; IsKey:boolean): pppd_choice_t;
165     procedure DoDestroy; override;
166  public
167    constructor Create; override;
168    function Write(const Buffer; Count:Integer; out Written: Integer): Boolean; override;
169
170    {-------------------------------------------------
171        SPECIFIC CUPS METHODS OR PROPERTIES
172    --------------------------------------------------}
173    procedure SetJobState(aJobId : LongInt; aOp : ipp_op_t);
174    function PrintFile(aFileName: String): longint;
175    function GetLastError: string;
176    procedure DebugOptions(AOPtions:Pcups_option_t=nil; n:Integer=0);
177    function cupsGetOption(aKeyWord: string): String;
178    function CopyOptions(out AOptions: Pcups_option_t): Integer;
179    procedure MergeOptions(const AOptions:Pcups_option_t; const n:Integer);
180    property CupsPPD:Pppd_file_t read fcupsPPD;
181  end;
182