fr_class.pas

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

    procedure SaveToFile(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;
  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 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
    procedure DoBuildReport; override;
  public
    Reports: TList;
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  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;

{ 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 = 24; // this is current version (2.4)
  frSpecCount = 9;
  frSpecFuncs: Array[0..frSpecCount - 1] of String =
    ('PAGE#', '', 'DATE', 'TIME', 'LINE#', 'LINETHROUGH#', 'COLUMN#',
     'CURRENT#', 'TOTALPAGES');
  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;
    Text: String;
    FontName: String[32];
    FontSize, FontStyle, FontColor, FontCharset, FillColor: Integer;
    DrawRect: TRect;
    FrameTyp, FrameWidth, FrameColor, Alignment: Integer;
  end;

  TfrAddInObjectInfo = record
    ClassRef: TClass;
    ButtonBmp: TBitmap;
    ButtonHint: String;
    IsControl: Boolean;
  end;

  TfrExportFilterInfo = record
    Filter: TfrExportFilter;
    FilterDesc, FilterExt: String;
  end;

  TfrFunctionInfo = record
    FunctionLibrary: TfrFunctionLibrary;
  end;

  TfrToolsInfo = record
    Caption: String;
    ButtonBmp: TBitmap;
    OnClick: TNotifyEvent;
  end;

var
  frDesigner: TfrReportDesigner;                  // designer reference
  frDesignerClass: TClass;
  frDataManager: TfrDataManager;                  // data manager reference
  frParser: TfrParser;                            // parser reference
  frInterpretator: TfrInterpretator;              // interpretator reference
  frVariables: TfrVariables;                      // report variables reference
  frConsts: TfrVariables;                         // some constants like 'clRed'
  frCompressor: TfrCompressor;                    // compressor reference
  frDialogForm: TForm;                            // dialog form reference
  CurReport: TfrReport;                           // currently proceeded report
  MasterReport: TfrReport;               // reference to main composite report
  CurView: TfrView;                               // currently proceeded view
  CurBand: TfrBand;                               // currently proceeded band
  CurPage: TfrPage;                               // currently proceeded page
  DocMode: TfrDocMode;                            // current mode
  DisableDrawing: Boolean;
  frAddIns: Array[0..31] of TfrAddInObjectInfo;   // add-in objects
  frAddInsCount: Integer;
  frFilters: Array[0..31] of TfrExportFilterInfo; // export filters
  frFiltersCount: Integer;
  frFunctions: Array[0..31] of TfrFunctionInfo;   // function libraries
  frFunctionsCount: Integer;
  frTools: Array[0..31] of TfrToolsInfo;          // tools
  frToolsCount: Integer;
  frInstalledFunctions: TfrInstalledFunctions;
  PageNo: Integer;                       // current page number in Building mode
  frCharset: 0..255;
  frBandNames: Array[0..22] of String;
  frDateFormats, frTimeFormats: Array[0..3] of String;
  frVersion: Byte;                       // version of currently loaded report
  ErrorFlag: Boolean;          // error occured through TfrView drawing
  ErrorStr: String;            // error description
  SMemo: TStringList;          // temporary memo used during TfrView drawing
  ShowBandTitles: Boolean = True;
  frThreadDone: Boolean;
  frProgressForm: TfrProgressForm;
// editors
  frMemoEditor: TNotifyEvent;
  frTagEditor: TNotifyEvent;
  frRestrEditor: TNotifyEvent;
  frHighlightEditor: TNotifyEvent;
  frFieldEditor: TNotifyEvent;
  frDataSourceEditor: TNotifyEvent;
  frCrossDataSourceEditor: TNotifyEvent;
  frGroupEditor: TNotifyEvent;
  frPictureEditor: TNotifyEvent;
  frFontEditor: TNotifyEvent;
  frGlobals: TfrGlobals;


implementation

uses
  FR_Fmted, FR_PrDlg, FR_Prntr, FR_Utils, FR_Const
  {$IFDEF Delphi6}, MaskUtils {$ELSE}, Mask{$ENDIF}
  {$IFDEF JPEG}, JPEG {$ENDIF};

{$R FR_Lng1.RES}
//{$DEFINE Trial}

type
  TfrStdFunctionLibrary = class(TfrFunctionLibrary)
  public
    constructor Create; override;
    procedure DoFunction(FNo: Integer; p1, p2, p3: Variant;
      var val: Variant); override;
  end;

  TInterpretator = class(TfrInterpretator)
  public
    procedure GetValue(const Name: String; var Value: Variant); override;
    procedure SetValue(const Name: String; Value: Variant); override;
    procedure DoFunction(const name: String; p1, p2, p3: Variant;
      var val: Variant); override;
  end;

  TAggregateFunctionsSplitter = class(TfrFunctionSplitter)
  public
    constructor CreateSplitter(SplitTo: TStrings);
    destructor Destroy; override;
    procedure SplitMemo(Memo: TStrings);
    procedure SplitScript(Script: TStrings);
  end;

  PfrFunctionDesc = ^TfrFunctionDesc;
  TfrFunctionDesc = record