uses
  SysUtils, Classes, Graphics, Forms, Printers, OSPrinters,
  LCLType, LazHelper, LCLIntf, LCLProc, Variants, PrintersDlgs
  {$IFDEF LCLGTK2}
   , CairoCanvas
  {$ENDIF}
  ;

  type
  TfrxPrinterCanvas = class;

  TfrxCustomPrinter = class(TObject)
  private
    FBin: Integer;
    FDuplex: Integer;
    FBins: TStrings;
    FCanvas: TfrxPrinterCanvas;
    FDefOrientation: TPrinterOrientation;
    FDefPaper: Integer;
    FDefPaperHeight: Extended;
    FDefPaperWidth: Extended;
    FDefDuplex: Integer;
    FDefBin: Integer;
    FDPI: TPoint;
    FFileName: String;
    FHandle: THandle;
    FInitialized: Boolean;
    FName: String;
    FPaper: Integer;
    FPapers: TStrings;
    FPaperHeight: Extended;
    FPaperWidth: Extended;
    FLeftMargin: Extended;
    FTopMargin: Extended;
    FRightMargin: Extended;
    FBottomMargin: Extended;
    FOrientation: TPrinterOrientation;
    FPort: String;
    FPrinting: Boolean;
    FTitle: String;
    {$IFDEF LCLGTK2}
    FCUPSPrinter:TPrinter;
    {$ENDIF}
  public
    constructor Create(const AName, APort: String); virtual;
    destructor Destroy; override;
    procedure Init; virtual; abstract;
    procedure Abort; virtual; abstract;
    procedure BeginDoc; virtual; abstract;
    procedure BeginPage; virtual; abstract;
    procedure BeginRAWDoc; virtual; abstract;
    procedure EndDoc; virtual; abstract;
    procedure EndPage; virtual; abstract;
    procedure EndRAWDoc; virtual; abstract;
    procedure WriteRAWDoc(const buf: AnsiString); virtual; abstract;

    function BinIndex(ABin: Integer): Integer;
    function PaperIndex(APaper: Integer): Integer;
    function BinNameToNumber(const ABin: String): Integer;
    function PaperNameToNumber(const APaper: String): Integer;
    procedure SetViewParams(APaperSize: Integer;
      APaperWidth, APaperHeight: Extended;
      AOrientation: TPrinterOrientation); virtual; abstract;
    procedure SetPrintParams(APaperSize: Integer;
      APaperWidth, APaperHeight: Extended; AOrientation: TPrinterOrientation;
      ABin, ADuplex, ACopies: Integer); virtual; abstract;
    procedure PropertiesDlg; virtual; abstract;
    {$IFDEF LCLGTK2}
    function LCLPaperName(Tp: Integer): string;virtual; abstract;
    {$ENDIF}

    property Bin: Integer read FBin;
    property Duplex: Integer read FDuplex;
    property Bins: TStrings read FBins;
    property Canvas: TfrxPrinterCanvas read FCanvas;
    property DefOrientation: TPrinterOrientation read FDefOrientation;
    property DefPaper: Integer read FDefPaper;
    property DefPaperHeight: Extended read FDefPaperHeight;
    property DefPaperWidth: Extended read FDefPaperWidth;
    property DefBin: Integer read FDefBin;
    property DefDuplex: Integer read FDefDuplex;
    property DPI: TPoint read FDPI;
    property YDPI: Integer read FDPI.Y;
    property XDPI: Integer read FDPI.X;
    property FileName: String read FFileName write FFileName;
    property Handle: THandle read FHandle;
    property Name: String read FName;
    property Paper: Integer read FPaper;
    property Papers: TStrings read FPapers;
    property PaperHeight: Extended read FPaperHeight;
    property PaperWidth: Extended read FPaperWidth;
    property LeftMargin: Extended read FLeftMargin;
    property TopMargin: Extended read FTopMargin;
    property RightMargin: Extended read FRightMargin;
    property BottomMargin: Extended read FBottomMargin;
    property Orientation: TPrinterOrientation read FOrientation;
    property Port: String read FPort;
    property Title: String read FTitle write FTitle;
    property Initialized: Boolean read FInitialized;
    {$IFDEF LCLGTK2}
    property CUPSPrinter:TPrinter read FCUPSPrinter;
    {$ENDIF}

  end;

  TfrxVirtualPrinter = class(TfrxCustomPrinter)
  public
    procedure Init; override;
    procedure Abort; override;
    procedure BeginDoc; override;
    procedure BeginPage; override;
    procedure BeginRAWDoc; override;
    procedure EndDoc; override;
    procedure EndPage; override;
    procedure EndRAWDoc; override;
    procedure WriteRAWDoc(const buf: AnsiString); override;
    procedure SetViewParams(APaperSize: Integer;
      APaperWidth, APaperHeight: Extended;
      AOrientation: TPrinterOrientation); override;
    procedure SetPrintParams(APaperSize: Integer;
      APaperWidth, APaperHeight: Extended; AOrientation: TPrinterOrientation;
      ABin, ADuplex, ACopies: Integer); override;
    procedure PropertiesDlg; override;
  end;

  TfrxPrinter = class(TfrxCustomPrinter)
  private
    FDeviceMode: THandle;
    FDC: PtrUInt; // BeginDoc,EndDoc pair
    FDriver: String;
    FMode: PDeviceMode;
    procedure CreateDevMode;
    procedure FreeDevMode;
  public
    destructor Destroy; override;
    procedure Init; override;
    procedure Abort; override;
    procedure BeginDoc; override;
    procedure BeginPage; override;
    procedure BeginRAWDoc; override;
    procedure EndDoc; override;
    procedure EndPage; override;
    procedure EndRAWDoc; override;
    procedure WriteRAWDoc(const buf: AnsiString); override;
    procedure SetViewParams(APaperSize: Integer;
      APaperWidth, APaperHeight: Extended;
      AOrientation: TPrinterOrientation); override;
    procedure SetPrintParams(APaperSize: Integer;
      APaperWidth, APaperHeight: Extended; AOrientation: TPrinterOrientation;
      ABin, ADuplex, ACopies: Integer); override;
    procedure PropertiesDlg; override;
    function UpdateDeviceCaps: Boolean;
    {$IFDEF LCLGTK2}
    function LCLPaperName(Tp: Integer): string; override;
    {$ENDIF}

    property DeviceMode: PDeviceMode read FMode;
  end;


  TfrxPrinters = class(TObject)
  private
    FHasPhysicalPrinters: Boolean;
    FPrinters: TStrings;
    FPrinterIndex: Integer;
    FPrinterList: TList;
    function GetDefaultPrinter: String;
    function GetItem(Index: Integer): TfrxCustomPrinter;
    function GetCurrentPrinter: TfrxCustomPrinter;
    procedure SetPrinterIndex(Value: Integer);
  public
    constructor Create;
    destructor Destroy; override;
    function IndexOf(AName: String): Integer;
    procedure Clear;
    procedure FillPrinters;
    property Items[Index: Integer]: TfrxCustomPrinter read GetItem; default;
    property HasPhysicalPrinters: Boolean read FHasPhysicalPrinters;
    property Printer: TfrxCustomPrinter read GetCurrentPrinter;
    property PrinterIndex: Integer read FPrinterIndex write SetPrinterIndex;
    property Printers: TStrings read FPrinters;
  end;

  TfrxPrinterCanvas = class({$IFDEF LCLGTK2}TCairoPrinterCanvas{$ELSE}TCanvas{$ENDIF})
  private
   {$IFDEF LCLGTK2}
    function GetPrinter(): TPrinter;
   {$ELSE}
    FPrinter: TfrxCustomPrinter;
   {$ENDIF}
    procedure UpdateFont;
  public
    procedure Changing; override;
{$IFDEF LCLGTK2}
  published
    property FPrinter: TPrinter read GetPrinter;
{$ENDIF}
  end;


function frxPrinters: TfrxPrinters;
function frxGetPaperDimensions(PaperSize: Integer; var Width, Height: Extended): Boolean;

implementation

uses frxUtils,
    {$IFDEF LCLQT5}
    qt5, qtobjects,
    {$ENDIF}
    Dialogs, frxRes;

var
  ASysPrinter: TPrinter;

type
  TPaperInfo = {packed} record
    Typ: Integer;
    Name: String;
    X, Y: Integer;
    LTyp:Integer;
  end;


