qrprntr.pas

delphi7报表打印控件源码 可以设计报表

    FQRPrinter : TQRPrinter;
    FZoom : integer;
    FZoomState : TQRZoomState;
    FOutlineControl : TTreeview;
    procedure SetPageNumber(Value : integer);
    procedure SetZoom(value : integer);
    procedure Fixvalues(Sender : TObject);
    procedure SetQRPrinter(Value : TQRPrinter);
  protected
    function GetOnHyperlink : TQRPreviewHyperlinkEvent;
    procedure SetOnHyperlink(Value : TQRPreviewHyperlinkEvent);
    procedure SetOutline(Value : TTreeview);
    procedure CMPageAvailable(var Message : TCM_QRPageAvailable); Message CM_QRPAGEAVAILABLE;
    procedure CMProgressUpdate(var Message : TCM_QRProgressUpdate); Message CM_QRPROGRESSUPDATE;
  public
    constructor Create(aOwner : TComponent); override;
    destructor Destroy; override;
    procedure UpdateImage;
    procedure UpdateZoom;
    procedure ZoomToWidth;
    procedure ZoomToFit;
    property PreviewImage : TQRPreviewImage read FPreviewImage;
    property QRPrinter : TQRPrinter read FQRPrinter write SetQRPrinter;
    property ZoomState : TQRZoomState read FZoomState write FZoomState;
  published
    property OnPageAvailable : TQRPageAvailableEvent read FOnPageAvailableEvent
                                                     write FOnPageAvailableEvent;
    property OnProgressUpdate : TQRProgressUpdateEvent read FOnProgressUpdateEvent write FOnProgressUpdateEvent;
    property OnHyperlink : TQRPreviewHyperlinkEvent read GetOnHyperlink write SetOnHyperlink;
    property Outline : TTreeview read FOutlineControl write SetOutline;
    property PageNumber : integer read FPageNumber write setPageNumber;
    property Zoom : integer read FZoom write SetZoom;
  end;

  { TQRExportFilter }
  TQRExportFilter = class
  private
    FOriginalQRPrinter : TQRPrinter;
    FActive : boolean;
    FFilename : string;
    FOwner : TComponent;
  protected
    function GetDescription : string; virtual;
    function GetExtension : string; virtual;
    function GetFilterName : string; virtual;
    function GetVendorName : string; virtual;
    function GetStreaming : boolean; virtual;
  public
    constructor Create(Filename : string);virtual;
    procedure Start(PaperWidth, PaperHeight : integer; Font : TFont); virtual;
    procedure EndPage; virtual;
    procedure Finish; virtual;
    procedure NewPage; virtual;
    procedure AcceptGraphic( Xoff, Yoff : extended; GControl : TControl); virtual;
    procedure AcceptBand( aBand : TControl; Xoff, Yoff, Expanded : extended); virtual;
    procedure TextOut(X,Y : extended; Font : TFont; BGColor : TColor; Alignment : TAlignment; Text : string); virtual;
    property Active : boolean read FActive write FActive;
    property Description : string read GetDescription;
    property FileExtension : string read GetExtension;
    property Filename : string read FFilename;
    property Name : string read GetFilterName;
    property Owner : TComponent read FOwner write FOwner;
    property Streaming : boolean read GetStreaming;
    property Vendor : string read GetVendorName;
    property OriginalQRPrinter : TQRPrinter read FOriginalQRPrinter write FOriginalQRPrinter;
  end;


