fr_class.pas

FASTREPORT报表工具,可以迅速制作报表.

    ChildBand, Master: String;
    Columns: Integer;
    ColumnWidth: Integer;
    ColumnGap: Integer;
    NewColumnAfter: Integer;
    constructor Create; override;
    procedure Draw(Canvas: TCanvas); override;
    procedure LoadFromStream(Stream: TStream); override;
    procedure SaveToStream(Stream: TStream); override;
    procedure DefinePopupMenu(Popup: TPopupMenu); override;
    procedure DefineProperties; override;
    function GetClipRgn(rt: TfrRgnType): HRGN; override;
    property BandType: TfrBandType read GetBandType write SetBandType;
    property DataSet: String read FormatStr write FormatStr;
    property GroupCondition: String read FormatStr write FormatStr;
  end;

  TfrSubReportView = class(TfrView)
  public
    SubPage: Integer;
    constructor Create; override;
    procedure Draw(Canvas: TCanvas); override;
    procedure LoadFromStream(Stream: TStream); override;
    procedure SaveToStream(Stream: TStream); override;
    procedure DefinePopupMenu(Popup: TPopupMenu); override;
  end;

  TfrPictureView = class(TfrView)
  private
    procedure P1Click(Sender: TObject);
    procedure P2Click(Sender: TObject);
  protected
    procedure SetPropValue(Index: String; Value: Variant); override;
    function GetPropValue(Index: String): Variant; override;
    function DoMethod(MethodName: String; Par1, Par2, Par3: Variant): Variant; override;
    procedure GetBlob(b: TfrTField); override;
  public
    Picture: TPicture;
    BlobType: Byte;
    constructor Create; override;
    destructor Destroy; override;
    procedure Draw(Canvas: TCanvas); override;
    procedure LoadFromStream(Stream: TStream); override;
    procedure SaveToStream(Stream: TStream); override;
    procedure DefinePopupMenu(Popup: TPopupMenu); override;
    procedure DefineProperties; override;
    procedure ShowEditor; override;
  end;

  TfrLineView = class(TfrStretcheable)
  public
    constructor Create; override;
    procedure Draw(Canvas: TCanvas); override;
    function CalcHeight: Integer; override;
    function MinHeight: Integer; override;
    function LostSpace: Integer; override;
    function GetClipRgn(rt: TfrRgnType): HRGN; override;
    procedure DefineProperties; override;
  end;

  TfrBand = class(TObject)
  private
    Parent: TfrPage;
    View: TfrBandView;
    Flags: Word;
    Next, Prev: TfrBand;
    NextGroup, PrevGroup: TfrBand;
    FirstGroup, LastGroup: TfrBand;
    Child: TfrBand;
    AggrBand: TfrBand;
    SubIndex, MaxY: Integer;
    EOFReached: Boolean;
    EOFArr: Array[0..31] of Boolean;
    Positions: Array[TfrDatasetPosition] of Integer;
    LastGroupValue: Variant;
    HeaderBand, FooterBand, DataBand, LastBand: TfrBand;
    Values: TfrVariables;
    Count: Integer;
    DisableInit: Boolean;
    CalculatedHeight: Integer;
    CurColumn: Integer;
    SaveXAdjust: Integer;
    SaveCurY: Boolean;
    MaxColumns: Integer;
    DisableBandScript: Boolean;
    procedure InitDataSet(Desc: String);
    procedure FreeDataSet;
    function CalcHeight: Integer;
    procedure StretchObjects(MaxHeight: Integer);
    procedure UnStretchObjects;
    procedure DrawObject(t: TfrView);
    procedure PrepareSubReports;
    procedure DoSubReports;
    function DrawObjects: Boolean;
    procedure DrawCrossCell(Parnt: TfrBand; CurX: Integer);
    procedure DrawCross;
    function CheckPageBreak(y, dy: Integer; PBreak: Boolean): Boolean;
    procedure DrawPageBreak;
    function HasCross: Boolean;
    function DoCalcHeight: Integer;
    procedure DoDraw;
    function Draw: Boolean;
    procedure InitValues;
    procedure DoAggregate;
    function ExtractField(const s: String; FieldNo: Integer): String;
    procedure AddAggregateValue(s: String; v: Variant);
    function GetAggregateValue(s: String): Variant;
  public
    x, y, dx, dy, maxdy: Integer;
    Typ: TfrBandType;
    Name: String;
    PrintIfSubsetEmpty, NewPageAfter, Stretched, PageBreak,
    PrintChildIfInvisible, Visible: Boolean;
    Objects: TList;
    Memo, Script: TStringList;
    DataSet: TfrDataSet;
    IsVirtualDS: Boolean;
    VCDataSet: TfrDataSet;
    IsVirtualVCDS: Boolean;
    GroupCondition: String;
    CallNewPage, CallNewColumn: Integer;
    constructor Create(ATyp: TfrBandType; AParent: TfrPage);
    destructor Destroy; override;
  end;

  TfrPage = class(TfrObject)
  private
    Bands: Array[TfrBandType] of TfrBand;
    Skip, InitFlag: Boolean;
    CurColumn, LastStaticColumnY, XAdjust: Integer;
    List: TList;
    Mode: TfrPageMode;
    PlayFrom: Integer;
    LastBand: TfrBand;
    ColPos, CurPos: Integer;
    WasBand: TfrBand;
    DisableRepeatHeader: Boolean;
    procedure InitPage;
    procedure DonePage;
    procedure TossObjects;
    procedure PrepareObjects;
    procedure FormPage;
    procedure AddRecord(b: TfrBand; rt: TfrBandRecType);
    procedure ClearRecList;
    function PlayRecList: Boolean;
    procedure DrawPageFooters;
    function BandExists(b: TfrBand): Boolean;
    procedure AfterPrint;
    procedure LoadFromStream(Stream: TStream);
    procedure SaveToStream(Stream: TStream);
    procedure ShowBand(b: TfrBand);
    function LeftOffset: Integer;
    procedure DoScript(Script: TStrings);
    procedure DialogFormActivate(Sender: TObject);
    procedure ResetPosition(b: TfrBand; ResetTo: Integer);
  protected
    procedure SetPropValue(Index: String; Value: Variant); override;
    function GetPropValue(Index: String): Variant; override;
  public
    pgSize, pgWidth, pgHeight: Integer;
    pgMargins: TRect;
    pgOr: TPrinterOrientation;
    pgBin: Integer;
    PrintToPrevPage, UseMargins: WordBool;
    PrnInfo: TfrPrnInfo;
    ColCount, ColWidth, ColGap: Integer;
    PageType: TfrPageType;
    Objects: TList;
    CurY, CurBottomY: Integer;
    Name: String;
    // dialog properties
    BorderStyle: Byte;
    Caption: String;
    Color: TColor;
    Left, Top, Width, Height: Integer;
    Position: Byte;
    Form: TForm;
    Script: TStringList;
    Visible: Boolean;
    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): TfrView;
    procedure ChangePaper(ASize, AWidth, AHeight, ABin: Integer; AOr: TPrinterOrientation);
    procedure ShowBandByName(s: String);
    procedure ShowBandByType(bt: TfrBandType);
    procedure NewPage;
    procedure NewColumn(Band: TfrBand);
    procedure ScriptEditor(Sender: TObject);
  end;

  TfrPages = class(TObject)
  private
    FPages: TList;
    Parent: TfrReport;
    function GetCount: Integer;
    function GetPages(Index: Integer): TfrPage;
    procedure RefreshObjects;
  public
    constructor Create(AParent: TfrReport);
    destructor Destroy; override;
    procedure Clear;
    procedure Add;
    procedure Delete(Index: Integer);
    procedure Move(OldIndex, NewIndex: Integer);
    procedure LoadFromStream(Stream: TStream);
    procedure SaveToStream(Stream: TStream);
    property Pages[Index: Integer]: TfrPage read GetPages; default;
    property Count: Integer read GetCount;
  end;

  TfrEMFPages = class(TObject)
  private
    FPages: TList;
    Parent: TfrReport;
    function GetCount: Integer;
    function GetPages(Index: Integer): PfrPageInfo;
    procedure ExportData(Index: Integer);
    procedure PageToObjects(Index: Integer);
    procedure ObjectsToPage(Index: Integer);
  public
    constructor Create(AParent: TfrReport);
    destructor Destroy; override;
    procedure Clear;
    procedure Draw(Index: Integer; Canvas: TCanvas; DrawRect: TRect);
    procedure Add(APage: TfrPage);
    procedure AddFrom(Report: TfrReport);
    procedure Insert(Index: Integer; APage: TfrPage);
    procedure Delete(Index: Integer);
    procedure LoadFromStream(AStream: TStream);
    procedure SaveToStream(AStream: TStream);
    function DoClick(Index: Integer; pt: TPoint; Click: Boolean; var Cursor: TCursor): Boolean;
    property Pages[Index: Integer]: PfrPageInfo read GetPages; default;
    property Count: Integer read GetCount;
    property List: TList read FPages write FPages;
  end;

  PfrCacheItem = ^TfrCacheItem;
  TfrCacheItem = record
    DataSet: TfrTDataSet;
    DataField: String;
  end;

  TfrDataDictionary = class(TObject)
  private
    Cache: TStringList;
    function GetValue(VarName: String): Variant;
    function GetRealFieldName(ItemName: String): String;
    function GetRealDataSetName(ItemName: String): String;
    function GetRealDataSourceName(ItemName: String): String;
    function GetAliasName(ItemName: String): String;
    procedure AddCacheItem(VarName: String; DataSet: TfrTDataSet; DataField: String);
    procedure ClearCache;
  public
    Variables: TfrVariables;
    FieldAliases: TfrVariables;
    BandDatasources: TfrVariables;
    DisabledDatasets: TStringList;
    constructor Create;
    destructor Destroy; override;
    procedure Clear;
    procedure LoadFromStream(Stream: TStream);
    procedure SaveToStream(Stream: TStream);
    procedure LoadFromFile(FName: String);
    procedure SaveToFile(FName: String);
    procedure ExtractFieldName(ComplexName: String;
      var DSName, FieldName: String);
    function IsVariable(VarName: String): Boolean;
    function DatasetEnabled(DatasetName: String): Boolean;
    procedure GetDatasetList(List: TStrings);
    procedure GetFieldList(DSName: String; List: TStrings);
    procedure GetBandDatasourceList(List: TStrings);
    procedure GetCategoryList(List: TStrings);
    procedure GetVariablesList(Category: String; List: TStrings);
    property Value[Index: String]: Variant read GetValue;
    property RealDataSetName[Index: String]: String read GetRealDataSetName;
    property RealDataSourceName[Index: String]: String read GetRealDataSourceName;
    property RealFieldName[Index: String]: String read GetRealFieldName;
    property AliasName[Index: String]: String read GetAliasName;
  end;

  TfrReport = class(TComponent)
  private
    FPages: TfrPages;
    FEMFPages: TfrEMFPages;
    FDictionary: TfrDataDictionary;
    FDataset: TfrDataset;
    FGrayedButtons: Boolean;
    FReportType: TfrReportType;
    FTitle: String;
    FShowProgress: Boolean;
    FModalPreview: Boolean;
    FModifyPrepared: Boolean;
    FStoreInDFM: Boolean;
    FPreview: TfrPreview;
    FPreviewButtons: TfrPreviewButtons;
    FInitialZoom: TfrPreviewZoom;
    FOnBeginDoc: TBeginDocEvent;
    FOnEndDoc: TEndDocEvent;
    FOnBeginPage: TBeginPageEvent;
    FOnEndPage: TEndPageEvent;
    FOnBeginBand: TBeginBandEvent;
    FOnEndBand: TEndBandEvent;
    FOnGetValue: TDetailEvent;
    FOnEnterRect: TEnterRectEvent;
    FOnProgress: TProgressEvent;
    FOnFunction: TFunctionEvent;
    FOnBeginColumn: TBeginColumnEvent;
    FOnPrintColumn: TPrintColumnEvent;
    FOnManualBuild: TManualBuildEvent;
    FObjectClick: TObjectClickEvent;
    FMouseOverObject: TMouseOverObjectEvent;
    FOnPrintReportEvent: TPrintReportEvent;
    FCurrentFilter: TfrExportFilter;
    FPageNumbers: String;
    FCopies: Integer;
    FCollate: Boolean;
    FPrintPages: TfrPrintPages;
    FCurPage: TfrPage;
    _DoublePass: Boolean;
    FMDIPreview: Boolean;
    FDefaultCopies: Integer;
    FDefaultCollate: Boolean;
    FPrnName: String;
    FDFMStream: TStream;
    FPrintIfEmpty: Boolean;
    FShowPrintDialog: Boolean;
    FOnCrossBeginDoc: TBeginDocEvent;
    FOnCustomizeObject: TNotifyEvent;
    function FormatValue(V: Variant; Format: Integer;
      const FormatStr: String): String;
    procedure BuildBeforeModal(Sender: TObject);
    procedure ExportBeforeModal(Sender: TObject);
    procedure PrintBeforeModal(Sender: TObject);
    function DoPrepareReport: Boolean;
    procedure DoBuildReport; virtual;
    procedure SetPrinterTo(PrnName: String);
    procedure GetIntrpValue(const Name: String; var Value: Variant);
    procedure GetIntrpFunction(const Name: String; p1, p2, p3: Variant;
      var Val: Variant);
  protected
    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: TfrPrintPages); virtual;
    procedure Loaded; override;
  public
    CanRebuild: Boolean;            // true, if report can be rebuilded
    Terminated: Boolean;
    PrintToDefault, DoublePass: WordBool;
    FinalPass: Boolean;
    FileName: String;
    Modified, ComponentModified: Boolean;
    MixVariablesAndDBFields: Boolean;
{$IFDEF 1CScript}
    Script : TStringList;
{$ENDIF}
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Clear;
    // internal events used through report building
    property OnCrossBeginDoc: TBeginDocEvent read FOnCrossBeginDoc write FOnCrossBeginDoc;
    procedure InternalOnEnterRect(Memo: TStringList; View: TfrView);
    procedure InternalOnExportData(View: TfrView);
    procedure InternalOnExportText(DrawRect: TRect; x, y: Integer;
      const text: String; FrameTyp: Integer; View: TfrView);
    procedure InternalOnGetValue(ParName: String; var ParValue: String);
    procedure InternalOnProgress(Percent: Integer);
    procedure InternalOnBeginColumn(Band: TfrBand);
    procedure InternalOnPrintColumn(ColNo: Integer; var ColWidth: Integer);
    procedure FillQueryParams;
    procedure GetVariableValue(const s: String; var v: Variant);
{$IFDEF 1CScript}
    procedure GetVariableV(const s: String; var v: Variant);
{$ENDIF}
    procedure OnGetParsFunction(const name: String; p1, p2, p3: Variant;
                                var val: Variant);
    function FindObject(Name: String): TfrView;
    // load/save methods
    procedure LoadFromStream(Stream: TStream);
    procedure SaveToStream(Stream: TStream);
    function LoadFromFile(FName: String): Boolean;