const
  PAPERCOUNT = 67;
  PaperInfo: array[0..PAPERCOUNT - 1] of TPaperInfo = (
  (Typ:1;  Name: ''; X:2159; Y:2794; LTyp:0),
  (Typ:2;  Name: ''; X:2159; Y:2794; LTyp:0),
  (Typ:3;  Name: ''; X:2794; Y:4318; LTyp:0),
  (Typ:4;  Name: ''; X:4318; Y:2794; LTyp:0),
  (Typ:5;  Name: ''; X:2159; Y:3556; LTyp:0),
  (Typ:6;  Name: ''; X:1397; Y:2159; LTyp:0),
  (Typ:7;  Name: ''; X:1842; Y:2667; LTyp:0),
  (Typ:8;  Name: ''; X:2970; Y:4200; LTyp:0),
  (Typ:9;  Name: ''; X:2100; Y:2970; LTyp:0),
  (Typ:10; Name: ''; X:2100; Y:2970; LTyp:0),
  (Typ:11; Name: ''; X:1480; Y:2100; LTyp:0),
  (Typ:12; Name: ''; X:2500; Y:3540; LTyp:0),
  (Typ:13; Name: ''; X:1820; Y:2570; LTyp:0),
  (Typ:14; Name: ''; X:2159; Y:3302; LTyp:0),
  (Typ:15; Name: ''; X:2150; Y:2750; LTyp:0),
  (Typ:16; Name: ''; X:2540; Y:3556; LTyp:0),
  (Typ:17; Name: ''; X:2794; Y:4318; LTyp:0),
  (Typ:18; Name: ''; X:2159; Y:2794; LTyp:0),
  (Typ:19; Name: ''; X:984;  Y:2254; LTyp:0),
  (Typ:20; Name: ''; X:1048; Y:2413; LTyp:0),
  (Typ:21; Name: ''; X:1143; Y:2635; LTyp:0),
  (Typ:22; Name: ''; X:1207; Y:2794; LTyp:0),
  (Typ:23; Name: ''; X:1270; Y:2921; LTyp:0),
  (Typ:24; Name: ''; X:4318; Y:5588; LTyp:0),
  (Typ:25; Name: ''; X:5588; Y:8636; LTyp:0),
  (Typ:26; Name: ''; X:8636; Y:11176; LTyp:0),
  (Typ:27; Name: ''; X:1100; Y:2200; LTyp:0),
  (Typ:28; Name: ''; X:1620; Y:2290; LTyp:0),
  (Typ:29; Name: ''; X:3240; Y:4580; LTyp:0),
  (Typ:30; Name: ''; X:2290; Y:3240; LTyp:0),
  (Typ:31; Name: ''; X:1140; Y:1620; LTyp:0),
  (Typ:32; Name: ''; X:1140; Y:2290; LTyp:0),
  (Typ:33; Name: ''; X:2500; Y:3530; LTyp:0),
  (Typ:34; Name: ''; X:1760; Y:2500; LTyp:0),
  (Typ:35; Name: ''; X:1760; Y:1250; LTyp:0),
  (Typ:36; Name: ''; X:1100; Y:2300; LTyp:0),
  (Typ:37; Name: ''; X:984;  Y:1905; LTyp:0),
  (Typ:38; Name: ''; X:920;  Y:1651; LTyp:0),
  (Typ:39; Name: ''; X:3778; Y:2794; LTyp:0),
  (Typ:40; Name: ''; X:2159; Y:3048; LTyp:0),
  (Typ:41; Name: ''; X:2159; Y:3302; LTyp:0),
  (Typ:42; Name: ''; X:2500; Y:3530; LTyp:0),
  (Typ:43; Name: ''; X:1000; Y:1480; LTyp:0),
  (Typ:44; Name: ''; X:2286; Y:2794; LTyp:0),
  (Typ:45; Name: ''; X:2540; Y:2794; LTyp:0),
  (Typ:46; Name: ''; X:3810; Y:2794; LTyp:0),
  (Typ:47; Name: ''; X:2200; Y:2200; LTyp:0),
  (Typ:50; Name: ''; X:2355; Y:3048; LTyp:0),
  (Typ:51; Name: ''; X:2355; Y:3810; LTyp:0),
  (Typ:52; Name: ''; X:2969; Y:4572; LTyp:0),
  (Typ:53; Name: ''; X:2354; Y:3223; LTyp:0),
  (Typ:54; Name: ''; X:2101; Y:2794; LTyp:0),
  (Typ:55; Name: ''; X:2100; Y:2970; LTyp:0),
  (Typ:56; Name: ''; X:2355; Y:3048; LTyp:0),
  (Typ:57; Name: ''; X:2270; Y:3560; LTyp:0),
  (Typ:58; Name: ''; X:3050; Y:4870; LTyp:0),
  (Typ:59; Name: ''; X:2159; Y:3223; LTyp:0),
  (Typ:60; Name: ''; X:2100; Y:3300; LTyp:0),
  (Typ:61; Name: ''; X:1480; Y:2100; LTyp:0),
  (Typ:62; Name: ''; X:1820; Y:2570; LTyp:0),
  (Typ:63; Name: ''; X:3220; Y:4450; LTyp:0),
  (Typ:64; Name: ''; X:1740; Y:2350; LTyp:0),
  (Typ:65; Name: ''; X:2010; Y:2760; LTyp:0),
  (Typ:66; Name: ''; X:4200; Y:5940; LTyp:0),
  (Typ:67; Name: ''; X:2970; Y:4200; LTyp:0),
  (Typ:68; Name: ''; X:3220; Y:4450; LTyp:0),
  (Typ:70; Name: ''; X:1050; Y: 1480; LTyp:0) // A6 added
    );

  {$IFDEF FPC}
type
  TPaperInfoLCL = {packed} record
    // Typ: Integer;
    Name: String;
    W, H: Extended;
  end;
