quickrpt.pas

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

{ :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
  :: QuickReport 4.0 for Delphi and C++Builder               ::
  ::                                                         ::
  :: QUICKRPT.PAS - MAIN UNIT                                ::
  ::                                                         ::
  :: Copyright (c) 2001 A Lochert/QBS Software               ::
  :: All Rights Reserved                                     ::
  ::                                                         ::
  :: web: http://www.qusoft.com                              ::
  :: V4.00                                                   ::
  :: 12/12/2003 add composite export                         ::
  :: 14/12/2003 add frames export                            ::
  :: 20/12/2003 Transparent property for band                ::
  :: 20/12/2003 BackgroundImage property for TQuickrep       ::
  ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: }

{$I QRDEFS.INC}
{$define notLLIONPDF}
unit QuickRpt;                                             

interface

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

uses Windows, Classes, Controls, StdCtrls, Sysutils, Graphics, Buttons,
  Forms, ExtCtrls, Dialogs, Printers, DB, DBTables, QRPrntr, QR4Const,
 QRPrgres, QRExpr, QRExpbld{$ifdef LLIONPDF},PDF{$endif};

type
  { Forward declarations }
  TCustomQuickRep = class;
  TQRBasePanel = class;
  TQRCustomBand = class;
  TQRChildBand = class;
  TQRPrintable = class;
  TQRSubDetail = class;
  TQRNewComponentClass = class of TQRPrintable;

  { TQRController class }
  TQROnNeedDataEvent = procedure (Sender : TObject; var MoreData : Boolean) of object;
  TQRPrinterEvent = procedure( Sender : TObject; var Cancel : Boolean; DevMode : pointer ) of object;
  TQRNotifyOperation = (qrMasterDataAdvance, qrBandPrinted, qrBandSizeChange);

  TQRNotifyOperationEvent = procedure (Sender : TObject; Operation : TQRNotifyOperation) of object;

  TQRCustomController = class(TComponent)
  private
    OrgOwner : TComponent;
    FMaster : TComponent;
    PrintAfterList : TList;
    PrintBeforeList : TList;
    GroupList : TList;
    FPrintIfEmpty : boolean;
    FSelfCheck : TComponent;
    FParentReport : TCustomQuickRep;
    FPrintBefore : boolean;
    NotifyList : TList;
    EvConstant : TQREvElement;
    function CheckGroups : boolean;
    procedure CheckLastGroupFooters;
    procedure NewPageCheckGroups;
    procedure SetMaster(Value : TComponent);
  protected
    function LocalVarValue : TQREvResult; virtual;
    procedure AddAfter(aController : TQRCustomController);
    procedure AddBefore(aController : TQRCustomController);
    procedure BuildTree; virtual;
    procedure Execute; virtual;
    procedure NotifyClients(Operation : TQRNotifyOperation);
    procedure Prepare; virtual;
    procedure Unprepare; virtual;
    procedure PrintAfterControllers; virtual;
    procedure PrintBeforeControllers; virtual;
    procedure PrintEmptyController; virtual;
    procedure PrintGroupHeaders;
    procedure PrintGroupFooters;
    procedure RegisterBands; virtual;
    procedure RegisterDatasets; virtual;
    procedure SetPrintBefore(Value : boolean); virtual;
    procedure UpdateLocalVar; virtual;
  public
    constructor Create(AOwner : TComponent); override;
    destructor Destroy; override;
    procedure AddNotifyClient(Value : TQRPrintable);
    property Master : TComponent read FMaster write SetMaster;
    property ParentReport : TCustomQuickRep read FParentReport write FParentReport;
    property PrintBefore : boolean read FPrintBefore write SetPrintBefore;
    property PrintIfEmpty : boolean read FPrintIfEmpty write FPrintIfEmpty;
    property SelfCheck : TComponent read FSelfCheck write FSelfCheck;
  end;

  TQRController = class(TQRCustomController)
  private
    FDataSet : TDataSet;
    FDetail : TQRCustomBand;
    FFooter : TQRCustomBand;
    FHeader : TQRCustomBand;
    FOnNeedDataEvent : TQROnNeedDataEvent;
    FDetailNumber : integer;
    UpdateSQLParams : boolean;
    procedure SetDataSet(Value : TDataSet);
  protected
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    procedure Prepare; override;
    procedure PrintEmptyController; override;
    procedure RegisterBands; override;
    procedure RegisterDatasets; override;
    procedure Execute; override;
  public
    property DataSet : TDataSet read FDataSet write SetDataSet;
    property DetailNumber : integer read FDetailNumber;
    property Detail : TQRCustomBand read FDetail write FDetail;
    property Footer : TQRCustomband read FFooter write FFooter;
    property Header : TQRCustomBand read FHeader write FHeader;
    property OnNeedData : TQROnNeedDataEvent read FOnNeedDataEvent write FOnNeedDataEvent;
  end;

  { TQRFrame }
  TQRFrame = class(TPersistent)
  private
    FColor : TColor;
    FBottom : boolean;
    FLeft : boolean;
    FParent : TControl;
    FPenStyle : TPenStyle;
    FRight : boolean;
    FTop : boolean;
    FWidth : integer;
    procedure SetColor(Value : TColor);
    procedure SetParent(Value : TControl);
    procedure SetStyle(Value : TPenStyle);
    procedure SetValue(index : integer; Value : boolean);
    procedure SetWidth(Value : integer);
  protected
    procedure PaintIt(ACanvas : TCanvas; ARect : TRect; XFact, YFact : extended);
    procedure SetPen(aPen : TPen);
  public
    constructor Create;
    function AnyFrame : boolean;
    property Parent : TControl read FParent write SetParent;
  published
    property Color: TColor read FColor write SetColor;
    property DrawTop : boolean index 0 read FTop write SetValue;
    property DrawBottom : boolean index 1 read FBottom write SetValue;
    property DrawLeft : boolean index 2 read FLeft write SetValue;
    property DrawRight : boolean index 3 read FRight write SetValue;
    property Style: TPenStyle read FPenStyle write SetStyle default psSolid;
    property Width: Integer read FWidth write SetWidth default 1;
  end;

  { TQRUnitBase - Base class for positioning objects with multiple units support }
  TQRUnit =(MM, Inches, Pixels, Characters, Native);

  TQRUnitBase = class(TPersistent)
  private
    FResolution : integer;
    FUnits : TQRUnit;
    SavedUnits : TQRUnit;
    FParentReport : TCustomQuickRep;
    FParentUpdating : boolean;
    FZoom : integer;
    function LoadUnit(Value : extended; aUnit : TQRUnit; Horizontal : boolean) : extended; virtual;
    function SaveUnit(Value : extended; aUnit : TQRUnit; Horizontal : boolean) : extended; virtual;
  protected
    function GetUnits : TQRUnit; virtual;
    procedure DefineProperties(Filer: TFiler); override;
    procedure Loaded; virtual;
    procedure ReadValues(Reader : TReader); virtual;
    procedure SetParentSizes; virtual;
    procedure SetUnits(Value : TQRUnit); virtual;
    procedure WriteValues(Writer : TWriter); virtual;
    procedure SetPixels;
    procedure RestoreUnit;
  public
    constructor Create;
    property ParentReport : TCustomQuickRep read FParentReport write FParentReport;
    property ParentUpdating : boolean read FParentUpdating write FParentUpdating;
    property Resolution : integer read FResolution;
    property Units : TQRUnit read GetUnits write SetUnits;
    property Zoom : integer read FZoom write FZoom;
  end;

  { TQRBandSize - Object for storing band size information }
  TQRBandSize = class(TQRUnitBase)
  private
    FWidth : extended;
    FLength : extended;
    Parent : TQRCustomBand;
    function GetValue(Index : integer): extended;
    procedure SetValue(Index : integer; Value : extended);
  protected
    procedure ReadValues(Reader : TReader); override;
    procedure SetParentSizes; override;
    procedure WriteValues(Writer : TWriter); override;
    procedure FixZoom;
  public
    constructor Create(AParent : TQRCustomBand);
    property Length : extended index 0 read GetValue write SetValue stored false;
  published
    { All properties are stored by the WriteValues method }
    property Height : extended index 0 read GetValue write SetValue stored false;
    property Width : extended index 1 read GetValue write SetValue stored false;
  end;

  { TQRPage - Object for storing page layout information }
  TQRPrintOrder = (ColByCol, RowByRow);

  TQRPage = class(TQRUnitBase)
  private
    FBottomMargin : extended;
    FColumnSpace : extended;
    FColumns : integer;
    FLeftMargin : extended;
    FLength : extended;
    FOrientation : TPrinterOrientation;
    FPaperSize : TQRPaperSize;
    FPrintOrder : TQRPrintOrder;
    FRightMargin : extended;
    FRuler : boolean;
    FTopMargin : extended;
    FWidth : extended;
    Parent : TCustomQuickRep;
    function GetPaperSize : TQRPaperSize;
    function GetRuler : boolean;
    function GetValue(Index : integer): extended;
    procedure SetColumns(Value : integer);
    procedure SetOrientation(Value : TPrinterOrientation);
    procedure SetPaperSize(Value : TQRPaperSize);
    procedure SetPrintOrder(Value : TQRPrintOrder);
    procedure SetRuler(Value : boolean);
    procedure SetValue(Index : integer; Value : extended);
    property PrintOrder : TQRPrintOrder read FPrintOrder write SetPrintOrder;
  protected
    procedure ReadValues(Reader : TReader); override;
    procedure SetParentSizes; override;
    procedure SetUnits(Value : TQRUnit); override;
    procedure WriteValues(Writer : TWriter); override;
    procedure FixZoom;
  public
    constructor Create(AParent : TCustomQuickRep);
  published
    { All the extended properties are stored by the WriteValues method }
    property BottomMargin : extended index 0 read GetValue write SetValue stored false;
    property ColumnSpace : extended index 6 read GetValue write SetValue stored false;
    property Columns : integer read FColumns write SetColumns;
    property LeftMargin : extended index 4 read GetValue write SetValue stored false;
    property Length : extended index 1 read GetValue write SetValue stored false;
    property Orientation : TPrinterOrientation read FOrientation write SetOrientation;
    property PaperSize : TQRPaperSize read GetPaperSize write SetPaperSize;
    property RightMargin : extended index 5 read GetValue write SetValue stored false;
    property Ruler : boolean read GetRuler write SetRuler default true;
    property TopMargin : extended index 2 read GetValue write SetValue stored false;
    property Width : extended index 3 read GetValue write SetValue stored false;
  end;

  { TQRBasePanel }
  TQRBasePanel = class(TCustomPanel)
  private
    FFontSize : integer;
    FZoom : integer;
    FFrame : TQRFrame;
    function GetFrame : TQRFrame;
    procedure SetFrame(Value : TQRFrame);
  protected
    procedure SetZoom(Value : integer); virtual;
    procedure Paint; override;
    procedure PaintRuler(Units : TQRUnit); virtual;
    procedure PrepareComponents;
    procedure UnprepareComponents;
    procedure CreateParams(var Params: TCreateParams); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    property Zoom : integer read FZoom write SetZoom;
    property FontSize : integer read FFontSize write FFontSize;
  published
    property Frame : TQRFrame read GetFrame write SetFrame;
  end;

  { TQRCustomBand }
  TQRBandBeforePrintEvent = procedure (Sender : TQRCustomBand; var PrintBand : Boolean) of object;

  TQRBandAfterPrintEvent = procedure (Sender : TQRCustomBand; BandPrinted : Boolean) of object;

  TQRCustomBand = class(TQRBasePanel)
  private
    FPreCaluculateBandHeight : boolean;
    FKeepOnOnePage : boolean;
    FExpandedHeight : extended;
    BandFrameRect : TRect;
    ButtonDown : boolean;
    FExpanded : extended;
    FAfterPrintEvent : TQRBandAfterPrintEvent;
    FAlignToBottom : boolean;
    FBeforePrintEvent : TQRBandBeforePrintEvent;
    FEnabled : boolean;
    FForceNewColumn : boolean;
    FForceNewPage : boolean;
    FLinkBand : TQRCustomBand;
    FParentReport : TCustomQuickRep;
    FParentUpdating : boolean;
    FTransparentBand : boolean;
    FQRBandType : TQRBandType;
    LoadedHeight : integer;
    FSize : TQRBandSize;
    FNotifyController : TQRCustomController;
    procedure SetLinkBand(Value : TQRCustomBand);
    function GetBandSize : TQRBandSize;
    function GetHasChild : boolean;
    function GetChild : TQRChildBand;
    procedure SetBandType(Value : TQRBandType);
    procedure SetHasChild(Value : boolean);
  protected
    function GetUnits : TQRUnit;
    function StretchHeight(IncludeNext : boolean) : extended;
    function BandTypeName : string; virtual;
    function BandComponentName : string; virtual;
    procedure AdvancePaper;
    procedure Loaded; override;
    procedure MakeSpace;
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    procedure Paint; override;
    procedure PaintRuler(Units : TQRUnit); override;
    procedure Print;
    procedure SetParent(AParent: TWinControl); override;
    procedure SetParentReport(AParentReport : TCustomQuickRep); virtual;
    procedure SetBandSize(Value : TQRBandSize);
    procedure SetEnabled(Value : boolean); override;
    procedure SetUnits(Value : TQRUnit);
    procedure SetZoom(Value : integer); override;
    procedure WriteDummy(Writer : TWriter); virtual;
    property NotifyController : TQRCustomController read FNotifyController write FNotifyController;
    property ParentUpdating : boolean read FParentUpdating write FParentUpdating;
    property Units : TQRUnit read GetUnits write SetUnits;
  public
    constructor Create(AOwner : TComponent); override;
    destructor Destroy; override;
    procedure SetBounds(ALeft, ATop, AWidth, AHeight: integer); override;
    function AddPrintable(PrintableClass : TQRNewComponentClass) : TQRPrintable;
    function CanExpand(Value : extended) : boolean;
    function ExpandBand(Value : extended; var NewExpanded : extended; var HasExpanded : boolean): boolean;
    property Expanded : extended read FExpanded;
    property BandType : TQRBandType read FQRBandType write SetBandType;
    property ChildBand : TQRChildBand read GetChild;
    property ParentReport : TCustomQuickRep read FParentReport write SetParentReport;
    procedure ExpandedHeight( var NewHeight : extended );
  published
    property AfterPrint : TQRBandAfterPrintEvent read FAfterPrintEvent write FAfterPrintEvent;
    property AlignToBottom : boolean read FAlignToBottom write FAlignToBottom;
    property BeforePrint : TQRBandBeforePrintEvent read FBeforePrintEvent write FBeforePrintEvent;
    property Color;
    property Enabled : boolean read FEnabled write SetEnabled default true;
    property TransparentBand : boolean read FTransparentBand write FTransparentBand;
    property Font;
    property ForceNewColumn : boolean read FForcenewColumn write FForceNewColumn;
    property ForceNewPage : boolean read FForceNewPage write FForceNewPage;
    property HasChild : boolean read GetHasChild write SetHasChild stored false;
    property LinkBand : TQRCustomBand read FLinkBand write SetLinkBand;
    property ParentFont;
    property Size : TQRBandSize read GetBandSize write SetBandSize;
    property PreCaluculateBandHeight : boolean  read FPreCaluculateBandHeight write FPreCaluculateBandHeight;
    property KeepOnOnePage : boolean  read FKeepOnOnePage write FKeepOnOnePage;
  end;

  { TQRBand }
  TQRBand = class(TQRCustomBand)
  published