fr_class.pas

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

    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}

    FR3Stream: Boolean;

    ReportComment, ReportName, ReportAutor: string;

    ReportCreateDate, ReportLastChange: TDateTime;

    ReportVersionMajor: string;

    ReportVersionMinor: string;

    ReportVersionRelease: string;

    ReportVersionBuild: string;

    ReportPasswordProtected: Boolean;

    ReportPassword: string;

    ReportGeneratorVersion: Byte;

    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;

    procedure SaveToFile(FName: string);

    procedure SaveToFR3File(FName: string);

{$IFDEF IBO}

    procedure LoadFromDB(Table: TIB_DataSet; DocN: Integer);

    procedure SaveToDB(Table: TIB_DataSet; DocN: Integer);

    procedure SaveToBlobField(Blob: TIB_ColumnBlob);

    procedure LoadFromBlobField(Blob: TIB_ColumnBlob);

{$ELSE}

    procedure LoadFromDB(Table: TDataSet; DocN: Integer);

    procedure SaveToDB(Table: TDataSet; DocN: Integer);

    procedure SaveToBlobField(Blob: TField);

    procedure LoadFromBlobField(Blob: TField);

{$ENDIF}

    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(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: TfrExportFilter; FileName: string);

    procedure ShowReport;

    procedure ShowPreparedReport;

    procedure PrintPreparedReportDlg;

    procedure PrintPreparedReport(PageNumbers: string; Copies: Integer;

      Collate: Boolean; PrintPages: TfrPrintPages);

    function ChangePrinter(OldIndex, NewIndex: Integer): Boolean;

    procedure EditPreparedReport(PageIndex: Integer);

    //

    property Pages: TfrPages read FPages;

    property EMFPages: TfrEMFPages read FEMFPages write FEMFPages;

    property Dictionary: TfrDataDictionary read FDictionary write FDictionary;

    //

    procedure BuildPage(Index: Integer);

  published

    property Dataset: TfrDataset read FDataset write FDataset;

    property DefaultCopies: Integer read FDefaultCopies write FDefaultCopies
      default 1;

    property DefaultCollate: Boolean read FDefaultCollate write FDefaultCollate
      default True;

    property GrayedButtons: Boolean read FGrayedButtons write FGrayedButtons
      default False;

    property InitialZoom: TfrPreviewZoom 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 True;

    property Preview: TfrPreview read FPreview write FPreview;

    property PreviewButtons: TfrPreviewButtons read FPreviewButtons write
      FPreviewButtons;

    property PrintIfEmpty: Boolean read FPrintIfEmpty write FPrintIfEmpty default
      True;

    property ReportType: TfrReportType read FReportType write FReportType default
      rtSimple;

    property ShowPrintDialog: Boolean read FShowPrintDialog write
      FShowPrintDialog default True;

    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 RebuildPrinter: Boolean read FRebuildPrinter write FRebuildPrinter;

    property UseDefaultDataSetName: Boolean read FUseDefaultDataSetName write
      FUseDefaultDataSetName default False;

    property OnBeginDoc: TBeginDocEvent read FOnBeginDoc write FOnBeginDoc;

    property OnEndDoc: TEndDocEvent read FOnEndDoc write FOnEndDoc;

    property OnBeginPage: TBeginPageEvent read FOnBeginPage write FOnBeginPage;

    property OnEndPage: TEndPageEvent read FOnEndPage write FOnEndPage;

    property OnBeginBand: TBeginBandEvent read FOnBeginBand write FOnBeginBand;

    property OnEndBand: TEndBandEvent read FOnEndBand write FOnEndBand;

    property OnGetValue: TDetailEvent read FOnGetValue write FOnGetValue;

    property OnBeforePrint: TEnterRectEvent read FOnEnterRect write
      FOnEnterRect;

    property OnUserFunction: TFunctionEvent read FOnFunction write FOnFunction;

    property OnProgress: TProgressEvent read FOnProgress write FOnProgress;

    property OnBeginColumn: TBeginColumnEvent read FOnBeginColumn write
      FOnBeginColumn;

    property OnPrintColumn: TPrintColumnEvent read FOnPrintColumn write
      FOnPrintColumn;

    property OnManualBuild: TManualBuildEvent read FOnManualBuild write
      FOnManualBuild;

    property OnObjectClick: TObjectClickEvent read FObjectClick write
      FObjectClick;

    property OnMouseOverObject: TMouseOverObjectEvent read FMouseOverObject write
      FMouseOverObject;

    property OnPrintReport: TPrintReportEvent read FOnPrintReportEvent write
      FOnPrintReportEvent;

    property OnCustomizeObject: TNotifyEvent read FOnCustomizeObject write
      FOnCustomizeObject;

  end;

  TfrCompositeReport = class(TfrReport)

  private

    //    FDoublePass : Boolean;

    procedure DoBuildReport; override;

  public

    Reports: TList;

    procedure Clear;

    constructor Create(AOwner: TComponent); override;

    destructor Destroy; override;

  published

    property DoublePassReport: WordBool read DoublePass write DoublePass;

  end;

  TfrReportDesigner = class(TForm)

  protected

    function GetModified: Boolean; virtual; abstract;

    procedure SetModified(Value: Boolean); virtual; abstract;

  public

    Page: TfrPage;

    FirstInstance: Boolean;

    constructor CreateDesigner(AFirstInstance: Boolean); virtual;

    procedure BeforeChange; virtual; abstract;

    procedure AfterChange; virtual; abstract;

    procedure RedrawPage; virtual; abstract;

    procedure SelectObject(ObjName: string); virtual; abstract;

    function InsertDBField: string; virtual; abstract;

    function InsertExpression: string; virtual; abstract;

    property Modified: Boolean read GetModified write SetModified;

  end;

  TfrDataManager = class(TObject)

  public

    procedure Clear; virtual; abstract;

    procedure LoadFromStream(Stream: TStream); virtual; abstract;

    procedure SaveToStream(Stream: TStream); virtual; abstract;

    procedure BeforePreparing; virtual; abstract;

    procedure AfterPreparing; virtual; abstract;

    procedure PrepareDataSet(ds: TfrTDataSet); virtual; abstract;

    function ShowParamsDialog: Boolean; virtual; abstract;

    procedure AfterParamsDialog; virtual; abstract;

  end;

  TfrObjEditorForm = class(TForm)

  public

    function ShowEditor(View: TfrView): TModalResult; virtual;

  end;

  TfrExportFilter = class(TComponent)

  protected

    FileName: string;

    Stream: TStream;

    Lines: TList;

    FShowDialog: Boolean;

    FDefault: Boolean;

    FOnBeforeExport: TBeforeExportEvent;

    FOnAfterExport: TAfterExportEvent;

    procedure ClearLines; virtual;

  public

    constructor Create(AOwner: TComponent); override;

    destructor Destroy; override;

    function ShowModal: Word; virtual;

    procedure OnBeginDoc; virtual;

    procedure OnEndDoc; virtual;

    procedure OnBeginPage; virtual;

    procedure OnEndPage; virtual;

    procedure OnData(x, y: Integer; View: TfrView); virtual;

    procedure OnText(DrawRect: TRect; x, y: Integer;

      const text: string; FrameTyp: Integer; View: TfrView); virtual;

  published

    property Default: Boolean read FDefault write FDefault default False;

    property ShowDialog: Boolean read FShowDialog write FShowDialog default
      True;

    property OnBeforeExport: TBeforeExportEvent read FOnBeforeExport write
      FOnBeforeExport;

    property OnAfterExport: TAfterExportEvent read FOnAfterExport write
      FOnAfterExport;

  end;

  TfrFunctionLibrary = class(TObject)

  public

    List: TStringList;

    constructor Create; virtual;

    destructor Destroy; override;

    function OnFunction(const FName: string; p1, p2, p3: Variant;

      var val: Variant): Boolean; virtual;

    procedure DoFunction(FNo: Integer; p1, p2, p3: Variant; var val: Variant);

    virtual; abstract;

    procedure AddFunctionDesc(FuncName, Category, Description: string);

  end;

  TfrCompressor = class(TObject)

  public

    Enabled: Boolean;

    constructor Create; virtual;

    procedure Compress(StreamIn, StreamOut: TStream); virtual;

    procedure DeCompress(StreamIn, StreamOut: TStream); virtual;

  end;

  TfrInstalledFunctions = class(TObject)

  private

    FList: TList;

    procedure UnRegisterFunctionLibrary(FunctionLibrary: TfrFunctionLibrary);

  public

    constructor Create;

    destructor Destroy; override;

    procedure Add(FunctionLibrary: TfrFunctionLibrary;

      FuncName, Category, Description: string);

    function GetFunctionDesc(FuncName: string): string;

    procedure GetCategoryList(List: TStrings);

    procedure GetFunctionList(Category: string; List: TStrings);

  end;

  TDatabaseFunctionLibrary = class(TfrFunctionLibrary)

  public

    constructor Create; override;

    procedure DoFunction(FNo: Integer; p1, p2, p3: Variant;

      var val: Variant); override;

  end;

  { TfrLocale class contains methods and properties for localization.

    You can use global function frLocale: TfrLocale to access these methods.

    FR localization can come from .exe resources (default) or dll resource file.

    To make dll resource file, go RES folder and subfolder with needed language

    and run mkdll.bat file. To use dll in your project, write the following code:



    frLocale.LoadDll('FR_ENGL.DLL');



    To use default .exe resources, unload dll by code:

    frLocale.UnloadDll;

    If you want to make own localization file (for instance, text file), use

    event handler frLocale.OnLocalize. It takes StringID parameter and must

    return ResultString string (see TLocalizeEvent for syntax). You handler

    may look like this:



    frLocale.OnLocalize := MyClass.OnLocalize;

    ...

    procedure TMyClass.OnLocalize(StringID: Integer; var ResultString: String);

    begin

      if StringID = 53000 then

        ResultString := 'Search';

    end;

  }

  TfrLocale = class

  private

    FDllHandle: THandle;

    FLoaded: Boolean;

    FLocalizedPropertyNames: Boolean;

    FOnLocalize: TLocalizeEvent;

    FIDEMode: Boolean;

  public

    constructor Create;

    function LoadBmp(ID: string): HBitmap;

    function LoadStr(ID: Integer): string;

    procedure LoadDll(Name: string);

    procedure UnloadDll;

    property LocalizedPropertyNames: Boolean read FLocalizedPropertyNames

    write FLocalizedPropertyNames;

    property OnLocalize: TLocalizeEvent read FOnLocalize write FOnLocalize;

  end;

  TfrGlobals = class

  public

    constructor Create;

    destructor Destroy; override;

    procedure Localize;

  end;