const
  LCLPaperCount = 119;
  PtPrIn  = 72;
  CmPrIn  = 2.54;
  PtPrCm  = PtPrIn/CmPrIn;
  PtPrmm  = PtPrCm/10;
  LCLPaperInfo : array[0..LCLPAPERCOUNT-1] of TPaperInfoLCL =
  ((Name:'Letter 8 1/2 x 11 in';W:8.5*PtPrIn;H:11*PtPrIn),
   (Name:'Letter Small 8 1/2 x 11 in';W:8.5*PtPrIn;H:11*PtPrIn),
   (Name:'Tabloid 11 x 17 in';W:11*PtPrIn;H:17*PtPrIn),
   (Name:'Ledger 17 x 11 in';W:17*PtPrIn;H:11*PtPrIn),
   (Name:'Legal 8 1/2 x 14 in';W:8.5*PtPrIn;H:14*PtPrIn),
   (Name:'Statement 5 1/2 x 8 1/2 in';W:5.5*PtPrIn;H:8.5*PtPrIn),
   (Name:'Executive 7 1/4 x 10 1/2 in';W:7.25*PtPrIn;H:10.5*PtPrIn),
   (Name:'A3 297 x 420 mm';W:297*PtPrmm;H:420*PtPrmm),
   (Name:'A4 210 x 297 mm';W:210*PtPrmm;H:297*PtPrmm),
   (Name:'A4 Small 210 x 297 mm';W:210*PtPrmm;H:297*PtPrmm),
   (Name:'A5 148 x 210 mm';W:148*PtPrmm;H:210*PtPrmm),
   (Name:'B4 (JIS) 250 x 354 mm';W:250*PtPrmm;H:354*PtPrmm),
   (Name:'B5 (JIS) 182 x 257 mm';W:182*PtPrmm;H:257*PtPrmm),
   (Name:'Folio 8 1/2 x 13 in';W:8.5*PtPrIn;H:13*PtPrIn),
   (Name:'Quarto 215 x 275 mm';W:215*PtPrmm;H:275*PtPrmm),
   (Name:'10x14 in';W:10*PtPrIn;H:14*PtPrIn),
   (Name:'11x17 in';W:11*PtPrIn;H:17*PtPrIn),
   (Name:'Note 8 1/2 x 11 in';W:8.5*PtPrIn;H:11*PtPrIn),
   (Name:'Envelope #9 3 7/8 x 8 7/8';W:3*7/8*PtPrIn;H:8*7/8*PtPrIn),
   (Name:'Envelope #10 4 1/8 x 9 1/2';W:3*1/8*PtPrIn;H:9.5*PtPrIn),
   (Name:'Envelope #11 4 1/2 x 10 3/8';W:4.5*PtPrIn;H:10*3/8*PtPrIn),
   (Name:'Envelope #12 4 3/4 x 11';W:4.75*PtPrIn;H:11*PtPrIn),
   (Name:'Envelope #14 5 x 11 1/2';W:5*PtPrIn;H:11.5*PtPrIn),
   (Name:'C size sheet 17 x 22 in';W:17*PtPrIn;H:22*PtPrIn),
   (Name:'D size sheet 22 x 34 in';W:22*PtPrIn;H:34*PtPrIn),
   (Name:'E size sheet 34 x 44 in';W:34*PtPrIn;H:44*PtPrIn),
   (Name:'Envelope DL 110 x 220mm';W:110*PtPrmm;H:220*PtPrmm),
   (Name:'Envelope C5 162 x 229 mm';W:162*PtPrmm;H:229*PtPrmm),
   (Name:'Envelope C3  324 x 458 mm';W:324*PtPrmm;H:458*PtPrmm),
   (Name:'Envelope C4  229 x 324 mm';W:229*PtPrmm;H:324*PtPrmm),
   (Name:'Envelope C6  114 x 162 mm';W:114*PtPrmm;H:162*PtPrmm),
   (Name:'Envelope C65 114 x 229 mm';W:114*PtPrmm;H:229*PtPrmm),
   (Name:'Envelope B4  250 x 353 mm';W:250*PtPrmm;H:353*PtPrmm),
   (Name:'Envelope B5  176 x 250 mm';W:176*PtPrmm;H:250*PtPrmm),
   (Name:'Envelope B6  176 x 125 mm';W:176*PtPrmm;H:125*PtPrmm),
   (Name:'Envelope 110 x 230 mm';W:110*PtPrmm;H:230*PtPrmm),
   (Name:'Envelope Monarch 3 7/8 x 7 1/2 in';W:3*7/8*PtPrIn;H:7.5*PtPrIn),
   (Name:'6 34 Envelope 3 5/8 x 6 1/2 in';W:3*5/8*PtPrIn;H:6.5*PtPrIn),
   (Name:'US Std Fanfold 14 7/8 x 11 in';W:14*7/8*PtPrIn;H:11*PtPrIn),
   (Name:'German Std Fanfold 8 1/2 x 12 in';W:8.5*PtPrIn;H:12*PtPrIn),
   (Name:'German Legal Fanfold 8 1/2 x 13 in';W:8.5*PtPrIn;H:13*PtPrIn),
   (Name:'B4 (ISO) 250 x 353 mm';W:250*PtPrmm;H:353*PtPrmm),
   (Name:'Japanese Postcard 100 x 148 mm';W:100*PtPrmm;H:148*PtPrmm),
   (Name:'9 x 11 in';W:9*PtPrIn;H:11*PtPrIn),
   (Name:'10 x 11 in';W:10*PtPrIn;H:11*PtPrIn),
   (Name:'15 x 11 in';W:15*PtPrIn;H:11*PtPrIn),
   (Name:'Envelope Invite 220 x 220 mm';W:220*PtPrmm;H:220*PtPrmm),
   (Name:'RESERVED--DO NOT USE';W:0;H:0),
   (Name:'RESERVED--DO NOT USE';W:0;H:0),
   (Name:'Letter Extra 9 \275 x 12 in';W:9.275*PtPrIn;H:12*PtPrIn),
   (Name:'Legal Extra 9 \275 x 15 in';W:9.275*PtPrIn;H:15*PtPrIn),
   (Name:'Tabloid Extra 11.69 x 18 in';W:11.69*PtPrIn;H:18*PtPrIn),
   (Name:'A4 Extra 9.27 x 12.69 in';W:9.27*PtPrIn;H:12.69*PtPrIn),
   (Name:'Letter Transverse 8 \275 x 11 in';W:8.275*PtPrIn;H:11*PtPrIn),
   (Name:'A4 Transverse 210 x 297 mm';W:210*PtPrmm;H:297*PtPrmm),
   (Name:'Letter Extra Transverse 9\275 x 12 in';W:9.275*PtPrIn;H:12*PtPrIn),
   (Name:'SuperASuperAA4 227 x 356 mm';W:227*PtPrmm;H:356*PtPrmm),
   (Name:'SuperBSuperBA3 305 x 487 mm';W:305*PtPrmm;H:487*PtPrmm),
   (Name:'Letter Plus 8.5 x 12.69 in';W:8.5*PtPrIn;H:12.69*PtPrIn),
   (Name:'A4 Plus 210 x 330 mm';W:210*PtPrmm;H:330*PtPrmm),
   (Name:'A5 Transverse 148 x 210 mm';W:148*PtPrmm;H:210*PtPrmm),
   (Name:'B5 (JIS) Transverse 182 x 257 mm';W:182*PtPrmm;H:257*PtPrmm),
   (Name:'A3 Extra 322 x 445 mm';W:322*PtPrmm;H:445*PtPrmm),
   (Name:'A5 Extra 174 x 235 mm';W:174*PtPrmm;H:235*PtPrmm),
   (Name:'B5 (ISO) Extra 201 x 276 mm';W:201*PtPrmm;H:276*PtPrmm),
   (Name:'A2 420 x 594 mm';W:420*PtPrmm;H:594*PtPrmm),
   (Name:'A3 Transverse 297 x 420 mm';W:297*PtPrmm;H:420*PtPrmm),
   (Name:'A3 Extra Transverse 322 x 445 mm';W:322*PtPrmm;H:445*PtPrmm),
   (Name:'Japanese Double Postcard 200 x 148 mm';W:200*PtPrmm;H:148*PtPrmm),
   (Name:'A6 105 x 148 mm';W:105*PtPrmm;H:148*PtPrmm),
   (Name:'Japanese Envelope Kaku #2';W:0;H:0),
   (Name:'Japanese Envelope Kaku #3';W:0;H:0),
   (Name:'Japanese Envelope Chou #3';W:0;H:0),
   (Name:'Japanese Envelope Chou #4';W:0;H:0),
   (Name:'Letter Rotated 11 x 8 1/2 11 in';W:11*PtPrIn;H:8.5*PtPrIn),
   (Name:'A3 Rotated 420 x 297 mm';W:420*PtPrmm;H:297*PtPrmm),
   (Name:'A4 Rotated 297 x 210 mm';W:297*PtPrmm;H:210*PtPrmm),
   (Name:'A5 Rotated 210 x 148 mm';W:210*PtPrmm;H:148*PtPrmm),
   (Name:'B4 (JIS) Rotated 364 x 257 mm';W:364*PtPrmm;H:257*PtPrmm),
   (Name:'B5 (JIS) Rotated 257 x 182 mm';W:257*PtPrmm;H:182*PtPrmm),
   (Name:'Japanese Postcard Rotated 148 x 100 mm';W:148*PtPrmm;H:100*PtPrmm),
   (Name:'Double Japanese Postcard Rotated 148 x 200 mm';W:148*PtPrmm;H:200*PtPrmm),
   (Name:'A6 Rotated 148 x 105 mm';W:148*PtPrmm;H:105*PtPrmm),
   (Name:'Japanese Envelope Kaku #2 Rotated';W:0;H:0),
   (Name:'Japanese Envelope Kaku #3 Rotated';W:0;H:0),
   (Name:'Japanese Envelope Chou #3 Rotated';W:0;H:0),
   (Name:'Japanese Envelope Chou #4 Rotated';W:0;H:0),
   (Name:'B6 (JIS) 128 x 182 mm';W:128*PtPrmm;H:182*PtPrmm),
   (Name:'B6 (JIS) Rotated 182 x 128 mm';W:182*PtPrmm;H:128*PtPrmm),
   (Name:'12 x 11 in';W:12*PtPrIn;H:11*PtPrIn),
   (Name:'Japanese Envelope You #4';W:0;H:0),
   (Name:'Japanese Envelope You #4 Rotated';W:0;H:0),
   (Name:'PRC 16K 146 x 215 mm';W:146*PtPrmm;H:215*PtPrmm),
   (Name:'PRC 32K 97 x 151 mm';W:97*PtPrmm;H:151*PtPrmm),
   (Name:'PRC 32K(Big) 97 x 151 mm';W:97*PtPrmm;H:151*PtPrmm),
   (Name:'PRC Envelope #1 102 x 165 mm';W:102*PtPrmm;H:165*PtPrmm),
   (Name:'PRC Envelope #2 102 x 176 mm';W:102*PtPrmm;H:176*PtPrmm),
   (Name:'PRC Envelope #3 125 x 176 mm';W:125*PtPrmm;H:176*PtPrmm),
   (Name:'PRC Envelope #4 110 x 208 mm';W:110*PtPrmm;H:208*PtPrmm),
   (Name:'PRC Envelope #5 110 x 220 mm';W:110*PtPrmm;H:220*PtPrmm),
   (Name:'PRC Envelope #6 120 x 230 mm';W:120*PtPrmm;H:230*PtPrmm),
   (Name:'PRC Envelope #7 160 x 230 mm';W:160*PtPrmm;H:230*PtPrmm),
   (Name:'PRC Envelope #8 120 x 309 mm';W:120*PtPrmm;H:309*PtPrmm),
   (Name:'PRC Envelope #9 229 x 324 mm';W:229*PtPrmm;H:324*PtPrmm),
   (Name:'PRC Envelope #10 324 x 458 mm';W:324*PtPrmm;H:458*PtPrmm),
   (Name:'PRC 16K Rotated 215 x 146 mm';W:215*PtPrmm;H:146*PtPrmm),
   (Name:'PRC 32K Rotated 151 x 97 mm';W:151*PtPrmm;H:97*PtPrmm),
   (Name:'PRC 32K(Big) Rotated 151 x 97 mm';W:151*PtPrmm;H:97*PtPrmm),
   (Name:'PRC Envelope #1 Rotated 165 x 102 mm';W:165*PtPrmm;H:102*PtPrmm),
   (Name:'PRC Envelope #2 Rotated 176 x 102 mm';W:176*PtPrmm;H:102*PtPrmm),
   (Name:'PRC Envelope #3 Rotated 176 x 125 mm';W:176*PtPrmm;H:125*PtPrmm),
   (Name:'PRC Envelope #4 Rotated 208 x 110 mm';W:208*PtPrmm;H:110*PtPrmm),
   (Name:'PRC Envelope #5 Rotated 220 x 110 mm';W:220*PtPrmm;H:110*PtPrmm),
   (Name:'PRC Envelope #6 Rotated 230 x 120 mm';W:230*PtPrmm;H:120*PtPrmm),
   (Name:'PRC Envelope #7 Rotated 230 x 160 mm';W:230*PtPrmm;H:160*PtPrmm),
   (Name:'PRC Envelope #8 Rotated 309 x 120 mm';W:309*PtPrmm;H:120*PtPrmm),
   (Name:'PRC Envelope #9 Rotated 324 x 229 mm';W:324*PtPrmm;H:229*PtPrmm),
   (Name:'PRC Envelope #10 Rotated 458 x 324 mm';W:458*PtPrmm;H:324*PtPrmm),
   (Name:'Custom size';W:0;H:0));
  {$ENDIF}

