frxclass.pas

报表源码 FastReport 3 is new generation of the report generators components. It consists of report engin

{******************************************}
{ }
{ FastReport v3.0 }
{ Report classes }
{ }
{ Copyright (c) 1998-2005 }
{ by Alexander Tzyganenko, }
{ Fast Reports Inc. }
{ }
{******************************************}

unit frxClass;

interface

{$I frx.inc}

uses
  SysUtils, Windows, Messages, Classes, Graphics, Controls, Forms, Dialogs,
  IniFiles, ExtCtrls, Printers, frxVariables, frxXML, frxProgress,
  fs_iinterpreter, fs_ipascal, fs_icpp, fs_ibasic, fs_ijs
{$IFDEF Delphi6}
, Variants
{$ENDIF};

const
  fr01cm = 3.77953; // 96 / 25.4
  fr1cm = 37.7953;
  fr01in = 9.6;
  fr1in = 96;
  fr1CharX = 9.6;
  fr1CharY = 17;
  clTransparent = clNone;
  crHand = 50;
  crZoom = 51;
  crFormat = 52;

type
  TfrxReport = class;
  TfrxPage = class;
  TfrxReportPage = class;
  TfrxDialogPage = class;
  TfrxCustomEngine = class;
  TfrxCustomDesigner = class;
  TfrxCustomPreview = class;
  TfrxCustomPreviewPages = class;
  TfrxComponent = class;
  TfrxReportComponent = class;
  TfrxView = class;
  TfrxStyleItem = class;
  TfrxCustomExportFilter = class;
  TfrxCustomCompressor = class;

  TfrxNotifyEvent = type String;
  TfrxCloseQueryEvent = type String;
  TfrxKeyEvent = type String;
  TfrxKeyPressEvent = type String;
  TfrxMouseEvent = type String;
  TfrxMouseMoveEvent = type String;
  TfrxPreviewClickEvent = type String;
  TfrxRunDialogsEvent = type String;

  TfrxStretchMode = (smDontStretch, smActualHeight, smMaxHeight);
  TfrxShiftMode = (smDontShift, smAlways, smWhenOverlapped);
  TfrxDuplexMode = (dmNone, dmVertical, dmHorizontal, dmSimplex);

  TfrxAlign = (baNone, baLeft, baRight, baCenter, baWidth, baBottom, baClient);

  TfrxFrameStyle = (fsSolid, fsDash, fsDot, fsDashDot, fsDashDotDot, fsDouble);

  TfrxFrameType = (ftLeft, ftRight, ftTop, ftBottom);
  TfrxFrameTypes = set of TfrxFrameType;

  TfrxFormatKind = (fkText, fkNumeric, fkDateTime, fkBoolean);

  TfrxHAlign = (haLeft, haRight, haCenter, haBlock);
  TfrxVAlign = (vaTop, vaBottom, vaCenter);

  TfrxRestriction = (rfDontModify, rfDontSize, rfDontMove, rfDontDelete);
  TfrxRestrictions = set of TfrxRestriction;

  TfrxShapeKind = (skRectangle, skRoundRectangle, skEllipse, skTriangle,
    skDiamond, skDiagonal1, skDiagonal2);

  TfrxPreviewButton = (pbPrint, pbLoad, pbSave, pbExport, pbZoom, pbFind,
    pbOutline, pbPageSetup, pbTools, pbEdit, pbNavigator);
  TfrxPreviewButtons = set of TfrxPreviewButton;
  TfrxZoomMode = (zmDefault, zmWholePage, zmPageWidth, zmManyPages);
  TfrxPrintPages = (ppAll, ppOdd, ppEven);
  TfrxAddPageAction = (apWriteOver, apAdd);
  TfrxRangeBegin = (rbFirst, rbCurrent);
  TfrxRangeEnd = (reLast, reCurrent, reCount);
  TfrxFieldType = (fftNumeric, fftString, fftBoolean);
  TfrxProgressType = (ptRunning, ptExporting, ptPrinting);

  TfrxRect = packed record
    Left, Top, Right, Bottom:Extended;
  end;

  TfrxPoint = packed record
    X, Y:Extended;
  end;

  TfrxProgressEvent = procedure(Sender:TfrxReport;
    ProgressType:TfrxProgressType; Progress:Integer) of object;
  TfrxBeforePrintEvent = procedure(Sender:TfrxReportComponent) of object;
  TfrxGetValueEvent = procedure(const VarName:String; var Value:Variant) of object;
  TfrxUserFunctionEvent = function(const MethodName:String;
    var Params:Variant):Variant of object;
  TfrxManualBuildEvent = procedure(Page:TfrxPage) of object;
  TfrxClickObjectEvent = procedure(Sender:TfrxView;
    Button:TMouseButton; Shift:TShiftState; var Modified:Boolean) of object;
  TfrxMouseOverObjectEvent = procedure(Sender:TfrxView) of object;
  TfrxCheckEOFEvent = procedure(Sender:TObject; var Eof:Boolean) of object;
  TfrxRunDialogEvent = procedure(Page:TfrxDialogPage) of object;

