LCL: Printers support for custom size papers for Windows and Linux.

git-svn-id: trunk@63930 -

components/printers/unix/cupsprinters.inc

@@ -11,6 +11,9 @@ uses
   {%H-}udlgpropertiesprinter, // used to compile it on this target
   FileUtil, LazFileUtils;
 
+const
+  CUPS_CUSTOM_PAPER = 'Custom';
+
 //Return always 72 because, PostScript it's 72 only
 function TCUPSPrinter.GetXDPI: Integer;
 begin
@@ -259,6 +262,20 @@ begin
   end;
 end;
 
+procedure TCUPSPrinter.DoCustomPaper;
+var
+  aSize: String;
+begin
+  // while the default canvas class is TCairoPsCanvas, this is not
+  // technically necessary, as the canvas setup the page size itself.
+  aSize := format('%s.%dx%d', [ CUPS_CUSTOM_PAPER, round(fCustomPaperWidth),
+                                round(fCustomPaperHeight) ]);
+  cupsAddOption('PageSize', aSize);
+  {$IFDEF DebugCUPS}
+  DebugLn('Using CustomPaper ', aSize);
+  {$ENDIF}
+end;
+
 function TCUPSPrinter.CupsPapersListValid: boolean;
 var
   Lst: TStringlist;
@@ -1194,6 +1211,10 @@ end;
 
 function TCUPSPrinter.DoGetPaperName: string;
 begin
+  if cpsCustomPaperValid in FStates then begin
+    result := CUPS_CUSTOM_PAPER;
+    exit;
+  end;
   if not (cpsPaperNameValid in FStates) then begin
     // paper is not yet retrieved for first time
     // first try to see if there is a list of papers available
@@ -1211,6 +1232,11 @@ end;
 
 procedure TCUPSPrinter.DoSetPaperName(aName: string);
 begin
+  if (aName=CUPS_CUSTOM_PAPER) and (cpsCustomPaperValid in FStates) then begin
+    DoCustomPaper;
+    exit;
+  end;
+
   {$IFDEF UseCache}
   if aName=DoGetPaperName then exit;
   Exclude(FStates,cpsPaperNameValid);
@@ -1219,8 +1245,10 @@ begin
   
   if FCupsPapersCount<=0 then
     PaperSize.PaperName:=AName
-  else
+  else begin
+    Exclude(Fstates, cpsCustomPaperValid);
     cupsAddOption('PageSize',aName)
+  end;
 end;
 
 //Initialise aPaperRc with the aName paper rect
@@ -1234,6 +1262,16 @@ var
   P : Pppd_size_t;
   Ky,Kx: Double;
 begin
+  if (aName=CUPS_CUSTOM_PAPER) and (cpsCustomPaperValid in FStates) then begin
+    aPaperRc.PhysicalRect.Left := 0;
+    aPaperRc.PhysicalRect.Top := 0;
+    aPaperRc.PhysicalRect.Right := round(fCustomPaperWidth*Printer.XDPI/72);
+    aPaperRc.PhysicalRect.Bottom := round(fCustomPaperHeight*Printer.YDPI/72);
+    aPaperRc.WorkRect := aPaperRc.PhysicalRect;
+    result := 0;
+    exit;
+  end;
+
   if (not (cpsPaperRectValid in FStates)) or
     (fCachePaperRectName<>aName) then
   begin
@@ -1344,6 +1382,25 @@ begin
   aPaperRc:=fCachePaperRect;
 end;
 
+function TCUPSPrinter.DoSetPaperRect(aPaperRc: TPaperRect): boolean;
+begin
+  result := CUPSLibInstalled;
+  if result then
+  begin
+    Include(fStates, cpsCustomPaperValid);
+    fCustomPaperWidth  := aPaperRC.PhysicalRect.Width * 72 / Printer.XDPI;
+    fCustomPaperHeight := aPaperRC.PhysicalRect.Height * 72 / Printer.YDPI;
+    DoCustomPaper;
+    {$IFDEF DebugCUPS}
+    DebugLn('CUPS: custom paper width=%dpx %4.1fpt %3.0fmm height=%dpx %4.1fpt %3.0fmm',
+      [aPaperRC.PhysicalRect.Width,
+       fCustomPaperWidth, fCustomPaperWidth*25.4/72,
+       aPaperRC.PhysicalRect.Height,
+       fCustomPaperHeight, fCustomPaperHeight*25.4/72
+       ]);
+    {$ENDIF}
+  end;
+end;
 
 function TCUPSPrinter.DoGetPrinterState: TPrinterState;
 var //Request   : Pipp_t; //IPP Request