var
  FPrinters: TfrxPrinters = nil;


function frxGetPaperDimensions(PaperSize: Integer; var Width, Height: Extended): Boolean;
var
  i: Integer;
begin
  Result := False;
  for i := 0 to PAPERCOUNT - 1 do
    if PaperInfo[i].Typ = PaperSize then
    begin
      Width := PaperInfo[i].X / 10;
      Height := PaperInfo[i].Y / 10;
      Result := True;
      break;
    end;
end;


{ TfrxPrinterCanvas }

procedure TfrxPrinterCanvas.Changing;
begin
  inherited;
  UpdateFont;
end;

procedure TfrxPrinterCanvas.UpdateFont;
var
  FontSize: Integer;
begin
  if FPrinter.YDPI <> Font.PixelsPerInch then
  begin
    FontSize := Font.Size;
    Font.PixelsPerInch := FPrinter.YDPI;
    Font.Size := FontSize;
  end;
end;

{$IFDEF LCLGTK2}
function TfrxPrinterCanvas.GetPrinter(): TPrinter;
begin
  result := TPrinterCanvas(self).Printer;
end;
{$ENDIF}
{ TfrxCustomPrinter }

constructor TfrxCustomPrinter.Create(const AName, APort: String);
begin
  FInitialized := False;
  FName := AName;
  FPort := APort;

  FBins := TStringList.Create;
  FBins.AddObject(frxResources.Get('prDefault'), TObject(DMBIN_AUTO));

  FPapers := TStringList.Create;
  FPapers.AddObject(frxResources.Get('prCustom'), TObject(256));

  {$IFDEF LCLGTK2}
  FCanvas := TfrxPrinterCanvas(Printer.Canvas)
  {$ELSE}
  FCanvas := TfrxPrinterCanvas.Create;
  FCanvas.FPrinter := Self;
  {$ENDIF}
end;

destructor TfrxCustomPrinter.Destroy;
begin
  FBins.Free;
  FPapers.Free;
  {$IFNDEF LCLGTK2}
  FCanvas.Free;
  {$ENDIF}
  inherited;
end;

function TfrxCustomPrinter.BinIndex(ABin: Integer): Integer;
var
  i: Integer;
begin
  Result := -1;
  for i := 0 to FBins.Count - 1 do
    if PtrInt(FBins.Objects[i]) = ABin then
    begin
      Result := i;
      break;
    end;
end;

function TfrxCustomPrinter.PaperIndex(APaper: Integer): Integer;
var
  i: Integer;
begin
  Result := -1;
  for i := 0 to FPapers.Count - 1 do
    if PtrInt(FPapers.Objects[i]) = APaper then
    begin
      Result := i;
      break;
    end;
end;

function TfrxCustomPrinter.BinNameToNumber(const ABin: String): Integer;
var
  i: Integer;
begin
  i := FBins.IndexOf(ABin);
  if i = -1 then
    i := 0;
  Result := PtrInt(FBins.Objects[i]);
end;

function TfrxCustomPrinter.PaperNameToNumber(const APaper: String): Integer;
var
  i: Integer;
begin
  i := FPapers.IndexOf(APaper);
  if i = -1 then
    i := 0;
  Result := Integer(FPapers.Objects[i]);
end;


{ TfrxVirtualPrinter }

procedure TfrxVirtualPrinter.Init;
var
  i: Integer;
begin
  if FInitialized then Exit;

  FDPI := Point(600, 600);
  FDefPaper := DMPAPER_A4;
  FDefOrientation := poPortrait;
  FDefPaperWidth := 210;
  FDefPaperHeight := 297;

  for i := 0 to PAPERCOUNT - 1 do
    FPapers.AddObject(PaperInfo[i].Name, TObject(PaperInfo[i].Typ));

  FBin := -1;
  FDuplex := -1;
  FInitialized := True;
end;

procedure TfrxVirtualPrinter.Abort;
begin
end;

procedure TfrxVirtualPrinter.BeginDoc;
begin
end;

procedure TfrxVirtualPrinter.BeginPage;
begin
end;

procedure TfrxVirtualPrinter.EndDoc;
begin
end;

procedure TfrxVirtualPrinter.EndPage;
begin
end;

procedure TfrxVirtualPrinter.BeginRAWDoc;
begin
end;

procedure TfrxVirtualPrinter.EndRAWDoc;
begin
end;

procedure TfrxVirtualPrinter.WriteRAWDoc(const buf: AnsiString);
begin
end;

procedure TfrxVirtualPrinter.SetViewParams(APaperSize: Integer;
  APaperWidth, APaperHeight: Extended; AOrientation: TPrinterOrientation);
var
  i: Integer;
  Found: Boolean;
begin
  Found := False;
  if APaperSize <> 256 then
    for i := 0 to PAPERCOUNT - 1 do
      if PaperInfo[i].Typ = APaperSize then
      begin
        if AOrientation = poPortrait then
        begin
          APaperWidth := PaperInfo[i].X / 10;
          APaperHeight := PaperInfo[i].Y / 10;
        end
        else
        begin
          APaperWidth := PaperInfo[i].Y / 10;
          APaperHeight := PaperInfo[i].X / 10;
        end;
        Found := True;
        break;
      end;

  if not Found then
    APaperSize := 256;

  FOrientation := AOrientation;
  FPaper := APaperSize;
  FPaperWidth := APaperWidth;
  FPaperHeight := APaperHeight;
  FLeftMargin := 5;
  FTopMargin := 5;
  FRightMargin := 5;
  FBottomMargin := 5;
end;

procedure TfrxVirtualPrinter.SetPrintParams(APaperSize: Integer;
  APaperWidth, APaperHeight: Extended; AOrientation: TPrinterOrientation;
  ABin, ADuplex, ACopies: Integer);
begin
  SetViewParams(APaperSize, APaperWidth, APaperHeight, AOrientation);
  FBin := ABin;
end;

procedure TfrxVirtualPrinter.PropertiesDlg;
begin
end;


{ TfrxPrinter }

destructor TfrxPrinter.Destroy;
begin
  FreeDevMode;
  inherited;
end;

