rm_class.pas

report machine 2.3 功能强大

    FLastBand: TRMBand;
    FColPos, FCurPos: Integer;
    FWasBand: TRMBand;
    FDisableRepeatHeader: Boolean;
    //WHF Add
    FAggrList: TList;
    FDrawRepeatHeader: Boolean;
    FFirstTime: Boolean;

    procedure SetpgMargins(aValue: TRect);
    procedure InitPage;
    procedure DonePage;
    procedure TossObjects;
    procedure PrepareObjects;
    procedure PrepareAggrObjects; //计算字段
    procedure FormPage; //打印主程序
    procedure AddRecord(b: TRMBand; rt: TRMBandRecType);
    procedure ClearRecList;
    function PlayRecList: Boolean;
    procedure DrawPageFooters(aLastPage: Boolean);
    procedure DrawColumnFooter;
    function BandExists(b: TRMBand): Boolean;
    procedure AfterPrint;
    procedure LoadFromStream(Stream: TStream);
    procedure SaveToStream(Stream: TStream);
    procedure ShowBand(b: TRMBand);
    function LeftOffset: Integer;
    procedure DoScript(Script: TStrings);
    procedure DialogFormActivate(Sender: TObject);
    procedure ResetPosition(b: TRMBand; ResetTo: Integer);

    procedure DoDetailHeaderAggrs(b: TRMBand);
    procedure DoGroupHeaderAggrs(aGroupHeader: TRMBand);
  protected
    FbkPicture: TPicture;
    procedure SetPropValue(Index: string; Value: Variant); override;
    function GetPropValue(Index: string): Variant; override;
    function DoMethod(const MethodName: string; Par1, Par2, Par3: Variant): Variant; override;
  public
    Name: string;
    pgSize, pgWidth, pgHeight: Integer;
    pgOr: TPrinterOrientation;
    pgBin: integer;
    PrintToPrevPage, UseMargins: WordBool;
    PrnInfo: TRMPrnInfo;
    ColCount, ColWidth, ColGap: Integer;
    PageType: TRMPageType;
    Objects: TList;
    CurY, CurBottomY: Integer;
    // dialog properties
    BorderStyle: Byte;
    Caption: string;
    Color: TColor;
    Left, Top, Width, Height: Integer;
    Position: Byte;
    Form: TForm;
    Script: TStringList;
    Visible: Boolean;
    bkPictureLeft, bkPictureTop: Integer;
    bkPictureWidth, bkPictureHeight: Integer;
    PageNumber: Integer;
    constructor Create(ASize, AWidth, AHeight, ABin: integer; AOr: TPrinterOrientation); virtual;
    destructor Destroy; override;
    procedure DefineProperties; override;
    procedure CreateUniqueName;
    function TopMargin: Integer;
    function BottomMargin: Integer;
    function LeftMargin: Integer;
    function RightMargin: Integer;
    procedure Clear;
    procedure Delete(Index: Integer);
    function FindObjectByID(ID: Integer): Integer;
    function FindObject(Name: string): TRMView;
    procedure ChangePaper(ASize, AWidth, AHeight, ABin: Integer; AOr: TPrinterOrientation);
    procedure ShowBandByName(s: string);
    procedure ShowBandByType(bt: TRMBandType);
    procedure NewPage;
    procedure NewColumn(Band: TRMBand);
    procedure ScriptEditor(Sender: TObject);
    procedure SetbkPicture(aGraphic: TGraphic);

    property CanDisableControls: Boolean read FCanDisableControls;
    property pgMargins: TRect read FpgMargins write SetpgMargins;
  end;

  { TRMPages }
  TRMPages = class(TObject)
  private
    FPages: TList;
    FParent: TRMReport;
    function GetCount: Integer;
    function GetPages(Index: Integer): TRMPage;
    procedure RefreshObjects;
    procedure MakeTmpObjects;
  public
    constructor Create(AParent: TRMReport);
    destructor Destroy; override;
    procedure Clear;
    function Add: TRMPage;
    procedure Delete(Index: Integer);
    procedure Move(OldIndex, NewIndex: Integer);
    procedure LoadFromStream(Stream: TStream);
    procedure SaveToStream(Stream: TStream);
    property Pages[Index: Integer]: TRMPage read GetPages; default;
    property Count: Integer read GetCount;
  end;

  TRMBkPicture = class
  private
    FLeft, FTop: Integer;
    FWidth, FHeight: Integer;
    FPicture: TPicture;
  public
    constructor Create(aLeft, aTop, aWidth, aHeight: Integer; aPic: TPicture);
    destructor Destroy; override;

    property Left: Integer read FLeft;
    property Top: Integer read FTop;
    property Width: Integer read FWidth;
    property Height: Integer read FHeight;
    property Picture: TPicture read FPicture;
  end;

  { TRMEMFPages }
  TRMEMFPages = class(TObject)
  private
    FPages: TList;
    FParent: TRMReport;
    FbkPictures: TList;
    function GetCount: Integer;
    function GetPages(Index: Integer): PRMPageInfo;
    procedure ExportData(Index: Integer);
    procedure ObjectsToPage(Index: Integer);
    procedure AddbkPicture(aLeft, aTop, aWidth, aHeight: Integer; aPicture: TPicture);
    function GetbkPicture(Index: Integer): TRMBkPicture;
  public
    constructor Create(AParent: TRMReport);
    destructor Destroy; override;
    procedure Clear;
    procedure Draw(Index: Integer; Canvas: TCanvas; DrawRect: TRect);
    procedure Add(APage: TRMPage);
    procedure AddFrom(aReport: TRMReport);
    procedure InsertFromPageInfo(Index: Integer; APageInfo: TRMPageInfo);
    procedure Insert(Index: Integer; APage: TRMPage);
    procedure Delete(Index: Integer);
    procedure LoadFromStream(AStream: TStream);
    procedure SaveToStream(AStream: TStream);
    procedure PageToObjects(Index: Integer);
    function DoClick(Index: Integer; pt: TPoint; Click: Boolean; var Cursor: TCursor): Boolean;

    property Pages[Index: Integer]: PRMPageInfo read GetPages; default;
    property Count: Integer read GetCount;
    property bkPictures[Index: Integer]: TRMbkPicture read GetbkPicture;
  end;

  { TRMDataDictionary }
  TRMDataDictionary = class(TObject)
  private
    FVersion: Integer;
    FCache: TStringList;
    function GetValue(const VarName: string): Variant;
    function GetRealFieldName(const ItemName: string): string;
    function GetRealDataSetName(const ItemName: string): string;
    function GetRealDataSourceName(const ItemName: string): string;
    function GetAliasName(const ItemName: string): string;
    procedure AddCacheItem(const index: string; ADataSet: TDataSet; const ADataField: string);
    procedure ClearCache;
  public
    Variables: TRMVariables;
    FieldAliases: TRMVariables;
    BandDatasources: TRMVariables;
    DisabledDatasets: TStringList;
    constructor Create;
    destructor Destroy; override;
    procedure Clear;
    procedure LoadFromStream(Stream: TStream);
    procedure SaveToStream(Stream: TStream);
    procedure LoadFromFile(AFileName: string);
    procedure SaveToFile(AFileName: string);
    procedure ExtractFieldName(const ComplexName: string; var DSName, FieldName: string);
    function IsVariable(const VarName: string): Boolean;
    function DatasetEnabled(const DatasetName: string): Boolean;
    procedure GetDatasetList(List: TStrings);
    procedure GetFieldList(DSName: string; List: TStrings);
    procedure GetBandDatasourceList(List: TStrings);
    procedure GetCategoryList(List: TStrings);
    procedure GetVariablesList(const Category: string; List: TStrings);
    property Value[const Index: string]: Variant read GetValue;
    property RealDataSetName[const Index: string]: string read GetRealDataSetName;
    property RealDataSourceName[const Index: string]: string read GetRealDataSourceName;
    property RealFieldName[const Index: string]: string read GetRealFieldName;
    property AliasName[const Index: string]: string read GetAliasName;
  end;

  TRMReportSaveEvent = procedure(var Saved: Boolean) of object;

  { TRMReport }
  TRMReport = class(TComponent)
  private
    FPages: TRMPages;
    FEMFPages: TRMEMFPages;
    FDictionary: TRMDataDictionary;
    FDataset: TRMDataset;
    FReportType: TRMReportType;
    FTitle: string;
    FShowProgress: Boolean;
    FModalPreview: Boolean;
    FModifyPrepared: Boolean;
    FStoreInDFM: Boolean;
    FPreview: TRMPreview;
    FPreviewButtons: TRMPreviewButtons;
    FInitialZoom: TRMPreviewZoom;
    FOnBeginDoc: TRMBeginDocEvent;
    FOnEndDoc: TRMEndDocEvent;
    FOnBeginPage: TRMBeginPageEvent;
    FOnEndPage: TRMEndPageEvent;
    FOnBeginBand: TRMBeginBandEvent;
    FOnCrossBeginDoc: TRMBeginDocEvent;
    FOnEndBand: TRMEndBandEvent;
    FOnGetValue: TRMDetailEvent;
    FOnEnterRect: TRMEnterRectEvent;
    FOnAfterPrint: TRMAfterPrintEvent;
    FOnProgress: TRMProgressEvent;
    FOnFunction: TFunctionEvent;
    FOnBeginColumn: TRMBeginColumnEvent;
    FOnPrintColumn: TRMPrintColumnEvent;
    FOnManualBuild: TRMManualBuildEvent;
    FObjectClick: TRMObjectClickEvent;
    FMouseOverObject: TRMMouseOverObjectEvent;
    FOnPrintReportEvent: TRMPrintReportEvent;
    FOnBeforePrintBand: TRMBeforePrintBandEvent;
    FOnCustomizeObject: TNotifyEvent;
    FCurrentFilter: TRMExportFilter;
    FPageNumbers: string;
    FCopies: Integer;
    FCollate: Boolean;
    FPrintPages: TRMPrintPages;
    FCurPage: TRMPage;
    _DoublePass: Boolean;
    FMDIPreview: Boolean;
    FDefaultCopies: Integer;
    FDefaultCollate: Boolean;
    FPrnName: string;
    FDFMStream: TStream;
    FPrintIfEmpty: Boolean;
    FShowPrintDialog: Boolean;
    FOnAfterPreviewPageSetup: TNotifyEvent;

    procedure BuildBeforeModal(Sender: TObject);
    procedure ExportBeforeModal(Sender: TObject);
    procedure PrintBeforeModal(Sender: TObject);
    function DoPrepareReport: Boolean;
    procedure DoBuildReport; virtual;
    procedure GetIntrpValue(const Name: string; var Value: Variant);
    procedure GetIntrpFunction(const Name: string; p1, p2, p3: Variant; var Val: Variant);
  protected
    UseScale: Boolean;
    Scale: Integer;
    PageSize, PageWidth, PageHeight: Integer;

    FOnSaveReport: TRMReportSaveEvent;
    FFlag_Taoda: Boolean;
    HVersion, LVersion: Byte;
    procedure CalcScaleXY;
    procedure SetPrinterTo(PrnName: string);
    procedure DefineProperties(Filer: TFiler); override;
    procedure ReadBinaryData(Stream: TStream);
    procedure WriteBinaryData(Stream: TStream);
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    procedure DoPrintReport(PageNumbers: string; Copies: Integer; //打印报表
      Collate: Boolean; PrintPages: TRMPrintPages); virtual;
    procedure Loaded; override;
    property OnAfterPreviewPageSetup: TNotifyEvent read FOnAfterPreviewPageSetup write FOnAfterPreviewPageSetup;
  public
    CanRebuild: Boolean; // true, if report can be rebuilded
    Terminated: Boolean;
    PrintToDefault, DoublePass: WordBool;
    FinalPass: Boolean;
    FileName: string;
    Modified, ComponentModified: Boolean;
    MixVariablesAndDBFields: Boolean;
    Taoda: Boolean;
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Clear;
    // internal events used through report building
    procedure InternalOnEnterRect(Memo: TStringList; View: TRMView);
    procedure InternalOnAfterPrint(const View: TRMView);
    procedure InternalOnExportData(View: TRMView);
    procedure InternalOnExportText(DrawRect: TRect; x, y: Integer;
      const text: string; FrameTyp: Integer; View: TRMView);
    procedure InternalOnGetValue(ParName: string; var ParValue: string);
    procedure InternalOnProgress(Percent: Integer);
    procedure InternalOnBeginColumn(Band: TRMBand);
    procedure InternalOnPrintColumn(ColNo: Integer; var ColWidth: Integer);
    procedure InternalOnBeforePrintBand(Band: TRMBand; var PrintBand: Boolean);
    procedure GetVariableValue(const s: string; var v: Variant);
    procedure OnGetParsFunction(const name: string; p1, p2, p3: Variant; var val: Variant);
    function FindObject(Name: string): TRMView;
    // load/save methods
    procedure LoadFromStream(Stream: TStream);
    procedure SaveToStream(Stream: TStream);
    function LoadFromFile(FName: string): Boolean;
    procedure SaveToFile(FName: string);
    procedure LoadFromDB(Table: TDataSet; DocN: Integer);
    procedure SaveToDB(Table: TDataSet; DocN: Integer);
    procedure SaveToBlobField(Blob: TField);
    procedure LoadFromBlobField(Blob: TField);
    procedure LoadFromResourceName(Instance: THandle; const ResName: string);
    procedure LoadFromResourceID(Instance: THandle; ResID: Integer);
    procedure LoadTemplate(fname: string; comm: TStrings; Bmp: TBitmap; Load: Boolean);
    procedure SaveTemplate(var fname: string; comm: TStrings; Bmp: TBitmap);
    procedure LoadPreparedReport(FName: string);
    procedure SavePreparedReport(FName: string);
    // report manipulation methods
    function DesignReport: TModalResult;
    function PrepareReport: Boolean;
    procedure ExportTo(Filter: TRMExportFilter; const FileName: string);
    procedure ShowReport;
    procedure PrintReport;
    procedure EditPreparedReport(PageIndex: Integer);
    function DesignPreviewedReport: Boolean;
    procedure ShowPreparedReport;
    procedure PrintPreparedReportDlg;
    procedure PrintPreparedReport(aPageNumbers: string; aCopies: Integer;
      aCollate: Boolean; aPrintPages: TRMPrintPages);
    function ChangePrinter(OldIndex, NewIndex: Integer): Boolean;

    property PrinterName: string read FPrnName write FPrnName;
    property Pages: TRMPages read FPages;
    property EMFPages: TRMEMFPages read FEMFPages write FEMFPages;
    property Dictionary: TRMDataDictionary read FDictionary write FDictionary;
    property OnCrossBeginDoc: TRMBeginDocEvent read FOnCrossBeginDoc write FOnCrossBeginDoc;
  published
    property Dataset: TRMDataset read FDataset write FDataset;
    property DefaultCopies: Integer read FDefaultCopies write FDefaultCopies default 1;
    property DefaultCollate: Boolean read FDefaultCollate write FDefaultCollate default True;
    property InitialZoom: TRMPreviewZoom read FInitialZoom write FInitialZoom;
    property MDIPreview: Boolean read FMDIPreview write FMDIPreview default False;
    property ModalPreview: Boolean read FModalPreview write FModalPreview default True;
    property ModifyPrepared: Boolean read FModifyPrepared write FModifyPrepared default False;
    property Preview: TRMPreview read FPreview write FPreview;
    property PreviewButtons: TRMPreviewButtons read FPreviewButtons write FPreviewButtons;
    property PrintIfEmpty: Boolean read FPrintIfEmpty write FPrintIfEmpty default False;
    property ReportType: TRMReportType read FReportType write FReportType default rtSimple;
    property ShowProgress: Boolean read FShowProgress write FShowProgress default True;
    property StoreInDFM: Boolean read FStoreInDFM write FStoreInDFM default False;
    property Title: string read FTitle write FTitle;
    property ShowPrintDialog: Boolean read FShowPrintDialog write FShowPrintDialog default True;
    property OnBeginDoc: TRMBeginDocEvent read FOnBeginDoc write FOnBeginDoc;
    property OnEndDoc: TRMEndDocEvent read FOnEndDoc write FOnEndDoc;
    property OnBeginPage: TRMBeginPageEvent read FOnBeginPage write FOnBeginPage;
    property OnEndPage: TRMEndPageEvent read FOnEndPage write FOnEndPage;
    property OnBeginBand: TRMBeginBandEvent read FOnBeginBand write FOnBeginBand;
    property OnEndBand: TRMEndBandEvent read FOnEndBand write FOnEndBand;
    property OnGetValue: TRMDetailEvent read FOnGetValue write FOnGetValue;
    property OnBeforePrint: TRMEnterRectEvent read FOnEnterRect write FOnEnterRect;
    property OnAfterPrint: TRMAfterPrintEvent read FOnAfterPrint write FOnAfterPrint;
    property OnUserFunction: TFunctionEvent read FOnFunction write FOnFunction;
    property OnProgress: TRMProgressEvent read FOnProgress write FOnProgress;
    property OnBeginColumn: TRMBeginColumnEvent read FOnBeginColumn write FOnBeginColumn;
    property OnPrintColumn: TRMPrintColumnEvent read FOnPrintColumn write FOnPrintColumn;
    property OnManualBuild: TRMManualBuildEvent read FOnManualBuild write FOnManualBuild;
    property OnObjectClick: TRMObjectClickEvent read FObjectClick write FObjectClick;
    property OnMouseOverObject: TRMMouseOverObjectEvent read FMouseOverObject write FMouseOverObject;
    property OnPrintReport: TRMPrintReportEvent read FOnPrintReportEvent write FOnPrintReportEvent;
    property OnBeforePrintBand: TRMBeforePrintBandEvent read FOnBeforePrintBand write FOnBeforePrintBand;
    property OnCustomizeObject: TNotifyEvent read FOnCustomizeObject write FOnCustomizeObject;
  end;

  { TRMCompositeReport }
  TRMCompositeReport = class(TRMReport)
  private
    procedure DoBuildReport; override;
  public
    Reports: TList;