qrprntr.pas

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

{ :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
  :: QuickReport 4.0 for Delphi and C++Builder               ::
  ::                                                         ::
  :: QRPRNTR.PAS - LOW LEVEL PRINT AND PREVIEW CLASSES       ::
  ::                                                         ::
  :: Copyright (c) 2003 A Lochert / QBS Software             ::
  :: All Rights Reserved                                     ::
  ::                                                         ::
  :: http://www.qusoft.com                                   ::
  ::  2/12/2004 many additions for QR4                       ::
  ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: }

{$I QRDEFS.INC}
{$define notLlionPDF}
unit QRPrntr;

{$R-}
{$T-}
{$B-}

interface

uses
  Windows, winspool, Sysutils, Messages, Classes, Controls, StdCtrls, ExtCtrls,
  ComCtrls, Buttons, Printers, Graphics, Forms, DB, DBTables, QR4Const, Dialogs,
  {$ifdef LLionPDF} PDF,{$endif}qrabout;

type

  TQRPaperSize = (Default,
                  Letter,
                  LetterSmall,
                  Tabloid,
                  Ledger,
                  Legal,
                  Statement,
                  Executive,
                  A3,
                  A4,
                  A4Small,
                  A5,
                  B4,
                  B5,
                  Folio,
                  Quarto,
                  qr10X14,
                  qr11X17,
                  Note,
                  Env9,
                  Env10,
                  Env11,
                  Env12,
                  Env14,
                  CSheet,
                  DSheet,
                  ESheet,
                  Custom);

  TQRBin = (First,
            Upper,
            Lower,
            Middle,
            Manual,
            Envelope,
            EnvManual,
            Auto,
            Tractor,
            SmallFormat,
            LargeFormat,
            LargeCapacity,
            Cassette,
            Last);