{ Forward declarations of all interfaces in frxClass module }

  IfrxComponent = interface;
  IfrxReport = interface;

{ Root classes }

   IfrxComponent = interface(IUnknown)
    ['{A47A7C28-B1C0-47CA-9826-07E231A1A182}']
    function GetObject(Index:Integer; out Component:IfrxComponent):HResult; stdcall;
    function Get_BaseName(out Value:WideString):HResult; stdcall;
    function Get_Description(out Value:WideString):HResult; stdcall;
    function Get_ObjectsCount(out Value:Integer):HResult; stdcall;
  end;

  IfrxComponentSelf = interface(IUnknown)
    ['{D4DA1DCC-F05D-40AF-909B-893E5A08964A}']
    function GetObject:TfrxComponent; //stdcall;
  end;

  TfrxComponent = class(TComponent, IfrxComponent, IfrxComponentSelf)
  private
    FObjects:TList;
    FAllObjects:TList;
    FParent:TfrxComponent;
    FLeft:Extended;
    FTop:Extended;
    FWidth:Extended;
    FHeight:Extended;
    FFont:TFont;
    FParentFont:Boolean;
    FGroupIndex:Integer;
    FIsDesigning:Boolean;
    FIsLoading:Boolean;
    FIsPrinting:Boolean;
    FIsWriting:Boolean;
    FDefaultDiff:Boolean;
    FRestrictions:TfrxRestrictions;
    FVisible:Boolean;
    FDescription:String;
    function GetAbsTop:Extended;
    function GetPage:TfrxPage;
    function GetReport:TfrxReport;
    function IsFontStored:Boolean;
    function GetAllObjects:TList;
    function GetAbsLeft:Extended;
    function GetIsLoading:Boolean;
  protected
    FAliasName:String;
    FBaseName:String;
    FOriginalComponent:TfrxComponent;
    FOriginalRect:TfrxRect;
    FOriginalBand:TfrxComponent;
    procedure SetParent(AParent:TfrxComponent); virtual;
    procedure SetLeft(Value:Extended); virtual;
    procedure SetTop(Value:Extended); virtual;
    procedure SetWidth(Value:Extended); virtual;
    procedure SetHeight(Value:Extended); virtual;
    procedure SetName(const AName:TComponentName); override;
    procedure SetFont(Value:TFont); virtual;
    procedure SetParentFont(const Value:Boolean); virtual;
    procedure SetVisible(Value:Boolean); virtual;
    procedure FontChanged(Sender:TObject); virtual;
    function DiffFont(f1, f2:TFont; const Add:String):String;
    function InternalDiff(AComponent:TfrxComponent):String;

    procedure GetChildren(Proc:TGetChildProc; Root:TComponent); override;
    function GetChildOwner:TComponent; override;
  public
    constructor Create(AOwner:TComponent); override;
    constructor DesignCreate(AOwner:TComponent; Flags:Word); virtual;
    destructor Destroy; override;
    procedure AlignChildren; virtual;
    procedure Assign(Source:TPersistent); override;
    procedure AssignAll(Source:TfrxComponent);
    procedure BeforeStartReport; virtual;
    procedure Clear; virtual;
    procedure CreateUniqueName;
    procedure LoadFromStream(Stream:TStream); virtual;
    procedure SaveToStream(Stream:TStream; SaveChildren:Boolean = True;
      SaveDefaultValues:Boolean = False); virtual;
    procedure SetBounds(ALeft, ATop, AWidth, AHeight:Extended);
    procedure OnNotify(Sender:TObject); virtual;
    function AllDiff(AComponent:TfrxComponent):String;
    function Diff(AComponent:TfrxComponent):String; virtual;
    function FindObject(const AName:String):TfrxComponent;
    class function GetDescription:String; virtual;

    property Objects:TList read FObjects;
    property AllObjects:TList read GetAllObjects;
    property Parent:TfrxComponent read FParent write SetParent;
    property Page:TfrxPage read GetPage;
    property Report:TfrxReport read GetReport;
    property IsDesigning:Boolean read FIsDesigning write FIsDesigning;
    property IsLoading:Boolean read GetIsLoading write FIsLoading;
    property IsPrinting:Boolean read FIsPrinting write FIsPrinting;
    property IsWriting:Boolean read FIsWriting write FIsWriting;
    property BaseName:String read FBaseName;
    property DefaultDiff:Boolean read FDefaultDiff write FDefaultDiff;
    property GroupIndex:Integer read FGroupIndex write FGroupIndex default 0;

    property Left:Extended read FLeft write SetLeft;
    property Top:Extended read FTop write SetTop;
    property Width:Extended read FWidth write SetWidth;
    property Height:Extended read FHeight write SetHeight;
    property AbsLeft:Extended read GetAbsLeft;
    property AbsTop:Extended read GetAbsTop;

    property Description:String read FDescription write FDescription;
    property Font:TFont read FFont write SetFont stored IsFontStored;
    property ParentFont:Boolean read FParentFont write SetParentFont default True;
    property Restrictions:TfrxRestrictions read FRestrictions write FRestrictions default [];
    property Visible:Boolean read FVisible write SetVisible default True;
    { IfrxComponent }
    function IfrxComponent.GetObject = IfrxComponent_GetObject;
    function IfrxComponent.Get_Description = IfrxComponent_Get_Description;
    function IfrxComponent.Get_BaseName = IfrxComponent_Get_BaseName;
    function IfrxComponent.Get_ObjectsCount = IfrxComponent_Get_ObjectsCount;
    function IfrxComponentSelf.GetObject = IfrxComponentSelf_GetObject;

    function IfrxComponent_GetObject(Index:Integer; out Component:IfrxComponent):HResult; stdcall;
    function IfrxComponent_Get_Description(out Value:WideString):HResult; stdcall;
    function IfrxComponent_Get_BaseName(out Value:WideString):HResult; stdcall;
    function IfrxComponent_Get_ObjectsCount(out Value:Integer):HResult; stdcall;
    function IfrxComponentSelf_GetObject:TfrxComponent; //stdcall;
  end;

  TfrxReportComponent = class(TfrxComponent)
  private
    FOnAfterData:TfrxNotifyEvent;
    FOnAfterPrint:TfrxNotifyEvent;
    FOnBeforePrint:TfrxNotifyEvent;
    FOnPreviewClick:TfrxPreviewClickEvent;
  public
    FShiftAmount:Extended;
    FShiftChildren:TList;
    constructor Create(AOwner:TComponent); override;
    destructor Destroy; override;
    procedure Draw(Canvas:TCanvas; ScaleX, ScaleY, OffsetX, OffsetY:Extended);
      virtual; abstract;
    procedure BeforePrint; virtual;
    procedure GetData; virtual;
    procedure AfterPrint; virtual;
    function GetComponentText:String; virtual;
    property OnAfterData:TfrxNotifyEvent read FOnAfterData write FOnAfterData;
    property OnAfterPrint:TfrxNotifyEvent read FOnAfterPrint write FOnAfterPrint;
    property OnBeforePrint:TfrxNotifyEvent read FOnBeforePrint write FOnBeforePrint;
    property OnPreviewClick:TfrxPreviewClickEvent read FOnPreviewClick write FOnPreviewClick;
  published
    property Description;
  end;

  TfrxDialogComponent = class(TfrxReportComponent)
  private
    FComponent:TComponent;
    procedure ReadLeft(Reader:TReader);
    procedure ReadTop(Reader:TReader);
  protected
    procedure DefineProperties(Filer:TFiler); override;
  public
    constructor Create(AOwner:TComponent); override;
    destructor Destroy; override;
    procedure Draw(Canvas:TCanvas; ScaleX, ScaleY, OffsetX, OffsetY:Extended); override;
    property Component:TComponent read FComponent write FComponent;
  end;

  TfrxDialogControl = class(TfrxReportComponent)
  private
    FControl:TControl;
    FOnClick:TfrxNotifyEvent;
    FOnDblClick:TfrxNotifyEvent;
    FOnEnter:TfrxNotifyEvent;
    FOnExit:TfrxNotifyEvent;
    FOnKeyDown:TfrxKeyEvent;
    FOnKeyPress:TfrxKeyPressEvent;
    FOnKeyUp:TfrxKeyEvent;
    FOnMouseDown:TfrxMouseEvent;
    FOnMouseMove:TfrxMouseMoveEvent;
    FOnMouseUp:TfrxMouseEvent;
    function GetColor:TColor;
    function GetEnabled:Boolean;
    procedure DoOnClick(Sender:TObject);
    procedure DoOnDblClick(Sender:TObject);
    procedure DoOnEnter(Sender:TObject);
    procedure DoOnExit(Sender:TObject);
    procedure DoOnKeyDown(Sender:TObject; var Key:Word; Shift:TShiftState);
    procedure DoOnKeyPress(Sender:TObject; var Key:Char);
    procedure DoOnKeyUp(Sender:TObject; var Key:Word; Shift:TShiftState);
    procedure DoOnMouseDown(Sender:TObject; Button:TMouseButton; Shift:TShiftState; X, Y:Integer);
    procedure DoOnMouseMove(Sender:TObject; Shift:TShiftState; X, Y:Integer);
    procedure DoOnMouseUp(Sender:TObject; Button:TMouseButton; Shift:TShiftState; X, Y:Integer);
    procedure SetColor(const Value:TColor);
    procedure SetEnabled(const Value:Boolean);
    function GetCaption:String;
    procedure SetCaption(const Value:String);
  protected
    procedure SetLeft(Value:Extended); override;
    procedure SetTop(Value:Extended); override;
    procedure SetWidth(Value:Extended); override;
    procedure SetHeight(Value:Extended); override;
    procedure SetParentFont(const Value:Boolean); override;
    procedure SetVisible(Value:Boolean); override;
    procedure SetParent(AParent:TfrxComponent); override;
    procedure FontChanged(Sender:TObject); override;
    procedure InitControl(AControl:TControl);
    procedure SetName(const AName:TComponentName); override;
  public
    constructor Create(AOwner:TComponent); override;
    destructor Destroy; override;
    procedure Draw(Canvas:TCanvas; ScaleX, ScaleY, OffsetX, OffsetY:Extended); override;

    property Caption:String read GetCaption write SetCaption;
    property Color:TColor read GetColor write SetColor;
    property Control:TControl read FControl write FControl;
    property OnClick:TfrxNotifyEvent read FOnClick write FOnClick;
    property OnDblClick:TfrxNotifyEvent read FOnDblClick write FOnDblClick;
    property OnEnter:TfrxNotifyEvent read FOnEnter write FOnEnter;
    property OnExit:TfrxNotifyEvent read FOnExit write FOnExit;
    property OnKeyDown:TfrxKeyEvent read FOnKeyDown write FOnKeyDown;
    property OnKeyPress:TfrxKeyPressEvent read FOnKeyPress write FOnKeyPress;
    property OnKeyUp:TfrxKeyEvent read FOnKeyUp write FOnKeyUp;
    property OnMouseDown:TfrxMouseEvent read FOnMouseDown write FOnMouseDown;
    property OnMouseMove:TfrxMouseMoveEvent read FOnMouseMove write FOnMouseMove;
    property OnMouseUp:TfrxMouseEvent read FOnMouseUp write FOnMouseUp;
  published
    property Left;
    property Top;