function frCreateObject(Typ: Byte; const ClassName: string): TfrView;

procedure frRegisterObject(ClassRef: TClass; ButtonBmp: TBitmap;

  const ButtonHint: string);

procedure frRegisterControl(ClassRef: TClass; ButtonBmp: TBitmap;

  const ButtonHint: string);

procedure frUnRegisterObject(ClassRef: TClass);

procedure frRegisterExportFilter(Filter: TfrExportFilter;

  const FilterDesc, FilterExt: string);

procedure frUnRegisterExportFilter(Filter: TfrExportFilter);

procedure frRegisterFunctionLibrary(ClassRef: TClass);

procedure frUnRegisterFunctionLibrary(ClassRef: TClass);

procedure frRegisterTool(MenuCaption: string; ButtonBmp: TBitmap; OnClick:
  TNotifyEvent);

procedure frAddFunctionDesc(FuncLibrary: TfrFunctionLibrary;

  FuncName, Category, Description: string);

function GetDefaultDataSet: TfrTDataSet;

function frLocale: TfrLocale;

const

  frCurrentVersion = 25; // this is current version (2.5)

  frSpecCount = 9;

  frSpecFuncs: array[0..frSpecCount - 1] of string =

  ('PAGE#', '', 'DATE', 'TIME', 'LINE#', 'LINETHROUGH#', 'COLUMN#',

    'CURRENT#', 'TOTALPAGES');

  frRepInfoCount = 9;

  frRepInfo: array[0..frRepInfoCount - 1] of string =

  ('REPORTCOMMENT', 'REPORTNAME', 'REPORTAUTOR',

    'VMAJOR', 'VMINOR', 'VRELEASE', 'VBUILD', 'REPORTDATE', 'REPORTLASTCHANGE');

  frColors: array[0..41] of TColor =

  (clWhite, clBlack, clMaroon, clGreen, clOlive, clNavy, clPurple, clTeal,

    clGray, clSilver, clRed, clLime, clYellow, clBlue, clFuchsia,

    clAqua, clNone,

    clScrollBar, clBackground, clActiveCaption, clInactiveCaption,

    clMenu, clWindow, clWindowFrame, clMenuText, clWindowText,

    clCaptionText, clActiveBorder, clInactiveBorder, clAppWorkSpace,

    clHighlight, clHighlightText, clBtnFace, clBtnShadow, clGrayText,

    clBtnText, clInactiveCaptionText, clBtnHighlight, cl3DDkShadow,

    cl3DLight, clInfoText, clInfoBk);

  frColorNames: array[0..41] of string =

  ('clWhite', 'clBlack', 'clMaroon', 'clGreen', 'clOlive', 'clNavy',

    'clPurple', 'clTeal', 'clGray', 'clSilver', 'clRed', 'clLime',

    'clYellow', 'clBlue', 'clFuchsia', 'clAqua', 'clTransparent',

    'clScrollBar', 'clBackground', 'clActiveCaption', 'clInactiveCaption',

    'clMenu', 'clWindow', 'clWindowFrame', 'clMenuText', 'clWindowText',

    'clCaptionText', 'clActiveBorder', 'clInactiveBorder', 'clAppWorkSpace',

    'clHighlight', 'clHighlightText', 'clBtnFace', 'clBtnShadow', 'clGrayText',

    'clBtnText', 'clInactiveCaptionText', 'clBtnHighlight', 'cl3DDkShadow',

    'cl3DLight', 'clInfoText', 'clInfoBk');

type

  PfrTextRec = ^TfrTextRec;

  TfrTextRec = record

    Next: PfrTextRec;

    X, Y: Integer;