procedure TfrxPrinter.Init;

  {$IFDEF LCLQT5}
  function QtPageSizeToPageSize(ASize: QPagedPaintDevicePageSize): Cardinal;
  begin
    Result := DMPAPER_USER;
    case ASize of
      QPagedPaintDeviceA4: Result := DMPAPER_A4;
      QPagedPaintDeviceB5: Result := DMPAPER_B5;
      QPagedPaintDeviceLetter: Result := DMPAPER_LETTER;
      QPagedPaintDeviceLegal: Result := DMPAPER_LEGAL;
      QPagedPaintDeviceExecutive: Result := DMPAPER_EXECUTIVE;
      QPagedPaintDeviceA0: Result := DMPAPER_ESHEET; // priblizno u mm
      QPagedPaintDeviceA1: Result := DMPAPER_DSHEET;
      QPagedPaintDeviceA2: Result := DMPAPER_A2;
      QPagedPaintDeviceA3: Result := DMPAPER_A3;
      QPagedPaintDeviceA5: Result := DMPAPER_A5;
      QPagedPaintDeviceA6: Result := DMPAPER_A6;
      QPagedPaintDeviceA7,
      QPagedPaintDeviceA8, QPagedPaintDeviceA9: Result := DMPAPER_A4; // FIXME
      QPagedPaintDeviceB0: Result := DMPAPER_ESHEET;
      QPagedPaintDeviceB1: Result := DMPAPER_DSHEET;
      QPagedPaintDeviceB2: Result := DMPAPER_A2;
      QPagedPaintDeviceB3: Result := DMPAPER_B4;

      QPagedPaintDeviceB6: Result := DMPAPER_ENV_B6;
      QPagedPaintDeviceB7, QPagedPaintDeviceB8, QPagedPaintDeviceB9,
        QPagedPaintDeviceB10: Result := DMPAPER_ENV_B6;
      QPagedPaintDeviceC5E: Result := DMPAPER_ENV_C5;
      QPagedPaintDeviceComm10E: Result := DMPAPER_ENV_10;
      QPagedPaintDeviceDLE: Result := DMPAPER_ENV_DL;
      QPagedPaintDeviceFolio: Result := DMPAPER_FOLIO;
      QPagedPaintDeviceLedger: Result := DMPAPER_LEDGER;
      QPagedPaintDeviceTabloid: Result := DMPAPER_TABLOID;
      (*
      QPrinterCustom = 30 { $1e };
      QPrinterNPageSize = 30 { $1e };
      QPrinterNPaperSize = 30 { $1e };
      *)
    end;
  end;
  {$ENDIF}

  {$IFDEF LCLGTK2}
  function FindLinuxPaper(w, h: Integer): Integer;
  var
    I: Integer;
    p: TPaperRect;
    lw,lh: Integer;
  begin
    Result := 0;
    for I := 0 to CUPSPrinter.PaperSize.SupportedPapers.Count - 1 do
    begin
      p := CUPSPrinter.PaperSize.PaperRectOf[CUPSPrinter.PaperSize.SupportedPapers[I]];
      lw :=
       Round((p.PhysicalRect.Right - p.PhysicalRect.Left)  * 25.4/ CUPSPrinter.XDPI*10);
      lh :=
        Round((p.PhysicalRect.Bottom - p.PhysicalRect.Top) * 25.4/ CUPSPrinter.YDPI*10);
      if ((w >= lw - 6) and (w <= lw + 6)) and ((h >= lh - 6) and (h <= lh + 6)) then
      begin
        Result := I;
        Break;
      end;
    end;
  end;

  procedure FillPapers;
  var
    i,k: Integer;
    fw, fh, lw, lh: Integer;
  begin
    //PaperSizesCount := PAPERCOUNT;
    for I := 0 to  PAPERCOUNT - 1 do
    begin
      fw := PaperInfo[I].X;
      fh := PaperInfo[I].Y;
      k := FindLinuxPaper(fw, fh);
      if k > 0 then
      begin
       PaperInfo[I].LTyp:= k;
       FPapers.AddObject(LCLPaperInfo[i].Name, TObject(PaperInfo[I].Typ));
      end;
    end;
  end;

  {$ELSE}

  procedure FillPapers;
  var
    i, PaperSizesCount: Integer;
    PaperSizes: array[0..511] of Word;
    PaperNames: PChar;
    {$IFDEF LCLQT5}
    PrnInfo: QPrinterInfoH;
    IntAr: TPtrIntArray;
    W: WideString;
    {$ENDIF}
  begin
    FillChar(PaperSizes, SizeOf(PaperSizes), 0);
    {$IFDEF FPC}
    PaperSizesCount := PAPERCOUNT;
    for i := 0 to PAPERCOUNT - 1 do
      FPapers.AddObject(LCLPaperInfo[i].Name, TObject(i + 1));
    {$ELSE}
    PaperSizesCount := DeviceCapabilities(PChar(FName), PChar(FPort), DC_PAPERS, @PaperSizes, FMode);
    GetMem(PaperNames, PaperSizesCount * 64 * sizeof(char));
    DeviceCapabilities(PChar(FName), PChar(FPort), DC_PAPERNAMES, PaperNames, FMode);
    for i := 0 to PaperSizesCount - 1 do
      if PaperSizes[i] <> 256 then
{$IFDEF Delphi12}
        FPapers.AddObject(StrPas(PWideChar(PaperNames + i * 64)), Pointer(PaperSizes[i]));
{$ELSE}
        FPapers.AddObject(StrPas(PAnsiChar(PaperNames + i * 64)), Pointer(PaperSizes[i]));
{$ENDIF}

    FreeMem(PaperNames, PaperSizesCount * 64 * sizeof(char));
    {$ENDIF}
  end;
{$ENDIF}

  procedure FillBins;
  var
    i, BinsCount: Integer;
    BinNumbers: array[0..255] of Word;
    BinNames: PChar;
    {$IFDEF LCLQT5}
    PrnInfo: QPrinterInfoH;
    {$ENDIF}
  begin
    FillChar(BinNumbers, SizeOf(BinNumbers), 0);
    {$IFDEF FPC}
    // QPrinterOnlyOne, QPrinterLower, QPrinterMiddle, QPrinterManual, QPrinterEnvelope, QPrinterEnvelopeManual, QPrinterAuto, QPrinterTractor, QPrinterSmallFormat, QPrinterLargeFormat, QPrinterLargeCapacity,
    // QPrinterCassette, QPrinterFormSource, QPrinterMaxPageSource );
    // QT's QPrinterPageSource is by -1 of DMBIN_ values !
    BinsCount := 12;
    FBins.AddObject('OnlyOne', TObject(Ord(DMBIN_ONLYONE)));
    FBins.AddObject('Lower', TObject(Ord(DMBIN_LOWER)));
    FBins.AddObject('Middle', TObject(Ord(DMBIN_MIDDLE)));
    FBins.AddObject('Manual', TObject(Ord(DMBIN_MANUAL)));
    FBins.AddObject('Envelope', TObject(Ord(DMBIN_ENVELOPE)));
    FBins.AddObject('EnvelopeManual', TObject(Ord(DMBIN_ENVMANUAL)));
    FBins.AddObject('Auto', TObject(Ord(DMBIN_AUTO)));
    FBins.AddObject('Tractor', TObject(Ord(DMBIN_TRACTOR)));
    FBins.AddObject('Small Format', TObject(Ord(DMBIN_SMALLFMT)));
    FBins.AddObject('Large Format', TObject(Ord(DMBIN_LARGEFMT)));
    FBins.AddObject('Large Capacity', TObject(Ord(DMBIN_LARGECAPACITY)));
    FBins.AddObject('Cassette', TObject(Ord(DMBIN_CASSETTE)));

    {$ELSE}
    BinsCount := DeviceCapabilities(PChar(FName), PChar(FPort), DC_BINS, @BinNumbers[0], FMode);
    GetMem(BinNames, BinsCount * 24 * sizeof(char));
      DeviceCapabilities(PChar(FName), PChar(FPort), DC_BINNAMES, BinNames, FMode);

    for i := 0 to BinsCount - 1 do
      if BinNumbers[i] <> DMBIN_AUTO then
{$IFDEF Delphi12}
        FBins.AddObject(StrPas(PwideChar(BinNames + i * 24)), Pointer(BinNumbers[i]));
{$ELSE}
        FBins.AddObject(StrPas(BinNames + i * 24), Pointer(BinNumbers[i]));
{$ENDIF}

    FreeMem(BinNames, BinsCount * 24 * sizeof(char));
    {$ENDIF}
  end;

begin
  if FInitialized then Exit;
  // writeln('SETTING DEF PRN TO ',FName,' Current index=',Printer.PrinterIndex);
  {$IFDEF LCLGTK2}
  FCUPSPrinter := ASysPrinter;
  {$ENDIF}
  {$IFDEF FPC}
  Printer.PrinterIndex := Printer.Printers.IndexOf(FName);
  {$ENDIF}
  CreateDevMode;
  if FDeviceMode = 0 then Exit;
  {$IFNDEF FPC}
  RecreateDC;
  {$ENDIF}

  if not UpdateDeviceCaps then
  begin
    FreeDevMode;
    Exit;
  end;

  FDefPaper := DMPAPER_A4;
  // ASysPrinter.PaperSize.DefaultPaperName;
  // FMode.dmPaperSize;
  FDefBin := FMode^.dmDefaultSource;
  FDefDuplex := FMode^.dmDuplex;
  FPaper := FDefPaper;
  FDefPaperWidth := FPaperWidth;
  FDefPaperHeight := FPaperHeight;
  if FMode^.dmOrientation = DMORIENT_PORTRAIT then
    FDefOrientation := poPortrait else
    FDefOrientation := poLandscape;
  FOrientation := FDefOrientation;
  FillPapers;
  FillBins;
  FBin := -1;
  FDuplex := -1;
  FInitialized := True;