// RP 1

  { TPrinterSettings }
  TPaperSizesSupported = array[Letter..Custom] of boolean;
  TQRPrinterSettingsEvent = procedure(Sender : TObject; var Cancel : Boolean; DevMode : pointer) of object;

  TPrinterSettings = class
  private
    { Device stuff }
    FDevice : PChar;
    FDriver : PChar;
    FPort : PChar;
    DeviceMode : THandle;
    DevMode : PDeviceMode;
    { Storage variables }
    FCopies : integer;
    FDuplex : boolean;
    FPrintMetafile : boolean;
    FUseStandardPrinter : boolean;
    FOnGetPrinterSettings : TQRPrinterSettingsEvent;
    FOnApplyPrinterSettings : TQRPrinterSettingsEvent;
    FUseExtendedDuplex : boolean;
    FExtendedDuplex : integer;
    FUseCustomBinCode : boolean;
    FCustomBinCode : integer;
    // QR 4
    FPrintQuality : integer;
    FCollate : integer;
    FColorOption : integer;
    FmemoryLimit : longint;
    FUseCustomPaperCode : boolean;
    FCustomPaperCode : integer;  FMaxExtentX : integer;
    FMaxExtentY : integer;
    FMinExtentX : integer;
    FMinExtentY : integer;
    FOrientation : TPrinterOrientation;
    FOutputBin : TQRBin;
    FPaperSize : TQRPaperSize;
    FPaperSizes : TPaperSizesSupported;
    FPaperWidth : integer;
    FPaperLength : integer;
    FPixelsPerX : integer;
    FPixelsPerY : integer;
    FTopOffset : integer;
    FLeftOffset : integer;
    FPrinter : TPrinter;
    FTitle : string;
    function GetCopies : integer;
    function GetDriver : string;
    function GetDuplex : boolean;
    function GetMaxExtentX : integer;
    function GetMaxExtentY : integer;
    function GetMinExtentX : integer;
    function GetMinExtentY : integer;
    function GetOrientation : TPrinterOrientation;
    function GetOutputBin : TQRBin;
    function GetPaperSize : TQRPaperSize;
    function GetPaperSizeSupported(PaperSize : TQRPaperSize) : boolean;
    function GetPaperWidth : integer;
    function GetPaperLength : integer;
    function GetPixelsPerX : integer;
    function GetPixelsPerY : integer;
    function GetPort : string;
    function GetPrinter : TPrinter;
    function GetTitle : string;
    function GetTopOffset : integer;
    function GetLeftOffset : integer;
    function Supported(Setting : integer) : boolean;
    procedure SetField(aField : integer);
    procedure GetPrinterSettings;
    procedure SetCopies(Value : integer);
    procedure SetDuplex(Value : boolean);
    procedure SetOrientation(Value : TPrinterOrientation);
    procedure SetOutputBin(Value : TQRBin);
    procedure SetPaperSize(Value : TQRPaperSize);
    procedure SetPaperLength(Value : integer);
    procedure SetPaperWidth(Value : integer);
    procedure SetPrinter(Value : TPrinter);
    procedure SetTitle(Value : string);
  public
    constructor Create;
    destructor Destroy; override;
    procedure ApplySettings;
    { read only properties }
    property Device : string read GetDriver;
    property Driver : string read GetDriver;
    property LeftOffset : integer read GetLeftOffset;
    property MaxExtentX : integer read GetMaxExtentX;
    property MaxExtentY : integer read GetMaxExtentY;
    property MinExtentX : integer read GetMinExtentX;
    property MinExtentY : integer read GetMinExtentY;
    property PaperSizeSupported[PaperSize : TQRPaperSize] : boolean read GetPaperSizeSupported;
    property PixelsPerX : integer read GetPixelsPerX;
    property PixelsPerY : integer read GetPixelsPerY;
    property Port : string read GetPort;
    property TopOffset : integer read GetTopOffset;
    { Read/write properties }
    property OnGetPrinterSettings : TQRPrinterSettingsEvent read FOnGetPrinterSettings write FOnGetPrinterSettings;
    property OnApplyPrinterSettings : TQRPrinterSettingsEvent read FOnApplyPrinterSettings write FOnApplyPrinterSettings;
    property Copies : integer read GetCopies write SetCopies;
    property Duplex : boolean read GetDuplex write SetDuplex;
    property Orientation : TPrinterOrientation read GetOrientation write SetOrientation;
    property PrintMetafile : boolean read FPrintMetafile write FPrintMetafile;
    property UseStandardprinter : boolean read FUseStandardprinter write FUseStandardprinter;
    property UseExtendedDuplex : boolean read FUseExtendedDuplex write FUseExtendedDuplex;
    property UseCustomBinCode : boolean read FUseCustomBinCode write FUseCustomBinCode;
    property UseCustomPaperCode : boolean read FUseCustomPaperCode write FUseCustomPaperCode;
    property CustomBinCode : integer read FCustomBinCode write FCustomBinCode;
    property ExtendedDuplex : integer read FExtendedDuplex write FExtendedDuplex;
    property CustomPaperCode : integer read FCustomPaperCode write FCustomPaperCode;
    property OutputBin : TQRBin read GetOutputBin write SetOutputBin;
    property PaperLength : integer read GetPaperLength write SetPaperLength;
    property PaperSize : TQRPaperSize read GetPaperSize write SetPaperSize;
    property PaperWidth : integer read GetPaperWidth write SetPaperWidth;
    property MemoryLimit : longint read FMemoryLimit write FMemoryLimit;
    property PrintQuality : integer read FPrintQuality write FPrintQuality;
    property Collate : integer read FCollate write FCollate;
    property ColorOption : integer read FColorOption write FColorOption;
    property Printer : TPrinter read GetPrinter write SetPrinter;
    property Title : string read GetTitle write SetTitle;
  end;

  { TQRPrinterSettings }
  TQRPrinterSettings = class(TPersistent)
  private
    FCopies : integer;
    FDuplex : boolean;
    FOrientation : TPrinterOrientation;
    FOutputBin : TQRBin;
    FPaperSize : TQRPaperSize;
    FPrinterIndex : integer;
    FTitle : string;
    FFirstPage : integer;
    FLastPage : integer;
    // lut
    FPrintMetafile : boolean;
    FUseStandardPrinter : boolean;
    FOnGetPrinterSettings : TQRPrinterSettingsEvent;
    FOnApplyPrinterSettings : TQRPrinterSettingsEvent;
    FUseExtendedDuplex : boolean;
    FExtendedDuplex : integer;
    // QR4
    FMemoryLimit : longint;
    FPrintQuality : integer;
    FCollate : integer;
    FColorOption : integer;
    FUseCustomBinCode : boolean;
    FCustomBinCode : integer;
    FUseCustomPaperCode : boolean;
    FCustomPaperCode : integer;  FMaxExtentX : integer;
  public
    constructor Create;
    procedure ApplySettings(APrinter : TQRPrinter);
    property Copies : integer read FCopies write FCopies;
    property Duplex : boolean read FDuplex write FDuplex;
    property FirstPage : integer read FFirstPage write FFirstPage;
    property LastPage : integer read FLastPage write FLastPage;
    property Orientation : TPrinterOrientation read FOrientation write FOrientation;
    property OutputBin : TQRBin read FOutputBin write FOutputBin;
    property PaperSize : TQRPaperSize read FPaperSize write FPaperSize;
    property PrinterIndex : integer read FPrinterIndex write FPrinterIndex;
    property Title : string read FTitle write FTitle;
    // lut
    property PrintMetafile : boolean read FPrintMetafile write FPrintMetafile;
    property UseStandardprinter : boolean read FUseStandardprinter write FUseStandardprinter;
    property UseExtendedDuplex : boolean read FUseExtendedDuplex write FUseExtendedDuplex;
    property UseCustomBinCode : boolean read FUseCustomBinCode write FUseCustomBinCode;
    property UseCustomPaperCode : boolean read FUseCustomPaperCode write FUseCustomPaperCode;
    property CustomBinCode : integer read FCustomBinCode write FCustomBinCode;
    property ExtendedDuplex : integer read FExtendedDuplex write FExtendedDuplex;
    property CustomPaperCode : integer read FCustomPaperCode write FCustomPaperCode;
    // QR4
    property MemoryLimit : longint read FMemoryLimit write FMemoryLimit default 250000;
    property PrintQuality : integer read FPrintQuality write FPrintQuality;
    property Collate : integer read FCollate write FCollate;
    property ColorOption : integer read FColorOption write FColorOption;

  end;

  { TQRPrinter related declarations }

  TQRPrinterDestination = (qrdMetafile, qrdPrinter {$ifdef LLionPDF}, qrdPDFFile{$endif});

  TQRPrinterStatus = (mpReady, mpBusy, mpFinished);

  TQRGenerateToPrinterEvent = procedure of object;
  TQRPrintSetupEvent = procedure of object;
  TQRExportToFilterEvent = procedure (aFilter : TQRExportFilter) of object;
  TQRPreviewEvent = procedure of object;
  TQRAfterPrintEvent = procedure (Sender : TObject) of object;
  TQRAfterPreviewEvent = procedure (Sender : TObject) of object;

  { TQRPrinter }
  TQRPrinter = class(TPersistent)
  private
    aPrinter : TPrinter;
    FParentReport : Tobject;
    aStream : TQRStream;
    FAfterPrintEvent : TQRAfterPrintEvent;
    FAfterPreviewEvent : TQRAfterPreviewEvent;
    FAvailablePages : integer;
    FCancelled : boolean;
    FCanvas : TCanvas;
    FCloseControl : TWinControl;
    FDestination : TQRPrinterDestination;
    FFirstPage : integer;
    FLastpage : integer;
    FLeftWaste : integer;
    FHyperlinks : TList;
    FClient : TWinControl;
    FMaster : TWinControl;
    FMetafile : TMetafile;
    FOnExportToFilterEvent : TQRExportToFilterEvent;
    FOnPreviewEvent : TNotifyEvent;
    FOnPrintSetupEvent : TQRPrintSetupEvent;
    FOutlineControl : TTreeview;
    FPage : TMetafile;
    FPageCount : integer;
    FPageNumber : integer;
    FPrinterOK : boolean;
    FProgress : integer;
    FMasterProgressStart : integer;
    FMasterProgressEnd : integer;
    FTitle : string;
    FTopWaste : integer;
    FShowingPreview : boolean;
    FStatus : TQRPrinterStatus;
    FXFactor : extended;
    FYFactor : extended;
    FPageList : TQRPageList;
    FPreviewControl : TWinControl;
    FReportLoaded : boolean;
    function CurrentPageOK : boolean;
    function GetLeftWaste : integer;
    function GetBin : TQRBin;
    function GetCanvas : TCanvas;
    function GetCompression : boolean;
    function GetCopies : integer;
    function GetDuplex : boolean;
    function GetOrientation : TPrinterOrientation;
    function GetPaperLength : integer;
    function GetPaperSize : TQRPaperSize;
    function GetPaperWidth : integer;
    function GetPrinterIndex : integer;
    function GetPrinters : TStrings;
    function GetTopWaste : integer;
    function GetOnGetPrinterSettings : TQRPrinterSettingsEvent;
    function GetOnApplyPrinterSettings : TQRPrinterSettingsEvent;
    function GetUseStandardPrinter : boolean;
    function GetPrintMetafile : boolean;
    function GetUseCustomBinCode : boolean;
    // QR4
    function GetPrinterHandle : THandle;
    function GetPrintQuality : integer;
    function GetCollate : integer;
    function GetColorOption : integer;
    procedure SetPrintQuality( value : integer);
    procedure SetCollate( value : integer);
    procedure SetColorOption( value : integer);

    function GetUseExtendedDuplex : boolean;
    function GetUseCustomPaperCode : boolean;
    function GetCustomBinCode : integer;
    function GetExtendedDuplex : integer;
    function GetCustomPaperCode : integer;
    procedure SetOnGetPrinterSettings(Value : TQRPrinterSettingsEvent);
    procedure SetOnApplyPrinterSettings(Value : TQRPrinterSettingsEvent);
    procedure SetUseStandardPrinter(Value : boolean);
    procedure CreateMetafileCanvas;
    procedure CreatePrinterCanvas;
    procedure EndMetafileCanvas;
    procedure EndPrinterCanvas;
    procedure SetUseExtendedDuplex( value : boolean);
    procedure SetUseCustomBinCode( value : boolean);
    procedure SetUseCustomPaperCode( value : boolean);
    procedure SetExtendedDuplex( value : integer);
    procedure SetCustomBinCode( value : integer);
    procedure SetCustomPaperCode( value : integer);
    procedure SetAvailablePages(Value : integer);
    procedure SetBin(Value : TQRBin);
    procedure SetCompression(Value : boolean);
    procedure SetCopies(Value : integer);
    procedure SetDestination(Value : TQRPrinterDestination);
    procedure SetDuplex(Value : boolean);
    procedure SetOrientation(Value : TPrinterOrientation);
    procedure SetOutline(Value : TTreeview);
    procedure SetPaperLength(Value : integer);
    procedure SetPageNumber(Value : integer);
    procedure SetPaperSize(Value : TQRPaperSize);
    procedure SetPaperWidth(Value : integer);
    procedure SetPrinterIndex(Value : integer);
    procedure SetProgress(Value : integer);
    procedure SetShowingPreview(Value : boolean);
    procedure SetPrintMetafile(Value : boolean);
{$ifdef LLIONPDF}
    procedure CreatePDFCanvas;
{$endif}
  public
{$ifdef LLIonPDF}
    PDFDoc : TPDFDocument;
{$endif}
    aPrinterSettings : TPrinterSettings;
    procedure PrintMetafileDirect( filename : string; frompage, topage : integer);
    constructor Create( parentrep : TObject);
    destructor Destroy; override;
    function GetPage(Value : integer) : TMetafile;
    procedure GetPageEx(Value : integer; var AMetafile : TMetafile;
                              var AHyperlinks : TList);
    function XPos(Value : extended) : integer;
    function XSize(Value : extended) : integer;
    function YPos(Value : extended) : integer;
    function YSize(Value : extended) : integer;
    function PaperLengthValue : integer;
    function PaperWidthValue : integer;
    procedure AbortDoc;
    procedure BeginDoc;
    procedure Cancel;
    procedure Cleanup;
    procedure ClosePreview(Control : TWinControl);
    procedure ClosePreviewA(Control : TWinControl);
    procedure EndDoc;
    procedure ExportToFilter(aFilter : TQRExportFilter);
    procedure FreeHyperlinks;
    procedure AddHyperlink(ARect : TRect; AHyperlink : string);
    procedure AddOutline(Level : integer; Caption : string; Target : TRect);
    procedure Load(Filename : string);
    procedure NewPage;
    procedure Preview;
    procedure PreviewModal;
    procedure Print;
    procedure PrintSetup;
    procedure Save(Filename : string);
    property ParentReport : TObject read FParentReport;
    property ReportLoaded : boolean read FReportLoaded write FReportLoaded;
    property AfterPreview : TQRAfterPreviewEvent read FAfterPreviewEvent write FAfterPreviewEvent;
    property AfterPrint : TQRAfterPrintEvent read FAfterPrintEvent write FAfterPrintEvent;
    property AvailablePages : integer read FAvailablePages write SetAvailablePages;
    property OutputBin : TQRBin read GetBin write SetBin;
    property PreviewControl : TWinControl read FPreviewControl write FPreviewControl;
    property Cancelled : boolean read FCancelled write FCancelled;
    property Canvas : TCanvas read GetCanvas;
    property Client : TWinControl read FClient write FClient;
    property Compression : boolean read GetCompression write SetCompression;
    property Copies : integer read GetCopies write SetCopies;
    property Destination : TQRPrinterDestination read FDestination write SetDestination;
    property Duplex : boolean read GetDuplex write SetDuplex;
    property FirstPage : integer read FFirstPage write FFirstPage;
    property LastPage : integer read FLastPage write FLastPage;