components/printers/win32/winprinters.inc

@@ -644,6 +644,10 @@ begin
     if i<>-1 then begin
       if not Printing then
         ClearDC;
+
+      dmW^.dmFields := dmW^.dmFields and not DM_PAPERLENGTH;
+      dmW^.dmFields := dmW^.dmFields and not DM_PAPERWIDTH;
+      dmW^.dmFields := dmW^.dmFields or DM_PAPERSIZE;
       dmW^.dmPaperSize := SHORT(ptrint(PaperSize.SupportedPapers.Objects[i]));
       if Printing then
         ResetDCW(fDC, dmW^);
@@ -712,6 +716,23 @@ begin
   end;
 end;
 
+function TWinPrinter.DoSetPaperRect(aPaperRc: TPaperRect): boolean;
+var
+  dmW  : PDeviceModeW;
+begin
+  result := GetCurrentDevModeW(dmW);
+  if result then begin
+    if not Printing then
+      ClearDC;
+    dmW^.dmFields := dmW^.dmFields or DM_PAPERLENGTH or DM_PAPERWIDTH or DM_PAPERSIZE;
+    dmW^.dmPaperSize := DMPAPER_USER;
+    dmW^.dmPaperWidth := round(aPaperRC.PhysicalRect.Width * 254 / XDPI);
+    dmW^.dmPaperLength := round(aPaperRC.PhysicalRect.Height * 254 / YDPI);
+    if Printing then
+      ResetDCW(fDC, dmW^);
+  end;
+end;
+
 function TWinPrinter.DoSetPrinter(aName: string): Integer;
 var
   i: Integer;

components/printers/win32/winprinters_h.inc

@@ -57,6 +57,7 @@ Type
     function DoGetDefaultPaperName: string; override;
     procedure DoSetPaperName(aName : string); override;
     function DoGetPaperRect(aName : string; Var aPaperRc : TPaperRect) : Integer; override;
+    function DoSetPaperRect(aPaperRc: TPaperRect):boolean; override;
 
     procedure DoEnumBins(Lst : TStrings); override;
     function DoGetDefaultBinName: string; override;

components/printers/win32/winutilprn.pas

@@ -38,6 +38,7 @@ const
 const
   Win32Orientations: array [TPrinterOrientation] of SHORT = (
     DMORIENT_PORTRAIT, DMORIENT_LANDSCAPE, DMORIENT_PORTRAIT, DMORIENT_LANDSCAPE);
+  DMPAPER_USER = 256;
 
 type
   TFcntHook = function(Wnd: HWND; uiMsg: UINT; wParam: WPARAM; lParam: LPARAM): UINT_PTR; stdcall;

lcl/printers.pas

@@ -132,6 +132,11 @@ type
     PaperRect: TPaperRect;
   end;
 
+  TCustomPaperItem = record
+    PaperSet: boolean;
+    Item: TPaperItem;
+  end;
+
   { TPaperSize }
 
   TPaperSize = Class(TObject)
@@ -156,10 +161,12 @@ type
     fInternalPapers    : array of TPaperItem;
     fDefaultPapers     : boolean;
     fDefaultPaperIndex : Integer;
+    fCustomPaper       : TCustomPaperItem;
     procedure CreateInternalPapers;
     procedure FillDefaultPapers;
     function GetDefaultPaperRect(const AName: string; var APaperRect:TPaperRect): Integer;
     function IndexOfDefaultPaper(const AName: string): Integer;
+    procedure SetPaperRect(AValue: TPaperRect);
   public
     constructor Create(aOwner : TPrinter); overload;
     destructor Destroy; override;
@@ -170,7 +177,7 @@ type
     property PaperName       : string read GetPaperName write SetPaperName;
     property DefaultPaperName: string read GetDefaultPaperName;
 