end;

procedure TfrxPrinter.Abort;
begin
  {$IFDEF FPC}
  Printer.Abort;
  {$ELSE}
  AbortDoc(FDC);
  {$ENDIF}
  EndDoc;
end;

procedure TfrxPrinter.BeginDoc;
{$IFDEF FPC}
begin
  FPrinting := True;
  FDC := $FFFFFFFF;
  {$IFDEF DEBUGFR4PRINTERS}
  DebugLn('TfrxPrinter.BeginDoc');
  ASysPrinter.PrinterName;
  DebugLn('PaperName ',ASysPrinter.PaperSize.PaperName,' orient ',dbgs(Ord(ASysPrinter.Orientation)),
  ' Name ',ASysPrinter.PrinterName);
  {$IFDEF LCLQT5}
  DebugLn('Qt paper ',dbgs(Ord(QtDefaultPrinter.PageSize)),' orient ',dbgs(Ord(QtDefaultPrinter.Orientation)),
  ' name ',QtDefaultPrinter.PrinterName,' OutFormat ', dbgs(Ord(QtDefaultPrinter.OutputFormat)));
  {$ENDIF}
  {$ENDIF}
  ASysPrinter.BeginDoc;
  FCanvas.Handle := ASysPrinter.Canvas.Handle;
  FCanvas.Refresh;
  FCanvas.UpdateFont;
{$ELSE}
var
  DocInfo: TDocInfo;
begin
  FPrinting := True;

  FillChar(DocInfo, SizeOf(DocInfo), 0);
  DocInfo.cbSize := SizeOf(DocInfo);
  if FTitle <> '' then
    DocInfo.lpszDocName := PChar(FTitle)
  else DocInfo.lpszDocName := PChar('Fast Report Document');

  if FFileName <> '' then
    DocInfo.lpszOutput := PChar(FFileName);

  RecreateDC;
  StartDoc(FDC, DocInfo);
{$ENDIF}
end;

procedure TfrxPrinter.BeginPage;
begin
  {$IFDEF FPC}
  if FDC = $FFFFFFFF then
    FDC := 1
  else
  begin
    Inc(FDC, 1);
    if not FPrinting then
      BeginDoc
    else
      ASysPrinter.NewPage;
  end;
  {$IFDEF DEBUGFR4PRINTERS}
  DebugLn('TfrxPrinter.Begin PrinterHandle ? ',dbgs(Printer.Canvas.HandleAllocated));
  {$ENDIF}
  if not Printer.Canvas.HandleAllocated then
    raise Exception.CreateFmt('Printer canvas handle not allocated.Printer state %d ',[Ord(Printer.PrinterState)]);

  // TQtPrinter(Printer.Canvas.Handle).
  // QPaintEngine_clearDirty(QPainter_paintEngine(TQtPrinter(Printer.Handle)), QPaintEngineAllDirty);
  {$ELSE}
  StartPage(FDC);
  {$ENDIF}
end;

procedure TfrxPrinter.EndDoc;
var
  Saved8087CW: Word;
begin
  {$IFDEF FPC}
  FDC := $00000000;
  {$IFNDEF LCLGTK2}
  FCanvas.Handle := 0;
  {$ENDIF}
  if FPrinting then
    ASysPrinter.EndDoc;
  {$ELSE}
  Saved8087CW := Default8087CW;
  Set8087CW($133F);
  try
    Windows.EndDoc(FDC);
  except
  end;
  Set8087CW(Saved8087CW);
  {$ENDIF}

  FPrinting := False;
  {$IFNDEF FPC}
  RecreateDC;
  {$ENDIF}
  FBin := -1;
  FDuplex := -1;

  FMode^.dmFields := FMode^.dmFields or DM_DEFAULTSOURCE or DM_DUPLEX;
  FMode^.dmDefaultSource := FDefBin;
  FMode^.dmDuplex := FDefDuplex;
  {$IFNDEF FPC}
  FDC := ResetDC(FDC, FMode^);
  {$ENDIF}
end;

procedure TfrxPrinter.EndPage;
begin
  {$IFDEF FPC}
  {$IFDEF DEBUGFR4PRINTERS}
  DebugLn('TfrxPrinter.EndPage PrinterHandle ? ',dbgs(Printer.Canvas.HandleAllocated));
  {$ENDIF}
  {$ELSE}
  Windows.EndPage(FDC);
  {$ENDIF}
end;

procedure TfrxPrinter.BeginRAWDoc;
{$IFNDEF FPC}
var
  DocInfo1: TDocInfo1;
{$ENDIF}
begin
  {$IFDEF FPC}
  // RecreateDC;
  {$ELSE}
  RecreateDC;
  DocInfo1.pDocName := PChar(FTitle);
  DocInfo1.pOutputFile := nil;
  DocInfo1.pDataType := 'RAW';
  StartDocPrinter(FHandle, 1, @DocInfo1);
  StartPagePrinter(FHandle);
  {$ENDIF}
end;

procedure TfrxPrinter.EndRAWDoc;
begin
  {$IFDEF FPC}

  {$ELSE}
  EndPagePrinter(FHandle);
  EndDocPrinter(FHandle);
  {$ENDIF}
end;

procedure TfrxPrinter.WriteRAWDoc(const buf: AnsiString);
var
  N: DWORD;
begin
  {$IFNDEF FPC}
  WritePrinter(FHandle, PAnsiChar(buf), Length(buf), N);
  {$ENDIF}
end;

procedure TfrxPrinter.CreateDevMode;
var
  bufSize: Integer;
{$IFNDEF Delphi12}
  dm: TDeviceMode;
{$ENDIF}
begin
  {$IFDEF FPC}
  GetMem(FMode, SizeOf(TDeviceMode) + 1);
  // FillChar(FMode, SizeOf(FMode), #0);
  FMode^.dmPaperSize := 0;
  FMode^.dmOrientation := 0;
  FHandle := THandle(ASysPrinter);
  FDeviceMode := 1;
  {$ELSE}
  if OpenPrinter(PChar(FName), FHandle, nil) then
  begin
{$IFDEF Delphi12}
    bufSize := DocumentProperties(0, FHandle, PChar(FName), nil, nil, 0);
{$ELSE}
    bufSize := DocumentProperties(0, FHandle, PChar(FName), dm, dm, 0);
{$ENDIF}
    if bufSize > 0 then
    begin
      FDeviceMode := GlobalAlloc(GHND, bufSize);
      if FDeviceMode <> 0 then
      begin
        FMode := GlobalLock(FDeviceMode);
        if DocumentProperties(0, FHandle, PChar(FName), FMode^, FMode^,
          DM_OUT_BUFFER) < 0 then
        begin
          GlobalUnlock(FDeviceMode);
          GlobalFree(FDeviceMode);
          FDeviceMode := 0;
          FMode := nil;
        end
      end;
    end;
  end;
  {$ENDIF}
end;

procedure TfrxPrinter.FreeDevMode;
begin
  {$IFDEF FPC}
  Freemem(FMode, SizeOf(TDeviceMode) + 1);
  // FCanvas.Handle := 0;
  // if FDC <> 0 then
  //  DeleteDC(FDC);
  FMode := nil;
  FDeviceMode := 0;
  {$ELSE}
  FCanvas.Handle := 0;
  if FDC <> 0 then
    DeleteDC(FDC);
  if FHandle <> 0 then
    ClosePrinter(FHandle);
  if FDeviceMode <> 0 then
  begin
    GlobalUnlock(FDeviceMode);
    GlobalFree(FDeviceMode);
  end;
  FDeviceMode := 0;
  FDC := 0;
  FHandle := 0;
  {$ENDIF}
end;

{$IFNDEF FPC}
procedure TfrxPrinter.RecreateDC;
begin
  if FDC <> 0 then
    try
      DeleteDC(FDC);
    except
    end;
  FDC := 0;
  GetDC;
end;

procedure TfrxPrinter.GetDC;
begin
  if FDC = 0 then
  begin
    {$IFDEF FPC}
    (*
    if FPrinting then
      FDC := Printer.Canvas.Handle
    else
    begin
      Printer.BeginDoc;
      FDC := Printer.Canvas.Handle;
    end;
    *)
    {$ELSE}
    if FPrinting then
      FDC := CreateDC(PChar(FDriver), PChar(FName), nil, FMode) else
      FDC := CreateIC(PChar(FDriver), PChar(FName), nil, FMode);
    {$ENDIF}
    FCanvas.Handle := FDC;
    FCanvas.Refresh;
    FCanvas.UpdateFont;
  end;
