frxclass.pas

Fastreport最新版本的补丁

{******************************************}
{                                          }
{             FastReport v4.0              }
{             Report classes               }
{                                          }
{         Copyright (c) 1998-2007          }
{         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, frxUnicodeUtils
{$IFDEF Delphi6}
, Variants
{$ENDIF}
{$IFNDEF NO_CRITICAL_SECTION}
,  SyncObjs
{$ENDIF}
{$IFDEF FR_COM}
, ActiveX, AxCtrls
, VCLCom, ComObj, ComServ
, ClrStream
, frxFont
, FastReport_TLB
, DispatchablePersistent
{$IFDEF ACTIVATION}
  , aspr_api
{$ENDIF}
{$ENDIF};

const
  fr01cm: Extended = 3.77953;
  fr1cm: Extended = 37.7953;
  fr01in: Extended = 9.6;
  fr1in: Integer = 96;
  fr1CharX: Extended = 9.6;
  fr1CharY: Integer = 17;
  clTransparent: TColor = clNone;
  crHand: Integer = 150;
  crZoom: Integer = 151;
  crFormat: Integer = 152;
  DEF_REG_CONNECTIONS: String = '\Software\Fast Reports\Connections';
  WM_CREATEHANDLE = WM_USER + 1;
  WM_DESTROYHANDLE = WM_USER + 2;

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;
  TfrxCustomDatabase = class;
  TfrxFrame = 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;

  SYSINT = Integer;

  TfrxComponentStyle = set of (csContainer, csPreviewVisible, csDefaultDiff);
  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);

  TfrxSilentMode = (simMessageBoxes, simSilent, simReThrow);
  TfrxRestriction = (rfDontModify, rfDontSize, rfDontMove, rfDontDelete, rfDontEdit);
  TfrxRestrictions = set of TfrxRestriction;

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

  TfrxPreviewButton = (pbPrint, pbLoad, pbSave, pbExport, pbZoom, pbFind,
    pbOutline, pbPageSetup, pbTools, pbEdit, pbNavigator, pbExportQuick,
    pbNoClose, pbNoFullScreen, pbNoEmail);
  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);
  TfrxPrintMode = (pmDefault, pmSplit, pmJoin, pmScale);

  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;
  TfrxEditConnectionEvent = function(const ConnString: String): String of object;
  TfrxSetConnectionEvent = procedure(const ConnString: String) of object;
  TfrxBeforeConnectEvent = procedure(Sender: TfrxCustomDatabase; var Connected: Boolean) of object;
  TfrxPrintPageEvent = procedure(Page: TfrxReportPage; CopyNo: Integer) of object;
  TfrxLoadTemplateEvent = procedure(Report: TfrxReport; const TemplateName: String) of object;

{ Root classes }

{$IFDEF FR_COM}
  TfrxComponent = class(TComponent, IfrxComponent )
  private
    FFont: TfrxFont;
{$ELSE}
  TfrxComponent = class(TComponent)
  private
    FFont: TFont;
{$ENDIF}
    FObjects: TList;
    FAllObjects: TList;
    FParent: TfrxComponent;
    FLeft: Extended;
    FTop: Extended;
    FWidth: Extended;
    FHeight: Extended;
    FParentFont: Boolean;
    FGroupIndex: Integer;
    FIsDesigning: Boolean;
    FIsLoading: Boolean;
    FIsPrinting: Boolean;
    FIsWriting: Boolean;
    FRestrictions: TfrxRestrictions;
    FVisible: Boolean;
    FDescription: String;
    FAncestor: Boolean;
    FComponentStyle: TfrxComponentStyle;
    function GetAbsTop: Extended;
    function GetPage: TfrxPage;
    function GetReport: TfrxReport;
    function IsFontStored: Boolean;
    function GetAllObjects: TList;
    function GetAbsLeft: Extended;
    function GetIsLoading: Boolean;
    function GetIsAncestor: 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;
    function GetContainerObjects: TList; virtual;

    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;
    class function GetDescription: String; virtual;
    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;
    procedure OnPaste; virtual;
    function AllDiff(AComponent: TfrxComponent): String;
    function Diff(AComponent: TfrxComponent): String; virtual;
    function FindObject(const AName: String): TfrxComponent;
    function ContainerAdd(Obj: TfrxComponent): Boolean; virtual;
    function ContainerMouseDown(Sender: TObject; X, Y: Integer): Boolean; virtual;
    procedure ContainerMouseMove(Sender: TObject; X, Y: Integer); virtual;
    procedure ContainerMouseUp(Sender: TObject; X, Y: Integer); virtual;

    property Objects: TList read FObjects;
    property AllObjects: TList read GetAllObjects;
    property ContainerObjects: TList read GetContainerObjects;
    property Parent: TfrxComponent read FParent write SetParent;
    property Page: TfrxPage read GetPage;
    property Report: TfrxReport read GetReport;
    property IsAncestor: Boolean read GetIsAncestor;
    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 GroupIndex: Integer read FGroupIndex write FGroupIndex default 0;
    property frComponentStyle: TfrxComponentStyle read FComponentStyle write FComponentStyle;

    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 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;
{$IFNDEF FR_COM}
    property Font: TFont read FFont write SetFont stored IsFontStored;
{$ELSE}
    function GetFont: TFont;
    property Font: TFont read GetFont write SetFont stored IsFontStored;
    { 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 IfrxComponent.Get_Left = IfrxComponent_Get_Left;
    function IfrxComponent.Set_Left = IfrxComponent_Set_Left;
    function IfrxComponent.Get_Top = IfrxComponent_Get_Top;
    function IfrxComponent.Set_Top = IfrxComponent_Set_Top;
    function IfrxComponent.Get_Width = IfrxComponent_Get_Width;
    function IfrxComponent.Set_Width = IfrxComponent_Set_Width;
    function IfrxComponent.Get_Height = IfrxComponent_Get_Height;
    function IfrxComponent.Set_Height = IfrxComponent_Set_Height;
    function IfrxComponent.FindObject = IfrxComponent_FindObject;
    function IfrxComponent.Get_AliasName = IfrxComponent_Get_AliasName;
    function IfrxComponent.Get_Name = IfrxComponent_Get_Name;

    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 IfrxComponent_Get_Left(out Value: Double): HResult; stdcall;
    function IfrxComponent_Set_Left(Value: Double): HResult; stdcall;
    function IfrxComponent_Get_Top(out Value: Double): HResult; stdcall;
    function IfrxComponent_Set_Top(Value: Double): HResult; stdcall;
    function IfrxComponent_Get_Width(out Value: Double): HResult; stdcall;
    function IfrxComponent_Set_Width(Value: Double): HResult; stdcall;
    function IfrxComponent_Get_Height(out Value: Double): HResult; stdcall;
    function IfrxComponent_Set_Height(Value: Double): HResult; stdcall;
    function IfrxComponent_FindObject(const ObjectName: WideString; out Object_: IfrxComponent): HResult; stdcall;
    function IfrxComponent_Get_AliasName(out Value: WideString): HResult; stdcall;
    function IfrxComponent_Get_Name(out Value: WideString): HResult; stdcall;
    function Get_Restrictions(out Value: frxRestrictions): HResult; stdcall;
    function Set_Restrictions(Value: frxRestrictions): HResult; stdcall;
{$ENDIF}
  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;