fr_class.pas

FastReport2.51.FS.Delphi567.rar是DELPHI中的一个报表控件.

    procedure Draw(Canvas: TCanvas); override;

    procedure LoadFromStream(Stream: TStream); override;

    procedure SaveToStream(Stream: TStream); override;

    procedure SaveToFR3Stream(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 SaveToFR3Stream(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 SaveToFR3Stream(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;

    procedure SaveToFR3Stream(Stream: TStream); 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..62] 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);

  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; var mess: string): Boolean;

    property Pages[Index: Integer]: PfrPageInfo read GetPages; default;

    property Count: Integer read GetCount;

    property List: TList read FPages write FPages;

    procedure PageToObjects(Index: Integer);

    procedure ObjectsToPage(Index: Integer);

  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;

    FRebuildPrinter: Boolean;

    FUseDefaultDataSetName: Boolean;

    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);

    procedure ClearAttribs;

  protected