end;
{$ENDIF}

procedure TfrxPrinter.SetViewParams(APaperSize: Integer;
  APaperWidth, APaperHeight: Extended; AOrientation: TPrinterOrientation);
{$IFDEF LCLGTK2}
var
  s: string;
{$ENDIF}

begin
  if APaperSize <> 256 then
  begin
    FMode^.dmFields := DM_PAPERSIZE or DM_ORIENTATION;
    FMode^.dmPaperSize := APaperSize;
    if AOrientation = poPortrait then
      FMode^.dmOrientation := DMORIENT_PORTRAIT else
      FMode^.dmOrientation := DMORIENT_LANDSCAPE;
    {$IFNDEF FPC}
    RecreateDC;
    {$ENDIF}
    {$IFDEF LCLGTK2}
    s := LCLPaperName(APaperSize);
    if s <> '' then
      CUPSPrinter.PaperSize.PaperName:= s
    else
      CUPSPrinter.PaperSize.PaperName := 'A4';
    FOrientation := AOrientation;
    {$ENDIF}
    if not UpdateDeviceCaps then Exit;
  end
  else
  begin
    // copy the margins from A4 paper
    SetViewParams(DMPAPER_A4, 0, 0, AOrientation);
    FPaperHeight := APaperHeight;
    FPaperWidth := APaperWidth;
  end;

  FPaper := APaperSize;
  FOrientation := AOrientation;
end;

procedure TfrxPrinter.SetPrintParams(APaperSize: Integer;
  APaperWidth, APaperHeight: Extended; AOrientation: TPrinterOrientation;
  ABin, ADuplex, ACopies: Integer);
{$IFDEF FPC}
var
  i: Integer;
  {$IFDEF LCLQT5}
  APrn: QPrinterH;
  ASize: QSizeFH;
  function DMDUP_to_Qt(ADuplex: Integer): QPrinterDuplexMode;
  begin
    Result := QPrinterDuplexNone;
    case ADuplex of
      DMDUP_SIMPLEX: Result := QPrinterDuplexNone;
      DMDUP_VERTICAL: Result := QPrinterDuplexShortSide;
      DMDUP_HORIZONTAL: Result := QPrinterDuplexLongSide;
    end;
  end;
  {$ENDIF}
{$ENDIF}
begin
  {$IFDEF DEBUGFR4PRINTERS}
  DebugLn(' > TfrxPrinter.SetPrintParams ');
  DebugLn('  > ',Format('PapW %d PapH %d Orient %d APaperSize %d',[Round(APaperWidth), Round(APaperHeight),
    Ord(AOrientation), APaperSize]));
  {$ENDIF}
  FMode^.dmFields := FMode^.dmFields or DM_PAPERSIZE or DM_ORIENTATION or DM_COPIES
    or DM_DEFAULTSOURCE;


  if APaperSize = 256 then
  begin
    FMode^.dmFields := FMode^.dmFields or DM_PAPERLENGTH or DM_PAPERWIDTH;
    if AOrientation = poLandscape then
    begin
      FMode^.dmPaperLength := Round(APaperWidth * 10);
      FMode^.dmPaperWidth := Round(APaperHeight * 10);
    end
    else
    begin
      FMode^.dmPaperLength := Round(APaperHeight * 10);
      FMode^.dmPaperWidth := Round(APaperWidth * 10);
    end;
  end
  else
  begin
    FMode^.dmPaperLength := 0;
    FMode^.dmPaperWidth := 0;
  end;

  FMode^.dmPaperSize := APaperSize;
  if AOrientation = poPortrait then
    FMode^.dmOrientation := DMORIENT_PORTRAIT else
    FMode^.dmOrientation := DMORIENT_LANDSCAPE;

  FMode^.dmCopies := ACopies;
  if FBin <> -1 then
    ABin := FBin;
  if ABin = DMBIN_AUTO then
    ABin := DefBin;
  FMode^.dmDefaultSource := ABin;

  if ADuplex = 0 then
    ADuplex := FDefDuplex
  else Inc(ADuplex);
  if ADuplex = 4 then
    ADuplex := DMDUP_SIMPLEX;
  if FDuplex <> -1 then
    ADuplex := FDuplex;
  if ADuplex <> 1 then
    FMode^.dmFields := FMode^.dmFields  or DM_DUPLEX;
  FMode^.dmDuplex := ADuplex;

  {$IFDEF FPC}
  if FPrinting then
    EndDoc;

  ASysPrinter.Orientation := AOrientation;
  ASysPrinter.Copies := ACopies;

  {$IFDEF LCLQT5}
  {$warning HARDCODED}
  APrn := QtDefaultPrinter.Handle;

  if AOrientation = poLandscape then
    QtDefaultPrinter.Orientation := QPrinterLandscape
  else
    QtDefaultPrinter.Orientation := QPrinterPortrait;

  QPrinter_setDuplex(APrn, DMDUP_to_Qt(ADuplex));
  if APaperSize = DMPAPER_A5 then
    QPagedPaintDevice_setPageSize(APrn, QPagedPaintDeviceA5)
  else
  if APaperSize = DMPAPER_A4 then
    QPagedPaintDevice_setPageSize(APrn, QPagedPaintDeviceA4)
  else
  begin
    // QtDefaultPrinter.Collate := ;
    if AOrientation = poLandscape then
      ASize := QSizeF_Create(APaperHeight, APaperWidth)
    else
      ASize := QSizeF_Create(APaperWidth, APaperHeight);
    QPrinter_setPaperSize(APrn, ASize, QPrinterMillimeter);
    QSizeF_destroy(ASize);
  end;

  QtDefaultPrinter.NumCopies := ACopies;

  // SET PAPER FROM PAPERSToQtPAPERS
  {$IFDEF DEBUGFR4PRINTERS}
  DebugLn('APAPERSIZE=',dbgs(APaperSize),' DEF PRN ',  QtDefaultPrinter.PrinterName,
  ' Setting paper size to w=',dbgs(APaperWidth),' h=',dbgs(APaperHeight));
  {$ENDIF}

  if FFileName <> '' then
  begin
    QtDefaultPrinter.OutputFileName := FileName;
    QtDefaultPrinter.OutputFormat := QPrinterPdfFormat;
    QtDefaultPrinter.ColorMode := QPrinterColor;
  end else
  begin
    QtDefaultPrinter.OutputFileName := '';
    QtDefaultPrinter.OutputFormat := QPrinterNativeFormat;
  end;
  {$ELSE}
  {$warning HARDCODED ALL PAPERS TO A4}
  //ASysPrinter.PaperSize.PaperName := 'A4';
  {$ENDIF}

  {$ELSE}
  FDC := ResetDC(FDC, FMode^);
  FDC := ResetDC(FDC, FMode^);  // needed for some printers
  {$ENDIF}
  FCanvas.Refresh;
  if not UpdateDeviceCaps then Exit;
  FPaper := APaperSize;
  FOrientation := AOrientation;
end;