-    property PaperRect       : TPaperRect read GetPaperRect;
+    property PaperRect       : TPaperRect read GetPaperRect write SetPaperRect;
     property SupportedPapers : TStrings read GetSupportedPapers;
 
     property PaperRectOf[aName : string] : TPaperRect read PaperRectOfName;
@@ -254,6 +261,7 @@ type
      function DoGetBinName: string; virtual;
      procedure DoSetBinName(aName: string); virtual;
      function DoGetPaperRect(aName : string; Var aPaperRc : TPaperRect) : Integer; virtual;
+     function DoSetPaperRect(aPaperRc: TPaperRect): boolean; virtual;
      function DoGetPrinterState: TPrinterState; virtual;
      procedure DoDestroy; virtual;
 
@@ -320,6 +328,9 @@ var
   
 implementation
 
+const
+  CUSTOM_PAPER_NAME = 'LCLCustomPaper';
+
 { TPrinter }
 
 constructor TPrinter.Create;
@@ -954,6 +965,11 @@ begin
   //Override this method
 end;
 
+function TPrinter.DoSetPaperRect(aPaperRc: TPaperRect): boolean;
+begin
+  result := false;
+end;
+
 //Get a state of current printer
 function TPrinter.DoGetPrinterState: TPrinterState;
 begin
@@ -1090,6 +1106,9 @@ function TPaperSize.GetPaperName: string;
 begin
   CheckSupportedPapers;
 
+  if fCustomPaper.PaperSet then
+    result := fCustomPaper.Item.PaperName
+  else
   if fDefaultPapers then
     Result := SupportedPapers[FDefaultPaperIndex]
   else
@@ -1101,6 +1120,9 @@ end;
 
 function TPaperSize.GetPaperRect: TPaperRect;
 begin
+  if fCustomPaper.PaperSet then
+    result := fCustomPaper.Item.PaperRect
+  else
   Result:=PaperRectOfName(PaperName);
 end;
 
@@ -1129,8 +1151,25 @@ begin
     end;
 end;
 
+procedure TPaperSize.SetPaperRect(AValue: TPaperRect);
+begin
+  fCustomPaper.PaperSet := true;
+  fCustomPaper.Item.PaperRect := AValue;
+  if not fDefaultPapers then
+    fOwnedPrinter.DoSetPaperRect(AValue);
+end;
+
 procedure TPaperSize.SetPaperName(const AName: string);
 begin
+
+  if fCustomPaper.PaperSet and (AName=fCustomPaper.Item.PaperName) then
+  begin
+    // update printer custom paper dimensions
+    if not fDefaultPapers and not fCustomPaper.Item.PaperRect.PhysicalRect.IsEmpty then
+      fOwnedPrinter.DoSetPaperRect(fCustomPaper.Item.PaperRect);
+    exit;
+  end;
+
   if SupportedPapers.IndexOf(aName)<>-1 then
   begin
     if aName<>PaperName then
@@ -1138,7 +1177,9 @@ begin
       if fDefaultPapers then
         FDefaultPaperIndex := IndexOfDefaultPaper(AName)
       else
-        FOwnedPrinter.DoSetPaperName(aName)
+        FOwnedPrinter.DoSetPaperName(aName);
+
+      fCustomPaper.PaperSet := false;
     end;
   end
   else
@@ -1150,6 +1191,13 @@ function TPaperSize.PaperRectOfName(const AName: string): TPaperRect;
 var TmpPaperRect : TPaperRect;
     Margins      : Integer;
 begin
+
+  if (fCustomPaper.PaperSet) and (AName=fCustomPaper.Item.PaperName) then
+  begin
+    result := fCustomPaper.Item.PaperRect;
+    exit;
+  end;
+
   FillChar(Result,SizeOf(Result),0);
 
   if SupportedPapers.IndexOf(AName)<>-1 then
@@ -1197,6 +1245,9 @@ begin
   fLastPrinterIndex:=-2;
   fOwnedPrinter:=aOwner;
   fSupportedPapers:=TStringList.Create;
+
+  FillChar(fCustomPaper, sizeOf(fCustomPaper), 0);
+  fCustomPaper.Item.PaperName := CUSTOM_PAPER_NAME;
 end;
 
 destructor TPaperSize.Destroy;