const
   cQRName = 'QuickReport 4'; { This string should not be resourced }
   cQRVersion = 403;
   cQRPDefaultExt = 'QRP';      { Default extesion for QRP files }
   cQRDefaultExt = 'QR';        { Default extesion for QR files }
   { Actual paper sizes for all the known paper types }
   cQRPaperSizeMetrics : array[Letter..ESheet, 0..1] of extended =
      ((215.9, 279.4), { Letter }
       (215.9, 279.4), { Letter small }
       (279.4, 431.8), { Tabloid }
       (431.8, 279.4), { Ledger }
       (215.9, 355.6), { Legal }
       (139.7, 215.9), { Statement }
       (190.5, 254.0), { Executive }
       (297.0, 420.0), { A3 }
       (210.0, 297.0), { A4 }
       (210.0, 297.0), { A4 small }
       (148.0, 210.0), { A5 }
       (250.0, 354.0), { B4 }
       (182.0, 257.0), { B5 }
       (215.9, 330.2), { Folio }
       (215.0, 275.0), { Quarto }
       (254.0, 355.6), { 10X14 }
       (279.4, 431.8), { 11X17 }
       (215.9, 279.0), { Note }
       (98.43, 225.4), { Envelope #9 }
       (104.8, 241.3), { Envelope #10 }
       (114.3, 263.5), { Envelope #11 }
       (101.6, 279.4), { Envelope #12 - might be wrong !! }
       (127.0, 292.1), { Envelope #14 }
       (100.0, 100.0),
       (100.0, 100.0),
       (100.0, 100.0));

   { Table for translating TQRPaperSize to values which can be used with the
     printer driver }
   cQRPaperTranslate : array[Default..Custom] of integer =
       (0,
       dmpaper_Letter,
       dmpaper_LetterSmall,
       dmpaper_Tabloid,
       dmpaper_Ledger,
       dmpaper_Legal,
       dmpaper_Statement,
       dmpaper_Executive,
       dmpaper_A3,
       dmpaper_A4,
       dmpaper_A4Small,
       dmpaper_A5,
       dmpaper_B4,
       dmpaper_B5,
       dmpaper_Folio,
       dmpaper_Quarto,
       dmpaper_10X14,
       dmpaper_11X17,
       dmpaper_Note,
       dmpaper_Env_9,
       dmpaper_Env_10,
       dmpaper_Env_11,
       dmpaper_Env_12,
       dmpaper_Env_14,
       dmpaper_CSheet,
       dmpaper_DSheet,
       dmpaper_ESheet,
       $100);

   cQRBinTranslate : array[First..Last] of integer =
     (1, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 14, 14);

type
  TQRBandType = (rbTitle,
                 rbPageHeader,
                 rbDetail,
                 rbPageFooter,
                 rbSummary,
                 rbGroupHeader,
                 rbGroupFooter,
                 rbSubDetail,
                 rbColumnHeader,
                 rbOverlay,
                 rbChild);

const
  { Misc constants }
  cQRPageShadowWidth = 2;
  cQRPageFrameWidth = 1;
  cQRPageShadowColor = clBlack;
  cQRCornerSize = 3;

  { TQRCompress related declarations }

const
  { TQRCompress constants }
  MaxChar = 256;
  EofChar = 256;
  PredMax = 255;
  TwiceMax = 512;
  ROOT = 0;
  BitMask : array[0..7] of Byte = (1, 2, 4, 8, 16, 32, 64, 128);

  CM_QRPROGRESSUPDATE = WM_USER + 0;
  CM_QRPAGEAVAILABLE = WM_USER + 1;
  CM_QRPRINT = WM_USER + 2;
  CM_QRPRINTSETUP = WM_USER + 3;
  CM_QRPREVIEWCLOSE = WM_USER + 4;
type
  TQRPrinter = class;

  EQRError = class(Exception);

  CodeType = 0..MaxChar;
  UpIndex = 0..PredMax;
  DownIndex = 0..TwiceMax;
  TreeDownArray = array[UpIndex] of DownIndex;
  TreeUpArray = array[DownIndex] of UpIndex;

  TCM_QRPRogressUpdate = record
    Msg : Cardinal;
    Position : word;
    QRPrinter : TQRPrinter;
  end;

  TCM_QRPageAvailable = record
    Msg : Cardinal;
    PageCount : word;
    QRPrinter : TQRPrinter;
  end;

  TCM_QRPreviewClose = record
    Msg : Cardinal;
    Dummy : word;
    QRPrinter : TQRPrinter;
  end;

  TCM_QRPrint = TMessage;

  { TQRExportFilterLibrary }
  TQRExportFilterClass = class of TQRExportFilter;

  TQRExportFilterLibraryEntry = class
  private
    FExportFilterClass : TQRExportFilterClass;
    FName : string;
    FExtension : string;
  public
    property ExportFilterClass : TQRExportFilterClass read FExportFilterClass write FExportFilterClass;
    property FilterName : string read FName write FName;
    property Extension : string read FExtension write FExtension;
  end;

  TQRExportFilterLibrary = class
  private
    FFilterList : TList;
  protected
    function GetSaveDialogFilter : string;
  public
    constructor Create;
    destructor Destroy; override;
    procedure AddFilter(AFilter : TQRExportFilterClass);
    procedure RemoveFilter(AFilter : TQRExportFilterClass);
    property Filters : TList read FFilterList;
    property SaveDialogFilterString : string read GetSaveDialogFilter;
  end;

  { TQRStream }
  TQRStream = class(TStream)
  private
    FLock: TRTLCriticalSection;
    MemoryStream : TMemoryStream;
    FFilename : string;
    FileStream : TFileStream;
    FInMemory : boolean;
    FMemoryLimit : longint;
  public
    constructor Create(pMemoryLimit : Longint);
    constructor CreateFromFile(Filename : string);
    destructor Destroy; override;
    function Write(const Buffer; Count: Longint): Longint; override;
    function Seek(Offset: Longint; Origin: Word): Longint; override;
    function Read(var Buffer; Count: Longint): Longint; override;
    procedure LockStream;
    procedure UnlockStream;
    procedure SaveToStream(AStream : TStream);
    property InMemory : boolean read FInMemory;
  end;

  { TQRCompress }
  TQRCompress = class
  private
    BitPos : Byte;
    CompressFlag : Boolean;
    InByte : CodeType;
    Left, Right : TreeDownArray;
    OutByte : CodeType;
    Stream : TStream;
    Up : TreeUpArray;
    function GetByte : Byte;
    procedure InitializeSplay;
    procedure Splay(Plain : CodeType);
  public
    constructor Create(aStream : TStream; CompressData : boolean);
    destructor Destroy; override;
    procedure Expand(var Expanded : byte);
    procedure Compress(Plain : CodeType);
  end;

  { TQROutline }
  TQROutlineNode = record
    Caption : string[50];
    Level : integer;
    Rect : TRect;
    Page : integer;
    TreeNode : TTreeNode;
  end;

  PQROutlineNode = ^TQROutlineNode;

  TQROutline = class
  private
    NodeList : TList;
    FTreeNodes: TTreeNodes;
    procedure SetTreeNodes(const Value: TTreeNodes);
  public
    constructor Create;
    destructor Destroy; override;
    procedure AddNode(ACaption : string; ALevel : integer; ARect : TRect; APage : integer);
    procedure Clear;
    procedure FindPosition(ATreeNode : TTreeNode; var ARect : TRect; var APage : integer);
    procedure LoadFromStream(AStream : TStream);
    procedure SaveToStream(AStream : TStream);
    procedure UpdateTreeNodes;
    property TreeNodes : TTreeNodes read FTreeNodes write SetTreeNodes;
  end;

  { TQRPageList }
  TQRPageList = class
  private
    FLock: TRTLCriticalSection;
    aCompressor : TQRCompress;
    FCompression : boolean;
    FPageCount : integer;
    FStream : TQRStream;
    OutlineLines : TStrings;
    FQROutline : TQROutline;
    procedure SeekToFirst;
    procedure SeekToLast;
    procedure SeekToPage(PageNumber : integer);
    procedure ReadFileHeader;
    procedure WriteFileHeader;
  public
    constructor Create;
    destructor Destroy; override;
    function GetPage(PageNumber : integer) : TMetafile;
    procedure GetPageEx(PageNumber : integer; var AMetafile : TMetafile; var AHyperlinks : TList);
    procedure AddPage(aMetafile : TMetafile);
    procedure AddPageEx(aMetafile : TMetafile; AHyperlinks : TList);
    procedure AddOutline(Level : integer; Caption : string; Target : TRect; PageNumber : integer);
    procedure Clear;
    procedure Finish;
    procedure LoadFromFile(Filename : string);
    procedure LockList;
    procedure SaveToFile(Filename : string);
    procedure UnlockList;
    property Compression : boolean read FCompression write FCompression;
    property PageCount : integer read FPageCount;
    property Stream : TQRStream read FStream write FStream;
    property QROutline : TQROutline read FQROutline;
  end;

  { TQRPreviewInterface }
  TQRPreviewInterface = class(TComponent)
  public
    function Show(AQRPrinter : TQRPrinter) : TWinControl; virtual;
    function ShowModal(AQRPrinter : TQRPrinter) : TWinControl; virtual;
  end;

  TQRPreviewInterfaceClass = class of TQRPreviewInterface;

  TQRStandardPreviewInterface = class(TQRPreviewInterface)
  public
    function Show(AQRPrinter : TQRPrinter) : TWinControl; override;
    function ShowModal(AQRPrinter : TQRPrinter): TWinControl; override;
  end;

  { TQRPreviewImage }
  TQRZoomState = (qrZoomToFit,qrZoomToWidth,qrZoomOther);

  THyperlink = class
  public
    Area : TRect;
    Link : string;
    constructor Create (AArea : TRect; ALink : string);
  end;

  TQRHyperlinkEventType = (heCursorMoveOver, heCursorMoveAway, heGoto, heGotoNewWindow);

  TQRPreviewHyperlinkEvent = procedure (Sender : TObject; EventType : TQRHyperlinkEventType; Link : string; var Handled : boolean) of object;
  TQRPreviewImage = class(TGraphicControl)
  private
    FHyperlinks : TList;
    FQRPrinter : TQRPrinter;
    FPageNumber : integer;
    FMetafile : TMetafile;
    FOutline : TTreeNodes;
    FOnHyperlink : TQRPreviewHyperlinkEvent;
    FZoom : integer;
    FIsLink : boolean;
    FLastLink : string;
    function Hyperlink(X, Y : integer) : string;
    procedure PaintPage;
    procedure SetPageNumber(Value : integer);
    procedure FreeHyperlinks;
  protected
    procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    procedure SetIsLink(Value : boolean);
    property IsLink : boolean read FIsLink write SetIsLink;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Paint; override;
    function ImageOK : boolean;
    function HyperlinksOK : boolean;
    property PageNumber : integer read FPageNumber write SetPageNumber;
    property QRPrinter : TQRPrinter read FQRPrinter write FQRPrinter;
    property Metafile : TMetafile read FMetafile;
    property Hyperlinks : TList read FHyperlinks;
    property Outline : TTreeNodes read FOutline;
    property Zoom : integer read FZoom write FZoom;
    property OnHyperlink : TQRPreviewHyperlinkEvent read FOnHyperlink write FOnHyperlink;
  end;

  { TQRPreview }
  TQRProgressUpdateEvent = procedure (Sender : TObject; Progress : integer) of object;

  TQRPageAvailableEvent = procedure (Sender : TObject; PageNum : integer) of object;

  TQRPreview = Class(TScrollBox)
  private
    FOnPageAvailableEvent : TQRPageAvailableEvent;
    FOnProgressUpdateEvent : TQRProgressUpdateEvent;
    FPreviewImage : TQRPreviewImage;
    FPageNumber : integer;