function TfrxPrinter.UpdateDeviceCaps: Boolean;
{$IFDEF FPC}
var
  WR, PR, WRmm, PRmm: TRect;
{$ENDIF}
begin
  Result := True;
  {$IFNDEF FPC}
  if FDC = 0 then GetDC;

  FDPI := Point(GetDeviceCaps(FDC, LOGPIXELSX), GetDeviceCaps(FDC, LOGPIXELSY));
  {$ELSE}
  FDPI.X := ASysPrinter.XDPI;
  FDPI.Y := ASysPrinter.YDPI;
  {$ENDIF}
  if (FDPI.X = 0) or (FDPI.Y = 0) then
  begin
    Result := False;
    frxErrorMsg('Printer selected is not valid');
    Exit;
  end;
  {$IFDEF LCLQT5}
  WR := QtDefaultPrinter.pageRect;
  PR := QtDefaultPrinter.paperRect;
  Wrmm := QtDefaultPrinter.PageRect(QPrinterMillimeter);
  Prmm := QtDefaultPrinter.PaperRect(QPrinterMillimeter);
  {$IFDEF DEBUGFR4PRINTERS}
  DebugLn('Dump printer page px wr ',dbgs(WR),' pr ',dbgs(PR));
  DebugLn('Dump printer page mm wr ',dbgs(WRmm),' pr ',dbgs(PRmm));
  {$ENDIF}
  FPaperHeight := PRmm.Bottom;
  FPaperWidth := Prmm.Right;
  FLeftMargin := WRmm.Left;
  FTopMargin := WRmm.Top;

  // FIXME, Right and bottom margin probably wrong ?
  FRightMargin := FLeftMargin;
  // FPaperWidth - Round(Printer.XDPI / FDPI.X * 25.4) - FLeftMargin;
  FBottomMargin := FTopMargin;
  // FPaperHeight - Round(Printer.YDPI / FDPI.Y * 25.4) - FTopMargin;
  {$ELSE}
  Prmm := ASysPrinter.PaperSize.PaperRect.PhysicalRect;
  WRmm := ASysPrinter.PaperSize.PaperRect.WorkRect;

  if FOrientation = poPortrait then
  begin
  FPaperHeight := PRmm.Bottom / DPI.Y * 25.4;
  FPaperWidth := Prmm.Right / DPI.X * 25.4;
  FLeftMargin := WRmm.Left / DPI.X * 25.4;
  FTopMargin := WRmm.Top / DPI.Y * 25.4;

  FRightMargin := (Prmm.Right - WRmm.Right) / DPI.X * 25.4;
  FBottomMargin := (Prmm.Bottom - WRmm.Bottom) / DPI.X * 25.4;

  end
  else if FOrientation = poLandscape then
  begin
    FPaperHeight := Prmm.Right / DPI.X * 25.4;
    FPaperWidth := PRmm.Bottom / DPI.Y * 25.4;

    FLeftMargin := WRmm.Top / DPI.X * 25.4;
    FTopMargin := WRmm.Left / DPI.Y * 25.4;

    FRightMargin := (Prmm.Bottom - WRmm.Bottom) / DPI.X * 25.4;
    FBottomMargin := (Prmm.Right - WRmm.Right) / DPI.X * 25.4;
  end;
  {$ENDIF}
  {$IFDEF DEBUGFR4PRINTERS}
  DebugLn('UPDATE DEVICE CAPS RESULTS ');
  DebugLn(Format('FPaperHeight %12.2n FPaperWidth %12.2n XDPI %d',[FPaperHeight, FPaperWidth, Round(Printer.XDPI / FDPI.X * 25.4)]));
  DebugLn(Format('MARGINE L %12.2n T %12.2n R %12.2n B %12.2n',
    [FLeftMargin, FTopMargin, FRightMargin, FBottomMargin]));
  DebugLn(Format('DPIX %d DPIY %d ',[DPI.X, DPI.Y]));
  {$ENDIF}
end;

{$IFDEF LCLGTK2}
function TfrxPrinter.LCLPaperName(Tp: Integer): string;
var
  I: Integer;
  fw, fh:Integer;
begin
  Result := '';
  for I := 0 to Length(PaperInfo) - 1 do
  begin
    if  PaperInfo[I].Typ = Tp then
    begin
      fw := PaperInfo[I].X;
      fh := PaperInfo[I].Y;
      Result :=  CUPSPrinter.PaperSize.SupportedPapers[PaperInfo[I].LTyp];
    end;
    if Result <> '' then
     Break;
  end;
end;
{$ENDIF}


procedure TfrxPrinter.PropertiesDlg;
var
  h: THandle;
  PrevDuplex: Integer;
  {$IFDEF LCLGTK2}
   pdlg: TPrinterSetupDialog;
  {$ENDIF}

  {$IFDEF LCLQT5}
  function QtPropsDlg: Boolean;
  var
    PgDlg: QPageSetupDialogH;
  begin
    Result := False;
    if not Assigned(ASysPrinter) then Exit;
    if ASysPrinter.Printers.Count <= 0 then Exit;
    {There's no special dialog for printer setup under Qt,
     so we'll use QPageSetupDialog here.}
    PgDlg := QPageSetupDialog_create(QtDefaultPrinter.Handle, nil);
    try
      Result := QPageSetupDialog_exec(PgDlg) = Ord(QDialogAccepted);
    finally
      QPageSetupDialog_destroy(PgDlg);
    end;
  end;
  {$ENDIF}
begin
  {$IFDEF LCLQT5}
  QtPropsDlg;
  {$ENDIF}
  {$IFDEF LCLGTK2}
  pdlg := TPrinterSetupDialog.Create(nil);
  try
  pdlg.Execute;
  finally
    pdlg.Free;
  end;
  {$ENDIF}
end;

{ TfrxPrinters }

constructor TfrxPrinters.Create;
begin
  FPrinterList := TList.Create;
  FPrinters := TStringList.Create;

  FillPrinters;
  if FPrinterList.Count = 0 then
  begin
    FPrinterList.Add(TfrxVirtualPrinter.Create(frxResources.Get('prVirtual'), ''));
    FHasPhysicalPrinters := False;
    PrinterIndex := 0;
  end
  else
  begin
    FHasPhysicalPrinters := True;
    PrinterIndex := IndexOf(GetDefaultPrinter);
    if PrinterIndex = -1 then  // important
      PrinterIndex := 0;
  end;
end;

destructor TfrxPrinters.Destroy;
begin
  Clear;
  FPrinterList.Free;
  FPrinters.Free;
  inherited;
end;

procedure TfrxPrinters.Clear;
begin
  while FPrinterList.Count > 0 do
  begin
    TObject(FPrinterList[0]).Free;
    FPrinterList.Delete(0);
  end;
  FPrinters.Clear;
end;

function TfrxPrinters.GetItem(Index: Integer): TfrxCustomPrinter;
begin
  if Index >= 0 then
    Result := TfrxCustomPrinter(FPrinterList[Index])
  else
    Result := nil
end;

function TfrxPrinters.IndexOf(AName: String): Integer;
var
  i: Integer;
begin
  Result := -1;
  for i := 0 to FPrinterList.Count - 1 do
    if AnsiCompareText(Items[i].Name, AName) = 0 then
    begin
      Result := i;
      break;
    end;
end;

procedure TfrxPrinters.SetPrinterIndex(Value: Integer);
begin
  if Value <> -1 then
    FPrinterIndex := Value
  else
    FPrinterIndex := IndexOf(GetDefaultPrinter);
  if FPrinterIndex <> -1 then
  begin
    if FHasPhysicalPrinters then
      begin
        {$IFDEF LCLQT5}
        QtDefaultPrinter.PrinterName := ASysPrinter.Printers.Strings[FPrinterIndex];
        {$ELSE}
        ASysPrinter.PrinterIndex := FPrinterIndex;
        // ASysPrinter.Printers.Strings[FPrinterIndex];
        {$ENDIF}
      end;
    Items[FPrinterIndex].Init;
  end;
end;

function TfrxPrinters.GetCurrentPrinter: TfrxCustomPrinter;
begin
  Result := Items[PrinterIndex];
end;

function TfrxPrinters.GetDefaultPrinter: String;
var
  {$IFDEF LCLQT5}
  prnName: WideString;
  PrnInfo: QPrinterInfoH;
  {$ELSE}
  prnName: array[0..255] of Char;
  {$ENDIF}
begin
  {$IFDEF LCLQT5}
  PrnInfo := QPrinterInfo_create();
  QPrinterInfo_defaultPrinter(PrnInfo);
  QPrinterInfo_printerName(PrnInfo, @PrnName);
  QPrinterInfo_destroy(PrnInfo);
  if PrnName = '' then
    PrnName := 'unknown';
  Result := PrnName;
  {$ELSE}
  Result := ASysPrinter.Printers[0];
  {$ENDIF}
end;

procedure TfrxPrinters.FillPrinters;
var
  i, j: Integer;
  Buf, prnInfo: PByte;
  Flags, bufSize, prnCount: DWORD;
  Level: Byte;
  sl: TStringList;

  procedure AddPrinter(ADevice, APort: String);
  begin
    FPrinterList.Add(TfrxPrinter.Create(ADevice, APort));
    FPrinters.Add(ADevice);
  end;

begin
  Clear;
  {$IFDEF DEBUGFR4PRINTERS}
  DebugLn('TfrxPrinters.FillPrinters ...');
  {$ENDIF}
  for i := 0 to ASysPrinter.Printers.Count - 1 do
  begin
    AddPrinter(ASysPrinter.Printers[i],'LPT1');
  end;
    // FPrinters.Add(TQtPrinters(ASysPrinter).Printers[i]);
  {$IFDEF DEBUGFR4PRINTERS}
  DebugLn('TfrxPrinters.FillPrinters ...FPrinters count ',dbgs(FPrinters.Count));
  {$ENDIF}
end;



function frxPrinters: TfrxPrinters;
begin
  if FPrinters = nil then
  begin
    ASysPrinter := Printer;
    FPrinters := TfrxPrinters.Create;
  end;
  Result := FPrinters;
end;

initialization

finalization
  if FPrinters <> nil then
    FPrinters.Free;
  FPrinters := nil;
