{******************************************} { } { 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; procedure BeforePrint; virtual; procedure GetData; virtual; procedure AfterPrint; virtual; function GetComponentText: String; virtual; function GetRealBounds: TfrxRect; 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); procedure WriteLeft(Writer: TWriter); procedure WriteTop(Writer: TWriter); protected FImageIndex: Integer; 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); function GetHint: String; procedure SetHint(const Value: String); function GetTabStop: Boolean; procedure SetTabStop(const Value: Boolean); 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 TabStop: Boolean read GetTabStop write SetTabStop default True; 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; property Width; property Height; property Font; property GroupIndex; property ParentFont; property Enabled: Boolean read GetEnabled write SetEnabled default True; property Hint: String read GetHint write SetHint; property Visible; end; {$IFDEF FR_COM} TfrxDataSet = class(TfrxDialogComponent, IfrxDataSet) {$ELSE} TfrxDataSet = class(TfrxDialogComponent) {$ENDIF} private FCloseDataSource: Boolean; FEnabled: Boolean; FEof: Boolean; FOpenDataSource: Boolean; FRangeBegin: TfrxRangeBegin; FRangeEnd: TfrxRangeEnd; FRangeEndCount: Integer; FReportRef: TfrxReport; FUserName: String; FOnCheckEOF: TfrxCheckEOFEvent; FOnFirst: TNotifyEvent; FOnNext: TNotifyEvent; FOnPrior: TNotifyEvent; FOnOpen: TNotifyEvent; FOnClose: TNotifyEvent; protected FInitialized: Boolean; FRecNo: Integer; function GetDisplayText(Index: String): WideString; virtual; function GetDisplayWidth(Index: String): Integer; virtual; function GetFieldType(Index: String): TfrxFieldType; virtual; function GetValue(Index: String): Variant; virtual; procedure SetName(const NewName: TComponentName); override; procedure SetUserName(const Value: String); virtual; public constructor Create(AOwner: TComponent); override; destructor Destroy; override; { Navigation methods } procedure Initialize; virtual; procedure Finalize; virtual; procedure Open; virtual; procedure Close; virtual; procedure First; virtual; procedure Next; virtual; procedure Prior; virtual; function Eof: Boolean; virtual; { Data access } function FieldsCount: Integer; virtual; function HasField(const fName: String): Boolean; function IsBlobField(const fName: String): Boolean; virtual; function RecordCount: Integer; virtual; procedure AssignBlobTo(const fName: String; Obj: TObject); virtual; procedure GetFieldList(List: TStrings); virtual; property DisplayText[Index: String]: WideString read GetDisplayText; property DisplayWidth[Index: String]: Integer read GetDisplayWidth; property FieldType[Index: String]: TfrxFieldType read GetFieldType; property Value[Index: String]: Variant read GetValue; property CloseDataSource: Boolean read FCloseDataSource write FCloseDataSource; { OpenDataSource is kept for backward compatibility only } property OpenDataSource: Boolean read FOpenDataSource write FOpenDataSource default True; property RecNo: Integer read FRecNo; property ReportRef: TfrxReport read FReportRef write FReportRef; property OnClose: TNotifyEvent read FOnClose write FOnClose; property OnOpen: TNotifyEvent read FOnOpen write FOnOpen; published property Enabled: Boolean read FEnabled write FEnabled default True; property RangeBegin: TfrxRangeBegin read FRangeBegin write FRangeBegin default rbFirst; property RangeEnd: TfrxRangeEnd read FRangeEnd write FRangeEnd default reLast; property RangeEndCount: Integer read FRangeEndCount write FRangeEndCount default 0; property UserName: String read FUserName write SetUserName; property OnCheckEOF: TfrxCheckEOFEvent read FOnCheckEOF write FOnCheckEOF; property OnFirst: TNotifyEvent read FOnFirst write FOnFirst; property OnNext: TNotifyEvent read FOnNext write FOnNext; property OnPrior: TNotifyEvent read FOnPrior write FOnPrior; {$IFDEF FR_COM} private { Interface section } function Get_UserName(out Value: WideString): HResult; stdcall; function Set_UserName(const Value: WideString): HResult; stdcall; function Get_RangeBegin(out Value: frxRangeBegin): HResult; stdcall; function Set_RangeBegin(Value: frxRangeBegin): HResult; stdcall; function Get_RangeEndCount(out Value: Integer): HResult; stdcall; function Set_RangeEndCount(Value: Integer): HResult; stdcall; function Get_RangeEnd(out Value: frxRangeEnd): HResult; stdcall; function Set_RangeEnd(Value: frxRangeEnd): HResult; stdcall; function Get_FieldsCount(out Value: Integer): HResult; stdcall; function Get_RecordsCount(out Value: Integer): HResult; stdcall; function ValueOfField(const FieldName: WideString; out Value: OleVariant): HResult; stdcall; function Get_CurrentRecordNo(out Value: Integer): HResult; stdcall; function GoFirst: HResult; stdcall; function GoNext: HResult; stdcall; function GoPrior: HResult; stdcall; {$ENDIF} end; {$IFDEF FR_COM} TfrxUserDataSet = class(TfrxDataset, IfrxUserDataSet, IConnectionPointContainer) private FConnectionPoints: TConnectionPoints; FConnectionPoint: TConnectionPoint; FEvent: IfrxUserDataSetEvents; {$ELSE} TfrxUserDataSet = class(TfrxDataset) private {$ENDIF} FFields: TStrings; FOnGetValue: TfrxGetValueEvent; procedure SetFields(const Value: TStrings); protected function GetDisplayText(Index: String): WideString; override; function GetValue(Index: String): Variant; override; public constructor Create(AOwner: TComponent); override; destructor Destroy; override; function FieldsCount: Integer; override; procedure GetFieldList(List: TStrings); override; published property Fields: TStrings read FFields write SetFields; property OnGetValue: TfrxGetValueEvent read FOnGetValue write FOnGetValue; {$IFDEF FR_COM} private function IfrxUserDataSet.Get_Fields = IfrxUserDataSet_Get_Fields; function IfrxUserDataSet.Set_Fields = IfrxUserDataSet_Set_Fields; function IfrxUserDataSet.Get_Name = IfrxUserDataSet_Get_Name; function IfrxUserDataSet.Set_Name = IfrxUserDataSet_Set_Name; function IfrxUserDataSet_Get_Fields(out Value: WideString): HResult; stdcall; function IfrxUserDataSet_Set_Fields(const Value: WideString): HResult; stdcall; function IfrxUserDataSet_Get_Name(out Value: WideString): HResult; stdcall; function IfrxUserDataSet_Set_Name(const Value: WideString): HResult; stdcall; procedure EventSinkChanged(const Sink: IUnknown; Connecting: Boolean); { COM proxy event functions } procedure COM_OnGetValueHandler(const VarName: String; var Value: Variant); procedure COM_OnCheckEOFHandler(Sender: TObject; var EOF : Boolean); procedure COM_OnFirstHandler(Sender: TObject); procedure COM_OnNextHandler(Sender: TObject); procedure COM_OnPrevHandler(Sender: TObject); public property ConnectionPoints: TConnectionPoints read FConnectionPoints implements IConnectionPointContainer; {$ENDIF} end; TfrxCustomDBDataSet = class(TfrxDataSet) private FAliases: TStrings; FFields: TStringList; procedure SetFieldAliases(const Value: TStrings); protected property Fields: TStringList read FFields; public constructor Create(AOwner: TComponent); override; destructor Destroy; override; function ConvertAlias(const fName: String): String; function GetAlias(const fName: String): String; function FieldsCount: Integer; override; published property CloseDataSource; property FieldAliases: TStrings read FAliases write SetFieldAliases; property OpenDataSource; property OnClose; property OnOpen; end; TfrxDBComponents = class(TComponent) public function GetDescription: String; virtual; end; TfrxCustomDatabase = class(TfrxDialogComponent) protected procedure BeforeConnect(var Value: Boolean); procedure SetConnected(Value: Boolean); virtual; procedure SetDatabaseName(const Value: String); virtual; procedure SetLoginPrompt(Value: Boolean); virtual; procedure SetParams(Value: TStrings); virtual; function GetConnected: Boolean; virtual; function GetDatabaseName: String; virtual; function GetLoginPrompt: Boolean; virtual; function GetParams: TStrings; virtual; public procedure SetLogin(const Login, Password: String); virtual; property Connected: Boolean read GetConnected write SetConnected default False; property DatabaseName: String read GetDatabaseName write SetDatabaseName; property LoginPrompt: Boolean read GetLoginPrompt write SetLoginPrompt default True; property Params: TStrings read GetParams write SetParams; end; TfrxComponentClass = class of TfrxComponent; { Report Objects } TfrxFrameLine = class(TPersistent) private FFrame: TfrxFrame; FColor: TColor; FStyle: TfrxFrameStyle; FWidth: Extended; function IsColorStored: Boolean; function IsStyleStored: Boolean; function IsWidthStored: Boolean; public constructor Create(AFrame: TfrxFrame); procedure Assign(Source: TPersistent); override; function Diff(ALine: TfrxFrameLine; const LineName: String; ColorChanged, StyleChanged, WidthChanged: Boolean): String; published property Color: TColor read FColor write FColor stored IsColorStored; property Style: TfrxFrameStyle read FStyle write FStyle stored IsStyleStored; property Width: Extended read FWidth write FWidth stored IsWidthStored; end; {$IFDEF FR_COM} TfrxFrame = class(TDispatchablePersistent, IfrxFrame) {$ELSE} TfrxFrame = class(TPersistent) {$ENDIF} private FLeftLine: TfrxFrameLine; FTopLine: TfrxFrameLine; FRightLine: TfrxFrameLine; FBottomLine: TfrxFrameLine; FColor: TColor; FDropShadow: Boolean; FShadowWidth: Extended; FShadowColor: TColor; FStyle: TfrxFrameStyle; FTyp: TfrxFrameTypes; FWidth: Extended; function IsShadowWidthStored: Boolean; function IsTypStored: Boolean; function IsWidthStored: Boolean; procedure SetBottomLine(const Value: TfrxFrameLine); procedure SetLeftLine(const Value: TfrxFrameLine); procedure SetRightLine(const Value: TfrxFrameLine); procedure SetTopLine(const Value: TfrxFrameLine); procedure SetColor(const Value: TColor); procedure SetStyle(const Value: TfrxFrameStyle); procedure SetWidth(const Value: Extended); {$IFDEF FR_COM} { IfrxFrame } function Get_Color(out Value: Integer): HResult; stdcall; function Set_Color(Value: Integer): HResult; stdcall; function Get_DropShadow(out Value: WordBool): HResult; stdcall; function Set_DropShadow(Value: WordBool): HResult; stdcall; function Get_ShadowColor(out Value: Integer): HResult; stdcall; function Set_ShadowColor(Value: Integer): HResult; stdcall; function Get_ShadowWidth(out Value: Double): HResult; stdcall; function Set_ShadowWidth(Value: Double): HResult; stdcall; function Get_Style(out Value: frxFrameStyle): HResult; stdcall; function Set_Style(Value: frxFrameStyle): HResult; stdcall; function Get_FrameType(out Value: Integer): HResult; stdcall; function Set_FrameType(Value: Integer): HResult; stdcall; function Get_Width(out Value: Double): HResult; stdcall; function Set_Width(Value: Double): HResult; stdcall; {$ENDIF} public constructor Create; destructor Destroy; override; procedure Assign(Source: TPersistent); override; function Diff(AFrame: TfrxFrame): String; published property Color: TColor read FColor write SetColor default clBlack; property DropShadow: Boolean read FDropShadow write FDropShadow default False; property ShadowColor: TColor read FShadowColor write FShadowColor default clBlack; property ShadowWidth: Extended read FShadowWidth write FShadowWidth stored IsShadowWidthStored; property Style: TfrxFrameStyle read FStyle write SetStyle default fsSolid; property Typ: TfrxFrameTypes read FTyp write FTyp stored IsTypStored; property Width: Extended read FWidth write SetWidth stored IsWidthStored; property LeftLine: TfrxFrameLine read FLeftLine write SetLeftLine; property TopLine: TfrxFrameLine read FTopLine write SetTopLine; property RightLine: TfrxFrameLine read FRightLine write SetRightLine; property BottomLine: TfrxFrameLine read FBottomLine write SetBottomLine; end; {$IFDEF FR_COM} TfrxView = class(TfrxReportComponent, IfrxView) {$ELSE} TfrxView = class(TfrxReportComponent) {$ENDIF} private FAlign: TfrxAlign; FBrushStyle: TBrushStyle; FColor: TColor; FCursor: TCursor; FDataField: String; FDataSet: TfrxDataSet; FDataSetName: String; FFrame: TfrxFrame; FPrintable: Boolean; FShiftMode: TfrxShiftMode; FTagStr: String; FTempTag: String; FTempURL: String; FURL: String; FPlainText: Boolean; procedure SetFrame(const Value: TfrxFrame); procedure SetDataSet(const Value: TfrxDataSet); procedure SetDataSetName(const Value: String); function GetDataSetName: String; protected FX: Integer; FY: Integer; FX1: Integer; FY1: Integer; FDX: Integer; FDY: Integer; FFrameWidth: Integer; FScaleX: Extended; FScaleY: Extended; FOffsetX: Extended; FOffsetY: Extended; FCanvas: TCanvas; procedure BeginDraw(Canvas: TCanvas; ScaleX, ScaleY, OffsetX, OffsetY: Extended); virtual; procedure DrawBackground; virtual; procedure DrawFrame; virtual; procedure DrawLine(x, y, x1, y1, w: Integer); procedure ExpandVariables(var Expr: String); procedure Notification(AComponent: TComponent; Operation: TOperation); override; {$IFDEF FR_COM} function Get_DataField(out Value: WideString): HResult; stdcall; function Set_DataField(const Value: WideString): HResult; stdcall; function Get_TagStr(out Value: WideString): HResult; stdcall; function Set_TagStr(const Value: WideString): HResult; stdcall; function Get_URL(out Value: WideString): HResult; stdcall; function Set_URL(const Value: WideString): HResult; stdcall; function Get_DataSetName(out Value: WideString): HResult; stdcall; function Set_DataSetName(const Value: WideString): HResult; stdcall; function Get_Name(out Value: WideString): HResult; stdcall; function Get_Frame(out Value: IfrxFrame): HResult; stdcall; function Get_ShiftMode(out Value: frxShiftMode): HResult; stdcall; function Set_ShiftMode(Value: frxShiftMode): HResult; stdcall; function Get_Align(out Value: frxAlign): HResult; stdcall; function Set_Align(Value: frxAlign): HResult; stdcall; {$ENDIF} public constructor Create(AOwner: TComponent); override; destructor Destroy; override; function Diff(AComponent: TfrxComponent): String; override; function IsDataField: Boolean; procedure Draw(Canvas: TCanvas; ScaleX, ScaleY, OffsetX, OffsetY: Extended); override; procedure BeforePrint; override; procedure GetData; override; procedure AfterPrint; override; property BrushStyle: TBrushStyle read FBrushStyle write FBrushStyle default bsSolid; property Color: TColor read FColor write FColor default clNone; property DataField: String read FDataField write FDataField; property DataSet: TfrxDataSet read FDataSet write SetDataSet; property DataSetName: String read GetDataSetName write SetDataSetName; property Frame: TfrxFrame read FFrame write SetFrame; property PlainText: Boolean read FPlainText write FPlainText; property Cursor: TCursor read FCursor write FCursor default crDefault; property TagStr: String read FTagStr write FTagStr; property URL: String read FURL write FURL; published property Align: TfrxAlign read FAlign write FAlign default baNone; property Printable: Boolean read FPrintable write FPrintable default True; property ShiftMode: TfrxShiftMode read FShiftMode write FShiftMode default smAlways; property Left; property Top; property Width; property Height; property GroupIndex; property Restrictions; property Visible; property OnAfterData; property OnAfterPrint; property OnBeforePrint; property OnPreviewClick; end; {$IFDEF FR_COM} TfrxStretcheable = class(TfrxView, IfrxStretcheable) {$ELSE} TfrxStretcheable = class(TfrxView) {$ENDIF} private FStretchMode: TfrxStretchMode; {$IFDEF FR_COM} function Get_StretchMode(out Value: frxStretchMode): HResult; stdcall; function Set_StretchMode(Value: frxStretchMode): HResult; stdcall; {$ENDIF} public FSaveHeight: Extended; constructor Create(AOwner: TComponent); override; function CalcHeight: Extended; virtual; function DrawPart: Extended; virtual; procedure InitPart; virtual; published property StretchMode: TfrxStretchMode read FStretchMode write FStretchMode default smDontStretch; end; {$IFDEF FR_COM} TfrxHighlight = class(TDispatchablePersistent, IfrxHighlight) {$ELSE} TfrxHighlight = class(TPersistent) {$ENDIF} private FActive: Boolean; FColor: TColor; FCondition: String; {$IFNDEF FR_COM} FFont: TFont; {$ELSE} FFont: TfrxFont; function GetFont: TFont; {$ENDIF} procedure SetFont(const Value: TFont); {$IFDEF FR_COM} { IfrxHighlight } function Get_Active(out Value: WordBool): HResult; stdcall; function Set_Active(Value: WordBool): HResult; stdcall; function Get_Color(out Value: Integer): HResult; stdcall; function Set_Color(Value: Integer): HResult; stdcall; function Get_Font(out Value: IfrxFont): HResult; stdcall; {$ENDIF} public constructor Create; destructor Destroy; override; procedure Assign(Source: TPersistent); override; published property Active: Boolean read FActive write FActive default False; {$IFNDEF FR_COM} property Font: TFont read FFont write SetFont; {$ELSE} property Font: TFont read GetFont write SetFont; {$ENDIF} property Color: TColor read FColor write FColor default clNone; property Condition: String read FCondition write FCondition; end; {$IFDEF FR_COM} TfrxFormat = class(TDispatchablePersistent, IfrxDisplayFormat) {$ELSE} TfrxFormat = class(TPersistent) {$ENDIF} private FDecimalSeparator: String; FFormatStr: String; FKind: TfrxFormatKind; {$IFDEF FR_COM} { IfrxDisplayFormat } function Get_DecimalSeparator(out Value: WideString): HResult; stdcall; function Set_DecimalSeparator(const Value: WideString): HResult; stdcall; function Get_FormatStr(out Value: WideString): HResult; stdcall; function Set_FormatStr(const Value: WideString): HResult; stdcall; function Get_Kind(out Value: frxFormatKind): HResult; stdcall; function Set_Kind(Value: frxFormatKind): HResult; stdcall; {$ENDIF} public {$IFDEF FR_COM} constructor Create; {$ENDIF} procedure Assign(Source: TPersistent); override; published property DecimalSeparator: String read FDecimalSeparator write FDecimalSeparator; property FormatStr: String read FFormatStr write FFormatStr; property Kind: TfrxFormatKind read FKind write FKind default fkText; end; {$IFDEF FR_COM} TfrxCustomMemoView = class(TfrxStretcheable, IfrxCustomMemoView) {$ELSE} TfrxCustomMemoView = class(TfrxStretcheable) {$ENDIF} private FAllowExpressions: Boolean; FAllowHTMLTags: Boolean; FAutoWidth: Boolean; FCharSpacing: Extended; FClipped: Boolean; FDisplayFormat: TfrxFormat; FExpressionDelimiters: String; FFlowTo: TfrxCustomMemoView; FFirstParaBreak: Boolean; FGapX: Extended; FGapY: Extended; FHAlign: TfrxHAlign; FHideZeros: Boolean; FHighlight: TfrxHighlight; FLastParaBreak: Boolean; FLineSpacing: Extended; FMemo: TWideStrings; FParagraphGap: Extended; FPartMemo: WideString; FRotation: Integer; FRTLReading: Boolean; FStyle: String; FSuppressRepeated: Boolean; FTempMemo: WideString; FUnderlines: Boolean; FVAlign: TfrxVAlign; FValue: Variant; FWordBreak: Boolean; FWordWrap: Boolean; FWysiwyg: Boolean; procedure SetMemo(const Value: TWideStrings); procedure SetRotation(Value: Integer); procedure SetText(const Value: WideString); function AdjustCalcHeight: Extended; function AdjustCalcWidth: Extended; function GetText: WideString; function IsExprDelimitersStored: Boolean; function IsLineSpacingStored: Boolean; function IsGapXStored: Boolean; function IsGapYStored: Boolean; function IsHighlightStored: Boolean; function IsParagraphGapStored: Boolean; procedure SetHighlight(const Value: TfrxHighlight); procedure SetDisplayFormat(const Value: TfrxFormat); procedure SetStyle(const Value: String); function IsCharSpacingStored: Boolean; protected FLastValue: Variant; FTotalPages: Integer; FCopyNo: Integer; FTextRect: TRect; FPrintScale: Extended; function CalcAndFormat(const Expr: WideString): WideString; procedure BeginDraw(Canvas: TCanvas; ScaleX, ScaleY, OffsetX, OffsetY: Extended); override; procedure SetDrawParams(Canvas: TCanvas; ScaleX, ScaleY, OffsetX, OffsetY: Extended); procedure Notification(AComponent: TComponent; Operation: TOperation); override; public constructor Create(AOwner: TComponent); override; destructor Destroy; override; class function GetDescription: String; override; function Diff(AComponent: TfrxComponent): String; override; function CalcHeight: Extended; override; function CalcWidth: Extended; virtual; function DrawPart: Extended; override; function GetComponentText: String; override; function FormatData(const Value: Variant; AFormat: TfrxFormat = nil): WideString; function WrapText(WrapWords: Boolean): WideString; procedure Draw(Canvas: TCanvas; ScaleX, ScaleY, OffsetX, OffsetY: Extended); override; procedure BeforePrint; override; procedure GetData; override; procedure AfterPrint; override; procedure InitPart; override; procedure ApplyStyle(Style: TfrxStyleItem); procedure ExtractMacros; procedure ResetSuppress; property Text: WideString read GetText write SetText; property Value: Variant read FValue write FValue; // analogue of Memo property property Lines: TWideStrings read FMemo write SetMemo; property AllowExpressions: Boolean read FAllowExpressions write FAllowExpressions default True; property AllowHTMLTags: Boolean read FAllowHTMLTags write FAllowHTMLTags default False; property AutoWidth: Boolean read FAutoWidth write FAutoWidth default False; property CharSpacing: Extended read FCharSpacing write FCharSpacing stored IsCharSpacingStored; property Clipped: Boolean read FClipped write FClipped default True; property DisplayFormat: TfrxFormat read FDisplayFormat write SetDisplayFormat; property ExpressionDelimiters: String read FExpressionDelimiters write FExpressionDelimiters stored IsExprDelimitersStored; property FlowTo: TfrxCustomMemoView read FFlowTo write FFlowTo; property GapX: Extended read FGapX write FGapX stored IsGapXStored; property GapY: Extended read FGapY write FGapY stored IsGapYStored; property HAlign: TfrxHAlign read FHAlign write FHAlign default haLeft; property HideZeros: Boolean read FHideZeros write FHideZeros default False; property Highlight: TfrxHighlight read FHighlight write SetHighlight stored IsHighlightStored; property LineSpacing: Extended read FLineSpacing write FLineSpacing stored IsLineSpacingStored; property Memo: TWideStrings read FMemo write SetMemo; property ParagraphGap: Extended read FParagraphGap write FParagraphGap stored IsParagraphGapStored; property Rotation: Integer read FRotation write SetRotation default 0; property RTLReading: Boolean read FRTLReading write FRTLReading default False; property Style: String read FStyle write SetStyle; property SuppressRepeated: Boolean read FSuppressRepeated write FSuppressRepeated default False; property Underlines: Boolean read FUnderlines write FUnderlines default False; property WordBreak: Boolean read FWordBreak write FWordBreak default False; property WordWrap: Boolean read FWordWrap write FWordWrap default True; property Wysiwyg: Boolean read FWysiwyg write FWysiwyg default True; property VAlign: TfrxVAlign read FVAlign write FVAlign default vaTop; {$IFDEF FR_COM} { IfrxCustomMemoView } function IfrxCustomMemoView.Get_Text = IfrxCustomMemoView_Get_Text; function IfrxCustomMemoView.Set_Text = IfrxCustomMemoView_Set_Text; function IfrxCustomMemoView_Get_Text(out Value: WideString): HResult; stdcall; function IfrxCustomMemoView_Set_Text(const Value: WideString): HResult; stdcall; {$ENDIF} published property FirstParaBreak: Boolean read FFirstParaBreak write FFirstParaBreak default False; property LastParaBreak: Boolean read FLastParaBreak write FLastParaBreak default False; property Cursor; property TagStr; property URL; end; {$IFDEF FR_COM} TfrxMemoView = class(TfrxCustomMemoView, IfrxMemoView) protected function Get_AutoWidth(out Value: WordBool): HResult; stdcall; function Set_AutoWidth(Value: WordBool): HResult; stdcall; function Get_AllowExpressions(out Value: WordBool): HResult; stdcall; function Set_AllowExpressions(Value: WordBool): HResult; stdcall; function Get_AllowHTMLTags(out Value: WordBool): HResult; stdcall; function Set_AllowHTMLTags(Value: WordBool): HResult; stdcall; function Get_BrushStyle(out Value: frxBrushStyle): HResult; stdcall; function Set_BrushStyle(Value: frxBrushStyle): HResult; stdcall; function Get_CharSpacing(out Value: Double): HResult; stdcall; function Set_CharSpacing(Value: Double): HResult; stdcall; function Get_Clipped(out Value: WordBool): HResult; stdcall; function Set_Clipped(Value: WordBool): HResult; stdcall; function Get_Color(out Value: Integer): HResult; stdcall; function Set_Color(Value: Integer): HResult; stdcall; function Get_DataField(out Value: WideString): HResult; stdcall; function Set_DataField(const Value: WideString): HResult; stdcall; function Get_DataSet(out Value: IfrxDataSet): HResult; stdcall; function Set_DataSet(const Value: IfrxDataSet): HResult; stdcall; function Get_DataSetName(out Value: WideString): HResult; stdcall; function Set_DataSetName(const Value: WideString): HResult; stdcall; function Get_DisplayFormat(out Value: IfrxDisplayFormat): HResult; stdcall; function Get_ExpressionDelimiters(out Value: WideString): HResult; stdcall; function Set_ExpressionDelimiters(const Value: WideString): HResult; stdcall; function Get_FlowTo(out Value: IfrxCustomMemoView): HResult; stdcall; function Set_FlowTo(const Value: IfrxCustomMemoView): HResult; stdcall; function Get_Font(out Value: IfrxFont): HResult; stdcall; function Get_Frame(out Value: IfrxFrame): HResult; stdcall; function Get_GapX(out Value: Double): HResult; stdcall; function Set_GapX(Value: Double): HResult; stdcall; function Get_GapY(out Value: Double): HResult; stdcall; function Set_GapY(Value: Double): HResult; stdcall; function Get_HAlign(out Value: frxHAlign): HResult; stdcall; function Set_HAlign(Value: frxHAlign): HResult; stdcall; function Get_HideZeros(out Value: WordBool): HResult; stdcall; function Set_HideZeros(Value: WordBool): HResult; stdcall; function Get_Highlight(out Value: IfrxHighlight): HResult; stdcall; function Get_LineSpacing(out Value: Double): HResult; stdcall; function Set_LineSpacing(Value: Double): HResult; stdcall; function Get_Memo(out Value: WideString): HResult; stdcall; function Set_Memo(const Value: WideString): HResult; stdcall; function Get_ParagraphGap(out Value: Double): HResult; stdcall; function Set_ParagraphGap(Value: Double): HResult; stdcall; function Get_ParentFont(out Value: WordBool): HResult; stdcall; function Set_ParentFont(Value: WordBool): HResult; stdcall; function Get_Rotation(out Value: Integer): HResult; stdcall; function Set_Rotation(Value: Integer): HResult; stdcall; function Get_RTLReading(out Value: WordBool): HResult; stdcall; function Set_RTLReading(Value: WordBool): HResult; stdcall; function Get_Style(out Value: WideString): HResult; stdcall; function Set_Style(const Value: WideString): HResult; stdcall; function Get_SuppressRepeated(out Value: WordBool): HResult; stdcall; function Set_SuppressRepeated(Value: WordBool): HResult; stdcall; function Get_Underlines(out Value: WordBool): HResult; stdcall; function Set_Underlines(Value: WordBool): HResult; stdcall; function Get_WordBreak(out Value: WordBool): HResult; stdcall; function Set_WordBreak(Value: WordBool): HResult; stdcall; function Get_WordWrap(out Value: WordBool): HResult; stdcall; function Set_WordWrap(Value: WordBool): HResult; stdcall; function Get_VAlign(out Value: frxVAlign): HResult; stdcall; function Set_VAlign(Value: frxVAlign): HResult; stdcall; {$ELSE} TfrxMemoView = class(TfrxCustomMemoView) {$ENDIF} published property AutoWidth; property AllowExpressions; property AllowHTMLTags; property BrushStyle; property CharSpacing; property Clipped; property Color; property DataField; property DataSet; property DataSetName; property DisplayFormat; property ExpressionDelimiters; property FlowTo; property Font; property Frame; property GapX; property GapY; property HAlign; property HideZeros; property Highlight; property LineSpacing; property Memo; property ParagraphGap; property ParentFont; property Rotation; property RTLReading; property Style; property SuppressRepeated; property Underlines; property WordBreak; property WordWrap; property Wysiwyg; property VAlign; end; TfrxSysMemoView = class(TfrxCustomMemoView) public class function GetDescription: String; override; published property AutoWidth; property BrushStyle; property CharSpacing; property Color; property DisplayFormat; property Font; property Frame; property GapX; property GapY; property HAlign; property HideZeros; property Highlight; property Memo; property ParentFont; property Rotation; property RTLReading; property Style; property SuppressRepeated; property VAlign; property WordWrap; end; TfrxCustomLineView = class(TfrxStretcheable) private FDiagonal: Boolean; FArrowEnd: Boolean; FArrowLength: Integer; FArrowSolid: Boolean; FArrowStart: Boolean; FArrowWidth: Integer; procedure DrawArrow(x1, y1, x2, y2: Integer); procedure DrawDiagonalLine; public constructor Create(AOwner: TComponent); override; constructor DesignCreate(AOwner: TComponent; Flags: Word); override; procedure Draw(Canvas: TCanvas; ScaleX, ScaleY, OffsetX, OffsetY: Extended); override; property ArrowEnd: Boolean read FArrowEnd write FArrowEnd default False; property ArrowLength: Integer read FArrowLength write FArrowLength default 20; property ArrowSolid: Boolean read FArrowSolid write FArrowSolid default False; property ArrowStart: Boolean read FArrowStart write FArrowStart default False; property ArrowWidth: Integer read FArrowWidth write FArrowWidth default 5; property Diagonal: Boolean read FDiagonal write FDiagonal default False; published property TagStr; end; TfrxLineView = class(TfrxCustomLineView) public class function GetDescription: String; override; published property ArrowEnd; property ArrowLength; property ArrowSolid; property ArrowStart; property ArrowWidth; property Frame; property Diagonal; end; {$IFDEF FR_COM} TfrxPictureView = class(TfrxView, IfrxPictureView) {$ELSE} TfrxPictureView = class(TfrxView) {$ENDIF} private FAutoSize: Boolean; FCenter: Boolean; FFileLink: String; FImageIndex: Integer; FIsImageIndexStored: Boolean; FIsPictureStored: Boolean; FKeepAspectRatio: Boolean; FPicture: TPicture; FPictureChanged: Boolean; FStretched: Boolean; procedure SetPicture(const Value: TPicture); procedure PictureChanged(Sender: TObject); procedure SetAutoSize(const Value: Boolean); {$IFDEF FR_COM} protected function Get_Picture(out Value: OLE_HANDLE): HResult; stdcall; function Set_Picture(Value: OLE_HANDLE): HResult; stdcall; function Get_Metafile(out Value: OLE_HANDLE): HResult; stdcall; function Set_Metafile(Value: OLE_HANDLE): HResult; stdcall; function LoadViewFromStream(const Stream: IUnknown): HResult; stdcall; function SaveViewToStream(const Stream: IUnknown): HResult; stdcall; {$ENDIF} public constructor Create(AOwner: TComponent); override; destructor Destroy; override; class function GetDescription: String; override; function Diff(AComponent: TfrxComponent): String; override; function LoadPictureFromStream(s: TStream): HResult; procedure Draw(Canvas: TCanvas; ScaleX, ScaleY, OffsetX, OffsetY: Extended); override; procedure GetData; override; property IsImageIndexStored: Boolean read FIsImageIndexStored write FIsImageIndexStored; property IsPictureStored: Boolean read FIsPictureStored write FIsPictureStored; published property Cursor; property AutoSize: Boolean read FAutoSize write SetAutoSize default False; property Center: Boolean read FCenter write FCenter default False; property DataField; property DataSet; property DataSetName; property Frame; property FileLink: String read FFileLink write FFileLink; property ImageIndex: Integer read FImageIndex write FImageIndex stored FIsImageIndexStored; property KeepAspectRatio: Boolean read FKeepAspectRatio write FKeepAspectRatio default True; property Picture: TPicture read FPicture write SetPicture stored FIsPictureStored; property Stretched: Boolean read FStretched write FStretched default True; property TagStr; property URL; end; {$IFDEF FR_COM} TfrxShapeView = class(TfrxView, IfrxShapeView) {$ELSE} TfrxShapeView = class(TfrxView) {$ENDIF} private FCurve: Integer; FShape: TfrxShapeKind; {$IFDEF FR_COM} function Get_Curve(out Value: Integer): HResult; stdcall; function Set_Curve(Value: Integer): HResult; stdcall; function Get_ShapeType(out Value: frxShapeType): HResult; stdcall; function Set_ShapeType(Value: frxShapeType): HResult; stdcall; {$ENDIF} public constructor Create(AOwner: TComponent); override; constructor DesignCreate(AOwner: TComponent; Flags: Word); override; function Diff(AComponent: TfrxComponent): String; override; procedure Draw(Canvas: TCanvas; ScaleX, ScaleY, OffsetX, OffsetY: Extended); override; class function GetDescription: String; override; published property BrushStyle; property Color; property Cursor; property Curve: Integer read FCurve write FCurve default 0; property Frame; property Shape: TfrxShapeKind read FShape write FShape default skRectangle; property TagStr; property URL; end; {$IFDEF FR_COM} TfrxSubreport = class(TfrxView, IfrxSubreport) {$ELSE} TfrxSubreport = class(TfrxView) {$ENDIF} private FPage: TfrxReportPage; FPrintOnParent: Boolean; procedure SetPage(const Value: TfrxReportPage); {$IFDEF FR_COM} function Get_Page(out Value: IfrxReportPage): HResult; stdcall; function Set_Page(const Value: IfrxReportPage): HResult; stdcall; function Get_PrintOnparent(out Value: WordBool): HResult; stdcall; function Set_PrintOnparent(Value: WordBool): HResult; stdcall; {$ENDIF} public constructor Create(AOwner: TComponent); override; destructor Destroy; override; procedure Draw(Canvas: TCanvas; ScaleX, ScaleY, OffsetX, OffsetY: Extended); override; class function GetDescription: String; override; published property Page: TfrxReportPage read FPage write SetPage; property PrintOnParent: Boolean read FPrintOnParent write FPrintOnParent default False; end; { Bands } TfrxChild = class; {$IFDEF FR_COM} TfrxBand = class(TfrxReportComponent, IfrxBand) {$ELSE} TfrxBand = class(TfrxReportComponent) {$ENDIF} private FAllowSplit: Boolean; FChild: TfrxChild; FKeepChild: Boolean; FOnAfterCalcHeight: TfrxNotifyEvent; FOutlineText: String; FOverflow: Boolean; FStartNewPage: Boolean; FStretched: Boolean; FPrintChildIfInvisible: Boolean; FVertical: Boolean; function GetBandName: String; procedure SetChild(Value: TfrxChild); protected procedure Notification(AComponent: TComponent; Operation: TOperation); override; procedure SetLeft(Value: Extended); override; procedure SetTop(Value: Extended); override; procedure SetHeight(Value: Extended); override; {$IFDEF FR_COM} { IfrxBand } function IfrxBand.Get_AllowSplit = IfrxBand_Get_AllowSplit; function IfrxBand.Set_AllowSplit = IfrxBand_Set_AllowSplit; function IfrxBand.Get_KeepChild = IfrxBand_Get_KeepChild; function IfrxBand.Set_KeepChild = IfrxBand_Set_KeepChild; function IfrxBand.Get_OutlineText = IfrxBand_Get_OutlineText; function IfrxBand.Set_OutlineText = IfrxBand_Set_OutlineText; function IfrxBand.Get_Overflow = IfrxBand_Get_Overflow; function IfrxBand.Set_Overflow = IfrxBand_Set_Overflow; function IfrxBand.Get_StartNewPage = IfrxBand_Get_StartNewPage; function IfrxBand.Set_StartNewPage = IfrxBand_Set_StartNewPage; function IfrxBand.Get_Stretched = IfrxBand_Get_Stretched; function IfrxBand.Set_Stretched = IfrxBand_Set_Stretched; function IfrxBand.Get_PrintChildIfInvisible = IfrxBand_Get_PrintChildIfInvisible; function IfrxBand.Set_PrintChildIfInvisible = IfrxBand_Set_PrintChildIfInvisible; function IfrxBand.Get_Vertical = IfrxBand_Get_Vertical; function IfrxBand.Set_Vertical = IfrxBand_Set_Vertical; function IfrxBand.Get_BandName = IfrxBand_Get_BandName; function IfrxBand_Get_AllowSplit(out Value: WordBool): HResult; stdcall; function IfrxBand_Set_AllowSplit(Value: WordBool): HResult; stdcall; function IfrxBand_Get_KeepChild(out Value: WordBool): HResult; stdcall; function IfrxBand_Set_KeepChild(Value: WordBool): HResult; stdcall; function IfrxBand_Get_OutlineText(out Value: WideString): HResult; stdcall; function IfrxBand_Set_OutlineText(const Value: WideString): HResult; stdcall; function IfrxBand_Get_Overflow(out Value: WordBool): HResult; stdcall; function IfrxBand_Set_Overflow(Value: WordBool): HResult; stdcall; function IfrxBand_Get_StartNewPage(out Value: WordBool): HResult; stdcall; function IfrxBand_Set_StartNewPage(Value: WordBool): HResult; stdcall; function IfrxBand_Get_Stretched(out Value: WordBool): HResult; stdcall; function IfrxBand_Set_Stretched(Value: WordBool): HResult; stdcall; function IfrxBand_Get_PrintChildIfInvisible(out Value: WordBool): HResult; stdcall; function IfrxBand_Set_PrintChildIfInvisible(Value: WordBool): HResult; stdcall; function IfrxBand_Get_Vertical(out Value: WordBool): HResult; stdcall; function IfrxBand_Set_Vertical(Value: WordBool): HResult; stdcall; function IfrxBand_Get_BandName(out Value: WideString): HResult; stdcall; function Get_Child(out Value: IfrxChild): HResult; stdcall; function Set_Child(const Value: IfrxChild): HResult; stdcall; {$ENDIF} public FSubBands: TList; { list of subbands } FHeader, FFooter, FGroup: TfrxBand; { h./f./g. bands } FLineN: Integer; { used for Line# } FLineThrough: Integer; { used for LineThrough# } FOriginalObjectsCount: Integer; { used for TfrxSubReport.PrintOnParent } FHasVBands: Boolean; { whether the band should show vbands } FStretchedHeight: Extended; constructor Create(AOwner: TComponent); override; destructor Destroy; override; function BandNumber: Integer; procedure Draw(Canvas: TCanvas; ScaleX, ScaleY, OffsetX, OffsetY: Extended); override; class function GetDescription: String; override; property AllowSplit: Boolean read FAllowSplit write FAllowSplit default False; property BandName: String read GetBandName; property Child: TfrxChild read FChild write SetChild; property KeepChild: Boolean read FKeepChild write FKeepChild default False; property OutlineText: String read FOutlineText write FOutlineText; property Overflow: Boolean read FOverflow write FOverflow; property PrintChildIfInvisible: Boolean read FPrintChildIfInvisible write FPrintChildIfInvisible default False; property StartNewPage: Boolean read FStartNewPage write FStartNewPage default False; property Stretched: Boolean read FStretched write FStretched default False; published property Font; property Height; property Left; property ParentFont; property Restrictions; property Top; property Vertical: Boolean read FVertical write FVertical default False; property Visible; property Width; property OnAfterCalcHeight: TfrxNotifyEvent read FOnAfterCalcHeight write FOnAfterCalcHeight; property OnAfterPrint; property OnBeforePrint; end; TfrxBandClass = class of TfrxBand; {$IFDEF FR_COM} TfrxDataBand = class(TfrxBand, IfrxDataBand) {$ELSE} TfrxDataBand = class(TfrxBand) {$ENDIF} private FColumnGap: Extended; FColumnWidth: Extended; FColumns: Integer; FCurColumn: Integer; FDataSet: TfrxDataSet; FDataSetName: String; FFooterAfterEach: Boolean; FKeepFooter: Boolean; FKeepHeader: Boolean; FKeepTogether: Boolean; FPrintIfDetailEmpty: Boolean; FRowCount: Integer; FOnMasterDetail: TfrxNotifyEvent; FVirtualDataSet: TfrxUserDataSet; procedure SetCurColumn(Value: Integer); procedure SetRowCount(const Value: Integer); procedure SetDataSet(const Value: TfrxDataSet); procedure SetDataSetName(const Value: String); function GetDataSetName: String; protected procedure Notification(AComponent: TComponent; Operation: TOperation); override; {$IFDEF FR_COM} {IfrxDataBand} function Get_ColumnGap(out Value: Double): HResult; stdcall; function Set_ColumnGap(Value: Double): HResult; stdcall; function Get_ColumnWidth(out Value: Double): HResult; stdcall; function Set_ColumnWidth(Value: Double): HResult; stdcall; function Get_ColumnsCount(out Value: Integer): HResult; stdcall; function Set_ColumnsCount(Value: Integer): HResult; stdcall; function Get_CurrentColumn(out Value: Integer): HResult; stdcall; function Set_CurrentColumn(Value: Integer): HResult; stdcall; function Get_DataSet(out Value: IfrxDataSet): HResult; stdcall; function Set_DataSet(const Value: IfrxDataSet): HResult; stdcall; function Get_FooterAfterEach(out Value: WordBool): HResult; stdcall; function Set_FooterAfterEach(Value: WordBool): HResult; stdcall; function Get_KeepFooter(out Value: WordBool): HResult; stdcall; function Set_KeepFooter(Value: WordBool): HResult; stdcall; function Get_KeepHeader(out Value: WordBool): HResult; stdcall; function Set_KeepHeader(Value: WordBool): HResult; stdcall; function Get_KeepTogether(out Value: WordBool): HResult; stdcall; function Set_KeepTogether(Value: WordBool): HResult; stdcall; function Get_PrintIfDetailEmpty(out Value: WordBool): HResult; stdcall; function Set_PrintIfDetailEmpty(Value: WordBool): HResult; stdcall; function Get_RowCount(out Value: Integer): HResult; stdcall; function Set_RowCount(Value: Integer): HResult; stdcall; function ResetDataSet: HResult; stdcall; {$ENDIF} public FMaxY: Extended; { used for columns } constructor Create(AOwner: TComponent); override; destructor Destroy; override; class function GetDescription: String; override; property CurColumn: Integer read FCurColumn write SetCurColumn; property VirtualDataSet: TfrxUserDataSet read FVirtualDataSet; published property AllowSplit; property Child; property Columns: Integer read FColumns write FColumns default 0; property ColumnWidth: Extended read FColumnWidth write FColumnWidth; property ColumnGap: Extended read FColumnGap write FColumnGap; property DataSet: TfrxDataSet read FDataSet write SetDataSet; property DataSetName: String read GetDataSetName write SetDataSetName; property FooterAfterEach: Boolean read FFooterAfterEach write FFooterAfterEach default False; property KeepChild; property KeepFooter: Boolean read FKeepFooter write FKeepFooter default False; property KeepHeader: Boolean read FKeepHeader write FKeepHeader default False; property KeepTogether: Boolean read FKeepTogether write FKeepTogether default False; property OutlineText; property PrintChildIfInvisible; property PrintIfDetailEmpty: Boolean read FPrintIfDetailEmpty write FPrintIfDetailEmpty default False; property RowCount: Integer read FRowCount write SetRowCount; property StartNewPage; property Stretched; property OnMasterDetail: TfrxNotifyEvent read FOnMasterDetail write FOnMasterDetail; end; {$IFDEF FR_COM} TfrxHeader = class(TfrxBand, IfrxHeader) {$ELSE} TfrxHeader = class(TfrxBand) {$ENDIF} private FReprintOnNewPage: Boolean; {$IFDEF FR_COM} function Get_ReprintOnNewPage(out Value: WordBool): HResult; stdcall; function Set_ReprintOnNewPage(Value: WordBool): HResult; stdcall; {$ENDIF} published property AllowSplit; property Child; property KeepChild; property PrintChildIfInvisible; property ReprintOnNewPage: Boolean read FReprintOnNewPage write FReprintOnNewPage default False; property StartNewPage; property Stretched; end; {$IFDEF FR_COM} TfrxFooter = class(TfrxBand, IfrxFooter) {$ELSE} TfrxFooter = class(TfrxBand) {$ENDIF} private public published property AllowSplit; property Child; property KeepChild; property PrintChildIfInvisible; property Stretched; end; {$IFDEF FR_COM} TfrxMasterData = class(TfrxDataBand, IfrxMasterData) {$ELSE} TfrxMasterData = class(TfrxDataBand) {$ENDIF} private public published end; {$IFDEF FR_COM} TfrxDetailData = class(TfrxDataBand, IfrxDetailData) {$ELSE} TfrxDetailData = class(TfrxDataBand) {$ENDIF} private public published end; {$IFDEF FR_COM} TfrxSubdetailData = class(TfrxDataBand, IfrxSubdetailData) {$ELSE} TfrxSubdetailData = class(TfrxDataBand) {$ENDIF} private public published end; {$IFDEF FR_COM} TfrxDataBand4 = class(TfrxDataBand, IfrxDataBand4) {$ELSE} TfrxDataBand4 = class(TfrxDataBand) {$ENDIF} private public published end; {$IFDEF FR_COM} TfrxDataBand5 = class(TfrxDataBand, IfrxDataBand6) {$ELSE} TfrxDataBand5 = class(TfrxDataBand) {$ENDIF} private public published end; {$IFDEF FR_COM} TfrxDataBand6 = class(TfrxDataBand, IfrxDataBand6) {$ELSE} TfrxDataBand6 = class(TfrxDataBand) {$ENDIF} private public published end; {$IFDEF FR_COM} TfrxPageHeader = class(TfrxBand, IfrxPageHeader) {$ELSE} TfrxPageHeader = class(TfrxBand) {$ENDIF} private FPrintOnFirstPage: Boolean; {$IFDEF FR_COM} function Get_PrintOnFirstPage(out Value: WordBool): HResult; stdcall; function Set_PrintOnFirstPage(Value: WordBool): HResult; stdcall; {$ENDIF} public constructor Create(AOwner: TComponent); override; published property Child; property PrintChildIfInvisible; property PrintOnFirstPage: Boolean read FPrintOnFirstPage write FPrintOnFirstPage default True; property Stretched; end; {$IFDEF FR_COM} TfrxPageFooter = class(TfrxBand, IfrxPageFooter) {$ELSE} TfrxPageFooter = class(TfrxBand) {$ENDIF} private FPrintOnFirstPage: Boolean; FPrintOnLastPage: Boolean; {$IFDEF FR_COM} function Get_PrintOnFirstPage(out Value: WordBool): HResult; stdcall; function Set_PrintOnFirstPage(Value: WordBool): HResult; stdcall; function Get_PrintOnLastPage(out Value: WordBool): HResult; stdcall; function Set_PrintOnLastPage(Value: WordBool): HResult; stdcall; {$ENDIF} public constructor Create(AOwner: TComponent); override; published property PrintOnFirstPage: Boolean read FPrintOnFirstPage write FPrintOnFirstPage default True; property PrintOnLastPage: Boolean read FPrintOnLastPage write FPrintOnLastPage default True; end; {$IFDEF FR_COM} TfrxColumnHeader = class(TfrxBand, IfrxColumnHeader) {$ELSE} TfrxColumnHeader = class(TfrxBand) {$ENDIF} private public published property Child; property Stretched; end; {$IFDEF FR_COM} TfrxColumnFooter = class(TfrxBand, IfrxColumnFooter) {$ELSE} TfrxColumnFooter = class(TfrxBand) {$ENDIF} private public published end; {$IFDEF FR_COM} TfrxGroupHeader = class(TfrxBand, IfrxGroupHeader) {$ELSE} TfrxGroupHeader = class(TfrxBand) {$ENDIF} private FCondition: String; FDrillDown: Boolean; FExpandDrillDown: Boolean; FShowFooterIfDrillDown: Boolean; FKeepTogether: Boolean; FReprintOnNewPage: Boolean; FResetPageNumbers: Boolean; {$IFDEF FR_COM} function Get_Condition(out Value: WideString): HResult; stdcall; function Set_Condition(const Value: WideString): HResult; stdcall; function Get_KeepTogether(out Value: WordBool): HResult; stdcall; function Set_KeepTogether(Value: WordBool): HResult; stdcall; function Get_ReprintOnNewPage(out Value: WordBool): HResult; stdcall; function Set_ReprintOnNewPage(Value: WordBool): HResult; stdcall; function Get_LastValue(out Value: OleVariant): HResult; stdcall; {$ENDIF} public FLastValue: Variant; function Diff(AComponent: TfrxComponent): String; override; published property AllowSplit; property Child; property Condition: String read FCondition write FCondition; property DrillDown: Boolean read FDrillDown write FDrillDown default False; property ExpandDrillDown: Boolean read FExpandDrillDown write FExpandDrillDown default False; property KeepChild; property KeepTogether: Boolean read FKeepTogether write FKeepTogether default False; property ReprintOnNewPage: Boolean read FReprintOnNewPage write FReprintOnNewPage default False; property OutlineText; property PrintChildIfInvisible; property ResetPageNumbers: Boolean read FResetPageNumbers write FResetPageNumbers default False; property ShowFooterIfDrillDown: Boolean read FShowFooterIfDrillDown write FShowFooterIfDrillDown default False; property StartNewPage; property Stretched; end; {$IFDEF FR_COM} TfrxGroupFooter = class(TfrxBand, IfrxGroupFooter) {$ELSE} TfrxGroupFooter = class(TfrxBand) {$ENDIF} private FHideIfSingleDataRecord: Boolean; {$IFDEF FR_COM} function Get_HideIfSingledatarecord(out Value: WordBool): HResult; stdcall; function Set_HideIfSingledatarecord(Value: WordBool): HResult; stdcall; {$ENDIF} public published property AllowSplit; property Child; property HideIfSingleDataRecord: Boolean read FHideIfSingleDataRecord write FHideIfSingleDataRecord default False; property KeepChild; property PrintChildIfInvisible; property Stretched; end; {$IFDEF FR_COM} TfrxReportTitle = class(TfrxBand, IfrxReportTitle) {$ELSE} TfrxReportTitle = class(TfrxBand) {$ENDIF} private public published property AllowSplit; property Child; property KeepChild; property PrintChildIfInvisible; property StartNewPage; property Stretched; end; {$IFDEF FR_COM} TfrxReportSummary = class(TfrxBand, IfrxReportSummary) {$ELSE} TfrxReportSummary = class(TfrxBand) {$ENDIF} private public published property AllowSplit; property Child; property KeepChild; property PrintChildIfInvisible; property StartNewPage; property Stretched; end; {$IFDEF FR_COM} TfrxChild = class(TfrxBand, IfrxChild) {$ELSE} TfrxChild = class(TfrxBand) {$ENDIF} private public published property AllowSplit; property Child; property KeepChild; property PrintChildIfInvisible; property StartNewPage; property Stretched; end; {$IFDEF FR_COM} TfrxOverlay = class(TfrxBand, IfrxOverlay) {$ELSE} TfrxOverlay = class(TfrxBand) {$ENDIF} private FPrintOnTop: Boolean; public published property PrintOnTop: Boolean read FPrintOnTop write FPrintOnTop default False; end; TfrxNullBand = class(TfrxBand); { Pages } {$IFDEF FR_COM} TfrxPage = class(TfrxComponent, IfrxPage) {$ELSE} TfrxPage = class(TfrxComponent) {$ENDIF} private protected {$IFDEF FR_COM} function Get_Visible(out Value: WordBool): HResult; stdcall; function Set_Visible(Value: WordBool): HResult; stdcall; {$ENDIF} public published property Font; property Visible; end; {$IFDEF FR_COM} TfrxReportPage = class(TfrxPage, IfrxReportPage) {$ELSE} TfrxReportPage = class(TfrxPage) {$ENDIF} private FBackPicture: TfrxPictureView; FBin: Integer; FBinOtherPages: Integer; FBottomMargin: Extended; FColumns: Integer; FColumnWidth: Extended; FColumnPositions: TStrings; FDataSet: TfrxDataSet; FDuplex: TfrxDuplexMode; FEndlessHeight: Boolean; FEndlessWidth: Boolean; FHGuides: TStrings; FLargeDesignHeight: Boolean; FLeftMargin: Extended; FMirrorMargins: Boolean; FOrientation: TPrinterOrientation; FOutlineText: String; FPrintIfEmpty: Boolean; FPrintOnPreviousPage: Boolean; FResetPageNumbers: Boolean; FRightMargin: Extended; FSubReport: TfrxSubReport; FTitleBeforeHeader: Boolean; FTopMargin: Extended; FVGuides: TStrings; FOnAfterPrint: TfrxNotifyEvent; FOnBeforePrint: TfrxNotifyEvent; FOnManualBuild: TfrxNotifyEvent; FDataSetName: String; procedure SetColumns(const Value: Integer); procedure SetOrientation(Value: TPrinterOrientation); procedure SetHGuides(const Value: TStrings); procedure SetVGuides(const Value: TStrings); procedure SetColumnPositions(const Value: TStrings); procedure SetFrame(const Value: TfrxFrame); function GetFrame: TfrxFrame; function GetColor: TColor; procedure SetColor(const Value: TColor); function GetBackPicture: TPicture; procedure SetBackPicture(const Value: TPicture); procedure SetDataSet(const Value: TfrxDataSet); procedure SetDataSetName(const Value: String); function GetDataSetName: String; protected FPaperHeight: Extended; FPaperSize: Integer; FPaperWidth: Extended; procedure Notification(AComponent: TComponent; Operation: TOperation); override; procedure SetPaperHeight(const Value: Extended); virtual; procedure SetPaperWidth(const Value: Extended); virtual; procedure SetPaperSize(const Value: Integer); virtual; procedure UpdateDimensions; public FSubBands: TList; { list of master bands } FVSubBands: TList; { list of vertical master bands } constructor Create(AOwner: TComponent); override; destructor Destroy; override; class function GetDescription: String; override; function FindBand(Band: TfrxBandClass): TfrxBand; function IsSubReport: Boolean; procedure AlignChildren; override; procedure ClearGuides; procedure Draw(Canvas: TCanvas; ScaleX, ScaleY, OffsetX, OffsetY: Extended); procedure SetDefaults; virtual; procedure SetSizeAndDimensions(ASize: Integer; AWidth, AHeight: Extended); property SubReport: TfrxSubReport read FSubReport; published { paper } property Orientation: TPrinterOrientation read FOrientation write SetOrientation default poPortrait; property PaperWidth: Extended read FPaperWidth write SetPaperWidth; property PaperHeight: Extended read FPaperHeight write SetPaperHeight; property PaperSize: Integer read FPaperSize write SetPaperSize; { margins } property LeftMargin: Extended read FLeftMargin write FLeftMargin; property RightMargin: Extended read FRightMargin write FRightMargin; property TopMargin: Extended read FTopMargin write FTopMargin; property BottomMargin: Extended read FBottomMargin write FBottomMargin; property MirrorMargins: Boolean read FMirrorMargins write FMirrorMargins default False; { columns } property Columns: Integer read FColumns write SetColumns default 0; property ColumnWidth: Extended read FColumnWidth write FColumnWidth; property ColumnPositions: TStrings read FColumnPositions write SetColumnPositions; { bins } property Bin: Integer read FBin write FBin default DMBIN_AUTO; property BinOtherPages: Integer read FBinOtherPages write FBinOtherPages default DMBIN_AUTO; { other } property BackPicture: TPicture read GetBackPicture write SetBackPicture; property Color: TColor read GetColor write SetColor default clNone; property DataSet: TfrxDataSet read FDataSet write SetDataSet; property DataSetName: String read GetDataSetName write SetDataSetName; property Duplex: TfrxDuplexMode read FDuplex write FDuplex default dmNone; property Frame: TfrxFrame read GetFrame write SetFrame; property EndlessHeight: Boolean read FEndlessHeight write FEndlessHeight default False; property EndlessWidth: Boolean read FEndlessWidth write FEndlessWidth default False; property LargeDesignHeight: Boolean read FLargeDesignHeight write FLargeDesignHeight default False; property OutlineText: String read FOutlineText write FOutlineText; property PrintIfEmpty: Boolean read FPrintIfEmpty write FPrintIfEmpty default True; property PrintOnPreviousPage: Boolean read FPrintOnPreviousPage write FPrintOnPreviousPage default False; property ResetPageNumbers: Boolean read FResetPageNumbers write FResetPageNumbers default False; property TitleBeforeHeader: Boolean read FTitleBeforeHeader write FTitleBeforeHeader default True; property HGuides: TStrings read FHGuides write SetHGuides; property VGuides: TStrings read FVGuides write SetVGuides; property OnAfterPrint: TfrxNotifyEvent read FOnAfterPrint write FOnAfterPrint; property OnBeforePrint: TfrxNotifyEvent read FOnBeforePrint write FOnBeforePrint; property OnManualBuild: TfrxNotifyEvent read FOnManualBuild write FOnManualBuild; {$IFDEF FR_COM} { IfrxReportPage } function IfrxReportPage.SetDefaults = IfrxReportPage_SetDefaults; function IfrxReportPage.Get_Bin = IfrxReportPage_Get_Bin; function IfrxReportPage.Set_Bin = IfrxReportPage_Set_Bin; function IfrxReportPage.Get_BinOtherPages = IfrxReportPage_Get_BinOtherPages; function IfrxReportPage.Set_BinOtherPages = IfrxReportPage_Set_BinOtherPages; function IfrxReportPage.Get_BottomMargin = IfrxReportPage_Get_BottomMargin; function IfrxReportPage.Set_BottomMargin = IfrxReportPage_Set_BottomMargin; function IfrxReportPage.Get_Columns = IfrxReportPage_Get_Columns; function IfrxReportPage.Set_Columns = IfrxReportPage_Set_Columns; function IfrxReportPage.Get_ColumnWidth = IfrxReportPage_Get_ColumnWidth; function IfrxReportPage.Set_ColumnWidth = IfrxReportPage_Set_ColumnWidth; function IfrxReportPage.Get_ColumnPositions = IfrxReportPage_Get_ColumnPosition; function IfrxReportPage.Set_ColumnPositions = IfrxReportPage_Set_ColumnPosition; function IfrxReportPage.Get_DataSet = IfrxReportPage_Get_DataSet; function IfrxReportPage.Set_DataSet = IfrxReportPage_Set_DataSet; function IfrxReportPage.Get_Duplex = IfrxReportPage_Get_Duplex; function IfrxReportPage.Set_Duplex = IfrxReportPage_Set_Duplex; function IfrxReportPage.Get_HGuides = IfrxReportPage_Get_HGuides; function IfrxReportPage.Set_HGuides = IfrxReportPage_Set_HGuides; function IfrxReportPage.Get_LargeDesignHeight = IfrxReportPage_Get_LargeDesignHeight; function IfrxReportPage.Set_LargeDesignHeight = IfrxReportPage_Set_LargeDesignHeight; function IfrxReportPage.Get_LeftMargin = IfrxReportPage_Get_LeftMargin; function IfrxReportPage.Set_LeftMargin = IfrxReportPage_Set_LeftMargin; function IfrxReportPage.Get_MirrorMargins = IfrxReportPage_Get_MirrorMargins; function IfrxReportPage.Set_MirrorMargins = IfrxReportPage_Set_MirrorMargins; function IfrxReportPage.Get_Orientation = IfrxReportPage_Get_Orientation; function IfrxReportPage.Set_Orientation = IfrxReportPage_Set_Orientation; function IfrxReportPage.Get_OutlineText = IfrxReportPage_Get_OutlineText; function IfrxReportPage.Set_OutlineText = IfrxReportPage_Set_OutlineText; function IfrxReportPage.Get_PrintIfEmpty = IfrxReportPage_Get_PrintIfEmpty; function IfrxReportPage.Set_PrintIfEmpty = IfrxReportPage_Set_PrintIfEmpty; function IfrxReportPage.Get_PrintOnPreviousPage = IfrxReportPage_Get_PrintOnPreviousPage; function IfrxReportPage.Set_PrintOnPreviousPage = IfrxReportPage_Set_PrintOnPreviousPage; function IfrxReportPage.Get_RightMargin = IfrxReportPage_Get_RightMargin; function IfrxReportPage.Set_RightMargin = IfrxReportPage_Set_RightMargin; function IfrxReportPage.Get_SubReport = IfrxReportPage_Get_SubReport; function IfrxReportPage.Set_SubReport = IfrxReportPage_Set_SubReport; function IfrxReportPage.Get_TitleBeforeHeader = IfrxReportPage_Get_TitleBeforeHeader; function IfrxReportPage.Set_TitleBeforeHeader = IfrxReportPage_Set_TitleBeforeHeader; function IfrxReportPage.Get_TopMargin = IfrxReportPage_Get_TopMargin; function IfrxReportPage.Set_TopMargin = IfrxReportPage_Set_TopMargin; function IfrxReportPage.Get_VGuides = IfrxReportPage_Get_VGuides; function IfrxReportPage.Set_VGuides = IfrxReportPage_Set_VGuides; function IfrxReportPage.Get_BackPickture = IfrxReportPage_Get_BackPickture; function IfrxReportPage.Set_BackPickture = IfrxReportPage_Set_BackPickture; function IfrxReportPage_SetDefaults: HResult; stdcall; function IfrxReportPage_Get_Bin(out Value: SYSINT): HResult; stdcall; function IfrxReportPage_Set_Bin(Value: SYSINT): HResult; stdcall; function IfrxReportPage_Get_BinOtherPages(out Value: SYSINT): HResult; stdcall; function IfrxReportPage_Set_BinOtherPages(Value: SYSINT): HResult; stdcall; function IfrxReportPage_Get_BottomMargin(out Value: Double): HResult; stdcall; function IfrxReportPage_Set_BottomMargin(Value: Double): HResult; stdcall; function IfrxReportPage_Get_Columns(out Value: SYSINT): HResult; stdcall; function IfrxReportPage_Set_Columns(Value: SYSINT): HResult; stdcall; function IfrxReportPage_Get_ColumnWidth(out Value: Double): HResult; stdcall; function IfrxReportPage_Set_ColumnWidth(Value: Double): HResult; stdcall; function IfrxReportPage_Get_ColumnPosition(out Value: WideString): HResult; stdcall; function IfrxReportPage_Set_ColumnPosition(const Value: WideString): HResult; stdcall; function IfrxReportPage_Get_DataSet(out Value: IfrxDataSet): HResult; stdcall; function IfrxReportPage_Set_DataSet(const Value: IfrxDataSet): HResult; stdcall; function IfrxReportPage_Get_Duplex(out Value: frxDuplexMode): HResult; stdcall; function IfrxReportPage_Set_Duplex(Value: frxDuplexMode): HResult; stdcall; function IfrxReportPage_Get_HGuides(out Value: WideString): HResult; stdcall; function IfrxReportPage_Set_HGuides(const Value: WideString): HResult; stdcall; function IfrxReportPage_Get_LargeDesignHeight(out Value: WordBool): HResult; stdcall; function IfrxReportPage_Set_LargeDesignHeight(Value: WordBool): HResult; stdcall; function IfrxReportPage_Get_LeftMargin(out Value: Double): HResult; stdcall; function IfrxReportPage_Set_LeftMargin(Value: Double): HResult; stdcall; function IfrxReportPage_Get_MirrorMargins(out Value: WordBool): HResult; stdcall; function IfrxReportPage_Set_MirrorMargins(Value: WordBool): HResult; stdcall; function IfrxReportPage_Get_Orientation(out Value: frxPrinterOrientation): HResult; stdcall; function IfrxReportPage_Set_Orientation(Value: frxPrinterOrientation): HResult; stdcall; function IfrxReportPage_Get_OutlineText(out Value: WideString): HResult; stdcall; function IfrxReportPage_Set_OutlineText(const Value: WideString): HResult; stdcall; function IfrxReportPage_Get_PrintIfEmpty(out Value: WordBool): HResult; stdcall; function IfrxReportPage_Set_PrintIfEmpty(Value: WordBool): HResult; stdcall; function IfrxReportPage_Get_PrintOnPreviousPage(out Value: WordBool): HResult; stdcall; function IfrxReportPage_Set_PrintOnPreviousPage(Value: WordBool): HResult; stdcall; function IfrxReportPage_Get_RightMargin(out Value: Double): HResult; stdcall; function IfrxReportPage_Set_RightMargin(Value: Double): HResult; stdcall; function IfrxReportPage_Get_SubReport(out Value: IfrxSubreport): HResult; stdcall; function IfrxReportPage_Set_SubReport(const Value: IfrxSubreport): HResult; stdcall; function IfrxReportPage_Get_TitleBeforeHeader(out Value: WordBool): HResult; stdcall; function IfrxReportPage_Set_TitleBeforeHeader(Value: WordBool): HResult; stdcall; function IfrxReportPage_Get_TopMargin(out Value: Double): HResult; stdcall; function IfrxReportPage_Set_TopMargin(Value: Double): HResult; stdcall; function IfrxReportPage_Get_VGuides(out Value: WideString): HResult; stdcall; function IfrxReportPage_Set_VGuides(const Value: WideString): HResult; stdcall; function IfrxReportPage_Get_BackPickture(out Value: OLE_HANDLE): HResult; stdcall; function IfrxReportPage_Set_BackPickture(Value: OLE_HANDLE): HResult; stdcall; function Get_PaperWidth(out Value: Double): HResult; stdcall; function Set_PaperWidth(Value: Double): HResult; stdcall; function Get_PaperHeight(out Value: Double): HResult; stdcall; function Set_PaperHeight(Value: Double): HResult; stdcall; {$ENDIF} end; TfrxDialogPage = class(TfrxPage) private FBorderStyle: TFormBorderStyle; FCaption: String; FColor: TColor; FForm: TForm; FOnActivate: TfrxNotifyEvent; FOnClick: TfrxNotifyEvent; FOnDeactivate: TfrxNotifyEvent; FOnHide: TfrxNotifyEvent; FOnKeyDown: TfrxKeyEvent; FOnKeyPress: TfrxKeyPressEvent; FOnKeyUp: TfrxKeyEvent; FOnResize: TfrxNotifyEvent; FOnShow: TfrxNotifyEvent; FOnCloseQuery: TfrxCloseQueryEvent; FPosition: TPosition; FWindowState: TWindowState; procedure DoInitialize; procedure DoOnActivate(Sender: TObject); procedure DoOnClick(Sender: TObject); procedure DoOnCloseQuery(Sender: TObject; var CanClose: Boolean); procedure DoOnDeactivate(Sender: TObject); procedure DoOnHide(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 DoOnShow(Sender: TObject); procedure DoOnResize(Sender: TObject); procedure DoModify(Sender: TObject); procedure SetBorderStyle(const Value: TFormBorderStyle); procedure SetCaption(const Value: String); procedure SetColor(const Value: TColor); function GetModalResult: TModalResult; procedure SetModalResult(const Value: TModalResult); protected procedure SetLeft(Value: Extended); override; procedure SetTop(Value: Extended); override; procedure SetWidth(Value: Extended); override; procedure SetHeight(Value: Extended); override; procedure FontChanged(Sender: TObject); override; public constructor Create(AOwner: TComponent); override; destructor Destroy; override; class function GetDescription: String; override; procedure Initialize; function ShowModal: TModalResult; property DialogForm: TForm read FForm; property ModalResult: TModalResult read GetModalResult write SetModalResult; published property BorderStyle: TFormBorderStyle read FBorderStyle write SetBorderStyle default bsSizeable; property Caption: String read FCaption write SetCaption; property Color: TColor read FColor write SetColor default clBtnFace; property Height; property Left; property Position: TPosition read FPosition write FPosition default poScreenCenter; property Top; property Width; property WindowState: TWindowState read FWindowState write FWindowState default wsNormal; property OnActivate: TfrxNotifyEvent read FOnActivate write FOnActivate; property OnClick: TfrxNotifyEvent read FOnClick write FOnClick; property OnCloseQuery: TfrxCloseQueryEvent read FOnCloseQuery write FOnCloseQuery; property OnDeactivate: TfrxNotifyEvent read FOnDeactivate write FOnDeactivate; property OnHide: TfrxNotifyEvent read FOnHide write FOnHide; property OnKeyDown: TfrxKeyEvent read FOnKeyDown write FOnKeyDown; property OnKeyPress: TfrxKeyPressEvent read FOnKeyPress write FOnKeyPress; property OnKeyUp: TfrxKeyEvent read FOnKeyUp write FOnKeyUp; property OnShow: TfrxNotifyEvent read FOnShow write FOnShow; property OnResize: TfrxNotifyEvent read FOnResize write FOnResize; end; TfrxDataPage = class(TfrxPage) private protected public constructor Create(AOwner: TComponent); override; class function GetDescription: String; override; published property Height; property Left; property Top; property Width; end; { Report } {$IFDEF FR_COM} TfrxEngineOptions = class(TDispatchablePersistent, IfrxEngineOptions) {$ELSE} TfrxEngineOptions = class(TPersistent) {$ENDIF} private FConvertNulls: Boolean; FDestroyForms: Boolean; FDoublePass: Boolean; FMaxMemSize: Integer; FPrintIfEmpty: Boolean; {$IFNDEF FR_COM} FReportThread: TThread; {$ENDIF} FEnableThreadSafe: Boolean; FSilentMode: TfrxSilentMode; FTempDir: String; FUseFileCache: Boolean; procedure SetSilentMode(Mode: Boolean); function GetSilentMode: Boolean; public constructor Create; procedure Assign(Source: TPersistent); override; procedure Clear; {$IFNDEF FR_COM} property ReportThread: TThread read FReportThread write FReportThread; {$ENDIF} property DestroyForms: Boolean read FDestroyForms write FDestroyForms; property EnableThreadSafe: Boolean read FEnableThreadSafe write FEnableThreadSafe; published property ConvertNulls: Boolean read FConvertNulls write FConvertNulls default True; property DoublePass: Boolean read FDoublePass write FDoublePass default False; property MaxMemSize: Integer read FMaxMemSize write FMaxMemSize default 10; property PrintIfEmpty: Boolean read FPrintIfEmpty write FPrintIfEmpty default True; property SilentMode: Boolean read GetSilentMode write SetSilentMode default False; property NewSilentMode: TfrxSilentMode read FSilentMode write FSilentMode default simMessageBoxes; property TempDir: String read FTempDir write FTempDir; property UseFileCache: Boolean read FUseFileCache write FUseFileCache default False; {$IFDEF FR_COM} { IfrxEngineOptions } function IfrxEngineOptions.Get_ConvertNulls = IfrxEngineOptions_Get_ConvertNulls; function IfrxEngineOptions.Set_ConvertNulls = IfrxEngineOptions_Set_ConvertNulls; function IfrxEngineOptions.Get_DestroyForms = IfrxEngineOptions_Get_DestroyForms; function IfrxEngineOptions.Set_DestroyForms = IfrxEngineOptions_Set_DestroyForms; function IfrxEngineOptions.Get_DoublePass = IfrxEngineOptions_Get_DoublePass; function IfrxEngineOptions.Set_DoublePass = IfrxEngineOptions_Set_DoublePass; function IfrxEngineOptions.Get_MaxMemSize = IfrxEngineOptions_Get_MaxMemSize; function IfrxEngineOptions.Set_MaxMemSize = IfrxEngineOptions_Set_MaxMemSize; function IfrxEngineOptions.Get_PrintIfEmpty = IfrxEngineOptions_Get_PrintIfEmpty; function IfrxEngineOptions.Set_PrintIfEmpty = IfrxEngineOptions_Set_PrintIfEmpty; function IfrxEngineOptions.Get_SilentMode = IfrxEngineOptions_Get_SilentMode; function IfrxEngineOptions.Set_SilentMode = IfrxEngineOptions_Set_SilentMode; function IfrxEngineOptions.Get_TempDir = IfrxEngineOptions_Get_TempDir; function IfrxEngineOptions.Set_TempDir = IfrxEngineOptions_Set_TempDir; function IfrxEngineOptions.Get_UseFilecache = IfrxEngineOptions_Get_UseFilecache; function IfrxEngineOptions.Set_UseFilecache = IfrxEngineOptions_Set_UseFilecache; function IfrxEngineOptions_Get_ConvertNulls(out Value: WordBool): HResult; stdcall; function IfrxEngineOptions_Set_ConvertNulls(Value: WordBool): HResult; stdcall; function IfrxEngineOptions_Get_DestroyForms(out Value: WordBool): HResult; stdcall; function IfrxEngineOptions_Set_DestroyForms(Value: WordBool): HResult; stdcall; function IfrxEngineOptions_Get_DoublePass(out Value: WordBool): HResult; stdcall; function IfrxEngineOptions_Set_DoublePass(Value: WordBool): HResult; stdcall; function IfrxEngineOptions_Get_MaxMemSize(out Value: SYSINT): HResult; stdcall; function IfrxEngineOptions_Set_MaxMemSize(Value: SYSINT): HResult; stdcall; function IfrxEngineOptions_Get_PrintIfEmpty(out Value: WordBool): HResult; stdcall; function IfrxEngineOptions_Set_PrintIfEmpty(Value: WordBool): HResult; stdcall; function IfrxEngineOptions_Get_SilentMode(out Value: frxSilentMode): HResult; stdcall; function IfrxEngineOptions_Set_SilentMode(Value: frxSilentMode): HResult; stdcall; function IfrxEngineOptions_Get_TempDir(out Value: WideString): HResult; stdcall; function IfrxEngineOptions_Set_TempDir(const Value: WideString): HResult; stdcall; function IfrxEngineOptions_Get_UseFilecache(out Value: WordBool): HResult; stdcall; function IfrxEngineOptions_Set_UseFilecache(Value: WordBool): HResult; stdcall; {$ENDIF} end; {$IFDEF FR_COM} TfrxPrintOptions = class(TDispatchablePersistent, IfrxPrintOptions) {$ELSE} TfrxPrintOptions = class(TPersistent) {$ENDIF} private FCopies: Integer; FCollate: Boolean; FPageNumbers: String; FPagesOnSheet: Integer; FPrinter: String; FPrintMode: TfrxPrintMode; FPrintOnSheet: Integer; FPrintPages: TfrxPrintPages; FReverse: Boolean; FShowDialog: Boolean; {$IFDEF FR_COM} protected { IfrxPrintOptions } function IfrxPrintOptions.Get_Copies = IfrxPrintOptions_Get_Copies; function IfrxPrintOptions.Set_Copies = IfrxPrintOptions_Set_Copies; function IfrxPrintOptions.Get_Collate = IfrxPrintOptions_Get_Collate; function IfrxPrintOptions.Set_Collate = IfrxPrintOptions_Set_Collate; function IfrxPrintOptions.Get_PageNumbers = IfrxPrintOptions_Get_PageNumbers; function IfrxPrintOptions.Set_PageNumbers = IfrxPrintOptions_Set_PageNumbers; function IfrxPrintOptions.Get_Printer = IfrxPrintOptions_Get_Printer; function IfrxPrintOptions.Set_Printer = IfrxPrintOptions_Set_Printer; function IfrxPrintOptions.Get_PrintPages = IfrxPrintOptions_Get_PrintPages; function IfrxPrintOptions.Set_PrintPages = IfrxPrintOptions_Set_PrintPages; function IfrxPrintOptions.Get_Reverse = IfrxPrintOptions_Get_Reverse; function IfrxPrintOptions.Set_Reverse = IfrxPrintOptions_Set_Reverse; function IfrxPrintOptions.Get_ShowDialog = IfrxPrintOptions_Get_ShowDialog; function IfrxPrintOptions.Set_ShowDialog = IfrxPrintOptions_Set_ShowDialog; function IfrxPrintOptions_Get_Copies(out Value: SYSINT): HResult; stdcall; function IfrxPrintOptions_Set_Copies(Value: SYSINT): HResult; stdcall; function IfrxPrintOptions_Get_Collate(out Value: WordBool): HResult; stdcall; function IfrxPrintOptions_Set_Collate(Value: WordBool): HResult; stdcall; function IfrxPrintOptions_Get_PageNumbers(out Value: WideString): HResult; stdcall; function IfrxPrintOptions_Set_PageNumbers(const Value: WideString): HResult; stdcall; function IfrxPrintOptions_Get_Printer(out Value: WideString): HResult; stdcall; function IfrxPrintOptions_Set_Printer(const Value: WideString): HResult; stdcall; function IfrxPrintOptions_Get_PrintPages(out Value: frxPrintPages): HResult; stdcall; function IfrxPrintOptions_Set_PrintPages(Value: frxPrintPages): HResult; stdcall; function IfrxPrintOptions_Get_Reverse(out Value: WordBool): HResult; stdcall; function IfrxPrintOptions_Set_Reverse(Value: WordBool): HResult; stdcall; function IfrxPrintOptions_Get_ShowDialog(out Value: WordBool): HResult; stdcall; function IfrxPrintOptions_Set_ShowDialog(Value: WordBool): HResult; stdcall; {$ENDIF} public constructor Create; {$IFDEF FR_COM} destructor Destroy; override; {$ENDIF} procedure Assign(Source: TPersistent); override; procedure Clear; published property Copies: Integer read FCopies write FCopies default 1; property Collate: Boolean read FCollate write FCollate default True; property PageNumbers: String read FPageNumbers write FPageNumbers; property Printer: String read FPrinter write FPrinter; property PrintMode: TfrxPrintMode read FPrintMode write FPrintMode default pmDefault; property PrintOnSheet: Integer read FPrintOnSheet write FPrintOnSheet; property PrintPages: TfrxPrintPages read FPrintPages write FPrintPages default ppAll; property Reverse: Boolean read FReverse write FReverse default False; property ShowDialog: Boolean read FShowDialog write FShowDialog default True; end; {$IFDEF FR_COM} TfrxPreviewOptions = class(TDispatchablePersistent, IfrxPreviewOptions) {$ELSE} TfrxPreviewOptions = class(TPersistent) {$ENDIF} private FAllowEdit: Boolean; FButtons: TfrxPreviewButtons; FDoubleBuffered: Boolean; FMaximized: Boolean; FMDIChild: Boolean; FModal: Boolean; FOutlineExpand: Boolean; FOutlineVisible: Boolean; FOutlineWidth: Integer; FPagesInCache: Integer; FShowCaptions: Boolean; FThumbnailVisible: Boolean; FZoom: Extended; FZoomMode: TfrxZoomMode; public constructor Create; procedure Assign(Source: TPersistent); override; procedure Clear; published property AllowEdit: Boolean read FAllowEdit write FAllowEdit default True; property Buttons: TfrxPreviewButtons read FButtons write FButtons; property DoubleBuffered: Boolean read FDoubleBuffered write FDoubleBuffered default True; property Maximized: Boolean read FMaximized write FMaximized default True; property MDIChild: Boolean read FMDIChild write FMDIChild default False; property Modal: Boolean read FModal write FModal default True; property OutlineExpand: Boolean read FOutlineExpand write FOutlineExpand default True; property OutlineVisible: Boolean read FOutlineVisible write FOutlineVisible default False; property OutlineWidth: Integer read FOutlineWidth write FOutlineWidth default 120; property PagesInCache: Integer read FPagesInCache write FPagesInCache default 50; property ThumbnailVisible: Boolean read FThumbnailVisible write FThumbnailVisible default False; property ShowCaptions: Boolean read FShowCaptions write FShowCaptions default False; property Zoom: Extended read FZoom write FZoom; property ZoomMode: TfrxZoomMode read FZoomMode write FZoomMode default zmDefault; {$IFDEF FR_COM} { IfrxPreviewOptions } function IfrxPreviewOptions.Get_AllowEdit = IfrxPreviewOptions_Get_AllowEdit; function IfrxPreviewOptions.Set_AllowEdit = IfrxPreviewOptions_Set_AllowEdit; function IfrxPreviewOptions.Get_Buttons = IfrxPreviewOptions_Get_Buttons; function IfrxPreviewOptions.Set_Buttons = IfrxPreviewOptions_Set_Buttons; function IfrxPreviewOptions.Get_DoubleBuffered = IfrxPreviewOptions_Get_DoubleBuffered; function IfrxPreviewOptions.Set_DoubleBuffered = IfrxPreviewOptions_Set_DoubleBuffered; function IfrxPreviewOptions.Get_Maximized = IfrxPreviewOptions_Get_Maximazed; function IfrxPreviewOptions.Set_Maximized = IfrxPreviewOptions_Set_Maximazed; function IfrxPreviewOptions.Get_MDIChild = IfrxPreviewOptions_Get_MDIChild; function IfrxPreviewOptions.Set_MDIChild = IfrxPreviewOptions_Set_MDIChild; function IfrxPreviewOptions.Get_Modal = IfrxPreviewOptions_Get_Modal; function IfrxPreviewOptions.Set_Modal = IfrxPreviewOptions_Set_Modal; function IfrxPreviewOptions.Get_OutlineExpand = IfrxPreviewOptions_Get_OutlineExpand; function IfrxPreviewOptions.Set_OutlineExpand = IfrxPreviewOptions_Set_OutlineExpand; function IfrxPreviewOptions.Get_OutlineVisible = IfrxPreviewOptions_Get_OutlineVisible; function IfrxPreviewOptions.Set_OutlineVisible = IfrxPreviewOptions_Set_OutlineVisible; function IfrxPreviewOptions.Get_OutlineWidth = IfrxPreviewOptions_Get_OutlineWidth; function IfrxPreviewOptions.Set_OutlineWidth = IfrxPreviewOptions_Set_OutlineWidth; function IfrxPreviewOptions.Get_ShowCaptions = IfrxPreviewOptions_Get_ShowCaptions; function IfrxPreviewOptions.Set_ShowCaptions = IfrxPreviewOptions_Set_ShowCaptions; function IfrxPreviewOptions.Get_Zoom = IfrxPreviewOptions_Get_Zoom; function IfrxPreviewOptions.Set_Zoom = IfrxPreviewOptions_Set_Zoom; function IfrxPreviewOptions.Get_ZoomMode = IfrxPreviewOptions_Get_ZoomMode; function IfrxPreviewOptions.Set_ZoomMode = IfrxPreviewOptions_Set_ZoomMode; function IfrxPreviewOptions_Get_AllowEdit(out Value: WordBool): HResult; stdcall; function IfrxPreviewOptions_Set_AllowEdit(Value: WordBool): HResult; stdcall; function IfrxPreviewOptions_Get_Buttons(out Value: frxPreviewButtons): HResult; stdcall; function IfrxPreviewOptions_Set_Buttons(Value: frxPreviewButtons): HResult; stdcall; function IfrxPreviewOptions_Get_DoubleBuffered(out Value: WordBool): HResult; stdcall; function IfrxPreviewOptions_Set_DoubleBuffered(Value: WordBool): HResult; stdcall; function IfrxPreviewOptions_Get_Maximazed(out Value: WordBool): HResult; stdcall; function IfrxPreviewOptions_Set_Maximazed(Value: WordBool): HResult; stdcall; function IfrxPreviewOptions_Get_MDIChild(out Value: WordBool): HResult; stdcall; function IfrxPreviewOptions_Set_MDIChild(Value: WordBool): HResult; stdcall; function IfrxPreviewOptions_Get_Modal(out Value: WordBool): HResult; stdcall; function IfrxPreviewOptions_Set_Modal(Value: WordBool): HResult; stdcall; function IfrxPreviewOptions_Get_OutlineExpand(out Value: WordBool): HResult; stdcall; function IfrxPreviewOptions_Set_OutlineExpand(Value: WordBool): HResult; stdcall; function IfrxPreviewOptions_Get_OutlineVisible(out Value: WordBool): HResult; stdcall; function IfrxPreviewOptions_Set_OutlineVisible(Value: WordBool): HResult; stdcall; function IfrxPreviewOptions_Get_OutlineWidth(out Value: SYSINT): HResult; stdcall; function IfrxPreviewOptions_Set_OutlineWidth(Value: SYSINT): HResult; stdcall; function IfrxPreviewOptions_Get_ShowCaptions(out Value: WordBool): HResult; stdcall; function IfrxPreviewOptions_Set_ShowCaptions(Value: WordBool): HResult; stdcall; function IfrxPreviewOptions_Get_Zoom(out Value: Double): HResult; stdcall; function IfrxPreviewOptions_Set_Zoom(Value: Double): HResult; stdcall; function IfrxPreviewOptions_Get_ZoomMode(out Value: frxZoomMode): HResult; stdcall; function IfrxPreviewOptions_Set_ZoomMode(Value: frxZoomMode): HResult; stdcall; {$ENDIF} end; {$IFDEF FR_COM} TfrxReportOptions = class(TDispatchablePersistent, IfrxReportOptions) {$ELSE} TfrxReportOptions = class(TPersistent) {$ENDIF} private FAuthor: String; FCompressed: Boolean; FConnectionName: String; FCreateDate: TDateTime; FDescription: TStrings; FInitString: String; FName: String; FLastChange: TDateTime; FPassword: String; FPicture: TPicture; FReport: TfrxReport; FVersionBuild: String; FVersionMajor: String; FVersionMinor: String; FVersionRelease: String; FPrevPassword: String; FInfo: Boolean; procedure SetDescription(const Value: TStrings); procedure SetPicture(const Value: TPicture); procedure SetConnectionName(const Value: String); public constructor Create(AOwner: TComponent); destructor Destroy; override; procedure Assign(Source: TPersistent); override; procedure Clear; function CheckPassword: Boolean; property PrevPassword: String write FPrevPassword; property Info: Boolean read FInfo write FInfo; published property Author: String read FAuthor write FAuthor; property Compressed: Boolean read FCompressed write FCompressed default False; property ConnectionName: String read FConnectionName write SetConnectionName; property CreateDate: TDateTime read FCreateDate write FCreateDate; property Description: TStrings read FDescription write SetDescription; property InitString: String read FInitString write FInitString; property Name: String read FName write FName; property LastChange: TDateTime read FLastChange write FLastChange; property Password: String read FPassword write FPassword; property Picture: TPicture read FPicture write SetPicture; property VersionBuild: String read FVersionBuild write FVersionBuild; property VersionMajor: String read FVersionMajor write FVersionMajor; property VersionMinor: String read FVersionMinor write FVersionMinor; property VersionRelease: String read FVersionRelease write FVersionRelease; {$IFDEF FR_COM} {IfrxReportOptions} function IfrxReportOptions.Get_Author = IfrxReportOptions_Get_Author; function IfrxReportOptions.Set_Author = IfrxReportOptions_Set_Author; function IfrxReportOptions.Get_Compressed = IfrxReportOptions_Get_Compressed; function IfrxReportOptions.Set_Compressed = IfrxReportOptions_Set_Compressed; function IfrxReportOptions.Get_ConnectionName = IfrxReportOptions_Get_ConnectionName; function IfrxReportOptions.Set_ConnectionName = IfrxReportOptions_Set_ConnectionName; function IfrxReportOptions.Get_CreationDate = IfrxReportOptions_Get_CreationDate; function IfrxReportOptions.Set_CreationDate = IfrxReportOptions_Set_CreationDate; function IfrxReportOptions.Get_Description = IfrxReportOptions_Get_Description; function IfrxReportOptions.Set_Description = IfrxReportOptions_Set_Description; function IfrxReportOptions.Get_InitString = IfrxReportOptions_Get_InitString; function IfrxReportOptions.Set_InitString = IfrxReportOptions_Set_InitString; function IfrxReportOptions.Get_Name = IfrxReportOptions_Get_Name; function IfrxReportOptions.Set_Name = IfrxReportOptions_Set_Name; function IfrxReportOptions.Get_LastChange = IfrxReportOptions_Get_LastChange; function IfrxReportOptions.Set_LastChange = IfrxReportOptions_Set_LastChange; function IfrxReportOptions.Get_Password = IfrxReportOptions_Get_Password; function IfrxReportOptions.Set_Password = IfrxReportOptions_Set_Password; function IfrxReportOptions.Get_Picture = IfrxReportOptions_Get_Picture; function IfrxReportOptions.Set_Picture = IfrxReportOptions_Set_Picture; function IfrxReportOptions.Get_VersionBuild = IfrxReportOptions_Get_VersionBuild; function IfrxReportOptions.Set_VersionBuild = IfrxReportOptions_Set_VersionBuild; function IfrxReportOptions.Get_VersionMajor = IfrxReportOptions_Get_VersionMajor; function IfrxReportOptions.Set_VersionMajor = IfrxReportOptions_Set_VersionMajor; function IfrxReportOptions.Get_VersionMinor = IfrxReportOptions_Get_VersionMinor; function IfrxReportOptions.Set_VersionMinor = IfrxReportOptions_Set_VersionMinor; function IfrxReportOptions.Get_VersionRelease = IfrxReportOptions_Get_VersionRelease; function IfrxReportOptions.Set_VersionRelease = IfrxReportOptions_Set_VersionRelease; function IfrxReportOptions_Get_Author(out Value: WideString): HResult; stdcall; function IfrxReportOptions_Set_Author(const Value: WideString): HResult; stdcall; function IfrxReportOptions_Get_Compressed(out Value: WordBool): HResult; stdcall; function IfrxReportOptions_Set_Compressed(Value: WordBool): HResult; stdcall; function IfrxReportOptions_Get_ConnectionName(out Value: WideString): HResult; stdcall; function IfrxReportOptions_Set_ConnectionName(const Value: WideString): HResult; stdcall; function IfrxReportOptions_Get_CreationDate(out Value: TDateTime): HResult; stdcall; function IfrxReportOptions_Set_CreationDate(Value: TDateTime): HResult; stdcall; function IfrxReportOptions_Get_Description(out Value: WideString): HResult; stdcall; function IfrxReportOptions_Set_Description(const Value: WideString): HResult; stdcall; function IfrxReportOptions_Get_InitString(out Value: WideString): HResult; stdcall; function IfrxReportOptions_Set_InitString(const Value: WideString): HResult; stdcall; function IfrxReportOptions_Get_Name(out Value: WideString): HResult; stdcall; function IfrxReportOptions_Set_Name(const Value: WideString): HResult; stdcall; function IfrxReportOptions_Get_LastChange(out Value: TDateTime): HResult; stdcall; function IfrxReportOptions_Set_LastChange(Value: TDateTime): HResult; stdcall; function IfrxReportOptions_Get_Password(out Value: WideString): HResult; stdcall; function IfrxReportOptions_Set_Password(const Value: WideString): HResult; stdcall; function IfrxReportOptions_Get_Picture(out Value: IUnknown): HResult; stdcall; function IfrxReportOptions_Set_Picture(const Value: IUnknown): HResult; stdcall; function IfrxReportOptions_Get_VersionBuild(out Value: WideString): HResult; stdcall; function IfrxReportOptions_Set_VersionBuild(const Value: WideString): HResult; stdcall; function IfrxReportOptions_Get_VersionMajor(out Value: WideString): HResult; stdcall; function IfrxReportOptions_Set_VersionMajor(const Value: WideString): HResult; stdcall; function IfrxReportOptions_Get_VersionMinor(out Value: WideString): HResult; stdcall; function IfrxReportOptions_Set_VersionMinor(const Value: WideString): HResult; stdcall; function IfrxReportOptions_Get_VersionRelease(out Value: WideString): HResult; stdcall; function IfrxReportOptions_Set_VersionRelease(const Value: WideString): HResult; stdcall; {$ENDIF} end; TfrxExpressionCache = class(TObject) private FExpressions: TStringList; FMainScript: TfsScript; FScript: TfsScript; FScriptLanguage: String; public constructor Create(AScript: TfsScript); destructor Destroy; override; procedure Clear; function Calc(const Expression: String; var ErrorMsg: String; AScript: TfsScript): Variant; end; TfrxDataSetItem = class(TCollectionItem) private FDataSet: TfrxDataSet; FDataSetName: String; procedure SetDataSet(const Value: TfrxDataSet); procedure SetDataSetName(const Value: String); function GetDataSetName: String; published property DataSet: TfrxDataSet read FDataSet write SetDataSet; property DataSetName: String read GetDataSetName write SetDataSetName; end; TfrxReportDataSets = class(TCollection) private FReport: TfrxReport; function GetItem(Index: Integer): TfrxDataSetItem; public constructor Create(AReport: TfrxReport); procedure Initialize; procedure Finalize; procedure Add(ds: TfrxDataSet); function Find(ds: TfrxDataSet): TfrxDataSetItem; overload; function Find(const Name: String): TfrxDataSetItem; overload; procedure Delete(const Name: String); overload; property Items[Index: Integer]: TfrxDataSetItem read GetItem; default; end; TfrxStyleItem = class(TCollectionItem) private FName: String; FColor: TColor; FFont: TFont; FFrame: TfrxFrame; procedure SetFont(const Value: TFont); procedure SetFrame(const Value: TfrxFrame); procedure SetName(const Value: String); public constructor Create(Collection: TCollection); override; destructor Destroy; override; procedure Assign(Source: TPersistent); override; procedure CreateUniqueName; published property Name: String read FName write SetName; property Color: TColor read FColor write FColor; property Font: TFont read FFont write SetFont; property Frame: TfrxFrame read FFrame write SetFrame; end; TfrxStyles = class(TCollection) private FName: String; FReport: TfrxReport; function GetItem(Index: Integer): TfrxStyleItem; public constructor Create(AReport: TfrxReport); function Add: TfrxStyleItem; function Find(const Name: String): TfrxStyleItem; procedure Apply; procedure GetList(List: TStrings); procedure LoadFromFile(const FileName: String); procedure LoadFromStream(Stream: TStream); procedure LoadFromXMLItem(Item: TfrxXMLItem); procedure SaveToFile(const FileName: String); procedure SaveToStream(Stream: TStream); procedure SaveToXMLItem(Item: TfrxXMLItem); property Items[Index: Integer]: TfrxStyleItem read GetItem; default; property Name: String read FName write FName; end; TfrxStyleSheet = class(TObject) private FItems: TList; function GetItems(Index: Integer): TfrxStyles; public constructor Create; destructor Destroy; override; procedure Clear; procedure Delete(Index: Integer); procedure GetList(List: TStrings); procedure LoadFromFile(const FileName: String); procedure LoadFromStream(Stream: TStream); procedure SaveToFile(const FileName: String); procedure SaveToStream(Stream: TStream); function Add: TfrxStyles; function Count: Integer; function Find(const Name: String): TfrxStyles; function IndexOf(const Name: String): Integer; property Items[Index: Integer]: TfrxStyles read GetItems; default; end; {$IFDEF FR_COM} TfrxReport = class(TfrxComponent, IfrxReport, IfrxBuiltinExports, IConnectionPointContainer) FConnectionPoints: TConnectionPoints; FConnectionPoint: TConnectionPoint; FEvent: IfrxReportEvents; private FUseDispatchableEvents: Boolean; {$ELSE} TfrxReport = class(TfrxComponent) private {$ENDIF} FCurObject: String; FDataSet: TfrxDataSet; FDataSetName: String; FDataSets: TfrxReportDatasets; FDesigner: TfrxCustomDesigner; FDotMatrixReport: Boolean; FDrawText: Pointer; FDrillState: TStrings; FEnabledDataSets: TfrxReportDataSets; FEngine: TfrxCustomEngine; FEngineOptions: TfrxEngineOptions; FErrors: TStrings; FExpressionCache: TfrxExpressionCache; FFileName: String; FIniFile: String; FLoadStream: TStream; FLocalValue: TfsCustomVariable; FModified: Boolean; FOldStyleProgress: Boolean; FParentForm: TForm; FParentReport: String; FParentReportObject: TfrxReport; FPreviewPages: TfrxCustomPreviewPages; FPreview: TfrxCustomPreview; FPreviewForm: TForm; FPreviewOptions: TfrxPreviewOptions; FPrintOptions: TfrxPrintOptions; FProgress: TfrxProgress; FReloading: Boolean; FReportOptions: TfrxReportOptions; FScript: TfsScript; FScriptLanguage: String; FScriptText: TStrings; FShowProgress: Boolean; FStoreInDFM: Boolean; FStyles: TfrxStyles; FSysVariables: TStrings; FTerminated: Boolean; FTimer: TTimer; FVariables: TfrxVariables; FVersion: String; FXMLSerializer: TObject; FOnAfterPrint: TfrxBeforePrintEvent; FOnAfterPrintReport: TNotifyEvent; FOnBeforeConnect: TfrxBeforeConnectEvent; FOnBeforePrint: TfrxBeforePrintEvent; FOnBeginDoc: TNotifyEvent; FOnClickObject: TfrxClickObjectEvent; FOnEditConnection: TfrxEditConnectionEvent; FOnEndDoc: TNotifyEvent; FOnGetValue: TfrxGetValueEvent; FOnLoadTemplate: TfrxLoadTemplateEvent; FOnManualBuild: TfrxManualBuildEvent; FOnMouseOverObject: TfrxMouseOverObjectEvent; FOnPreview: TNotifyEvent; FOnPrintPage: TfrxPrintPageEvent; FOnPrintReport: TNotifyEvent; FOnProgressStart: TfrxProgressEvent; FOnProgress: TfrxProgressEvent; FOnProgressStop: TfrxProgressEvent; FOnRunDialogs: TfrxRunDialogsEvent; FOnSetConnection: TfrxSetConnectionEvent; FOnStartReport: TfrxNotifyEvent; FOnStopReport: TfrxNotifyEvent; FOnUserFunction: TfrxUserFunctionEvent; FOnClosePreview: TNotifyEvent; function CallMethod(Instance: TObject; ClassType: TClass; const MethodName: String; var Params: Variant): Variant; function DoGetValue(const Expr: String; var Value: Variant): Boolean; function GetScriptValue(Instance: TObject; ClassType: TClass; const MethodName: String; var Params: Variant): Variant; function SetScriptValue(Instance: TObject; ClassType: TClass; const MethodName: String; var Params: Variant): Variant; function DoUserFunction(Instance: TObject; ClassType: TClass; const MethodName: String; var Params: Variant): Variant; function GetDataSetName: String; function GetLocalValue: Variant; function GetPages(Index: Integer): TfrxPage; function GetPagesCount: Integer; procedure AncestorNotFound(Reader: TReader; const ComponentName: string; ComponentClass: TPersistentClass; var Component: TComponent); procedure DoClear; procedure DoGetAncestor(const Name: String; var Ancestor: TPersistent); procedure DoLoadFromStream; procedure OnTimer(Sender: TObject); procedure ReadDatasets(Reader: TReader); procedure ReadStyle(Reader: TReader); procedure ReadVariables(Reader: TReader); procedure SetDataSet(const Value: TfrxDataSet); procedure SetDataSetName(const Value: String); procedure SetEngineOptions(const Value: TfrxEngineOptions); procedure SetLocalValue(const Value: Variant); procedure SetParentReport(const Value: String); procedure SetPreviewOptions(const Value: TfrxPreviewOptions); procedure SetPrintOptions(const Value: TfrxPrintOptions); procedure SetReportOptions(const Value: TfrxReportOptions); procedure SetScriptText(const Value: TStrings); procedure SetStyles(const Value: TfrxStyles); procedure SetTerminated(const Value: Boolean); procedure WriteDatasets(Writer: TWriter); procedure WriteStyle(Writer: TWriter); procedure WriteVariables(Writer: TWriter); procedure SetPreview(const Value: TfrxCustomPreview); procedure SetVersion(const Value: String); protected procedure Notification(AComponent: TComponent; Operation: TOperation); override; procedure DefineProperties(Filer: TFiler); override; {$IFDEF FR_COM} public // procedure EventSinkChanged(const Sink: IUnknown; Connecting: Boolean); procedure OnSetConnectionHandler(const ConnString: String); function OnEditConnectionHandler(const ConnString: String): String; { COM proxy event functions } procedure OnAfterPrintHandler(Sender: TfrxReportComponent); procedure OnBeforePrintHandler(Sender: TfrxReportComponent); procedure OnClickObjectHandler(Sender: TfrxView; Button: TMouseButton; Shift: TShiftState; var Modified: Boolean); function OnUserFunctionHandler(const MethodName: String; var Params: Variant): Variant; procedure OnBeforeConnectHandler(Sender: TfrxCustomDatabase; var Connected: Boolean); procedure OnBeginDocHandler(Sender: TObject); procedure OnEndDocHandler(Sender: TObject); procedure OnPrintReportHandler(Sender: TObject); procedure OnAfterPrintReportHandler(Sender: TObject); procedure OnProgressHandler(Sender: TfrxReport; ProgressType: TfrxProgressType; Progress: Integer); procedure OnProgressStartHandler(Sender: TfrxReport; ProgressType: TfrxProgressType; Progress: Integer); procedure OnProgressStopHandler(Sender: TfrxReport; ProgressType: TfrxProgressType; Progress: Integer); procedure OnRunDialogsEvent(Page: TfrxDialogPage); {IfrxReport} function LoadReportFromFile(const szFileName: WideString): HResult; stdcall; function SaveReportToFile(const FileName: WideString): HResult; stdcall; function LoadReportFromStream(const Stream: IUnknown): HResult; stdcall; function SaveReportToStream(const Stream: IUnknown): HResult; stdcall; function LoadPreparedReportFromFile(const szFileName: WideString): HResult; stdcall; function SavePreparedReportToFile(const szFileName: WideString): HResult; stdcall; function ClearReport: HResult; stdcall; function PrintReport: HResult; stdcall; function ExportReport(const Filter: IfrxCustomExportFilter): HResult; stdcall; function Get_Errors(out Value: WideString): HResult; stdcall; function Get_PreviewPages(out Value: IfrxCustomPreviewPages): HResult; stdcall; function Get_ReportOptions(out Value: IfrxReportOptions): HResult; stdcall; function Get_PreviewOptions(out Value: IfrxPreviewOptions): HResult; stdcall; function Get_EngineOptions(out Value: IfrxEngineOptions): HResult; stdcall; function Get_PrintOptions(out Value: IfrxPrintOptions): HResult; stdcall; function Get_ScriptLanguage(out Value: WideString): HResult; stdcall; function Set_ScriptLanguage(const Value: WideString): HResult; stdcall; function Get_ScriptText(out Value: WideString): HResult; stdcall; function Set_ScriptText(const Value: WideString): HResult; stdcall; function Get_DisableDialogs(out Value: WordBool): HResult; stdcall; function Set_DisableDialogs(Value: WordBool): HResult; stdcall; function SetVariable(const Index: WideString; Value: OleVariant): HResult; stdcall; function GetVariable(const Index: WideString; out Value: OleVariant): HResult; stdcall; function AddVariable(const Category: WideString; const Name: WideString; Value: OleVariant): HResult; stdcall; function DeleteCategory(const Name: WideString): HResult; stdcall; function DeleteVariable(const Name: WideString): HResult; stdcall; function SelectDataset(Selected: WordBool; const DataSet: IfrxDataSet): HResult; stdcall; function LoadLanguageResourcesFromFile(const FileName: WideString): HResult; stdcall; function GetResourceString(const ID: WideString; out ResourceString_: WideString): HResult; stdcall; function Set_MainWindowHandle(Value: Integer): HResult; stdcall; function Set_ShowProgress(Value: WordBool): HResult; stdcall; function CreateReportObject(const ParentObject: IfrxComponent; ObjectType: TGUID; const Name: WideString; out GeneratedObject: IfrxComponent): HResult; stdcall; function SavePreparedReportToStream(const Stream: IUnknown): HResult; stdcall; function Get_Resources(out Value: IfrxResources): HResult; stdcall; function AddFunction(const FuncName: WideString; const Category: WideString; const Description: WideString): HResult; stdcall; function Get_Version(out Value: WideString): HResult; stdcall; function BindObject(const Value: IfrxPlugin): HResult; stdcall; function Get_Page(Index: Integer; out Value: IfrxPage): HResult; stdcall; function Get_PagesCount(out Value: Integer): HResult; stdcall; function CreateReportObjectEx(const ParentObject: IfrxComponent; const ObjectType: WideString; const Name: WideString; out GeneratedObject: IfrxComponent): HResult; stdcall; function ClearDatasets: HResult; stdcall; function FindCOMObject(const ObjectName: WideString; out Obj: IfrxComponent): HResult; stdcall; function FindObjectEx(const ObjectName: WideString; out Obj: IfrxComponent): HResult; stdcall; function IfrxReport.FindObject = FindCOMObject; function Get_OldStyleProgress(out Value: WordBool): HResult; stdcall; function Set_OldStyleProgress(Value: WordBool): HResult; stdcall; function Get_Engine(out Value: IfrxCustomEngine): HResult; stdcall; function Get_Script(out Value: IfsScript): HResult; stdcall; function Get_Print(out Value: WordBool): HResult; stdcall; function Set_UseDispatchableEvents(Value: WordBool): HResult; stdcall; function Get_FileName(out Value: WideString): HResult; stdcall; function Set_FileName(const Value: WideString): HResult; stdcall; function Set_Terminated(Value: WordBool): HResult; stdcall; {IfrxBuiltinExports} function ExportToPDF(const FileName: WideString; Compressed, EmbeddedFonts, PrintOptimized: WordBool): HResult; stdcall; function ExportToBMP(const FileName: WideString; Resolution: SYSINT; Monochrome, CropPages, SeparatePages: WordBool): HResult; stdcall; function ExportToHTML(const FileName: WideString; Pictures, FixedWidth, Multipage, Navigator, PicsInSameFolder, Background: WordBool): HResult; stdcall; function ExportToRTF(const FileName: WideString; Pictures, PageBreaks, WYSIWYG: WordBool): HResult; stdcall; function ExportToTXT(const FileName: WideString; PageBreaks: WordBool; Frames: WordBool; OEMCodepage: WordBool; EmptyLines: WordBool): HResult; stdcall; function ExportToXLS(const szFileName: WideString; Pictures, PageBreaks, WYSIWYG, AsText, Background: WordBool): HResult; stdcall; function ExportToXML(const FileName: WideString; Styles, PageBreaks, WYSIWYG, Background: WordBool): HResult; stdcall; function ExportToJPEG(const FileName: WideString; Resolution, JpegQuality: SYSINT; Monochrome, CropPages, SeparatePages: WordBool): HResult; stdcall; function ExportToTIFF(const FileName: WideString; Resolution: SYSINT; Monochrome, CropPages, SeparatePages: WordBool): HResult; stdcall; function ExportToCSV(const FileName: WideString; const Separator: WideString; OEMCodepage: WordBool): HResult; stdcall; function ExportToGIF(const FileName: WideString; Resolution: SYSINT; Monochrome, CropPages, SeparatePages: WordBool): HResult; stdcall; function SendMail(const Server: WideString; Port: SYSINT; const User: WideString; const Password: WideString; const From: WideString; const To_: WideString; const Subject: WideString; const Text: WideString; const FileName: WideString; const AttachName: WideString): HResult; stdcall; function ExportToDMP(const FileName: WideString): HResult; stdcall; {IConnectionPointContainer} property ConnectionPoints: TConnectionPoints read FConnectionPoints implements IConnectionPointContainer; {$ENDIF} public constructor Create(AOwner: TComponent); override; destructor Destroy; override; procedure Clear; override; class function GetDescription: String; override; { internal methods } function Calc(const Expr: String; AScript: TfsScript = nil): Variant; function DesignPreviewPage: Boolean; function GetAlias(DataSet: TfrxDataSet): String; function GetDataset(const Alias: String): TfrxDataset; function GetIniFile: TCustomIniFile; function GetApplicationFolder: String; function PrepareScript: Boolean; function InheritFromTemplate(const templName: String): Boolean; procedure DesignReport(IDesigner: IUnknown; Editor: TObject); overload; procedure DoNotifyEvent(Obj: TObject; const EventName: String; RunAlways: Boolean = False); procedure DoParamEvent(const EventName: String; var Params: Variant; RunAlways: Boolean = False); procedure DoAfterPrint(c: TfrxReportComponent); procedure DoBeforePrint(c: TfrxReportComponent); procedure DoPreviewClick(v: TfrxView; Button: TMouseButton; Shift: TShiftState; var Modified: Boolean); procedure GetDatasetAndField(const ComplexName: String; var Dataset: TfrxDataset; var Field: String); procedure GetDataSetList(List: TStrings; OnlyDB: Boolean = False); procedure InternalOnProgressStart(ProgressType: TfrxProgressType); virtual; procedure InternalOnProgress(ProgressType: TfrxProgressType; Progress: Integer); virtual; procedure InternalOnProgressStop(ProgressType: TfrxProgressType); virtual; procedure SelectPrinter; procedure SetProgressMessage(const Value: String); procedure CheckDataPage; { public methods } function LoadFromFile(const FileName: String; ExceptionIfNotFound: Boolean = False): Boolean; procedure LoadFromStream(Stream: TStream); override; procedure SaveToFile(const FileName: String); procedure SaveToStream(Stream: TStream; SaveChildren: Boolean = True; SaveDefaultValues: Boolean = False); override; {$IFNDEF FR_COM} procedure DesignReport(Modal: Boolean = True; MDIChild: Boolean = False); overload; stdcall; function PrepareReport(ClearLastReport: Boolean = True): Boolean; procedure ShowPreparedReport; stdcall; procedure ShowReport(ClearLastReport: Boolean = True); stdcall; procedure AddFunction(const FuncName: String; const Category: String = ''; const Description: String = ''); {$ELSE} function DesignReport: HResult; overload; stdcall; function DesignReportEx(Modal: WordBool; MDIChild: WordBool; ParentWindowHandle: Integer): HResult; stdcall; function ShowReport: HResult; stdcall; function PrepareReport(ClearLastReport: WordBool = True): HResult; stdcall; function ShowPreparedReport: HResult; stdcall; {$ENDIF} procedure DesignReportInPanel(Panel: TWinControl); function Print: Boolean; stdcall; function Export(Filter: TfrxCustomExportFilter): Boolean; { internals } property CurObject: String read FCurObject write FCurObject; property DrillState: TStrings read FDrillState; property LocalValue: Variant read GetLocalValue write SetLocalValue; property PreviewForm: TForm read FPreviewForm; property XMLSerializer: TObject read FXMLSerializer; property Reloading: Boolean read FReloading write FReloading; { public } property DataSets: TfrxReportDataSets read FDataSets; property Designer: TfrxCustomDesigner read FDesigner write FDesigner; property EnabledDataSets: TfrxReportDataSets read FEnabledDataSets; property Engine: TfrxCustomEngine read FEngine; property Errors: TStrings read FErrors; property FileName: String read FFileName write FFileName; property Modified: Boolean read FModified write FModified; property PreviewPages: TfrxCustomPreviewPages read FPreviewPages; property Pages[Index: Integer]: TfrxPage read GetPages; property PagesCount: Integer read GetPagesCount; property Script: TfsScript read FScript; property Styles: TfrxStyles read FStyles write SetStyles; property Terminated: Boolean read FTerminated write SetTerminated; property Variables: TfrxVariables read FVariables; property OnEditConnection: TfrxEditConnectionEvent read FOnEditConnection write FOnEditConnection; property OnSetConnection: TfrxSetConnectionEvent read FOnSetConnection write FOnSetConnection; published property Version: String read FVersion write SetVersion; property ParentReport: String read FParentReport write SetParentReport; property DataSet: TfrxDataSet read FDataSet write SetDataSet; property DataSetName: String read GetDataSetName write SetDataSetName; property DotMatrixReport: Boolean read FDotMatrixReport write FDotMatrixReport; property EngineOptions: TfrxEngineOptions read FEngineOptions write SetEngineOptions; property IniFile: String read FIniFile write FIniFile; property OldStyleProgress: Boolean read FOldStyleProgress write FOldStyleProgress default False; property Preview: TfrxCustomPreview read FPreview write SetPreview; property PreviewOptions: TfrxPreviewOptions read FPreviewOptions write SetPreviewOptions; property PrintOptions: TfrxPrintOptions read FPrintOptions write SetPrintOptions; property ReportOptions: TfrxReportOptions read FReportOptions write SetReportOptions; property ScriptLanguage: String read FScriptLanguage write FScriptLanguage; property ScriptText: TStrings read FScriptText write SetScriptText; property ShowProgress: Boolean read FShowProgress write FShowProgress default True; property StoreInDFM: Boolean read FStoreInDFM write FStoreInDFM default True; property OnAfterPrint: TfrxBeforePrintEvent read FOnAfterPrint write FOnAfterPrint; property OnBeforeConnect: TfrxBeforeConnectEvent read FOnBeforeConnect write FOnBeforeConnect; property OnBeforePrint: TfrxBeforePrintEvent read FOnBeforePrint write FOnBeforePrint; property OnBeginDoc: TNotifyEvent read FOnBeginDoc write FOnBeginDoc; property OnClickObject: TfrxClickObjectEvent read FOnClickObject write FOnClickObject; property OnEndDoc: TNotifyEvent read FOnEndDoc write FOnEndDoc; property OnGetValue: TfrxGetValueEvent read FOnGetValue write FOnGetValue; property OnManualBuild: TfrxManualBuildEvent read FOnManualBuild write FOnManualBuild; property OnMouseOverObject: TfrxMouseOverObjectEvent read FOnMouseOverObject write FOnMouseOverObject; property OnPreview: TNotifyEvent read FOnPreview write FOnPreview; property OnPrintPage: TfrxPrintPageEvent read FOnPrintPage write FOnPrintPage; property OnPrintReport: TNotifyEvent read FOnPrintReport write FOnPrintReport; property OnAfterPrintReport: TNotifyEvent read FOnAfterPrintReport write FOnAfterPrintReport; property OnProgressStart: TfrxProgressEvent read FOnProgressStart write FOnProgressStart; property OnProgress: TfrxProgressEvent read FOnProgress write FOnProgress; property OnProgressStop: TfrxProgressEvent read FOnProgressStop write FOnProgressStop; property OnRunDialogs: TfrxRunDialogsEvent read FOnRunDialogs write FOnRunDialogs; property OnStartReport: TfrxNotifyEvent read FOnStartReport write FOnStartReport; property OnStopReport: TfrxNotifyEvent read FOnStopReport write FOnStopReport; property OnUserFunction: TfrxUserFunctionEvent read FOnUserFunction write FOnUserFunction; property OnLoadTemplate: TfrxLoadTemplateEvent read FOnLoadTemplate write FOnLoadTemplate; property OnClosePreview: TNotifyEvent read FOnClosePreview write FOnClosePreview; end; TfrxCustomDesigner = class(TForm) private FReport: TfrxReport; FIsPreviewDesigner: Boolean; FMemoFontName: String; FMemoFontSize: Integer; FUseObjectFont: Boolean; protected FModified: Boolean; FObjects: TList; FPage: TfrxPage; FSelectedObjects: TList; procedure SetModified(const Value: Boolean); virtual; procedure SetPage(const Value: TfrxPage); virtual; function GetCode: TStrings; virtual; abstract; public constructor CreateDesigner(AOwner: TComponent; AReport: TfrxReport; APreviewDesigner: Boolean = False); destructor Destroy; override; function InsertExpression(const Expr: String): String; virtual; abstract; procedure Lock; virtual; abstract; procedure ReloadPages(Index: Integer); virtual; abstract; procedure ReloadReport; virtual; abstract; procedure UpdateDataTree; virtual; abstract; procedure UpdatePage; virtual; abstract; property IsPreviewDesigner: Boolean read FIsPreviewDesigner; property Modified: Boolean read FModified write SetModified; property Objects: TList read FObjects; property Report: TfrxReport read FReport; property SelectedObjects: TList read FSelectedObjects; property Page: TfrxPage read FPage write SetPage; property Code: TStrings read GetCode; property UseObjectFont: Boolean read FUseObjectFont write FUseObjectFont; property MemoFontName: String read FMemoFontName write FMemoFontName; property MemoFontSize: Integer read FMemoFontSize write FMemoFontSize; end; TfrxDesignerClass = class of TfrxCustomDesigner; {$IFDEF FR_COM} TfrxCustomExportFilter = class(TComponent, IfrxCustomExportFilter) {$ELSE} TfrxCustomExportFilter = class(TComponent) {$ENDIF} private FCurPage: Boolean; FExportNotPrintable: Boolean; FName: String; FNoRegister: Boolean; FPageNumbers: String; FReport: TfrxReport; FShowDialog: Boolean; FStream: TStream; FUseFileCache: Boolean; FDefaultPath: String; FSlaveExport: Boolean; FShowProgress: Boolean; FDefaultExt: String; FFilterDesc: String; FSuppressPageHeadersFooters: Boolean; FTitle: String; protected public constructor Create(AOwner: TComponent); override; constructor CreateNoRegister; destructor Destroy; override; class function GetDescription: String; virtual; function ShowModal: TModalResult; virtual; function Start: Boolean; virtual; procedure ExportObject(Obj: TfrxComponent); virtual; abstract; procedure Finish; virtual; procedure FinishPage(Page: TfrxReportPage; Index: Integer); virtual; procedure StartPage(Page: TfrxReportPage; Index: Integer); virtual; property CurPage: Boolean read FCurPage write FCurPage; property PageNumbers: String read FPageNumbers write FPageNumbers; property Report: TfrxReport read FReport write FReport; property Stream: TStream read FStream write FStream; property SlaveExport: Boolean read FSlaveExport write FSlaveExport; property DefaultExt: String read FDefaultExt write FDefaultExt; property FilterDesc: String read FFilterDesc write FFilterDesc; property SuppressPageHeadersFooters: Boolean read FSuppressPageHeadersFooters write FSuppressPageHeadersFooters; property ExportTitle: String read FTitle write FTitle; published property ShowDialog: Boolean read FShowDialog write FShowDialog default True; property FileName: String read FName write FName; property ExportNotPrintable: Boolean read FExportNotPrintable write FExportNotPrintable default False; property UseFileCache: Boolean read FUseFileCache write FUseFileCache; property DefaultPath: String read FDefaultPath write FDefaultPath; property ShowProgress: Boolean read FShowProgress write FShowProgress; end; TfrxCustomWizard = class(TComponent) private FDesigner: TfrxCustomDesigner; FReport: TfrxReport; public constructor Create(AOwner: TComponent); override; class function GetDescription: String; virtual; function Execute: Boolean; virtual; abstract; property Designer: TfrxCustomDesigner read FDesigner; property Report: TfrxReport read FReport; end; TfrxWizardClass = class of TfrxCustomWizard; {$IFDEF FR_COM} TfrxCustomEngine = class(TDispatchablePersistent, IfrxCustomEngine) {$ELSE} TfrxCustomEngine = class(TPersistent) {$ENDIF} private FCurColumn: Integer; FCurVColumn: Integer; FCurLine: Integer; FCurLineThrough: Integer; FCurX: Extended; FCurY: Extended; FFinalPass: Boolean; FNotifyList: TList; FPageHeight: Extended; FPageWidth: Extended; FPreviewPages: TfrxCustomPreviewPages; FReport: TfrxReport; FRunning: Boolean; FStartDate: TDateTime; FStartTime: TDateTime; FTotalPages: Integer; FOnRunDialog: TfrxRunDialogEvent; function GetDoublePass: Boolean; protected {$IFDEF FR_COM} function Get_CurColumn(out Value: Integer): HResult; stdcall; function Set_CurColumn(Value: Integer): HResult; stdcall; function Get_CurVColumn(out Value: Integer): HResult; stdcall; function Set_CurVColumn(Value: Integer): HResult; stdcall; function Get_CurX(out Value: Double): HResult; stdcall; function Set_CurX(Value: Double): HResult; stdcall; function Get_CurY(out Value: Double): HResult; stdcall; function Set_CurY(Value: Double): HResult; stdcall; function Get_DoublePass(out Value: WordBool): HResult; stdcall; function Get_FinalPass(out Value: WordBool): HResult; stdcall; function Set_FinalPass(Value: WordBool): HResult; stdcall; function Get_PageHeight(out Value: Double): HResult; stdcall; function Set_PageHeight(Value: Double): HResult; stdcall; function Get_PageWidth(out Value: Double): HResult; stdcall; function Set_PageWidth(Value: Double): HResult; stdcall; function Get_StartDate(out Value: TDateTime): HResult; stdcall; function Set_StartDate(Value: TDateTime): HResult; stdcall; function Get_TotalPages(out Value: Integer): HResult; stdcall; function Set_TotalPages(Value: Integer): HResult; stdcall; {$ENDIF} public constructor Create(AReport: TfrxReport); virtual; destructor Destroy; override; procedure EndPage; virtual; abstract; procedure NewColumn; virtual; abstract; procedure NewPage; virtual; abstract; procedure ShowBand(Band: TfrxBand); overload; virtual; abstract; procedure ShowBand(Band: TfrxBandClass); overload; virtual; abstract; procedure ShowBandByName(const BandName: String); procedure StopReport; function HeaderHeight: Extended; virtual; abstract; function FooterHeight: Extended; virtual; abstract; function FreeSpace: Extended; virtual; abstract; function GetAggregateValue(const Name, Expression: String; Band: TfrxBand; Flags: Integer): Variant; virtual; abstract; function Run: Boolean; virtual; abstract; property CurLine: Integer read FCurLine write FCurLine; property CurLineThrough: Integer read FCurLineThrough write FCurLineThrough; property NotifyList: TList read FNotifyList; property PreviewPages: TfrxCustomPreviewPages read FPreviewPages; property Report: TfrxReport read FReport; property Running: Boolean read FRunning write FRunning; property OnRunDialog: TfrxRunDialogEvent read FOnRunDialog write FOnRunDialog; published property CurColumn: Integer read FCurColumn write FCurColumn; property CurVColumn: Integer read FCurVColumn write FCurVColumn; property CurX: Extended read FCurX write FCurX; property CurY: Extended read FCurY write FCurY; property DoublePass: Boolean read GetDoublePass; property FinalPass: Boolean read FFinalPass write FFinalPass; property PageHeight: Extended read FPageHeight write FPageHeight; property PageWidth: Extended read FPageWidth write FPageWidth; property StartDate: TDateTime read FStartDate write FStartDate; property StartTime: TDateTime read FStartTime write FStartTime; property TotalPages: Integer read FTotalPages write FTotalPages; end; TfrxCustomOutline = class(TPersistent) private FCurItem: TfrxXMLItem; FPreviewPages: TfrxCustomPreviewPages; protected function GetCount: Integer; virtual; abstract; public constructor Create(APreviewPages: TfrxCustomPreviewPages); virtual; procedure AddItem(const Text: String; Top: Integer); virtual; abstract; procedure LevelDown(Index: Integer); virtual; abstract; procedure LevelRoot; virtual; abstract; procedure LevelUp; virtual; abstract; procedure GetItem(Index: Integer; var Text: String; var Page, Top: Integer); virtual; abstract; procedure ShiftItems(From: TfrxXMLItem; NewTop: Integer); virtual; abstract; function Engine: TfrxCustomEngine; function GetCurPosition: TfrxXMLItem; virtual; abstract; property Count: Integer read GetCount; property CurItem: TfrxXMLItem read FCurItem write FCurItem; property PreviewPages: TfrxCustomPreviewPages read FPreviewPages; end; {$IFDEF FR_COM} TfrxCustomPreviewPages = class(TAutoObject, IfrxCustomPreviewPages) {$ELSE} TfrxCustomPreviewPages = class(TObject) {$ENDIF} private FAddPageAction: TfrxAddPageAction; { used in the cross-tab renderer } FCurPage: Integer; FCurPreviewPage: Integer; FEngine: TfrxCustomEngine; FFirstPage: Integer; { used in the composite reports } FOutline: TfrxCustomOutline; FReport: TfrxReport; protected function GetCount: Integer; virtual; abstract; function GetPage(Index: Integer): TfrxReportPage; virtual; abstract; function GetPageSize(Index: Integer): TPoint; virtual; abstract; {$IFDEF FR_COM} function IfrxCustomPreviewPages_AddObject(const Value: IfrxComponent): HResult; stdcall; function IfrxCustomPreviewPages_AddPage(const Value: IfrxReportPage): HResult; stdcall; function IfrxCustomPreviewPages_AddEmptyPage(Index: Integer): HResult; stdcall; function IfrxCustomPreviewPages_DeletePage(Index: Integer): HResult; stdcall; function IfrxCustomPreviewPages_Page(Index: Integer; out Value: IfrxReportPage): HResult; stdcall; function IfrxCustomPreviewPages.AddObject = IfrxCustomPreviewPages_AddObject; function IfrxCustomPreviewPages.AddPage = IfrxCustomPreviewPages_AddPage; function IfrxCustomPreviewPages.AddEmptyPage = IfrxCustomPreviewPages_AddEmptyPage; function IfrxCustomPreviewPages.DeletePage = IfrxCustomPreviewPages_DeletePage; function IfrxCustomPreviewPages.Page = IfrxCustomPreviewPages_Page; function Get_Count(out Value: Integer): HResult; stdcall; function Get_CurrentPage(out Value: Integer): HResult; stdcall; function Set_CurrentPage(Value: Integer): HResult; stdcall; function Get_CurPreviewPage(out Value: Integer): HResult; stdcall; function Set_CurPreviewPage(Value: Integer): HResult; stdcall; {$ENDIF} public constructor Create(AReport: TfrxReport); virtual; destructor Destroy; override; procedure Clear; virtual; abstract; {$IFNDEF FR_COM} procedure Initialize; virtual; abstract; {$ENDIF} procedure AddObject(Obj: TfrxComponent); virtual; abstract; procedure AddPage(Page: TfrxReportPage); virtual; abstract; procedure AddSourcePage(Page: TfrxReportPage); virtual; abstract; procedure AddToSourcePage(Obj: TfrxComponent); virtual; abstract; procedure BeginPass; virtual; abstract; procedure ClearFirstPassPages; virtual; abstract; procedure CutObjects(APosition: Integer); virtual; abstract; procedure Finish; virtual; abstract; procedure IncLogicalPageNumber; virtual; abstract; procedure ResetLogicalPageNumber; virtual; abstract; procedure PasteObjects(X, Y: Extended); virtual; abstract; procedure ShiftAnchors(From, NewTop: Integer); virtual; abstract; procedure AddPicture(Picture: TfrxPictureView); virtual; abstract; function BandExists(Band: TfrxBand): Boolean; virtual; abstract; function GetCurPosition: Integer; virtual; abstract; function GetAnchorCurPosition: Integer; virtual; abstract; function GetLastY: Extended; virtual; abstract; function GetLogicalPageNo: Integer; virtual; abstract; function GetLogicalTotalPages: Integer; virtual; abstract; procedure AddEmptyPage(Index: Integer); virtual; abstract; procedure DeletePage(Index: Integer); virtual; abstract; procedure ModifyPage(Index: Integer; Page: TfrxReportPage); virtual; abstract; procedure DrawPage(Index: Integer; Canvas: TCanvas; ScaleX, ScaleY, OffsetX, OffsetY: Extended); virtual; abstract; procedure ObjectOver(Index: Integer; X, Y: Integer; Button: TMouseButton; Shift: TShiftState; Scale, OffsetX, OffsetY: Extended; Click: Boolean; var Cursor: TCursor); virtual; abstract; procedure AddFrom(Report: TfrxReport); virtual; abstract; procedure LoadFromStream(Stream: TStream; AllowPartialLoading: Boolean = False); virtual; abstract; procedure SaveToStream(Stream: TStream); virtual; abstract; function LoadFromFile(const FileName: String; ExceptionIfNotFound: Boolean = False): Boolean; virtual; abstract; procedure SaveToFile(const FileName: String); virtual; abstract; function Print: Boolean; virtual; abstract; function Export(Filter: TfrxCustomExportFilter): Boolean; virtual; abstract; property AddPageAction: TfrxAddPageAction read FAddPageAction write FAddPageAction; property Count: Integer read GetCount; property CurPage: Integer read FCurPage write FCurPage; property CurPreviewPage: Integer read FCurPreviewPage write FCurPreviewPage; property Engine: TfrxCustomEngine read FEngine; property FirstPage: Integer read FFirstPage write FFirstPage; property Outline: TfrxCustomOutline read FOutline; property Page[Index: Integer]: TfrxReportPage read GetPage; property PageSize[Index: Integer]: TPoint read GetPageSize; property Report: TfrxReport read FReport; end; TfrxCustomPreview = class(TCustomControl) private FPreviewPages: TfrxCustomPreviewPages; FReport: TfrxReport; public procedure Init; virtual; abstract; procedure Lock; virtual; abstract; procedure Unlock; virtual; abstract; procedure RefreshReport; virtual; abstract; procedure InternalOnProgressStart(Sender: TfrxReport; ProgressType: TfrxProgressType; Progress: Integer); virtual; abstract; procedure InternalOnProgress(Sender: TfrxReport; ProgressType: TfrxProgressType; Progress: Integer); virtual; abstract; procedure InternalOnProgressStop(Sender: TfrxReport; ProgressType: TfrxProgressType; Progress: Integer); virtual; abstract; property PreviewPages: TfrxCustomPreviewPages read FPreviewPages write FPreviewPages; property Report: TfrxReport read FReport write FReport; end; TfrxCompressorClass = class of TfrxCustomCompressor; {$IFDEF FR_COM} TfrxCustomCompressor = class(TComponent, IfrxCustomCompressor) {$ELSE} TfrxCustomCompressor = class(TComponent) {$ENDIF} private FIsFR3File: Boolean; FOldCompressor: TfrxCompressorClass; FReport: TfrxReport; FStream: TStream; FTempFile: String; {$IFDEF FR_COM} protected function CompressStream(const InputStream: IUnknown; const OutputStream: IUnknown; Compression_: Integer; const FileName: WideString): HResult; stdcall; function DecompressStream(const Stream: IUnknown): HResult; stdcall; {$ENDIF} public constructor Create(AOwner: TComponent); override; destructor Destroy; override; function Decompress(Source: TStream): Boolean; virtual; abstract; procedure Compress(Dest: TStream); virtual; abstract; procedure CreateStream; property IsFR3File: Boolean read FIsFR3File write FIsFR3File; property Report: TfrxReport read FReport write FReport; property Stream: TStream read FStream write FStream; end; TfrxCrypterClass = class of TfrxCustomCrypter; TfrxCustomCrypter = class(TComponent) private FStream: TStream; public constructor Create(AOwner: TComponent); override; destructor Destroy; override; function Decrypt(Source: TStream; const Key: String): Boolean; virtual; abstract; procedure Crypt(Dest: TStream; const Key: String); virtual; abstract; procedure CreateStream; property Stream: TStream read FStream write FStream; end; TfrxLoadEvent = function(Sender: TfrxReport; Stream: TStream): Boolean of object; TfrxGetScriptValueEvent = function(var Params: Variant): Variant of object; TfrxFR2Events = class(TObject) private FOnGetValue: TfrxGetValueEvent; FOnPrepareScript: TNotifyEvent; FOnLoad: TfrxLoadEvent; FOnGetScriptValue: TfrxGetScriptValueEvent; public property OnGetValue: TfrxGetValueEvent read FOnGetValue write FOnGetValue; property OnPrepareScript: TNotifyEvent read FOnPrepareScript write FOnPrepareScript; property OnLoad: TfrxLoadEvent read FOnLoad write FOnLoad; property OnGetScriptValue: TfrxGetScriptValueEvent read FOnGetScriptValue write FOnGetScriptValue; end; TfrxGlobalDataSetList = class(TList) {$IFNDEF NO_CRITICAL_SECTION} FCriticalSection: TCriticalSection; {$ENDIF} public constructor Create; destructor Destroy; override; procedure Lock; procedure Unlock; end; function frxParentForm: TForm; function frxFindDataSet(DataSet: TfrxDataSet; const Name: String; Owner: TComponent): TfrxDataSet; procedure frxGetDataSetList(List: TStrings); var frxDesignerClass: TfrxDesignerClass; frxDotMatrixExport: TfrxCustomExportFilter; frxCompressorClass: TfrxCompressorClass; frxCrypterClass: TfrxCrypterClass; frxCharset: Integer = DEFAULT_CHARSET; frxFR2Events: TfrxFR2Events; {$IFNDEF NO_CRITICAL_SECTION} frxCS: TCriticalSection; {$ENDIF} frxGlobalVariables: TfrxVariables; const FR_VERSION = {$I frxVersion.inc}; BND_COUNT = 18; frxBands: array[0..BND_COUNT - 1] of TfrxComponentClass = (TfrxReportTitle, TfrxReportSummary, TfrxPageHeader, TfrxPageFooter, TfrxHeader, TfrxFooter, TfrxMasterData, TfrxDetailData, TfrxSubdetailData, TfrxDataBand4, TfrxDataBand5, TfrxDataBand6, TfrxGroupHeader, TfrxGroupFooter, TfrxChild, TfrxColumnHeader, TfrxColumnFooter, TfrxOverlay); implementation {$R *.RES} {$IFDEF FR_COM} {$R frxDesgnIcon.res} {$ENDIF} uses Registry, frxEngine, frxPreviewPages, frxPreview, frxPrinter, frxUtils, frxPassw, frxGraphicUtils, frxDialogForm, frxXMLSerializer, frxAggregate, frxRes, frxDsgnIntf, frxrcClass, frxClassRTTI, frxInheritError, fs_ipascal, fs_icpp, fs_ibasic, fs_ijs, fs_iclassesrtti, fs_igraphicsrtti, fs_iformsrtti, fs_idialogsrtti, fs_iinirtti, frxDMPClass {$IFDEF JPEG} , jpeg {$ENDIF} {$IFDEF PNG} , pngimage {$ENDIF} {$IFDEF FR_COM} , {$IFNDEF FR_LITE} frxExportPDF, frxExportXML, frxExportXLS, frxExportHTML, frxDMPExport, frxExportImage, frxExportRTF, frxExportMail, frxCross, frxBarcode, frxRich, frxChart, frxDCtrl, frxOLE, frxGradient, {$ENDIF} frxExportText, frxExportCSV, frxChBox, frxDesgn, frxADOComponents, ADODB, frxGZIP, frxNetDataTable {$ENDIF}; var FParentForm: TForm; DatasetList: TfrxGlobalDataSetList; {$IFDEF FR_COM} frxDefaultConnection: TADOConnection = nil; frxADOComponent: TfrxADOComponents = nil; frxGZipCompressor: TfrxGZipCompressor = nil; {$IFNDEF EXT_EXPORTS} {$IFNDEF FR_LITE} Export2PDF: TfrxPDFExport; Export2BMP: TfrxBMPExport; Export2HTML: TfrxHTMLExport; Export2RTF: TfrxRTFExport; Export2XLS: TfrxXLSExport; Export2XML: TfrxXMLExport; Export2JPEG: TfrxJPEGExport; Export2TIFF: TfrxTIFFExport; Export2Mail: TfrxMailExport; Export2Gif: TfrxGifExport; Export2DMP: TfrxDotMatrixExport; {$ENDIF} Export2CSV: TfrxCSVExport; Export2TXT: TfrxSimpleTextExport; {$ENDIF} DispatchableComponentFactory: TComponentFactory; {$ENDIF} const DefFontName = 'Arial'; DefFontSize = 10; type TByteSet = set of 0..7; PByteSet = ^TByteSet; THackControl = class(TControl); THackWinControl = class(TWinControl); THackPersistent = class(TPersistent); THackThread = class(TThread); TParentForm = class(TForm) protected procedure WndProc(var Message: TMessage); override; end; procedure TParentForm.WndProc(var Message: TMessage); begin case Message.Msg of WM_CREATEHANDLE: TWinControl(Message.WParam).HandleNeeded; WM_DESTROYHANDLE: THackWinControl(Message.WParam).DestroyHandle; else inherited; end; end; function Round8(e: Extended): Extended; begin Result := Round(e * 100000000) / 100000000; end; function frxParentForm: TForm; begin if FParentForm = nil then begin FParentForm := TParentForm.CreateNew(nil); if not ModuleIsLib then // Access denied AV inside multithreaded (COM) environment FParentForm.HandleNeeded; end; Result := FParentForm; end; function frxFindDataSet(DataSet: TfrxDataSet; const Name: String; Owner: TComponent): TfrxDataSet; var i: Integer; ds: TfrxDataSet; begin Result := DataSet; if Name = '' then begin Result := nil; Exit; end; if Owner = nil then Exit; DatasetList.Lock; for i := 0 to DatasetList.Count - 1 do begin ds := DatasetList[i]; if AnsiCompareText(ds.UserName, Name) = 0 then if not ((Owner is TfrxReport) and (ds.Owner is TfrxReport) and (ds.Owner <> Owner)) then begin Result := DatasetList[i]; break; end; end; DatasetList.Unlock; end; procedure frxGetDataSetList(List: TStrings); var i: Integer; ds: TfrxDataSet; begin DatasetList.Lock; List.Clear; for i := 0 to DatasetList.Count - 1 do begin ds := DatasetList[i]; if (ds <> nil) and (ds.UserName <> '') and ds.Enabled then List.AddObject(ds.UserName, ds); end; DatasetList.Unlock; end; procedure EmptyParentForm; begin while FParentForm.ControlCount > 0 do FParentForm.Controls[0].Parent := nil; end; function FloatDiff(const Val1, Val2: Extended): Boolean; begin Result := Abs(Val1 - Val2) > 1e-4; end; function ShiftToByte(Value: TShiftState): Byte; begin Result := Byte(PByteSet(@Value)^); end; { TfrxDataset } constructor TfrxDataSet.Create(AOwner: TComponent); begin inherited; FEnabled := True; FOpenDataSource := True; FRangeBegin := rbFirst; FRangeEnd := reLast; DatasetList.Lock; DatasetList.Add(Self); DatasetList.Unlock; end; destructor TfrxDataSet.Destroy; begin DatasetList.Lock; DatasetList.Remove(Self); inherited; DatasetList.Unlock; end; procedure TfrxDataSet.SetName(const NewName: TComponentName); begin if NewName <> '' then if (FUserName = '') or (FUserName = Name) then UserName := NewName; inherited; end; procedure TfrxDataSet.SetUserName(const Value: String); begin if Trim(Value) = '' then raise Exception.Create(frxResources.Get('prInvProp')); FUserName := Value; end; procedure TfrxDataSet.Initialize; begin end; procedure TfrxDataSet.Finalize; begin end; procedure TfrxDataSet.Close; begin if Assigned(FOnClose) then FOnClose(Self); end; procedure TfrxDataSet.Open; begin if Assigned(FOnOpen) then FOnOpen(Self); end; procedure TfrxDataSet.First; begin FRecNo := 0; FEof := False; if Assigned(FOnFirst) then FOnFirst(Self); end; procedure TfrxDataSet.Next; begin FEof := False; Inc(FRecNo); if not ((FRangeEnd = reCount) and (FRecNo >= FRangeEndCount)) then begin if Assigned(FOnNext) then FOnNext(Self); end else begin FRecNo := FRangeEndCount - 1; FEof := True; end; end; procedure TfrxDataSet.Prior; begin Dec(FRecNo); if Assigned(FOnPrior) then FOnPrior(Self); end; function TfrxDataSet.Eof: Boolean; begin Result := False; if FRangeEnd = reCount then if (FRecNo >= FRangeEndCount) or FEof then Result := True; if Assigned(FOnCheckEOF) then FOnCheckEOF(Self, Result); end; function TfrxDataSet.GetDisplayText(Index: String): WideString; begin Result := ''; end; function TfrxDataSet.GetDisplayWidth(Index: String): Integer; begin Result := 10; end; procedure TfrxDataSet.GetFieldList(List: TStrings); begin List.Clear; end; function TfrxDataSet.GetValue(Index: String): Variant; begin Result := Null; end; function TfrxDataSet.HasField(const fName: String): Boolean; var sl: TStringList; begin sl := TStringList.Create; GetFieldList(sl); Result := sl.IndexOf(fName) <> -1; sl.Free; end; procedure TfrxDataSet.AssignBlobTo(const fName: String; Obj: TObject); begin // empty method end; function TfrxDataSet.IsBlobField(const fName: String): Boolean; begin Result := False; end; function TfrxDataSet.FieldsCount: Integer; begin Result := 0; end; function TfrxDataSet.GetFieldType(Index: String): TfrxFieldType; begin Result := fftNumeric; end; function TfrxDataSet.RecordCount: Integer; begin if (RangeBegin = rbFirst) and (RangeEnd = reCount) then Result := RangeEndCount else Result := 0; end; {$IFDEF FR_COM} function TfrxDataSet.Get_UserName(out Value: WideString): HResult; stdcall; begin Value := UserName; Result := S_OK; end; function TfrxDataSet.Set_UserName(const Value: WideString): HResult; stdcall; begin UserName := Value; Result := S_OK; end; function TfrxDataSet.Get_RangeBegin(out Value: frxRangeBegin): HResult; stdcall; begin Value := frxRangeBegin(RangeBegin); Result := S_OK; end; function TfrxDataSet.Set_RangeBegin(Value: frxRangeBegin): HResult; stdcall; begin RangeBegin := TfrxRangeBegin(Value); Result := S_OK; end; function TfrxDataSet.Get_RangeEndCount(out Value: Integer): HResult; stdcall; begin Value := RangeEndCount; Result := S_OK; end; function TfrxDataSet.Set_RangeEndCount(Value: Integer): HResult; stdcall; begin RangeEndCount := Value; Result := S_OK; end; function TfrxDataSet.Get_RangeEnd(out Value: frxRangeEnd): HResult; stdcall; begin Value := frxRangeEnd(RangeEnd); Result := S_OK; end; function TfrxDataSet.Set_RangeEnd(Value: frxRangeEnd): HResult; stdcall; begin RangeEnd := TfrxRangeEnd(Value); Result := S_OK; end; function TfrxDataSet.Get_FieldsCount(out Value: Integer): HResult; stdcall; begin Value := FieldsCount; Result := S_OK; end; function TfrxDataSet.Get_RecordsCount(out Value: Integer): HResult; stdcall; begin value := RecordCount; Result := S_OK; end; function TfrxDataSet.ValueOfField(const FieldName: WideString; out Value: OleVariant): HResult; stdcall; begin Value := Self.Value[FieldName]; Result := S_OK; end; function TfrxDataSet.Get_CurrentRecordNo(out Value: Integer): HResult; stdcall; begin Value := RecNo; Result := S_OK; end; function TfrxDataSet.GoFirst: HResult; stdcall; begin First; Result := S_OK; end; function TfrxDataSet.GoNext: HResult; stdcall; begin Next; Result := S_OK; end; function TfrxDataSet.GoPrior: HResult; stdcall; begin Prior; Result := S_OK; end; {$ENDIF} { TfrxUserDataSet } constructor TfrxUserDataSet.Create(AOwner: TComponent); begin inherited; FFields := TStringList.Create; {$IFDEF FR_COM} FEvent := nil; OnGetValue := COM_OnGetValueHandler; OnFirst := COM_OnFirstHandler; OnNext := COM_OnNextHandler; OnPrior := COM_OnPrevHandler; OnCheckEOF := COM_OnCheckEOFHandler; FConnectionPoints := TConnectionPoints.Create(Self); FConnectionPoints.CreateConnectionPoint( IfrxUserDataSetEvents, ckSingle, EventSinkChanged ); FConnectionPoint := FConnectionPoints.CreateConnectionPoint(IfrxUserDataSetEventDispatcher, ckMulti, nil); {$ENDIF} end; destructor TfrxUserDataSet.Destroy; begin {$IFDEF FR_COM} FConnectionPoint.Free; FConnectionPoints.Free; {$ENDIF} FFields.Free; inherited; end; procedure TfrxUserDataSet.SetFields(const Value: TStrings); begin FFields.Assign(Value); end; procedure TfrxUserDataSet.GetFieldList(List: TStrings); begin List.Assign(FFields); end; function TfrxUserDataSet.FieldsCount: Integer; begin Result := FFields.Count; end; function TfrxUserDataSet.GetDisplayText(Index: String): WideString; var v: Variant; begin Result := ''; if Assigned(FOnGetValue) then begin v := Null; FOnGetValue(Index, v); Result := VarToWideStr(v); end; end; function TfrxUserDataSet.GetValue(Index: String): Variant; begin Result := Null; if Assigned(FOnGetValue) then FOnGetValue(Index, Result); end; {$IFDEF FR_COM} procedure TfrxUserDataSet.EventSinkChanged(const Sink: IUnknown; Connecting: Boolean); begin if Connecting then FEvent := Sink as IfrxUserDataSetEvents else FEvent := nil; end; function TfrxUserDataSet.IfrxUserDataSet_Get_Fields(out Value: WideString): HResult; stdcall; begin Value := WideString(String(Fields.GetText)); Result := 0; end; function TfrxUserDataSet.IfrxUserDataSet_Set_Fields(const Value: WideString): HResult; stdcall; begin Fields.SetText( PAnsiChar(String(Value)) ); Result := 0; end; function TfrxUserDataSet.IfrxUserDataSet_Get_Name(out Value: WideString): HResult; stdcall; begin Value := WideString(String(UserName)); Result := 0; end; function TfrxUserDataSet.IfrxUserDataSet_Set_Name(const Value: WideString): HResult; stdcall; begin UserName := ( PAnsiChar(String(Value)) ); Result := 0; end; procedure TfrxUserDataSet.COM_OnGetValueHandler(const VarName: String; var Value: Variant); var OleVal : OleVariant; Enum : IEnumConnections; ConnectData : TConnectData; Fetched : Longint; begin if FEvent <> nil then begin FEvent.OnGetValue( OleVariant(VarName), OleVal); Value := OleVal; end else begin OleCheck((FConnectionPoint as IConnectionPoint).EnumConnections(Enum)); while Enum.Next (1, ConnectData, @Fetched) = S_OK do begin (ConnectData.pUnk as IfrxUserDataSetEventDispatcher).OnGetValue(OleVariant(VarName), OleVal); ConnectData.pUnk := nil; if not VarIsEmpty(OleVal) then begin Value := OleVal; Break; end; end; end; end; procedure TfrxUserDataSet.COM_OnCheckEOFHandler(Sender: TObject; var EOF: Boolean); var e : WordBool; Enum : IEnumConnections; ConnectData : TConnectData; Fetched : Longint; begin e := True; if FEvent <> nil then begin FEvent.OnCheckEOF(e); EOF := Boolean(e); end else begin EOF := False; OleCheck((FConnectionPoint as IConnectionPoint).EnumConnections(Enum)); while Enum.Next (1, ConnectData, @Fetched) = S_OK do begin (ConnectData.pUnk as IfrxUserDataSetEventDispatcher).OnCheckEOF(e); ConnectData.pUnk := nil; EOF := EOF or Boolean(e); end; end; end; procedure TfrxUserDataSet.COM_OnFirstHandler(Sender: TObject); var Enum : IEnumConnections; ConnectData : TConnectData; Fetched : Longint; begin if FEvent <> nil then FEvent.OnFirst else begin OleCheck((FConnectionPoint as IConnectionPoint).EnumConnections(Enum)); while Enum.Next (1, ConnectData, @Fetched) = S_OK do begin (ConnectData.pUnk as IfrxUserDataSetEventDispatcher).OnFirst; ConnectData.pUnk := nil; end; end; end; procedure TfrxUserDataSet.COM_OnNextHandler(Sender: TObject); var Enum : IEnumConnections; ConnectData : TConnectData; Fetched : Longint; begin if FEvent <> nil then FEvent.OnNext else begin OleCheck((FConnectionPoint as IConnectionPoint).EnumConnections(Enum)); while Enum.Next (1, ConnectData, @Fetched) = S_OK do begin (ConnectData.pUnk as IfrxUserDataSetEventDispatcher).OnNext; ConnectData.pUnk := nil; end; end; end; procedure TfrxUserDataSet.COM_OnPrevHandler(Sender: TObject); var Enum : IEnumConnections; ConnectData : TConnectData; Fetched : Longint; begin if FEvent <> nil then FEvent.OnPrior else begin OleCheck((FConnectionPoint as IConnectionPoint).EnumConnections(Enum)); while Enum.Next (1, ConnectData, @Fetched) = S_OK do begin (ConnectData.pUnk as IfrxUserDataSetEventDispatcher).OnPrior; ConnectData.pUnk := nil; end; end; end; {$ENDIF} { TfrxCustomDBDataSet } constructor TfrxCustomDBDataset.Create(AOwner: TComponent); begin FFields := TStringList.Create; FFields.Sorted := True; FFields.Duplicates := dupIgnore; FAliases := TStringList.Create; inherited; end; destructor TfrxCustomDBDataset.Destroy; begin FFields.Free; FAliases.Free; inherited; end; procedure TfrxCustomDBDataset.SetFieldAliases(const Value: TStrings); begin FAliases.Assign(Value); end; function TfrxCustomDBDataset.ConvertAlias(const fName: String): String; var i: Integer; s: String; begin Result := fName; for i := 0 to FAliases.Count - 1 do begin s := FAliases[i]; if AnsiCompareText(Copy(s, Pos('=', s) + 1, MaxInt), fName) = 0 then begin Result := FAliases.Names[i]; break; end; end; end; function TfrxCustomDBDataset.GetAlias(const fName: String): String; var i: Integer; begin Result := fName; for i := 0 to FAliases.Count - 1 do if AnsiCompareText(FAliases.Names[i], fName) = 0 then begin Result := FAliases[i]; Result := Copy(Result, Pos('=', Result) + 1, MaxInt); break; end; end; function TfrxCustomDBDataset.FieldsCount: Integer; var sl: TStrings; begin sl := TStringList.Create; try GetFieldList(sl); finally Result := sl.Count; sl.Free; end; end; { TfrxDBComponents } function TfrxDBComponents.GetDescription: String; begin Result := ''; end; { TfrxCustomDatabase } procedure TfrxCustomDatabase.BeforeConnect(var Value: Boolean); begin if (Report <> nil) and Assigned(Report.OnBeforeConnect) then Report.OnBeforeConnect(Self, Value); end; function TfrxCustomDatabase.GetConnected: Boolean; begin Result := False; end; function TfrxCustomDatabase.GetDatabaseName: String; begin Result := ''; end; function TfrxCustomDatabase.GetLoginPrompt: Boolean; begin Result := False; end; function TfrxCustomDatabase.GetParams: TStrings; begin Result := nil; end; procedure TfrxCustomDatabase.SetConnected(Value: Boolean); begin // empty end; procedure TfrxCustomDatabase.SetDatabaseName(const Value: String); begin // empty end; procedure TfrxCustomDatabase.SetLogin(const Login, Password: String); begin // empty end; procedure TfrxCustomDatabase.SetLoginPrompt(Value: Boolean); begin // empty end; procedure TfrxCustomDatabase.SetParams(Value: TStrings); begin // empty end; { TfrxComponent } constructor TfrxComponent.Create(AOwner: TComponent); begin if AOwner is TfrxComponent then inherited Create(TfrxComponent(AOwner).Report) else inherited Create(AOwner); FComponentStyle := [csPreviewVisible]; FBaseName := ClassName; Delete(FBaseName, Pos('Tfrx', FBaseName), 4); Delete(FBaseName, Pos('View', FBaseName), 4); FObjects := TList.Create; FAllObjects := TList.Create; {$IFNDEF FR_COM} FFont := TFont.Create; {$ELSE} FFont := TfrxFont.Create; {$ENDIF} with FFont do begin PixelsPerInch := 96; Name := DefFontName; Size := DefFontSize; Color := clBlack; Charset := frxCharset; OnChange := FontChanged; end; FVisible := True; ParentFont := True; if AOwner is TfrxComponent then SetParent(TfrxComponent(AOwner)); end; constructor TfrxComponent.DesignCreate(AOwner: TComponent; Flags: Word); begin FIsDesigning := True; Create(AOwner); end; destructor TfrxComponent.Destroy; begin SetParent(nil); Clear; FFont.Free; FObjects.Free; FAllObjects.Free; inherited; end; procedure TfrxComponent.Assign(Source: TPersistent); var s: TMemoryStream; begin if Source is TfrxComponent then begin s := TMemoryStream.Create; try TfrxComponent(Source).SaveToStream(s, False, True); s.Position := 0; LoadFromStream(s); finally s.Free; end; end; end; procedure TfrxComponent.AssignAll(Source: TfrxComponent); var s: TMemoryStream; begin s := TMemoryStream.Create; try Source.SaveToStream(s, True, True); s.Position := 0; LoadFromStream(s); finally s.Free; end; end; procedure TfrxComponent.LoadFromStream(Stream: TStream); var Reader: TfrxXMLSerializer; begin Clear; Reader := TfrxXMLSerializer.Create(Stream); if Report <> nil then Report.FXMLSerializer := Reader; try Reader.Owner := Report; if (Report <> nil) and Report.EngineOptions.EnableThreadSafe then begin {$IFNDEF NO_CRITICAL_SECTION} frxCS.Enter; {$ENDIF} try Reader.ReadRootComponent(Self, nil); finally {$IFNDEF NO_CRITICAL_SECTION} frxCS.Leave; {$ENDIF} end; end else Reader.ReadRootComponent(Self, nil); if Report <> nil then Report.Errors.AddStrings(Reader.Errors); finally Reader.Free; if Report <> nil then Report.FXMLSerializer := nil; end; end; procedure TfrxComponent.SaveToStream(Stream: TStream; SaveChildren: Boolean = True; SaveDefaultValues: Boolean = False); var Writer: TfrxXMLSerializer; begin Writer := TfrxXMLSerializer.Create(Stream); try Writer.Owner := Report; Writer.SerializeDefaultValues := SaveDefaultValues; if Self is TfrxReport then Writer.OnGetAncestor := Report.DoGetAncestor; Writer.WriteRootComponent(Self, SaveChildren); finally Writer.Free; end; end; procedure TfrxComponent.Clear; var i: Integer; c: TfrxComponent; begin i := 0; while i < FObjects.Count do begin c := FObjects[i]; if (csAncestor in c.ComponentState) then begin c.Clear; Inc(i); end else c.Free; end; end; procedure TfrxComponent.SetParent(AParent: TfrxComponent); begin if FParent <> AParent then begin if FParent <> nil then FParent.FObjects.Remove(Self); if AParent <> nil then AParent.FObjects.Add(Self); end; FParent := AParent; if FParent <> nil then SetParentFont(FParentFont); end; procedure TfrxComponent.SetBounds(ALeft, ATop, AWidth, AHeight: Extended); begin Left := ALeft; Top := ATop; Width := AWidth; Height := AHeight; end; function TfrxComponent.GetPage: TfrxPage; var p: TfrxComponent; begin if Self is TfrxPage then begin Result := TfrxPage(Self); Exit; end; Result := nil; p := Parent; while p <> nil do begin if p is TfrxPage then begin Result := TfrxPage(p); Exit; end; p := p.Parent; end; end; function TfrxComponent.GetReport: TfrxReport; var p: TfrxComponent; begin if Self is TfrxReport then begin Result := TfrxReport(Self); Exit; end; Result := nil; p := Parent; while p <> nil do begin if p is TfrxReport then begin Result := TfrxReport(p); Exit; end; p := p.Parent; end; end; function TfrxComponent.GetIsLoading: Boolean; begin Result := FIsLoading or (csLoading in ComponentState); end; function TfrxComponent.GetAbsTop: Extended; begin if (Parent <> nil) and not (Parent is TfrxDialogPage) then Result := Parent.AbsTop + Top else Result := Top; end; function TfrxComponent.GetAbsLeft: Extended; begin if (Parent <> nil) and not (Parent is TfrxDialogPage) then Result := Parent.AbsLeft + Left else Result := Left; end; procedure TfrxComponent.SetLeft(Value: Extended); begin if not IsDesigning or not (rfDontMove in FRestrictions) then FLeft := Value; end; procedure TfrxComponent.SetTop(Value: Extended); begin if not IsDesigning or not (rfDontMove in FRestrictions) then FTop := Value; end; procedure TfrxComponent.SetWidth(Value: Extended); begin if not IsDesigning or not (rfDontSize in FRestrictions) then FWidth := Value; end; procedure TfrxComponent.SetHeight(Value: Extended); begin if not IsDesigning or not (rfDontSize in FRestrictions) then FHeight := Value; end; function TfrxComponent.IsFontStored: Boolean; begin Result := not FParentFont; end; procedure TfrxComponent.SetFont(Value: TFont); begin FFont.Assign(Value); FParentFont := False; end; procedure TfrxComponent.SetParentFont(const Value: Boolean); begin if Value then if Parent <> nil then Font := Parent.Font; FParentFont := Value; end; procedure TfrxComponent.SetVisible(Value: Boolean); begin FVisible := Value; end; procedure TfrxComponent.FontChanged(Sender: TObject); var i: Integer; c: TfrxComponent; begin FParentFont := False; for i := 0 to FObjects.Count - 1 do begin c := FObjects[i]; if c.ParentFont then c.ParentFont := True; end; end; function TfrxComponent.GetAllObjects: TList; procedure EnumObjects(c: TfrxComponent); var i: Integer; begin if c <> Self then FAllObjects.Add(c); for i := 0 to c.FObjects.Count - 1 do EnumObjects(c.FObjects[i]); end; begin FAllObjects.Clear; EnumObjects(Self); Result := FAllObjects; end; procedure TfrxComponent.SetName(const AName: TComponentName); var c: TfrxComponent; begin if CompareText(AName, Name) = 0 then Exit; if (AName <> '') and (Report <> nil) then begin c := Report.FindObject(AName); if (c <> nil) and (c <> Self) then raise Exception.Create(frxResources.Get('prDupl')); if IsAncestor then raise Exception.Create('Could not rename ' + Name + ', it was introduced in the ancestor report'); end; inherited; end; procedure TfrxComponent.CreateUniqueName; var i: Integer; l: TList; sl: TStringList; begin sl := TStringList.Create; sl.Sorted := True; sl.Duplicates := dupIgnore; if Report <> nil then l := Report.AllObjects else l := Parent.AllObjects; for i := 0 to l.Count - 1 do sl.Add(TfrxComponent(l[i]).Name); i := 1; while sl.IndexOf(FBaseName + IntToStr(i)) <> -1 do Inc(i); Name := FBaseName + IntToStr(i); sl.Free; end; function TfrxComponent.Diff(AComponent: TfrxComponent): String; begin Result := InternalDiff(AComponent); end; function TfrxComponent.DiffFont(f1, f2: TFont; const Add: String): String; var fs: Integer; begin Result := ''; if f1.Name <> f2.Name then Result := Result + Add + 'Font.Name="' + frxStrToXML(f1.Name) + '"'; if f1.Size <> f2.Size then Result := Result + Add + 'Font.Size="' + IntToStr(f1.Size) + '"'; if f1.Color <> f2.Color then Result := Result + Add + 'Font.Color="' + IntToStr(f1.Color) + '"'; if f1.Style <> f2.Style then begin fs := 0; if fsBold in f1.Style then fs := 1; if fsItalic in f1.Style then fs := fs or 2; if fsUnderline in f1.Style then fs := fs or 4; if fsStrikeout in f1.Style then fs := fs or 8; Result := Result + Add + 'Font.Style="' + IntToStr(fs) + '"'; end; if f1.Charset <> f2.Charset then Result := Result + Add + 'Font.Charset="' + IntToStr(f1.Charset) + '"'; end; function TfrxComponent.InternalDiff(AComponent: TfrxComponent): String; begin Result := ''; if FloatDiff(FLeft, AComponent.FLeft) then Result := Result + ' l="' + FloatToStr(FLeft) + '"'; if (Self is TfrxBand) or FloatDiff(FTop, AComponent.FTop) then Result := Result + ' t="' + FloatToStr(FTop) + '"'; if not ((Self is TfrxCustomMemoView) and TfrxCustomMemoView(Self).FAutoWidth) then if FloatDiff(FWidth, AComponent.FWidth) then Result := Result + ' w="' + FloatToStr(FWidth) + '"'; if FloatDiff(FHeight, AComponent.FHeight) then Result := Result + ' h="' + FloatToStr(FHeight) + '"'; if FVisible <> AComponent.FVisible then Result := Result + ' Visible="' + frxValueToXML(FVisible) + '"'; if not FParentFont then Result := Result + DiffFont(FFont, AComponent.FFont, ' '); if FParentFont <> AComponent.FParentFont then Result := Result + ' ParentFont="' + frxValueToXML(FParentFont) + '"'; if Tag <> AComponent.Tag then Result := Result + ' Tag="' + IntToStr(Tag) + '"'; end; function TfrxComponent.AllDiff(AComponent: TfrxComponent): String; var s: TStringStream; Writer: TfrxXMLSerializer; i: Integer; begin s := TStringStream.Create(''); Writer := TfrxXMLSerializer.Create(s); Writer.Owner := Report; Writer.WriteComponent(Self); Writer.Free; Result := s.DataString; i := Pos(' ', Result); if i <> 0 then begin Delete(Result, 1, i); Delete(Result, Length(Result) - 1, 2); end else Result := ''; if AComponent <> nil then Result := Result + ' ' + InternalDiff(AComponent); s.Free; end; procedure TfrxComponent.AlignChildren; var i: Integer; c: TfrxComponent; sl: TStringList; procedure DoAlign(v: TfrxView; n, dir: Integer); var i: Integer; c, c0: TfrxComponent; begin c0 := nil; i := n; while (i >= 0) and (i < sl.Count) do begin c := TfrxComponent(sl.Objects[i]); if c <> v then if (c.AbsTop < v.AbsTop + v.Height - 1e-4) and (v.AbsTop < c.AbsTop + c.Height - 1e-4) then begin { special case for baWidth } if (v.Align = baWidth) and (((dir = 1) and (c.Left > v.Left)) or ((dir = -1) and (c.Left + c.Width < v.Left + v.Width))) then begin Dec(i, dir); continue; end; c0 := c; break; end; Dec(i, dir); end; if (dir = 1) and (v.Align in [baLeft, baWidth]) then if c0 = nil then v.Left := 0 else v.Left := c0.Left + c0.Width; if v.Align = baRight then if c0 = nil then v.Left := Width - v.Width else v.Left := c0.Left - v.Width; if (dir = -1) and (v.Align = baWidth) then if c0 = nil then v.Width := Width - v.Left else v.Width := c0.Left - v.Left; end; begin sl := TStringList.Create; sl.Sorted := True; sl.Duplicates := dupAccept; for i := 0 to FObjects.Count - 1 do begin c := FObjects[i]; if c is TfrxView then if c.Left >= 0 then sl.AddObject('1' + Format('%9.2f', [c.Left]), c) else sl.AddObject('0' + Format('%9.2f', [-c.Left]), c); end; { process baLeft } for i := 0 to sl.Count - 1 do begin c := TfrxComponent(sl.Objects[i]); if c is TfrxView then if TfrxView(c).Align in [baLeft, baWidth] then DoAlign(TfrxView(c), i, 1); end; { process baRight } for i := sl.Count - 1 downto 0 do begin c := TfrxComponent(sl.Objects[i]); if c is TfrxView then if TfrxView(c).Align in [baRight, baWidth] then DoAlign(TfrxView(c), i, -1); end; { process others } for i := 0 to FObjects.Count - 1 do begin c := FObjects[i]; if c is TfrxView then case TfrxView(c).Align of baCenter: c.Left := (Width - c.Width) / 2; baBottom: c.Top := Height - c.Height; baClient: begin c.Left := 0; c.Top := 0; c.Width := Width; c.Height := Height; end; end; end; sl.Free; end; function TfrxComponent.FindObject(const AName: String): TfrxComponent; var i: Integer; l: TList; begin Result := nil; l := AllObjects; for i := 0 to l.Count - 1 do if CompareText(AName, TfrxComponent(l[i]).Name) = 0 then begin Result := l[i]; break; end; end; class function TfrxComponent.GetDescription: String; begin Result := ClassName; end; function TfrxComponent.GetChildOwner: TComponent; begin Result := Self; end; procedure TfrxComponent.GetChildren(Proc: TGetChildProc; Root: TComponent); var i: Integer; begin if (Self is TfrxReport) and not TfrxReport(Self).StoreInDFM then Exit; for i := 0 to FObjects.Count - 1 do Proc(FObjects[i]); end; procedure TfrxComponent.BeforeStartReport; begin // do nothing end; procedure TfrxComponent.OnNotify(Sender: TObject); begin // do nothing end; procedure TfrxComponent.OnPaste; begin // end; function TfrxComponent.GetIsAncestor: Boolean; begin Result := (csAncestor in ComponentState) or FAncestor; end; function TfrxComponent.GetContainerObjects: TList; begin Result := FObjects; end; function TfrxComponent.ContainerAdd(Obj: TfrxComponent): Boolean; begin Result := False; end; function TfrxComponent.ContainerMouseDown(Sender: TObject; X, Y: Integer): Boolean; begin Result := False; end; procedure TfrxComponent.ContainerMouseMove(Sender: TObject; X, Y: Integer); begin end; procedure TfrxComponent.ContainerMouseUp(Sender: TObject; X, Y: Integer); begin end; {$IFDEF FR_COM} function TfrxComponent.GetFont: TFont; begin Result := FFont; end; { IfrxComponent support } function TfrxComponent.IfrxComponent_Get_Description(out Value: WideString): HResult; stdcall; begin Value := WideString(GetDescription); Result := S_OK; end; function TfrxComponent.IfrxComponent_Get_ObjectsCount(out Value: Integer): HResult; stdcall; begin Value := FObjects.Count; Result := S_OK; end; function TfrxComponent.IfrxComponent_GetObject(Index: Integer; out Component: IfrxComponent): HResult; stdcall; begin if (Index >= 0) and (Index < FObjects.Count) then begin Component := TfrxComponent(FObjects[Index]); Result := S_OK; end else Result := E_UNEXPECTED; end; function TfrxComponent.IfrxComponent_Get_BaseName(out Value: WideString): HResult; stdcall; begin Value := BaseName; Result := S_OK; end; function TfrxComponent.IfrxComponent_Get_AliasName(out Value: WideString): HResult; stdcall; begin Value := FAliasName; Result := S_OK; end; function TfrxComponent.IfrxComponent_Get_Name(out Value: WideString): HResult; stdcall; begin Value := Name; Result := S_OK; end; function TfrxComponent.IfrxComponent_Get_Left(out Value: Double): HResult; stdcall; begin Value := Left; Result := S_OK; end; function TfrxComponent.IfrxComponent_Set_Left(Value: Double): HResult; stdcall; begin Left := Value; Result := S_OK; end; function TfrxComponent.IfrxComponent_Get_Top(out Value: Double): HResult; stdcall; begin Value := Top; Result := S_OK; end; function TfrxComponent.IfrxComponent_Set_Top(Value: Double): HResult; stdcall; begin Top := Value; Result := S_OK; end; function TfrxComponent.IfrxComponent_Get_Width(out Value: Double): HResult; stdcall; begin Value := Width; Result := S_OK; end; function TfrxComponent.IfrxComponent_Set_Width(Value: Double): HResult; stdcall; begin Width := Value; Result := S_OK; end; function TfrxComponent.IfrxComponent_Get_Height(out Value: Double): HResult; stdcall; begin Value := Height; Result := S_OK; end; function TfrxComponent.IfrxComponent_Set_Height(Value: Double): HResult; stdcall; begin Height := Value; Result := S_OK; end; function TfrxComponent.IfrxComponent_FindObject(const ObjectName: WideString; out Object_: IfrxComponent): HResult; stdcall; var i: Integer; TempStr: WideString; begin TempStr := ObjectName; for i := 0 to length(ObjectName) - 1 do if ObjectName[i] = ' ' then TempStr[i] := '_'; Object_ := FindObject(TempStr); if Object_ <> nil then Result := S_OK else Result := S_FALSE; end; function TfrxComponent.Get_Restrictions(out Value: frxRestrictions): HResult; stdcall; begin Value := PInteger( @Restrictions )^; Result := S_OK; end; function TfrxComponent.Set_Restrictions(Value: frxRestrictions): HResult; stdcall; type PfrxRestrictions = ^ TfrxRestrictions; var dst: TfrxRestrictions; src: Integer; begin src := Value; dst := PfrxRestrictions(@src)^; Restrictions := dst; Result := S_OK; end; {$ENDIF} { TfrxReportComponent } constructor TfrxReportComponent.Create(AOwner: TComponent); begin inherited; FShiftChildren := TList.Create; end; destructor TfrxReportComponent.Destroy; begin FShiftChildren.Free; inherited; end; procedure TfrxReportComponent.GetData; begin // do nothing end; procedure TfrxReportComponent.BeforePrint; begin FOriginalRect := frxRect(Left, Top, Width, Height); end; procedure TfrxReportComponent.AfterPrint; begin with FOriginalRect do SetBounds(Left, Top, Right, Bottom); end; function TfrxReportComponent.GetComponentText: String; begin Result := ''; end; function TfrxReportComponent.GetRealBounds: TfrxRect; begin Result := frxRect(AbsLeft, AbsTop, AbsLeft + Width, AbsTop + Height); end; { TfrxDialogComponent } constructor TfrxDialogComponent.Create(AOwner: TComponent); begin inherited; frComponentStyle := frComponentStyle - [csPreviewVisible]; Width := 28; Height := 28; end; destructor TfrxDialogComponent.Destroy; begin if FComponent <> nil then FComponent.Free; FComponent := nil; inherited; end; procedure TfrxDialogComponent.DefineProperties(Filer: TFiler); begin inherited; Filer.DefineProperty('pLeft', ReadLeft, WriteLeft, Report <> nil); Filer.DefineProperty('pTop', ReadTop, WriteTop, Report <> nil); end; procedure TfrxDialogComponent.ReadLeft(Reader: TReader); begin Left := Reader.ReadInteger; end; procedure TfrxDialogComponent.ReadTop(Reader: TReader); begin Top := Reader.ReadInteger; end; procedure TfrxDialogComponent.WriteLeft(Writer: TWriter); begin Writer.WriteInteger(Round(Left)); end; procedure TfrxDialogComponent.WriteTop(Writer: TWriter); begin Writer.WriteInteger(Round(Top)); end; procedure TfrxDialogComponent.Draw(Canvas: TCanvas; ScaleX, ScaleY, OffsetX, OffsetY: Extended); var r: TRect; i, w, ImageIndex: Integer; Item: TfrxObjectItem; begin Width := 28; Height := 28; r := Rect(Round(Left), Round(Top), Round(Left + 28), Round(Top + 28)); Canvas.Brush.Color := clBtnFace; Canvas.FillRect(r); DrawEdge(Canvas.Handle, r, EDGE_RAISED, BF_RECT); ImageIndex := -1; for i := 0 to frxObjects.Count - 1 do begin Item := frxObjects[i]; if Item.ClassRef = ClassType then begin ImageIndex := Item.ButtonImageIndex; break; end; end; if ImageIndex <> -1 then frxResources.ObjectImages.Draw(Canvas, r.Left + 6, r.Top + 6, ImageIndex); Canvas.Font.Name := 'Tahoma'; Canvas.Font.Size := 8; Canvas.Font.Color := clBlack; Canvas.Font.Style := []; w := Canvas.TextWidth(Name); Canvas.Brush.Color := clWindow; Canvas.TextOut(r.Left - (w - 28) div 2, r.Bottom + 4, Name); end; { TfrxDialogControl } constructor TfrxDialogControl.Create(AOwner: TComponent); begin inherited; FBaseName := ClassName; Delete(FBaseName, Pos('Tfrx', FBaseName), 4); Delete(FBaseName, Pos('Control', FBaseName), 7); end; destructor TfrxDialogControl.Destroy; begin inherited; if FControl <> nil then FControl.Free; FControl := nil; end; procedure TfrxDialogControl.InitControl(AControl: TControl); begin FControl := AControl; with THackControl(FControl) do begin OnClick := DoOnClick; OnDblClick := DoOnDblClick; OnMouseDown := DoOnMouseDown; OnMouseMove := DoOnMouseMove; OnMouseUp := DoOnMouseUp; end; if FControl is TWinControl then with THackWinControl(FControl) do begin OnEnter := DoOnEnter; OnExit := DoOnExit; OnKeyDown := DoOnKeyDown; OnKeyPress := DoOnKeyPress; OnKeyUp := DoOnKeyUp; end; SetParent(Parent); end; procedure TfrxDialogControl.Draw(Canvas: TCanvas; ScaleX, ScaleY, OffsetX, OffsetY: Extended); var Bmp: TBitmap; MemDC: HDC; OldBitmap: HBITMAP; begin Bmp := TBitmap.Create; Bmp.Width := Round(Width); Bmp.Height := Round(Height); Bmp.Canvas.Brush.Color := clBtnFace; Bmp.Canvas.FillRect(Rect(0, 0, Round(Width) + 1, Round(Height) + 1)); Canvas.Lock; try MemDC := CreateCompatibleDC(0); OldBitmap := SelectObject(MemDC, Bmp.Handle); if FControl is TWinControl then TWinControl(FControl).PaintTo(MemDC, 0, 0) else begin FControl.Perform(WM_ERASEBKGND, MemDC, 0); FControl.Perform(WM_PAINT, MemDC, 0); end; SelectObject(MemDC, OldBitmap); DeleteDC(MemDC); finally Canvas.Unlock; end; Canvas.Draw(Round(AbsLeft), Round(AbsTop), Bmp); Bmp.Free; end; function TfrxDialogControl.GetCaption: String; begin Result := THackControl(FControl).Caption; end; function TfrxDialogControl.GetColor: TColor; begin Result := THackControl(FControl).Color; end; function TfrxDialogControl.GetEnabled: Boolean; begin Result := FControl.Enabled; end; procedure TfrxDialogControl.SetLeft(Value: Extended); begin inherited; FControl.Left := Round(Left); end; procedure TfrxDialogControl.SetTop(Value: Extended); begin inherited; FControl.Top := Round(Top); end; procedure TfrxDialogControl.SetWidth(Value: Extended); begin inherited; FControl.Width := Round(Width); end; procedure TfrxDialogControl.SetHeight(Value: Extended); begin inherited; FControl.Height := Round(Height); end; procedure TfrxDialogControl.SetVisible(Value: Boolean); begin inherited; FControl.Visible := Visible; end; procedure TfrxDialogControl.SetCaption(const Value: String); begin THackControl(FControl).Caption := Value; end; procedure TfrxDialogControl.SetColor(const Value: TColor); begin THackControl(FControl).Color := Value; end; procedure TfrxDialogControl.SetEnabled(const Value: Boolean); begin FControl.Enabled := Value; end; function TfrxDialogControl.GetHint: String; begin Result := FControl.Hint; end; procedure TfrxDialogControl.SetHint(const Value: String); begin FControl.Hint := Value; end; function TfrxDialogControl.GetTabStop: Boolean; begin Result := True; if FControl is TWinControl then Result := THackWinControl(FControl).TabStop; end; procedure TfrxDialogControl.SetTabStop(const Value: Boolean); begin if FControl is TWinControl then THackWinControl(FControl).TabStop := Value; end; procedure TfrxDialogControl.FontChanged(Sender: TObject); begin inherited; if FControl <> nil then THackControl(FControl).Font.Assign(Font); end; procedure TfrxDialogControl.SetParentFont(const Value: Boolean); begin inherited; if FControl <> nil then THackControl(FControl).ParentFont := Value; end; procedure TfrxDialogControl.SetParent(AParent: TfrxComponent); begin inherited; if FControl <> nil then if AParent is TfrxDialogControl then FControl.Parent := TWinControl(TfrxDialogControl(AParent).Control) else if AParent is TfrxDialogPage then FControl.Parent := TfrxDialogPage(AParent).DialogForm else FControl.Parent := frxParentForm; end; procedure TfrxDialogControl.SetName(const AName: TComponentName); var ChangeText: Boolean; begin ChangeText := (csSetCaption in FControl.ControlStyle) and (Name = Caption) and not IsLoading; inherited SetName(AName); if ChangeText then Caption := AName; end; procedure TfrxDialogControl.DoOnClick(Sender: TObject); begin if Report <> nil then Report.DoNotifyEvent(Self, FOnClick); end; procedure TfrxDialogControl.DoOnDblClick(Sender: TObject); begin if Report <> nil then Report.DoNotifyEvent(Self, FOnDblClick); end; procedure TfrxDialogControl.DoOnEnter(Sender: TObject); begin if Report <> nil then Report.DoNotifyEvent(Self, FOnEnter); end; procedure TfrxDialogControl.DoOnExit(Sender: TObject); begin if Report <> nil then Report.DoNotifyEvent(Self, FOnExit); end; procedure TfrxDialogControl.DoOnKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); var v: Variant; begin v := VarArrayOf([Integer(Self), Key, ShiftToByte(Shift)]); if (Report <> nil) and (FOnKeyDown <> '') then begin Report.DoParamEvent(FOnKeyDown, v); Key := v[1]; end; end; procedure TfrxDialogControl.DoOnKeyPress(Sender: TObject; var Key: Char); var v: Variant; begin v := VarArrayOf([Integer(Self), Key]); if (Report <> nil) and (FOnKeyPress <> '') then begin Report.DoParamEvent(FOnKeyPress, v); if VarToStr(v[1]) <> '' then Key := VarToStr(v[1])[1] else Key := Chr(0); end; end; procedure TfrxDialogControl.DoOnKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState); var v: Variant; begin v := VarArrayOf([Integer(Self), Key, ShiftToByte(Shift)]); if (Report <> nil) and (FOnKeyUp <> '') then begin Report.DoParamEvent(FOnKeyUp, v); Key := v[1]; end; end; procedure TfrxDialogControl.DoOnMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); var v: Variant; begin v := VarArrayOf([Integer(Self), Button, ShiftToByte(Shift), X, Y]); if Report <> nil then Report.DoParamEvent(FOnMouseDown, v); end; procedure TfrxDialogControl.DoOnMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); var v: Variant; begin v := VarArrayOf([Integer(Self), ShiftToByte(Shift), X, Y]); if Report <> nil then Report.DoParamEvent(FOnMouseMove, v); end; procedure TfrxDialogControl.DoOnMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); var v: Variant; begin v := VarArrayOf([Integer(Self), Button, ShiftToByte(Shift), X, Y]); if Report <> nil then Report.DoParamEvent(FOnMouseUp, v); end; { TfrxFrameLine } constructor TfrxFrameLine.Create(AFrame: TfrxFrame); begin FColor := clBlack; FStyle := fsSolid; FWidth := 1; FFrame := AFrame; end; procedure TfrxFrameLine.Assign(Source: TPersistent); begin if Source is TfrxFrameLine then begin FColor := TfrxFrameLine(Source).Color; FStyle := TfrxFrameLine(Source).Style; FWidth := TfrxFrameLine(Source).Width; end; end; function TfrxFrameLine.IsColorStored: Boolean; begin Result := FColor <> FFrame.Color; end; function TfrxFrameLine.IsStyleStored: Boolean; begin Result := FStyle <> FFrame.Style; end; function TfrxFrameLine.IsWidthStored: Boolean; begin Result := FWidth <> FFrame.Width; end; function TfrxFrameLine.Diff(ALine: TfrxFrameLine; const LineName: String; ColorChanged, StyleChanged, WidthChanged: Boolean): String; begin Result := ''; if (ColorChanged and IsColorStored) or (not ColorChanged and (FColor <> ALine.Color)) then Result := Result + ' ' + LineName + '.Color="' + IntToStr(FColor) + '"'; if (StyleChanged and IsStyleStored) or (not StyleChanged and (FStyle <> ALine.Style)) then Result := Result + ' ' + LineName + '.Style="' + frxValueToXML(FStyle) + '"'; if (WidthChanged and IsWidthStored) or (not WidthChanged and FloatDiff(FWidth, ALine.Width)) then Result := Result + ' ' + LineName + '.Width="' + FloatToStr(FWidth) + '"'; end; { TfrxFrame } constructor TfrxFrame.Create; begin FColor := clBlack; FShadowColor := clBlack; FShadowWidth := 4; FStyle := fsSolid; FTyp := []; FWidth := 1; FLeftLine := TfrxFrameLine.Create(Self); FTopLine := TfrxFrameLine.Create(Self); FRightLine := TfrxFrameLine.Create(Self); FBottomLine := TfrxFrameLine.Create(Self); {$IFDEF FR_COM} inherited Create(IfrxFrame); {$ENDIF} end; destructor TfrxFrame.Destroy; begin FLeftLine.Free; FTopLine.Free; FRightLine.Free; FBottomLine.Free; inherited; end; procedure TfrxFrame.Assign(Source: TPersistent); begin if Source is TfrxFrame then begin FColor := TfrxFrame(Source).Color; FDropShadow := TfrxFrame(Source).DropShadow; FShadowColor := TfrxFrame(Source).ShadowColor; FShadowWidth := TfrxFrame(Source).ShadowWidth; FStyle := TfrxFrame(Source).Style; FTyp := TfrxFrame(Source).Typ; FWidth := TfrxFrame(Source).Width; FLeftLine.Assign(TfrxFrame(Source).LeftLine); FTopLine.Assign(TfrxFrame(Source).TopLine); FRightLine.Assign(TfrxFrame(Source).RightLine); FBottomLine.Assign(TfrxFrame(Source).BottomLine); end; end; function TfrxFrame.IsShadowWidthStored: Boolean; begin Result := FShadowWidth <> 4; end; function TfrxFrame.IsTypStored: Boolean; begin Result := FTyp <> []; end; function TfrxFrame.IsWidthStored: Boolean; begin Result := FWidth <> 1; end; procedure TfrxFrame.SetBottomLine(const Value: TfrxFrameLine); begin FBottomLine.Assign(Value); end; procedure TfrxFrame.SetLeftLine(const Value: TfrxFrameLine); begin FLeftLine.Assign(Value); end; procedure TfrxFrame.SetRightLine(const Value: TfrxFrameLine); begin FRightLine.Assign(Value); end; procedure TfrxFrame.SetTopLine(const Value: TfrxFrameLine); begin FTopLine.Assign(Value); end; procedure TfrxFrame.SetColor(const Value: TColor); begin FColor := Value; FLeftLine.Color := Value; FTopLine.Color := Value; FRightLine.Color := Value; FBottomLine.Color := Value; end; procedure TfrxFrame.SetStyle(const Value: TfrxFrameStyle); begin FStyle := Value; FLeftLine.Style := Value; FTopLine.Style := Value; FRightLine.Style := Value; FBottomLine.Style := Value; end; procedure TfrxFrame.SetWidth(const Value: Extended); begin FWidth := Value; FLeftLine.Width := Value; FTopLine.Width := Value; FRightLine.Width := Value; FBottomLine.Width := Value; end; function TfrxFrame.Diff(AFrame: TfrxFrame): String; var i: Integer; ColorChanged, StyleChanged, WidthChanged: Boolean; begin Result := ''; ColorChanged := FColor <> AFrame.Color; if ColorChanged then Result := Result + ' Frame.Color="' + IntToStr(FColor) + '"'; if FDropShadow <> AFrame.DropShadow then Result := Result + ' Frame.DropShadow="' + frxValueToXML(FDropShadow) + '"'; if FShadowColor <> AFrame.ShadowColor then Result := Result + ' Frame.ShadowColor="' + IntToStr(FShadowColor) + '"'; if FloatDiff(FShadowWidth, AFrame.ShadowWidth) then Result := Result + ' Frame.ShadowWidth="' + FloatToStr(FShadowWidth) + '"'; StyleChanged := FStyle <> AFrame.Style; if StyleChanged then Result := Result + ' Frame.Style="' + frxValueToXML(FStyle) + '"'; if FTyp <> AFrame.Typ then begin i := 0; if ftLeft in FTyp then i := i or 1; if ftRight in FTyp then i := i or 2; if ftTop in FTyp then i := i or 4; if ftBottom in FTyp then i := i or 8; Result := Result + ' Frame.Typ="' + IntToStr(i) + '"'; end; WidthChanged := FloatDiff(FWidth, AFrame.Width); if WidthChanged then Result := Result + ' Frame.Width="' + FloatToStr(FWidth) + '"'; Result := Result + FLeftLine.Diff(AFrame.LeftLine, 'Frame.LeftLine', ColorChanged, StyleChanged, WidthChanged); Result := Result + FTopLine.Diff(AFrame.TopLine, 'Frame.TopLine', ColorChanged, StyleChanged, WidthChanged); Result := Result + FRightLine.Diff(AFrame.RightLine, 'Frame.RightLine', ColorChanged, StyleChanged, WidthChanged); Result := Result + FBottomLine.Diff(AFrame.BottomLine, 'Frame.BottomLine', ColorChanged, StyleChanged, WidthChanged); end; {$IFDEF FR_COM} function TfrxFrame.Get_Color(out Value: Integer): HResult; stdcall; begin Value := Color; Result := S_OK; end; function TfrxFrame.Set_Color(Value: Integer): HResult; stdcall; begin Color := Value; Result := S_OK; end; function TfrxFrame.Get_DropShadow(out Value: WordBool): HResult; stdcall; begin Value := DropShadow; Result := S_OK; end; function TfrxFrame.Set_DropShadow(Value: WordBool): HResult; stdcall; begin DropShadow := Value; Result := S_OK; end; function TfrxFrame.Get_ShadowColor(out Value: Integer): HResult; stdcall; begin Value := ShadowColor; Result := S_OK; end; function TfrxFrame.Set_ShadowColor(Value: Integer): HResult; stdcall; begin ShadowColor := Value; Result := S_OK; end; function TfrxFrame.Get_ShadowWidth(out Value: Double): HResult; stdcall; begin Value := ShadowWidth; Result := S_OK; end; function TfrxFrame.Set_ShadowWidth(Value: Double): HResult; stdcall; begin ShadowWidth := Value; Result := S_OK; end; function TfrxFrame.Get_Style(out Value: frxFrameStyle): HResult; stdcall; begin Value := frxFrameStyle(Style); Result := S_OK; end; function TfrxFrame.Set_Style(Value: frxFrameStyle): HResult; stdcall; begin Style := TfrxFrameStyle(Value); Result := S_OK; end; function TfrxFrame.Get_FrameType(out Value: Integer): HResult; stdcall; begin Value := PInteger(@Typ)^; Result := S_OK; end; function TfrxFrame.Set_FrameType(Value: Integer): HResult; stdcall; type PfrxFrameTypes = ^ TfrxFrameTypes; var dst: TfrxFrameTypes; src: Integer; begin src := Value; dst := PfrxFrameTypes(@src)^; Typ := dst; Result := S_OK; end; function TfrxFrame.Get_Width(out Value: Double): HResult; stdcall; begin Value := Width; Result := S_OK; end; function TfrxFrame.Set_Width(Value: Double): HResult; stdcall; begin Width := Value; Result := S_OK; end; {$ENDIF} { TfrxView } constructor TfrxView.Create(AOwner: TComponent); begin inherited Create(AOwner); frComponentStyle := frComponentStyle + [csDefaultDiff]; FAlign := baNone; FBrushStyle := bsSolid; FColor := clTransparent; FFrame := TfrxFrame.Create; FShiftMode := smAlways; FPrintable := True; FPlainText := False; end; destructor TfrxView.Destroy; begin FFrame.Free; inherited; end; procedure TfrxView.Notification(AComponent: TComponent; Operation: TOperation); begin inherited; if (Operation = opRemove) and (AComponent = FDataSet) then FDataSet := nil; end; procedure TfrxView.SetDataSet(const Value: TfrxDataSet); begin FDataSet := Value; if FDataSet = nil then FDataSetName := '' else FDataSetName := FDataSet.UserName; end; procedure TfrxView.SetDataSetName(const Value: String); begin FDataSetName := Value; FDataSet := frxFindDataSet(FDataSet, FDataSetName, Report); end; function TfrxView.GetDataSetName: String; begin if FDataSet = nil then Result := FDataSetName else Result := FDataSet.UserName; end; procedure TfrxView.SetFrame(const Value: TfrxFrame); begin FFrame.Assign(Value); end; procedure TfrxView.BeginDraw(Canvas: TCanvas; ScaleX, ScaleY, OffsetX, OffsetY: Extended); begin FCanvas := Canvas; FScaleX := ScaleX; FScaleY := ScaleY; FOffsetX := OffsetX; FOffsetY := OffsetY; FX := Round(AbsLeft * ScaleX + OffsetX); FY := Round(AbsTop * ScaleY + OffsetY); FX1 := Round((AbsLeft + Width) * ScaleX + OffsetX); FY1 := Round((AbsTop + Height) * ScaleY + OffsetY); if Frame.DropShadow then begin FX1 := FX1 - Round(Frame.ShadowWidth * ScaleX); FY1 := FY1 - Round(Frame.ShadowWidth * ScaleY); end; FDX := FX1 - FX; FDY := FY1 - FY; FFrameWidth := Round(Frame.Width * ScaleX); end; procedure TfrxView.DrawBackground; var br, oldbr: HBRUSH; begin with FCanvas do begin if FColor <> clNone then begin Brush.Color := FColor; Brush.Style := bsSolid; FillRect(Rect(FX, FY, FX1, FY1)); end; if FBrushStyle <> bsSolid then begin { Brush.Style := xxx does not work for some printers } br := CreateHatchBrush(Integer(FBrushStyle) - 2, ColorToRGB(Frame.Color)); oldbr := SelectObject(Handle, br); Rectangle(FX, FY, FX1 + 1, FY1 + 1); SelectObject(Handle, oldbr); DeleteObject(br); end; end; end; procedure TfrxView.DrawLine(x, y, x1, y1, w: Integer); var i, d: Integer; begin with FCanvas do begin if w = 0 then w := 1; if w mod 2 = 0 then d := 1 else d := 0; for i := (-w div 2) to (w div 2 - d) do begin if Abs(x1 - x) > Abs(y1 - y) then begin MoveTo(x, y + i); LineTo(x1, y1 + i); end else begin MoveTo(x + i, y); LineTo(x1 + i, y1); end; end; end; end; procedure TfrxView.DrawFrame; var d: Integer; procedure Line(x, y, x1, y1: Integer; Line: TfrxFrameLine; Typ: TfrxFrameType; gap1, gap2: Boolean); var g1, g2, g3, g4, fw: Integer; procedure Line1(x, y, x1, y1: Integer); begin FCanvas.MoveTo(x, y); FCanvas.LineTo(x1, y1); end; begin fw := Round(Line.Width * FScaleX); if Line.Style = fsSolid then Line1(x, y, x1, y1) else if Line.Style = fsDouble then begin if gap1 then g1 := fw else g1 := 0; if gap2 then g2 := fw else g2 := 0; g3 := -g1; g4 := -g2; if Typ in [ftLeft, ftTop] then begin g1 := -g1; g2 := -g2; g3 := -g3; g4 := -g4; end; if x = x1 then Line1(x - fw, y + g1, x1 - fw, y1 - g2) else Line1(x + g1, y - fw, x1 - g2, y1 - fw); if Color <> clNone then begin FCanvas.Pen.Color := Color; Line1(x, y, x1, y1); end; FCanvas.Pen.Color := Line.Color; if x = x1 then Line1(x + fw, y + g3, x1 + fw, y1 - g4) else Line1(x + g3, y + fw, x1 - g4, y1 + fw); end else DrawLine(x, y, x1, y1, fw); end; procedure SetPen(Line: TfrxFrameLine); begin with FCanvas do begin Pen.Color := Line.Color; if Line.Style in [fsSolid, fsDouble] then begin Pen.Style := psSolid; Pen.Width := Round(Line.Width * FScaleX); end else begin Pen.Style := TPenStyle(Line.Style); Pen.Width := 1; end; end; end; begin if Frame.DropShadow then with FCanvas do begin Pen.Style := psSolid; Pen.Color := Frame.ShadowColor; d := Round(Frame.ShadowWidth * FScaleX); DrawLine(FX1 + d div 2, FY + d, FX1 + d div 2, FY1, d); d := Round(Frame.ShadowWidth * FScaleY); DrawLine(FX + d, FY1 + d div 2, FX1 + d, FY1 + d div 2, d); end; if (Frame.Typ <> []) and (Frame.Color <> clNone) and (Frame.Width <> 0) then with FCanvas do begin Brush.Style := bsSolid; if Frame.Style <> fsSolid then if Color = clNone then Brush.Style := bsClear else Brush.Color := Color; if ftLeft in Frame.Typ then begin SetPen(FFrame.LeftLine); if Pen.Width = 2 then d := 1 else d := 0; Line(FX, FY - d, FX, FY1, FFrame.LeftLine, ftLeft, ftTop in Frame.Typ, ftBottom in Frame.Typ); end; if ftRight in Frame.Typ then begin SetPen(FFrame.RightLine); Line(FX1, FY, FX1, FY1, FFrame.RightLine, ftRight, ftTop in Frame.Typ, ftBottom in Frame.Typ); end; if ftTop in Frame.Typ then begin SetPen(FFrame.TopLine); Line(FX, FY, FX1, FY, FFrame.TopLine, ftTop, ftLeft in Frame.Typ, ftRight in Frame.Typ); end; if ftBottom in Frame.Typ then begin SetPen(FFrame.BottomLine); if Pen.Width = 1 then d := 1 else d := 0; Line(FX, FY1, FX1 + d, FY1, FFrame.BottomLine, ftBottom, ftLeft in Frame.Typ, ftRight in Frame.Typ); end; end; end; procedure TfrxView.Draw(Canvas: TCanvas; ScaleX, ScaleY, OffsetX, OffsetY: Extended); begin BeginDraw(Canvas, ScaleX, ScaleY, OffsetX, OffsetY); DrawBackground; DrawFrame; end; function TfrxView.Diff(AComponent: TfrxComponent): String; var v: TfrxView; begin Result := inherited Diff(AComponent); v := TfrxView(AComponent); if FBrushStyle <> v.FBrushStyle then Result := Result + ' BrushStyle="' + frxValueToXML(FBrushStyle) + '"'; if FAlign <> v.FAlign then Result := Result + ' Align="' + frxValueToXML(FAlign) + '"'; if FColor <> v.FColor then Result := Result + ' Color="' + IntToStr(FColor) + '"'; Result := Result + FFrame.Diff(v.FFrame); if Cursor <> v.Cursor then Result := Result + ' Cursor="' + frxValueToXML(Cursor) + '"'; if FPrintable <> v.FPrintable then Result := Result + ' Printable="' + frxValueToXML(FPrintable) + '"'; if TagStr <> v.TagStr then Result := Result + ' TagStr="' + frxStrToXML(TagStr) + '"'; if URL <> v.URL then Result := Result + ' URL="' + frxStrToXML(URL) + '"'; end; function TfrxView.IsDataField: Boolean; begin Result := (DataSet <> nil) and (Length(DataField) <> 0); end; procedure TfrxView.BeforePrint; begin inherited; FTempTag := FTagStr; FTempURL := FURL; end; procedure TfrxView.ExpandVariables(var Expr: String); var i, j: Integer; s: String; begin i := 1; repeat while i < Length(Expr) do if isDBCSLeadByte(Byte(Expr[i])) then { if DBCS then skip 2 bytes } Inc(i, 2) else if (Expr[i] <> '[') then Inc(i) else break; s := frxGetBrackedVariable(Expr, '[', ']', i, j); if i <> j then begin Delete(Expr, i, j - i + 1); s := VarToStr(Report.Calc(s)); Insert(s, Expr, i); Inc(i, Length(s)); j := 0; end; until i = j; end; procedure TfrxView.GetData; begin if (FTagStr <> '') and (Pos('[', FTagStr) <> 0) then ExpandVariables(FTagStr); if (FURL <> '') and (Pos('[', FURL) <> 0) then ExpandVariables(FURL); end; procedure TfrxView.AfterPrint; begin inherited; FTagStr := FTempTag; FURL := FTempURL; end; {$IFDEF FR_COM} function TfrxView.Get_DataField(out Value: WideString): HResult; stdcall; begin Value := FDataField; Result := S_OK; end; function TfrxView.Set_DataField(const Value: WideString): HResult; stdcall; begin FDataField := Value; Result := S_OK; end; function TfrxView.Get_TagStr(out Value: WideString): HResult; stdcall; begin Value := FTagStr; Result := S_OK; end; function TfrxView.Set_TagStr(const Value: WideString): HResult; stdcall; begin FTagStr := Value; Result := S_OK; end; function TfrxView.Get_URL(out Value: WideString): HResult; stdcall; begin Value := FURL; Result := S_OK; end; function TfrxView.Set_URL(const Value: WideString): HResult; stdcall; begin FURL := Value; Result := S_OK; end; function TfrxView.Get_DataSetName(out Value: WideString): HResult; stdcall; begin Value := GetDataSetName; Result := S_OK; end; function TfrxView.Set_DataSetName(const Value: WideString): HResult; stdcall; begin SetDataSetName(Value); Result := S_OK; end; function TfrxView.Get_Name(out Value: WideString): HResult; stdcall; begin Value := Name; Result := S_OK; end; function TfrxView.Get_Frame(out Value: IfrxFrame): HResult; stdcall; begin Value := Frame as IfrxFrame; Result := S_OK; end; function TfrxView.Get_ShiftMode(out Value: frxShiftMode): HResult; stdcall; begin Value := TOleEnum(ShiftMode); Result := S_OK; end; function TfrxView.Set_ShiftMode(Value: frxShiftMode): HResult; stdcall; begin ShiftMode := TfrxShiftMode(Value); Result := S_OK; end; function TfrxView.Get_Align(out Value: frxAlign): HResult; stdcall; begin Value := TOleEnum(Align); Result := S_OK; end; function TfrxView.Set_Align(Value: frxAlign): HResult; stdcall; begin Align := TfrxAlign(Value); Result := S_OK; end; {$ENDIF} { TfrxShapeView } constructor TfrxShapeView.Create(AOwner: TComponent); begin inherited; frComponentStyle := frComponentStyle - [csDefaultDiff]; end; constructor TfrxShapeView.DesignCreate(AOwner: TComponent; Flags: Word); begin inherited; FShape := TfrxShapeKind(Flags); end; procedure TfrxShapeView.Draw(Canvas: TCanvas; ScaleX, ScaleY, OffsetX, OffsetY: Extended); var SaveLeft, SaveTop, SaveWidth, SaveHeight: Extended; procedure DrawShape; var min: Integer; begin if FDY < FDX then min := FDY else min := FDX; with Canvas do case FShape of skRectangle: Rectangle(FX, FY, FX1 + 1, FY1 + 1); skRoundRectangle: begin if FCurve = 0 then min := min div 4 else min := Round(FCurve * FScaleX * 10); RoundRect(FX, FY, FX1 + 1, FY1 + 1, min, min); end; skEllipse: Ellipse(FX, FY, FX1 + 1, FY1 + 1); skTriangle: Polygon([Point(FX1, FY1), Point(FX, FY1), Point(FX + FDX div 2, FY), Point(FX1, FY1)]); skDiamond: Polygon([Point(FX + FDX div 2, FY), Point(FX1, FY + FDY div 2), Point(FX + FDX div 2, FY1), Point(FX, FY + FDY div 2)]); skDiagonal1: DrawLine(FX, FY1, FX1, FY, FFrameWidth); skDiagonal2: DrawLine(FX, FY, FX1, FY1, FFrameWidth); end; end; procedure DoDraw; begin with Canvas do begin Pen.Color := Frame.Color; Pen.Width := FFrameWidth; Brush.Style := bsSolid; SetBkMode(Handle, Opaque); if FBrushStyle = bsSolid then begin Pen.Style := TPenStyle(Frame.Style); if FColor <> clNone then Brush.Color := FColor else Brush.Style := bsClear; DrawShape; end else begin Pen.Style := TPenStyle(Frame.Style); if FColor <> clNone then begin Brush.Color := FColor; DrawShape; end; Brush.Style := FBrushStyle; Brush.Color := Frame.Color; DrawShape; end; end; end; begin if Frame.Style = fsDouble then begin Frame.Style := fsSolid; SaveLeft := Left; SaveTop := Top; SaveWidth := Width; SaveHeight := Height; BeginDraw(Canvas, ScaleX, ScaleY, OffsetX, OffsetY); DoDraw; case FShape of skRectangle, skRoundRectangle, skEllipse: begin Left := Left + 2 * Frame.Width; Top := Top + 2 * Frame.Width; Width := Width - 4 * Frame.Width; Height := Height - 4 * Frame.Width; end; skTriangle: begin Left := Left + 4 * Frame.Width; Top := Top + 4 * Frame.Width; Width := Width - 8 * Frame.Width; Height := Height - 6 * Frame.Width; end; skDiamond: begin Left := Left + 3 * Frame.Width; Top := Top + 3 * Frame.Width; Width := Width - 6 * Frame.Width; Height := Height - 6 * Frame.Width; end; skDiagonal1, skDiagonal2: begin Left := Left + 2 * Frame.Width; end; end; BeginDraw(Canvas, ScaleX, ScaleY, OffsetX, OffsetY); DoDraw; Frame.Style := fsDouble; Left := SaveLeft; Top := SaveTop; Width := SaveWidth; Height := SaveHeight; end else begin BeginDraw(Canvas, ScaleX, ScaleY, OffsetX, OffsetY); DoDraw; end; end; function TfrxShapeView.Diff(AComponent: TfrxComponent): String; begin Result := inherited Diff(AComponent); if FShape <> TfrxShapeView(AComponent).FShape then Result := Result + ' Shape="' + frxValueToXML(FShape) + '"'; end; class function TfrxShapeView.GetDescription: String; begin Result := frxResources.Get('obShape'); end; {$IFDEF FR_COM} function TfrxShapeView.Get_Curve(out Value: Integer): HResult; stdcall; begin Value := Curve; Result := S_OK; end; function TfrxShapeView.Set_Curve(Value: Integer): HResult; stdcall; begin Curve := Value; Result := S_OK; end; function TfrxShapeView.Get_ShapeType(out Value: frxShapeType): HResult; stdcall; begin Value := frxShapeType(Shape); Result := S_OK; end; function TfrxShapeView.Set_ShapeType(Value: frxShapeType): HResult; stdcall; begin Shape := TfrxShapeKind(Value); Result := S_OK; end; {$ENDIF} { TfrxHighlight } constructor TfrxHighlight.Create; begin FColor := clTransparent; {$IFNDEF FR_COM} FFont := TFont.Create; {$ELSE} inherited Create(IfrxHighlight); FFont := TfrxFont.Create; {$ENDIF} with FFont do begin Name := DefFontName; Size := DefFontSize; Color := clRed; Charset := frxCharset; end; end; destructor TfrxHighlight.Destroy; begin FFont.Free; inherited; end; procedure TfrxHighlight.Assign(Source: TPersistent); begin if Source is TfrxHighlight then begin FFont.Assign(TfrxHighlight(Source).Font); FColor := TfrxHighlight(Source).Color; FCondition := TfrxHighlight(Source).Condition; end; end; procedure TfrxHighlight.SetFont(const Value: TFont); begin FFont.Assign(Value); end; {$IFDEF FR_COM} function TfrxHighlight.GetFont: TFont; begin Result := FFont as TFont; end; function TfrxHighlight.Get_Active(out Value: WordBool): HResult; stdcall; begin Value := Active; Result := S_OK; end; function TfrxHighlight.Set_Active(Value: WordBool): HResult; stdcall; begin Active := Value; Result := S_OK; end; function TfrxHighlight.Get_Color(out Value: Integer): HResult; stdcall; begin Value := Color; Result := S_OK; end; function TfrxHighlight.Set_Color(Value: Integer): HResult; stdcall; begin Color := Value; Result := S_OK; end; function TfrxHighlight.Get_Font(out Value: IfrxFont): HResult; stdcall; begin Value := FFont as IfrxFont; Value._AddRef(); Result := S_OK; end; {$ENDIF} { TfrxFormat } procedure TfrxFormat.Assign(Source: TPersistent); begin if Source is TfrxFormat then begin FDecimalSeparator := TfrxFormat(Source).DecimalSeparator; FFormatStr := TfrxFormat(Source).FormatStr; FKind := TfrxFormat(Source).Kind; end; end; {$IFDEF FR_COM} constructor TfrxFormat.Create; begin inherited Create(IfrxDisplayFormat); end; function TfrxFormat.Get_DecimalSeparator(out Value: WideString): HResult; stdcall; begin Value := DecimalSeparator; Result := S_OK; end; function TfrxFormat.Set_DecimalSeparator(const Value: WideString): HResult; stdcall; begin DecimalSeparator := Value; Result := S_OK; end; function TfrxFormat.Get_FormatStr(out Value: WideString): HResult; stdcall; begin Value := FormatStr; Result := S_OK; end; function TfrxFormat.Set_FormatStr(const Value: WideString): HResult; stdcall; begin FormatStr := Value; Result := S_OK; end; function TfrxFormat.Get_Kind(out Value: frxFormatKind): HResult; stdcall; begin Value := frxFormatKind(Kind); Result := S_OK; end; function TfrxFormat.Set_Kind(Value: frxFormatKind): HResult; stdcall; begin Kind := TfrxFormatKind(Value); Result := S_OK; end; {$ENDIF} { TfrxStretcheable } constructor TfrxStretcheable.Create(AOwner: TComponent); begin inherited Create(AOwner); FStretchMode := smDontStretch; end; function TfrxStretcheable.CalcHeight: Extended; begin Result := Height; end; function TfrxStretcheable.DrawPart: Extended; begin Result := 0; end; procedure TfrxStretcheable.InitPart; begin // end; {$IFDEF FR_COM} function TfrxStretcheable.Get_StretchMode(out Value: frxStretchMode): HResult; stdcall; begin Value := frxStretchMode(StretchMode); Result := S_OK; end; function TfrxStretcheable.Set_StretchMode(Value: frxStretchMode): HResult; stdcall; begin StretchMode := TfrxStretchMode(Value); Result := S_OK; end; {$ENDIF} { TfrxCustomMemoView } constructor TfrxCustomMemoView.Create(AOwner: TComponent); begin inherited Create(AOwner); frComponentStyle := frComponentStyle - [csDefaultDiff]; FHighlight := TfrxHighlight.Create; FDisplayFormat := TfrxFormat.Create; FMemo := TWideStrings.Create; FAllowExpressions := True; FClipped := True; FExpressionDelimiters := '[,]'; FGapX := 2; FGapY := 1; FHAlign := haLeft; FVAlign := vaTop; FLineSpacing := 2; ParentFont := True; FWordWrap := True; FWysiwyg := True; FLastValue := Null; end; destructor TfrxCustomMemoView.Destroy; begin FHighlight.Free; FDisplayFormat.Free; FMemo.Free; inherited; end; class function TfrxCustomMemoView.GetDescription: String; begin Result := frxResources.Get('obText'); end; procedure TfrxCustomMemoView.Notification(AComponent: TComponent; Operation: TOperation); begin inherited; if (Operation = opRemove) and (AComponent = FFlowTo) then FFlowTo := nil; end; function TfrxCustomMemoView.IsExprDelimitersStored: Boolean; begin Result := FExpressionDelimiters <> '[,]'; end; function TfrxCustomMemoView.IsLineSpacingStored: Boolean; begin Result := FLineSpacing <> 2; end; function TfrxCustomMemoView.IsGapXStored: Boolean; begin Result := FGapX <> 2; end; function TfrxCustomMemoView.IsGapYStored: Boolean; begin Result := FGapY <> 1; end; function TfrxCustomMemoView.IsParagraphGapStored: Boolean; begin Result := FParagraphGap <> 0; end; function TfrxCustomMemoView.IsCharSpacingStored: Boolean; begin Result := FCharSpacing <> 0; end; function TfrxCustomMemoView.IsHighlightStored: Boolean; begin Result := Trim(FHighlight.Condition) <> ''; end; procedure TfrxCustomMemoView.SetRotation(Value: Integer); begin FRotation := Value mod 360; end; procedure TfrxCustomMemoView.SetText(const Value: WideString); begin FMemo.Text := Value; end; function TfrxCustomMemoView.GetText: WideString; begin Result := FMemo.Text; end; procedure TfrxCustomMemoView.SetMemo(const Value: TWideStrings); begin FMemo.Assign(Value); end; procedure TfrxCustomMemoView.SetHighlight(const Value: TfrxHighlight); begin FHighlight.Assign(Value); end; procedure TfrxCustomMemoView.SetDisplayFormat(const Value: TfrxFormat); begin FDisplayFormat.Assign(Value); end; procedure TfrxCustomMemoView.SetStyle(const Value: String); begin FStyle := Value; if Report <> nil then ApplyStyle(Report.Styles.Find(FStyle)); end; function TfrxCustomMemoView.AdjustCalcHeight: Extended; begin Result := GapY * 2; if ftTop in Frame.Typ then Result := Result + (Frame.Width - 1) / 2; if ftBottom in Frame.Typ then Result := Result + Frame.Width / 2; if Frame.DropShadow then Result := Result + Frame.ShadowWidth; end; function TfrxCustomMemoView.AdjustCalcWidth: Extended; begin Result := GapX * 2; if ftLeft in Frame.Typ then Result := Result + (Frame.Width - 1) / 2; if ftRight in Frame.Typ then Result := Result + Frame.Width / 2; if Frame.DropShadow then Result := Result + Frame.ShadowWidth; end; procedure TfrxCustomMemoView.BeginDraw(Canvas: TCanvas; ScaleX, ScaleY, OffsetX, OffsetY: Extended); var bx, by, bx1, by1, wx1, wx2, wy1, wy2, gx1, gy1: Integer; begin inherited BeginDraw(Canvas, ScaleX, ScaleY, OffsetX, OffsetY); wx1 := Round((Frame.Width * ScaleX - 1) / 2); wx2 := Round(Frame.Width * ScaleX / 2); wy1 := Round((Frame.Width * ScaleY - 1) / 2); wy2 := Round(Frame.Width * ScaleY / 2); bx := FX; by := FY; bx1 := FX1; by1 := FY1; if ftLeft in Frame.Typ then Inc(bx, wx1); if ftRight in Frame.Typ then Dec(bx1, wx2); if ftTop in Frame.Typ then Inc(by, wy1); if ftBottom in Frame.Typ then Dec(by1, wy2); gx1 := Round(GapX * ScaleX); gy1 := Round(GapY * ScaleY); FTextRect := Rect(bx + gx1, by + gy1, bx1 - gx1 + 1, by1 - gy1 + 1); end; procedure TfrxCustomMemoView.SetDrawParams(Canvas: TCanvas; ScaleX, ScaleY, OffsetX, OffsetY: Extended); var ScaledRect: TRect; SaveWidth: Extended; FDrawText: TfrxDrawText; begin if Report <> nil then FDrawText := Report.FDrawText else FDrawText := frxDrawText; if FHighlight.Active then begin FDrawText.SetFont(FHighlight.Font); FColor := FHighlight.Color; end else FDrawText.SetFont(FFont); FDrawText.SetOptions(FWordWrap, FAllowHTMLTags, FRTLReading, FWordBreak, FClipped, FWysiwyg, FRotation); FDrawText.SetGaps(FParagraphGap, FCharSpacing, FLineSpacing); if not IsDesigning then if FAutoWidth then begin FDrawText.SetDimensions(1, 1, 1, Rect(0, 0, 10000, 10000), Rect(0, 0, 10000, 10000)); FDrawText.SetText(FMemo); SaveWidth := Width; Width := FDrawText.CalcWidth + AdjustCalcWidth; if FHAlign = haRight then Left := Left + SaveWidth - Width else if FHAlign = haCenter then Left := Left + (SaveWidth - Width) / 2; if Parent <> nil then Parent.AlignChildren; end; BeginDraw(Canvas, ScaleX, ScaleY, OffsetX, OffsetY); ScaledRect := FTextRect; BeginDraw(Canvas, 1, 1, 0, 0); if not IsPrinting then FPrintScale := 1; FDrawText.SetDimensions(ScaleX, ScaleY, FPrintScale, FTextRect, ScaledRect); FDrawText.SetText(FMemo); FDrawText.SetParaBreaks(FFirstParaBreak, FLastParaBreak); end; procedure TfrxCustomMemoView.Draw(Canvas: TCanvas; ScaleX, ScaleY, OffsetX, OffsetY: Extended); var SaveColor: TColor; FDrawText: TfrxDrawText; procedure DrawUnderlines; var dy, h: Extended; begin with Canvas do begin Pen.Color := Frame.Color; Pen.Width := FFrameWidth; Pen.Style := psSolid; Pen.Mode := pmCopy; end; h := FDrawText.LineHeight * ScaleY; dy := FY + h + (GapY - LineSpacing + 1) * ScaleY; while dy < FY1 do begin Canvas.MoveTo(FX, Round(dy)); Canvas.LineTo(FX1, Round(dy)); dy := dy + h; end; end; begin if Report <> nil then FDrawText := Report.FDrawText else FDrawText := frxDrawText; if not IsDesigning then ExtractMacros else if IsDataField then FMemo.Text := '[' + DataSet.UserName + '."' + DataField + '"]'; SaveColor := FColor; FDrawText.Lock; try SetDrawParams(Canvas, ScaleX, ScaleY, OffsetX, OffsetY); inherited Draw(Canvas, ScaleX, ScaleY, OffsetX, OffsetY); if FUnderlines and (FRotation = 0) then DrawUnderlines; FDrawText.DrawText(FCanvas, HAlign, VAlign); finally FDrawText.Unlock; end; FColor := SaveColor; end; function TfrxCustomMemoView.CalcHeight: Extended; var FDrawText: TfrxDrawText; begin if Report <> nil then FDrawText := Report.FDrawText else FDrawText := frxDrawText; FDrawText.Lock; try if FHighlight.Active then FDrawText.SetFont(FHighlight.Font) else FDrawText.SetFont(FFont); FDrawText.SetOptions(FWordWrap, FAllowHTMLTags, FRTLReading, FWordBreak, FClipped, FWysiwyg, FRotation); FDrawText.SetGaps(FParagraphGap, FCharSpacing, FLineSpacing); if FAutoWidth then FDrawText.SetDimensions(1, 1, 1, Rect(0, 0, 10000, 10000), Rect(0, 0, 10000, 10000)) else begin BeginDraw(nil, 1, 1, 0, 0); FDrawText.SetDimensions(1, 1, 1, FTextRect, FTextRect); end; FDrawText.SetText(FMemo); Result := Round(FDrawText.CalcHeight + AdjustCalcHeight); finally FDrawText.Unlock; end; end; function TfrxCustomMemoView.CalcWidth: Extended; var FDrawText: TfrxDrawText; begin if Report <> nil then FDrawText := Report.FDrawText else FDrawText := frxDrawText; FDrawText.Lock; try if FHighlight.Active then FDrawText.SetFont(FHighlight.Font) else FDrawText.SetFont(FFont); FDrawText.SetOptions(FWordWrap, FAllowHTMLTags, FRTLReading, FWordBreak, FClipped, FWysiwyg, FRotation); FDrawText.SetGaps(FParagraphGap, FCharSpacing, FLineSpacing); FDrawText.SetDimensions(1, 1, 1, Rect(0, 0, 10000, 10000), Rect(0, 0, 10000, 10000)); FDrawText.SetText(FMemo); Result := Round(FDrawText.CalcWidth + AdjustCalcWidth); finally FDrawText.Unlock; end; end; procedure TfrxCustomMemoView.InitPart; begin FPartMemo := FMemo.Text; FFirstParaBreak := False; FLastParaBreak := False; end; function TfrxCustomMemoView.DrawPart: Extended; var SaveColor: TColor; FDrawText: TfrxDrawText; ParaBreak: Boolean; begin if Report <> nil then FDrawText := Report.FDrawText else FDrawText := frxDrawText; SaveColor := FColor; FDrawText.Lock; try FMemo.Text := FPartMemo; SetDrawParams(nil, 1, 1, 0, 0); FPartMemo := FDrawText.GetOutBoundsText(ParaBreak); FMemo.Text := FDrawText.GetInBoundsText; FLastParaBreak := ParaBreak; Result := FDrawText.UnusedSpace; if Result = 0 then Result := Height; finally FDrawText.Unlock; end; FColor := SaveColor; end; function TfrxCustomMemoView.Diff(AComponent: TfrxComponent): String; var m: TfrxCustomMemoView; s: WideString; c: Integer; begin Result := inherited Diff(AComponent); m := TfrxCustomMemoView(AComponent); if FAutoWidth <> m.FAutoWidth then Result := Result + ' AutoWidth="' + frxValueToXML(FAutoWidth) + '"'; if FloatDiff(FCharSpacing, m.FCharSpacing) then Result := Result + ' CharSpacing="' + FloatToStr(FCharSpacing) + '"'; if FloatDiff(FGapX, m.FGapX) then Result := Result + ' GapX="' + FloatToStr(FGapX) + '"'; if FloatDiff(FGapY, m.FGapY) then Result := Result + ' GapY="' + FloatToStr(FGapY) + '"'; if FHAlign <> m.FHAlign then Result := Result + ' HAlign="' + frxValueToXML(FHAlign) + '"'; if FHighlight.Active <> m.FHighlight.Active then Result := Result + ' Highlight.Active="' + frxValueToXML(FHighlight.Active) + '"'; if FloatDiff(FLineSpacing, m.FLineSpacing) then Result := Result + ' LineSpacing="' + FloatToStr(FLineSpacing) + '"'; c := FMemo.Count; if c = 0 then Result := Result + ' u=""' else begin if c = 1 then Result := Result + ' u="' + frxStrToXML(Utf8Encode(FMemo[0])) + '"' else begin s := Text; SetLength(s, Length(s) - 2); Result := Result + ' u="' + frxStrToXML(Utf8Encode(s)) + '"'; end; end; if FloatDiff(FParagraphGap, m.FParagraphGap) then Result := Result + ' ParagraphGap="' + FloatToStr(FParagraphGap) + '"'; if FRotation <> m.FRotation then Result := Result + ' Rotation="' + IntToStr(FRotation) + '"'; if FRTLReading <> m.FRTLReading then Result := Result + ' RTLReading="' + frxValueToXML(FRTLReading) + '"'; if FUnderlines <> m.FUnderlines then Result := Result + ' Underlines="' + frxValueToXML(FUnderlines) + '"'; if FVAlign <> m.FVAlign then Result := Result + ' VAlign="' + frxValueToXML(FVAlign) + '"'; if FWordWrap <> m.FWordWrap then Result := Result + ' WordWrap="' + frxValueToXML(FWordWrap) + '"'; if FFirstParaBreak then Result := Result + ' FirstParaBreak="1"'; if FLastParaBreak then Result := Result + ' LastParaBreak="1"'; FFirstParaBreak := FLastParaBreak; FLastParaBreak := False; end; procedure TfrxCustomMemoView.BeforePrint; begin inherited; if not IsDataField then FTempMemo := FMemo.Text; end; procedure TfrxCustomMemoView.AfterPrint; begin if not IsDataField then FMemo.Text := FTempMemo; inherited; end; procedure TfrxCustomMemoView.GetData; var i, j: Integer; s, s1, s2, dc1, dc2: WideString; begin inherited; if IsDataField then begin if DataSet.IsBlobField(DataField) then DataSet.AssignBlobTo(DataField, FMemo) else begin FValue := DataSet.Value[DataField]; if FDisplayFormat.Kind = fkText then FMemo.Text := DataSet.DisplayText[DataField] else FMemo.Text := FormatData(FValue); if FHideZeros and (TVarData(FValue).VType <> varString) and (TVarData(FValue).VType <> varOleStr) and (FValue = 0) then FMemo.Text := ''; end end else if AllowExpressions then begin s := FMemo.Text; i := 1; dc1 := FExpressionDelimiters; dc2 := Copy(dc1, Pos(',', dc1) + 1, 255); dc1 := Copy(dc1, 1, Pos(',', dc1) - 1); if Pos(dc1, s) <> 0 then begin repeat while (i < Length(s)) and (Copy(s, i, Length(dc1)) <> dc1) do Inc(i); s1 := frxGetBrackedVariableW(s, dc1, dc2, i, j); if i <> j then begin Delete(s, i, j - i + 1); s2 := CalcAndFormat(s1); Insert(s2, s, i); Inc(i, Length(s2)); j := 0; end; until i = j; FMemo.Text := s; end; end; Report.LocalValue := FValue; FHighlight.Active := False; if FHighlight.Condition <> '' then FHighlight.Active := Report.Calc(FHighlight.Condition); if FSuppressRepeated then begin if FLastValue = FMemo.Text then FMemo.Text := '' else FLastValue := FMemo.Text; end; if FFlowTo <> nil then begin InitPart; DrawPart; FFlowTo.Text := FPartMemo; FFlowTo.AllowExpressions := False; end; end; procedure TfrxCustomMemoView.ResetSuppress; begin FLastValue := ''; end; function TfrxCustomMemoView.CalcAndFormat(const Expr: WideString): WideString; var i: Integer; ExprStr, FormatStr: WideString; Format: TfrxFormat; begin Result := ''; Format := nil; i := Pos(' #', Expr); if i <> 0 then begin ExprStr := Copy(Expr, 1, i - 1); FormatStr := Copy(Expr, i + 2, Length(Expr) - i - 1); if Pos(')', FormatStr) = 0 then begin Format := TfrxFormat.Create; if FormatStr[1] in [WideChar('N'), WideChar('n')] then begin Format.Kind := fkNumeric; for i := 1 to Length(FormatStr) do if FormatStr[i] in [WideChar(','), WideChar('.'), WideChar('-')] then begin Format.DecimalSeparator := FormatStr[i]; FormatStr[i] := '.'; end; end else if FormatStr[1] in [WideChar('D'), WideChar('T'), WideChar('d'), WideChar('t')] then Format.Kind := fkDateTime else if FormatStr[1] in [WideChar('B'), WideChar('b')] then Format.Kind := fkBoolean; Format.FormatStr := Copy(FormatStr, 2, 255); end else ExprStr := Expr; end else ExprStr := Expr; try if CompareText(ExprStr, 'TOTALPAGES#') = 0 then FValue := '[TotalPages#]' else if CompareText(ExprStr, 'COPYNAME#') = 0 then FValue := '[CopyName#]' else FValue := Report.Calc(ExprStr); if FHideZeros and (TVarData(FValue).VType <> varString) and (TVarData(FValue).VType <> varOleStr) and (FValue = 0) then Result := '' else Result := FormatData(FValue, Format); finally if Format <> nil then Format.Free; end; end; function TfrxCustomMemoView.FormatData(const Value: Variant; AFormat: TfrxFormat = nil): WideString; var i: Integer; begin if AFormat = nil then AFormat := FDisplayFormat; if VarIsNull(Value) then Result := '' else if AFormat.Kind = fkText then Result := VarToWideStr(Value) else try case AFormat.Kind of fkNumeric: begin if Pos('#', AFormat.FormatStr) <> 0 then Result := FormatFloat(AFormat.FormatStr, Extended(Value)) else if Pos('d', AFormat.FormatStr) <> 0 then Result := Format(AFormat.FormatStr, [Integer(Value)]) else Result := Format(AFormat.FormatStr, [Extended(Value)]); if (Length(AFormat.DecimalSeparator) = 1) and (DecimalSeparator <> AFormat.DecimalSeparator[1]) then for i := 1 to Length(Result) do if Result[i] = WideChar(DecimalSeparator) then Result[i] := WideChar(AFormat.DecimalSeparator[1]); end; fkDateTime: Result := FormatDateTime(AFormat.FormatStr, Value); fkBoolean: if Value = True then Result := Copy(AFormat.FormatStr, Pos(',', AFormat.FormatStr) + 1, 255) else Result := Copy(AFormat.FormatStr, 1, Pos(',', AFormat.FormatStr) - 1); else Result := VarToWideStr(Value) end; except Result := VarToWideStr(Value); end; end; function TfrxCustomMemoView.GetComponentText: String; var i: Integer; begin Result := FMemo.Text; if FAllowExpressions then { extract TOTALPAGES macro if any } begin i := Pos('[TOTALPAGES]', UpperCase(Result)); if i <> 0 then begin Delete(Result, i, 12); Insert(IntToStr(FTotalPages), Result, i); end; end; end; procedure TfrxCustomMemoView.ApplyStyle(Style: TfrxStyleItem); begin if Style <> nil then begin Color := Style.Color; Font := Style.Font; Frame := Style.Frame; end; end; function TfrxCustomMemoView.WrapText(WrapWords: Boolean): WideString; var TempBMP: TBitmap; FDrawText: TfrxDrawText; begin Result := ''; TempBMP := TBitmap.Create; if Report <> nil then FDrawText := Report.FDrawText else FDrawText := frxDrawText; FDrawText.Lock; try SetDrawParams(TempBMP.Canvas, 1, 1, 0, 0); if WrapWords then Result := FDrawText.WrappedText else Result := FDrawText.DeleteTags(Text); finally FDrawText.Unlock; TempBMP.Free; end; end; procedure TfrxCustomMemoView.ExtractMacros; var s, s1: String; i, j: Integer; begin if FAllowExpressions then begin s := FMemo.Text; i := Pos('[TOTALPAGES#]', UpperCase(s)); if i <> 0 then begin Delete(s, i, 13); Insert(IntToStr(FTotalPages), s, i); FMemo.Text := s; end; i := Pos('[COPYNAME#]', UpperCase(s)); if i <> 0 then begin j := frxGlobalVariables.IndexOf('CopyName' + IntToStr(FCopyNo)); if j <> -1 then s1 := VarToStr(frxGlobalVariables.Items[j].Value) else s1 := ''; Delete(s, i, 11); Insert(s1, s, i); FMemo.Text := s; end; end; end; {$IFDEF FR_COM} function TfrxCustomMemoView.IfrxCustomMemoView_Get_Text(out Value: WideString): HResult; stdcall; begin Value := WideString(FMemo.Text); Result := 0; end; function TfrxCustomMemoView.IfrxCustomMemoView_Set_Text(const Value: WideString): HResult; stdcall; begin FMemo.Text := String(Value); Result := 0; end; {$ENDIF} {$IFDEF FR_COM} { TfrxMemoView } function TfrxMemoView.Get_AutoWidth(out Value: WordBool): HResult; stdcall; begin Value := AutoWidth; Result := S_OK; end; function TfrxMemoView.Set_AutoWidth(Value: WordBool): HResult; stdcall; begin AutoWidth := Value; Result := S_OK; end; function TfrxMemoView.Get_AllowExpressions(out Value: WordBool): HResult; stdcall; begin Value := AllowExpressions; Result := S_OK; end; function TfrxMemoView.Set_AllowExpressions(Value: WordBool): HResult; stdcall; begin AllowExpressions := Value; Result := S_OK; end; function TfrxMemoView.Get_AllowHTMLTags(out Value: WordBool): HResult; stdcall; begin Value := AllowHTMLTags; Result := S_OK; end; function TfrxMemoView.Set_AllowHTMLTags(Value: WordBool): HResult; stdcall; begin AllowHTMLTags := Value; Result := S_OK; end; function TfrxMemoView.Get_BrushStyle(out Value: frxBrushStyle): HResult; stdcall; begin Value := frxBrushStyle(BrushStyle); Result := S_OK; end; function TfrxMemoView.Set_BrushStyle(Value: frxBrushStyle): HResult; stdcall; begin BrushStyle := TBrushStyle(Value); Result := S_OK; end; function TfrxMemoView.Get_CharSpacing(out Value: Double): HResult; stdcall; begin Value := CharSpacing; Result := S_OK; end; function TfrxMemoView.Set_CharSpacing(Value: Double): HResult; stdcall; begin CharSpacing := Value; Result := S_OK; end; function TfrxMemoView.Get_Clipped(out Value: WordBool): HResult; stdcall; begin Value := Clipped; Result := S_OK; end; function TfrxMemoView.Set_Clipped(Value: WordBool): HResult; stdcall; begin Clipped := Value; Result := S_OK; end; function TfrxMemoView.Get_Color(out Value: Integer): HResult; stdcall; begin Value := Color; Result := S_OK; end; function TfrxMemoView.Set_Color(Value: Integer): HResult; stdcall; begin Color := Value; Result := S_OK; end; function TfrxMemoView.Get_DataField(out Value: WideString): HResult; stdcall; begin Value := DataField; Result := S_OK; end; function TfrxMemoView.Set_DataField(const Value: WideString): HResult; stdcall; begin DataField := Value; Result := S_OK; end; function TfrxMemoView.Get_DataSet(out Value: IfrxDataSet): HResult; stdcall; begin Value := DataSet as IfrxDataset; Result := S_OK; end; function TfrxMemoView.Set_DataSet(const Value: IfrxDataSet): HResult; stdcall; var idsp: {IfrxComponentSelf} IInterfaceComponentReference; begin Result := Value.QueryInterface( {IfrxComponentSelf} IInterfaceComponentReference, idsp); if Result = S_OK then DataSet := TfrxDataSet(idsp.GetComponent{Get_Object}); end; function TfrxMemoView.Get_DataSetName(out Value: WideString): HResult; stdcall; begin Value := DataSetName; Result := S_OK; end; function TfrxMemoView.Set_DataSetName(const Value: WideString): HResult; stdcall; begin DataSetName := Value; Result := S_OK; end; function TfrxMemoView.Get_DisplayFormat(out Value: IfrxDisplayFormat): HResult; stdcall; begin Value := DisplayFormat as IfrxDisplayFormat; Result := S_OK; end; function TfrxMemoView.Get_ExpressionDelimiters(out Value: WideString): HResult; stdcall; begin Value := ExpressionDelimiters; Result := S_OK; end; function TfrxMemoView.Set_ExpressionDelimiters(const Value: WideString): HResult; stdcall; begin ExpressionDelimiters := Value; Result := S_OK; end; function TfrxMemoView.Get_FlowTo(out Value: IfrxCustomMemoView): HResult; stdcall; begin Value := FlowTo as IfrxCustomMemoView; Result := S_OK; end; function TfrxMemoView.Set_FlowTo(const Value: IfrxCustomMemoView): HResult; stdcall; var idsp: {IfrxComponentSelf} IInterfaceComponentReference; begin Result := Value.QueryInterface({IfrxComponentSelf} IInterfaceComponentReference, idsp); if Result = S_OK then FlowTo := TfrxCustomMemoView(idsp.GetComponent{Get_Object}); end; function TfrxMemoView.Get_Font(out Value: IfrxFont): HResult; stdcall; begin Result := S_OK; Value := FFont as IfrxFont; Value._AddRef(); end; function TfrxMemoView.Get_Frame(out Value: IfrxFrame): HResult; stdcall; begin Value := Frame as IfrxFrame; Result := S_OK; end; function TfrxMemoView.Get_GapX(out Value: Double): HResult; stdcall; begin Value := GapX; Result := S_OK; end; function TfrxMemoView.Set_GapX(Value: Double): HResult; stdcall; begin GapX := Value; Result := S_OK; end; function TfrxMemoView.Get_GapY(out Value: Double): HResult; stdcall; begin Value := GapY; Result := S_OK; end; function TfrxMemoView.Set_GapY(Value: Double): HResult; stdcall; begin GapY := Value; Result := S_OK; end; function TfrxMemoView.Get_HAlign(out Value: frxHAlign): HResult; stdcall; begin Value := TOleEnum(HAlign); Result := S_OK; end; function TfrxMemoView.Set_HAlign(Value: frxHAlign): HResult; stdcall; begin HAlign := TfrxHAlign(Value); Result := S_OK; end; function TfrxMemoView.Get_HideZeros(out Value: WordBool): HResult; stdcall; begin Value := HideZeros; Result := S_OK; end; function TfrxMemoView.Set_HideZeros(Value: WordBool): HResult; stdcall; begin HideZeros := Value; Result := S_OK; end; function TfrxMemoView.Get_Highlight(out Value: IfrxHighlight): HResult; stdcall; begin Value := Highlight as IfrxHighlight; Result := S_OK; end; function TfrxMemoView.Get_LineSpacing(out Value: Double): HResult; stdcall; begin Value := LineSpacing; Result := S_OK; end; function TfrxMemoView.Set_LineSpacing(Value: Double): HResult; stdcall; begin LineSpacing := Value; Result := S_OK; end; function TfrxMemoView.Get_Memo(out Value: WideString): HResult; stdcall; begin Value := Memo.Text; Result := S_OK; end; function TfrxMemoView.Set_Memo(const Value: WideString): HResult; stdcall; begin Memo.Text := Value; Result := S_OK; end; function TfrxMemoView.Get_ParagraphGap(out Value: Double): HResult; stdcall; begin Value := ParagraphGap; Result := S_OK; end; function TfrxMemoView.Set_ParagraphGap(Value: Double): HResult; stdcall; begin ParagraphGap := Value; Result := S_OK; end; function TfrxMemoView.Get_ParentFont(out Value: WordBool): HResult; stdcall; begin Value := ParentFont; Result := S_OK; end; function TfrxMemoView.Set_ParentFont(Value: WordBool): HResult; stdcall; begin ParentFont := Value; Result := S_OK; end; function TfrxMemoView.Get_Rotation(out Value: Integer): HResult; stdcall; begin Value := Rotation; Result := S_OK; end; function TfrxMemoView.Set_Rotation(Value: Integer): HResult; stdcall; begin Rotation := Value; Result := S_OK; end; function TfrxMemoView.Get_RTLReading(out Value: WordBool): HResult; stdcall; begin Value := RTLReading; Result := S_OK; end; function TfrxMemoView.Set_RTLReading(Value: WordBool): HResult; stdcall; begin RTLReading := Value; Result := S_OK; end; function TfrxMemoView.Get_Style(out Value: WideString): HResult; stdcall; begin Value := Style; Result := S_OK; end; function TfrxMemoView.Set_Style(const Value: WideString): HResult; stdcall; begin Style := Value; Result := S_OK; end; function TfrxMemoView.Get_SuppressRepeated(out Value: WordBool): HResult; stdcall; begin Value := SuppressRepeated; Result := S_OK; end; function TfrxMemoView.Set_SuppressRepeated(Value: WordBool): HResult; stdcall; begin SuppressRepeated := Value; Result := S_OK; end; function TfrxMemoView.Get_Underlines(out Value: WordBool): HResult; stdcall; begin Value := Underlines; Result := S_OK; end; function TfrxMemoView.Set_Underlines(Value: WordBool): HResult; stdcall; begin Underlines := Value; Result := S_OK; end; function TfrxMemoView.Get_WordBreak(out Value: WordBool): HResult; stdcall; begin Value := WordBreak; Result := S_OK; end; function TfrxMemoView.Set_WordBreak(Value: WordBool): HResult; stdcall; begin WordBreak := Value; Result := S_OK; end; function TfrxMemoView.Get_WordWrap(out Value: WordBool): HResult; stdcall; begin Value := WordWrap; Result := S_OK; end; function TfrxMemoView.Set_WordWrap(Value: WordBool): HResult; stdcall; begin WordWrap := Value; Result := S_OK; end; function TfrxMemoView.Get_VAlign(out Value: frxVAlign): HResult; stdcall; begin Value := TOleEnum(VAlign); Result := S_OK; end; function TfrxMemoView.Set_VAlign(Value: frxVAlign): HResult; stdcall; begin VAlign := TfrxVAlign(Value); Result := S_OK; end; {$ENDIF} { TfrxSysMemoView } class function TfrxSysMemoView.GetDescription: String; begin Result := frxResources.Get('obSysText'); end; { TfrxCustomLineView } constructor TfrxCustomLineView.Create(AOwner: TComponent); begin inherited; frComponentStyle := frComponentStyle - [csDefaultDiff]; FArrowWidth := 5; FArrowLength := 20; end; constructor TfrxCustomLineView.DesignCreate(AOwner: TComponent; Flags: Word); begin inherited; FDiagonal := Flags <> 0; FArrowEnd := Flags in [2, 4]; FArrowStart := Flags in [3, 4]; end; procedure TfrxCustomLineView.Draw(Canvas: TCanvas; ScaleX, ScaleY, OffsetX, OffsetY: Extended); begin if not FDiagonal then begin if Width > Height then begin Height := 0; Frame.Typ := [ftTop]; end else begin Width := 0; Frame.Typ := [ftLeft]; end; end; BeginDraw(Canvas, ScaleX, ScaleY, OffsetX, OffsetY); if not FDiagonal then begin DrawFrame; if FArrowStart then DrawArrow(FX1, FY1, FX, FY); if FArrowEnd then DrawArrow(FX, FY, FX1, FY1); end else DrawDiagonalLine; end; procedure TfrxCustomLineView.DrawArrow(x1, y1, x2, y2: Integer); var k1, a, b, c, D: Double; xp, yp, x3, y3, x4, y4: Integer; begin if abs(x2 - x1) > 8 then begin k1 := (y2 - y1) / (x2 - x1); a := Sqr(k1) + 1; b := 2 * k1 * (x2 * y1 - x1 * y2) / (x2 - x1) - 2 * y2 * k1 - 2 * x2; c := Sqr(x2) + Sqr(y2) - Sqr(FArrowLength * FScaleX) + sqr((x2 * y1 - x1 * y2) / (x2 - x1)) - 2 * y2 * (x2 * y1 - x1 * y2) / (x2 - x1); D := Sqr(b) - 4 * a * c; xp := Round((-b + Sqrt(D)) / (2 * a)); if (xp > x1) and (xp > x2) or (xp < x1) and (xp < x2) then xp := Round((-b - Sqrt(D)) / (2 * a)); yp := Round(xp * k1 + (x2 * y1 - x1 * y2) / (x2 - x1)); if y2 <> y1 then begin x3 := Round(xp + FArrowWidth * FScaleX * sin(ArcTan(k1))); y3 := Round(yp - FArrowWidth * FScaleX * cos(ArcTan(k1))); x4 := Round(xp - FArrowWidth * FScaleX * sin(ArcTan(k1))); y4 := Round(yp + FArrowWidth * FScaleX * cos(ArcTan(k1))); end else begin x3 := xp; y3 := yp - Round(FArrowWidth * FScaleX); x4 := xp; y4 := yp + Round(FArrowWidth * FScaleX); end; end else begin xp := x2; yp := y2 - Round(FArrowLength * FScaleX); if (yp > y1) and (yp > y2) or (yp < y1) and (yp < y2) then yp := y2 + Round(FArrowLength * FScaleX); x3 := xp - Round(FArrowWidth * FScaleX); y3 := yp; x4 := xp + Round(FArrowWidth * FScaleX); y4 := yp; end; if FArrowSolid then begin FCanvas.Brush.Color := Frame.Color; FCanvas.Polygon([Point(x2, y2), Point(x3, y3), Point(x4, y4), Point(x2, y2)]) end else begin FCanvas.Pen.Width := Round(FFrame.Width * FScaleX); FCanvas.Polyline([Point(x3, y3), Point(x2, y2), Point(x4, y4)]); end; end; procedure TfrxCustomLineView.DrawDiagonalLine; begin if (Frame.Color = clNone) or (Frame.Width = 0) then exit; with FCanvas do begin Brush.Style := bsSolid; if Color = clNone then Brush.Style := bsClear else Brush.Color := Color; Pen.Color := Frame.Color; Pen.Width := 1; if Frame.Style <> fsDouble then Pen.Style := TPenStyle(Frame.Style) else Pen.Style := psSolid; DrawLine(FX, FY, FX1, FY1, FFrameWidth); if FArrowStart then DrawArrow(FX1, FY1, FX, FY); if FArrowEnd then DrawArrow(FX, FY, FX1, FY1); end; end; { TfrxLineView } class function TfrxLineView.GetDescription: String; begin Result := frxResources.Get('obLine'); end; { TfrxPictureView } constructor TfrxPictureView.Create(AOwner: TComponent); begin inherited; frComponentStyle := frComponentStyle - [csDefaultDiff]; FPicture := TPicture.Create; FPicture.OnChange := PictureChanged; FKeepAspectRatio := True; FStretched := True; FColor := clWhite; FIsPictureStored := True; end; destructor TfrxPictureView.Destroy; begin FPicture.Free; inherited; end; class function TfrxPictureView.GetDescription: String; begin Result := frxResources.Get('obPicture'); end; procedure TfrxPictureView.SetPicture(const Value: TPicture); begin FPicture.Assign(Value); end; procedure TfrxPictureView.SetAutoSize(const Value: Boolean); begin FAutoSize := Value; if FAutoSize and not (FPicture.Graphic = nil) then begin FWidth := FPicture.Width; FHeight := FPicture.Height; end; end; procedure TfrxPictureView.PictureChanged(Sender: TObject); begin AutoSize := FAutoSize; FPictureChanged := True; end; procedure TfrxPictureView.Draw(Canvas: TCanvas; ScaleX, ScaleY, OffsetX, OffsetY: Extended); var r: TRect; kx, ky: Extended; rgn: HRGN; procedure PrintGraphic(Canvas: TCanvas; DestRect: TRect; aGraph: TGraphic); begin frxDrawGraphic(Canvas, DestRect, aGraph, IsPrinting); end; begin BeginDraw(Canvas, ScaleX, ScaleY, OffsetX, OffsetY); with Canvas do begin DrawBackground; r := Rect(FX, FY, FX1, FY1); if (FPicture.Graphic = nil) or FPicture.Graphic.Empty then begin if IsDesigning then frxResources.ObjectImages.Draw(Canvas, FX + 1, FY + 2, 3); end else begin if FStretched then begin if FKeepAspectRatio then begin kx := FDX / FPicture.Width; ky := FDY / FPicture.Height; if kx < ky then r.Bottom := r.Top + Round(FPicture.Height * kx) else r.Right := r.Left + Round(FPicture.Width * ky); if FCenter then OffsetRect(r, (FDX - (r.Right - r.Left)) div 2, (FDY - (r.Bottom - r.Top)) div 2); end; PrintGraphic(Canvas, r, FPicture.Graphic); end else begin rgn := CreateRectRgn(0, 0, 10000, 10000); GetClipRgn(Canvas.Handle, rgn); IntersectClipRect(Canvas.Handle, Round(FX), Round(FY), Round(FX1), Round(FY1)); if FCenter then OffsetRect(r, (FDX - Round(ScaleX * FPicture.Width)) div 2, (FDY - Round(ScaleY * FPicture.Height)) div 2); r.Right := r.Left + Round(FPicture.Width * ScaleX); r.Bottom := r.Top + Round(FPicture.Height * ScaleY); PrintGraphic(Canvas, r, Picture.Graphic); SelectClipRgn(Canvas.Handle, rgn); DeleteObject(rgn); end; end; DrawFrame; end; end; function TfrxPictureView.Diff(AComponent: TfrxComponent): String; begin if FPictureChanged then begin Report.PreviewPages.AddPicture(Self); FPictureChanged := False; end; Result := ' ' + inherited Diff(AComponent) + ' ImageIndex="' + IntToStr(FImageIndex) + '"'; end; {$IFDEF FR_COM} function TfrxPictureView.Get_Picture(out Value: OLE_HANDLE): HResult; stdcall; begin Value := FPicture.Bitmap.Handle; Result := S_OK; end; function TfrxPictureView.Set_Picture(Value: OLE_HANDLE): HResult; stdcall; begin FPicture.Bitmap.Handle := Value; Result := S_OK; end; function TfrxPictureView.Get_Metafile(out Value: OLE_HANDLE): HResult; stdcall; begin Value := FPicture.Metafile.Handle; Result := S_OK; end; function TfrxPictureView.Set_Metafile(Value: OLE_HANDLE): HResult; stdcall; begin FPicture.Metafile.Handle := Value; Result := S_OK; end; function TfrxPictureView.LoadViewFromStream(const Stream: IUnknown): HResult; stdcall; var ComStream: IStream; OleStream: TOleStream; NetStream: _Stream; ClrStream: TClrStream; begin try Result := Stream.QueryInterface(IStream, ComStream); if Result = S_OK then begin OleStream := TOleStream.Create(ComStream); LoadPictureFromStream(OleStream); OleStream.Free; ComStream := nil; end else begin Result := Stream.QueryInterface(_Stream, NetStream); if Result = S_OK then begin ClrStream := TClrStream.Create(NetStream); LoadPictureFromStream(ClrStream); ClrStream.Free; NetStream._Release(); end; end; except Result := E_FAIL; end; end; function TfrxPictureView.SaveViewToStream(const Stream: IUnknown): HResult; stdcall; var ComStream: IStream; OleStream: TOleStream; NetStream: _Stream; ClrStream: TClrStream; begin try Result := Stream.QueryInterface(IStream, ComStream); if Result = S_OK then begin OleStream := TOleStream.Create(ComStream); FPicture.Bitmap.SaveToStream(OleStream); OleStream.Free; ComStream._Release(); end else begin Result := Stream.QueryInterface(_Stream, NetStream); if Result = S_OK then begin ClrStream := TClrStream.Create(NetStream); FPicture.Bitmap.SaveToStream(ClrStream); ClrStream.Free; NetStream._Release(); end; end; except Result := E_FAIL; end; end; {$ENDIF} const WMFKey = Integer($9AC6CDD7); WMFWord = $CDD7; rc3_StockIcon = 0; rc3_Icon = 1; rc3_Cursor = 2; type TGraphicHeader = record Count: Word; HType: Word; Size: Longint; end; TMetafileHeader = packed record Key: Longint; Handle: SmallInt; Box: TSmallRect; Inch: Word; Reserved: Longint; CheckSum: Word; end; TCursorOrIcon = packed record Reserved: Word; wType: Word; Count: Word; end; const OriginalPngHeader: array[0..7] of Char = (#137, #80, #78, #71, #13, #10, #26, #10); function TfrxPictureView.LoadPictureFromStream(s: TStream): Hresult; var pos: Integer; Header: TGraphicHeader; BMPHeader: TBitmapFileHeader; {$IFDEF JPEG} JPEGHeader: array[0..1] of Byte; {$ENDIF} {$IFDEF PNG} PNGHeader: array[0..7] of Char; {$ENDIF} EMFHeader: TEnhMetaHeader; WMFHeader: TMetafileHeader; ICOHeader: TCursorOrIcon; NewGraphic: TGraphic; bOK : Boolean; begin NewGraphic := nil; if s.Size > 0 then begin // skip Delphi blob-image header if s.Size >= SizeOf(TGraphicHeader) then begin s.Read(Header, SizeOf(Header)); if (Header.Count <> 1) or (Header.HType <> $0100) or (Header.Size <> s.Size - SizeOf(Header)) then s.Position := 0; end; pos := s.Position; bOK := False; if (s.Size-pos) >= SizeOf(BMPHeader) then begin // try bmp header s.ReadBuffer(BMPHeader, SizeOf(BMPHeader)); s.Position := pos; if BMPHeader.bfType = $4D42 then begin NewGraphic := TBitmap.Create; bOK := True; end; end; {$IFDEF JPEG} if not bOK then begin if (s.Size-pos) >= SizeOf(JPEGHeader) then begin // try jpeg header s.ReadBuffer(JPEGHeader, SizeOf(JPEGHeader)); s.Position := pos; if (JPEGHeader[0] = $FF) and (JPEGHeader[1] = $D8) then begin NewGraphic := TJPEGImage.Create; bOK := True; end; end; end; {$ENDIF} {$IFDEF PNG} if not bOK then begin if (s.Size-pos) >= SizeOf(PNGHeader) then begin // try png header s.ReadBuffer(PNGHeader, SizeOf(PNGHeader)); s.Position := pos; if PNGHeader = OriginalPngHeader then begin NewGraphic := TPngObject.Create; bOK := True; end; end; end; {$ENDIF} if not bOK then begin if (s.Size-pos) >= SizeOf(WMFHeader) then begin // try wmf header s.ReadBuffer(WMFHeader, SizeOf(WMFHeader)); s.Position := pos; if WMFHeader.Key = WMFKEY then begin NewGraphic := TMetafile.Create; bOK := True; end; end; end; if not bOK then begin if (s.Size-pos) >= SizeOf(EMFHeader) then begin // try emf header s.ReadBuffer(EMFHeader, SizeOf(EMFHeader)); s.Position := pos; if EMFHeader.dSignature = ENHMETA_SIGNATURE then begin NewGraphic := TMetafile.Create; bOK := True; end; end; end; if not bOK then begin if (s.Size-pos) >= SizeOf(ICOHeader) then begin // try icon header s.ReadBuffer(ICOHeader, SizeOf(ICOHeader)); s.Position := pos; if ICOHeader.wType in [RC3_STOCKICON, RC3_ICON] then NewGraphic := TIcon.Create; end; end; end; if NewGraphic <> nil then begin FPicture.Graphic := NewGraphic; NewGraphic.Free; FPicture.Graphic.LoadFromStream(s); Result := S_OK; end else begin FPicture.Assign(nil); Result := E_INVALIDARG; end; // workaround pngimage bug {$IFDEF PNG} if FPicture.Graphic is TPngObject then PictureChanged(nil); {$ENDIF} end; procedure TfrxPictureView.GetData; var m: TMemoryStream; s: String; begin inherited; if FFileLink <> '' then begin s := FFileLink; if Pos('[', s) <> 0 then ExpandVariables(s); if FileExists(s) then FPicture.LoadFromFile(s) else FPicture.Assign(nil); end else if IsDataField and DataSet.IsBlobField(DataField) then begin m := TMemoryStream.Create; try DataSet.AssignBlobTo(DataField, m); LoadPictureFromStream(m); finally m.Free; end; end; end; { TfrxBand } constructor TfrxBand.Create(AOwner: TComponent); begin inherited; FSubBands := TList.Create; FOriginalObjectsCount := -1; end; destructor TfrxBand.Destroy; begin FSubBands.Free; inherited; end; procedure TfrxBand.Notification(AComponent: TComponent; Operation: TOperation); begin inherited; if (Operation = opRemove) and (AComponent = FChild) then FChild := nil; end; procedure TfrxBand.Draw(Canvas: TCanvas; ScaleX, ScaleY, OffsetX, OffsetY: Extended); begin end; function TfrxBand.GetBandName: String; begin Result := ClassName; Delete(Result, Pos('Tfrx', Result), 4); Delete(Result, Pos('Band', Result), 4); end; function TfrxBand.BandNumber: Integer; var i: Integer; begin Result := 0; for i := 0 to BND_COUNT - 1 do if Self is frxBands[i] then Result := i; end; class function TfrxBand.GetDescription: String; begin Result := frxResources.Get('obBand'); end; procedure TfrxBand.SetLeft(Value: Extended); begin if Parent is TfrxDMPPage then Value := Round(Value / fr1CharX) * fr1CharX; inherited; end; procedure TfrxBand.SetTop(Value: Extended); begin if Parent is TfrxDMPPage then Value := Round(Value / fr1CharY) * fr1CharY; inherited; end; procedure TfrxBand.SetHeight(Value: Extended); begin if Parent is TfrxDMPPage then Value := Round(Value / fr1CharY) * fr1CharY; inherited; end; procedure TfrxBand.SetChild(Value: TfrxChild); var b: TfrxBand; begin b := Value; while b <> nil do begin b := b.Child; if b = Self then raise Exception.Create('Circular child reference is not allowed'); end; FChild := Value; end; {$IFDEF FR_COM} function TfrxBand.IfrxBand_Get_AllowSplit(out Value: WordBool): HResult; stdcall; begin Value := FAllowSplit; Result := S_OK; end; function TfrxBand.IfrxBand_Set_AllowSplit(Value: WordBool): HResult; stdcall; begin FAllowSplit := Value; Result := S_OK; end; function TfrxBand.IfrxBand_Get_KeepChild(out Value: WordBool): HResult; stdcall; begin Value := FKeepChild; Result := S_OK; end; function TfrxBand.IfrxBand_Set_KeepChild(Value: WordBool): HResult; stdcall; begin FKeepChild := Value; Result := S_OK; end; function TfrxBand.IfrxBand_Get_OutlineText(out Value: WideString): HResult; stdcall; begin Value := FOutlineText; Result := S_OK; end; function TfrxBand.IfrxBand_Set_OutlineText(const Value: WideString): HResult; stdcall; begin FOutlineText := Value; Result := S_OK; end; function TfrxBand.IfrxBand_Get_Overflow(out Value: WordBool): HResult; stdcall; begin Value := FOverflow; Result := S_OK; end; function TfrxBand.IfrxBand_Set_Overflow(Value: WordBool): HResult; stdcall; begin FOverflow := Value; Result := S_OK; end; function TfrxBand.IfrxBand_Get_StartNewPage(out Value: WordBool): HResult; stdcall; begin Value := FStartNewPage; Result := S_OK; end; function TfrxBand.IfrxBand_Set_StartNewPage(Value: WordBool): HResult; stdcall; begin FStartNewPage := Value; Result := S_OK; end; function TfrxBand.IfrxBand_Get_Stretched(out Value: WordBool): HResult; stdcall; begin Value := FStretched; Result := S_OK; end; function TfrxBand.IfrxBand_Set_Stretched(Value: WordBool): HResult; stdcall; begin FStretched := Value; Result := S_OK; end; function TfrxBand.IfrxBand_Get_PrintChildIfInvisible(out Value: WordBool): HResult; stdcall; begin Value := FPrintChildIfInvisible; Result := S_OK; end; function TfrxBand.IfrxBand_Set_PrintChildIfInvisible(Value: WordBool): HResult; stdcall; begin FPrintChildIfInvisible := Value; Result := S_OK; end; function TfrxBand.IfrxBand_Get_Vertical(out Value: WordBool): HResult; stdcall; begin Value := FVertical; Result := S_OK; end; function TfrxBand.IfrxBand_Set_Vertical(Value: WordBool): HResult; stdcall; begin FVertical := Value; Result := S_OK; end; function TfrxBand.IfrxBand_Get_BandName(out Value: WideString): HResult; stdcall; begin Value := GetBandName; Result := S_OK; end; function TfrxBand.Get_Child(out Value: IfrxChild): HResult; stdcall; begin Value := Child; Result := S_OK; end; function TfrxBand.Set_Child(const Value: IfrxChild): HResult; stdcall; var idsp: {IfrxComponentSelf} IInterfaceComponentReference; begin Result := Value.QueryInterface( {IfrxComponentSelf} IInterfaceComponentReference, idsp); if Result = S_OK then Child := TfrxChild(idsp.GetComponent {Get_Object}); end; { TfrxHeader } function TfrxHeader.Get_ReprintOnNewPage(out Value: WordBool): HResult; stdcall; begin Value := ReprintOnNewPage; Result := S_OK; end; function TfrxHeader.Set_ReprintOnNewPage(Value: WordBool): HResult; stdcall; begin ReprintOnNewPage := Value; Result := S_OK; end; { TfrxPageHeader } function TfrxPageHeader.Get_PrintOnFirstPage(out Value: WordBool): HResult; stdcall; begin Value := PrintOnFirstPage; Result := S_OK; end; function TfrxPageHeader.Set_PrintOnFirstPage(Value: WordBool): HResult; stdcall; begin PrintOnFirstPage := Value; Result := S_OK; end; { TfrxPageFooter } function TfrxPageFooter.Get_PrintOnFirstPage(out Value: WordBool): HResult; stdcall; begin Value := PrintOnFirstPage; Result := S_OK; end; function TfrxPageFooter.Set_PrintOnFirstPage(Value: WordBool): HResult; stdcall; begin PrintOnFirstPage := Value; Result := S_OK; end; function TfrxPageFooter.Get_PrintOnLastPage(out Value: WordBool): HResult; stdcall; begin Value := PrintOnLastPage; Result := S_OK; end; function TfrxPageFooter.Set_PrintOnLastPage(Value: WordBool): HResult; stdcall; begin PrintOnLastPage := Value; Result := S_OK; end; { TfrxGroupHeader } function TfrxGroupHeader.Get_Condition(out Value: WideString): HResult; stdcall; begin Value := Condition; Result := S_OK; end; function TfrxGroupHeader.Set_Condition(const Value: WideString): HResult; stdcall; begin Condition := Value; Result := S_OK; end; function TfrxGroupHeader.Get_KeepTogether(out Value: WordBool): HResult; stdcall; begin Value := KeepTogether; Result := S_OK; end; function TfrxGroupHeader.Set_KeepTogether(Value: WordBool): HResult; stdcall; begin KeepTogether := Value; Result := S_OK; end; function TfrxGroupHeader.Get_ReprintOnNewPage(out Value: WordBool): HResult; stdcall; begin Value := ReprintOnNewPage; Result := S_OK; end; function TfrxGroupHeader.Set_ReprintOnNewPage(Value: WordBool): HResult; stdcall; begin ReprintOnNewPage := Value; Result := S_OK; end; function TfrxGroupHeader.Get_LastValue(out Value: OleVariant): HResult; stdcall; begin Value := FLastValue; Result := S_OK; end; { TfrxGroupFooter } function TfrxGroupFooter.Get_HideIfSingledatarecord(out Value: WordBool): HResult; stdcall; begin Value := HideIfSingledatarecord; Result := S_OK; end; function TfrxGroupFooter.Set_HideIfSingledatarecord(Value: WordBool): HResult; stdcall; begin HideIfSingledatarecord := Value; Result := S_OK; end; {$ENDIF} { TfrxDataBand } constructor TfrxDataBand.Create(AOwner: TComponent); begin inherited; FVirtualDataSet := TfrxUserDataSet.Create(nil); FVirtualDataSet.RangeEnd := reCount; end; destructor TfrxDataBand.Destroy; begin FVirtualDataSet.Free; inherited; end; class function TfrxDataBand.GetDescription: String; begin Result := frxResources.Get('obDataBand'); end; procedure TfrxDataBand.Notification(AComponent: TComponent; Operation: TOperation); begin inherited; if (Operation = opRemove) and (AComponent = FDataSet) then FDataSet := nil; end; procedure TfrxDataBand.SetCurColumn(Value: Integer); begin if Value > FColumns then Value := 1; FCurColumn := Value; if FCurColumn = 1 then FMaxY := 0; FLeft := (FCurColumn - 1) * (FColumnWidth + FColumnGap); end; procedure TfrxDataBand.SetDataSet(const Value: TfrxDataSet); begin FDataSet := Value; if FDataSet = nil then FDataSetName := '' else FDataSetName := FDataSet.UserName; end; procedure TfrxDataBand.SetDataSetName(const Value: String); begin FDataSetName := Value; FDataSet := frxFindDataSet(FDataSet, FDataSetName, Report); end; function TfrxDataBand.GetDataSetName: String; begin if FDataSet = nil then Result := FDataSetName else Result := FDataSet.UserName; end; procedure TfrxDataBand.SetRowCount(const Value: Integer); begin FRowCount := Value; FVirtualDataSet.RangeEndCount := Value; end; {$IFDEF FR_COM} function TfrxDataBand.Get_ColumnGap(out Value: Double): HResult; stdcall; begin Value := ColumnGap; Result := S_OK; end; function TfrxDataBand.Set_ColumnGap(Value: Double): HResult; stdcall; begin ColumnGap := Value; Result := S_OK; end; function TfrxDataBand.Get_ColumnWidth(out Value: Double): HResult; stdcall; begin Value := ColumnWidth; Result := S_OK; end; function TfrxDataBand.Set_ColumnWidth(Value: Double): HResult; stdcall; begin ColumnWidth := Value; Result := S_OK; end; function TfrxDataBand.Get_ColumnsCount(out Value: Integer): HResult; stdcall; begin Value := Columns; Result := S_OK; end; function TfrxDataBand.Set_ColumnsCount(Value: Integer): HResult; stdcall; begin Columns := Value; Result := S_OK; end; function TfrxDataBand.Get_CurrentColumn(out Value: Integer): HResult; stdcall; begin Value := CurColumn; Result := S_OK; end; function TfrxDataBand.Set_CurrentColumn(Value: Integer): HResult; stdcall; begin CurColumn := Value; Result := S_OK; end; function TfrxDataBand.Get_DataSet(out Value: IfrxDataSet): HResult; stdcall; begin Value := DataSet as IfrxDataSet; Result := S_OK; end; function TfrxDataBand.Set_DataSet(const Value: IfrxDataSet): HResult; stdcall; var idsp: {IfrxComponentSelf} IInterfaceComponentReference; begin Result := Value.QueryInterface( {IfrxComponentSelf} IInterfaceComponentReference, idsp); if Result = S_OK then DataSet := TfrxDataSet(idsp.GetComponent {Get_Object} ); end; function TfrxDataBand.Get_FooterAfterEach(out Value: WordBool): HResult; stdcall; begin Value := FooterAfterEach; Result := S_OK; end; function TfrxDataBand.Set_FooterAfterEach(Value: WordBool): HResult; stdcall; begin FooterAfterEach := Value; Result := S_OK; end; function TfrxDataBand.Get_KeepFooter(out Value: WordBool): HResult; stdcall; begin Value := KeepFooter; Result := S_OK; end; function TfrxDataBand.Set_KeepFooter(Value: WordBool): HResult; stdcall; begin KeepFooter := Value; Result := S_OK; end; function TfrxDataBand.Get_KeepHeader(out Value: WordBool): HResult; stdcall; begin Value := KeepHeader; Result := S_OK; end; function TfrxDataBand.Set_KeepHeader(Value: WordBool): HResult; stdcall; begin KeepHeader := Value; Result := S_OK; end; function TfrxDataBand.Get_KeepTogether(out Value: WordBool): HResult; stdcall; begin Value := KeepTogether; Result := S_OK; end; function TfrxDataBand.Set_KeepTogether(Value: WordBool): HResult; stdcall; begin KeepTogether := Value; Result := S_OK; end; function TfrxDataBand.Get_PrintIfDetailEmpty(out Value: WordBool): HResult; stdcall; begin Value := PrintIfDetailEmpty; Result := S_OK; end; function TfrxDataBand.Set_PrintIfDetailEmpty(Value: WordBool): HResult; stdcall; begin PrintIfDetailEmpty := Value; Result := S_OK; end; function TfrxDataBand.Get_RowCount(out Value: Integer): HResult; stdcall; begin Value := RowCount; Result := S_OK; end; function TfrxDataBand.Set_RowCount(Value: Integer): HResult; stdcall; begin RowCount := Value; Result := S_OK; end; function TfrxDataBand.ResetDataSet: HResult; stdcall; begin Self.FDataSet := nil; Result := S_OK; end; {$ENDIF} { TfrxPageHeader } constructor TfrxPageHeader.Create(AOwner: TComponent); begin inherited; FPrintOnFirstPage := True; end; { TfrxPageFooter } constructor TfrxPageFooter.Create(AOwner: TComponent); begin inherited; FPrintOnFirstPage := True; FPrintOnLastPage := True; end; { TfrxGroupHeader } function TfrxGroupHeader.Diff(AComponent: TfrxComponent): String; begin Result := inherited Diff(AComponent); if FDrillDown then Result := Result + ' Tag="' + IntToStr(FLineThrough) + '"'; end; { TfrxSubreport } constructor TfrxSubreport.Create(AOwner: TComponent); begin inherited; frComponentStyle := frComponentStyle - [csPreviewVisible]; FFrame.Typ := [ftLeft, ftRight, ftTop, ftBottom]; FFont.Name := 'Tahoma'; FFont.Size := 8; FColor := clSilver; end; destructor TfrxSubreport.Destroy; begin if FPage <> nil then FPage.FSubReport := nil; inherited; end; procedure TfrxSubreport.SetPage(const Value: TfrxReportPage); begin FPage := Value; if FPage <> nil then FPage.FSubReport := Self; end; procedure TfrxSubreport.Draw(Canvas: TCanvas; ScaleX, ScaleY, OffsetX, OffsetY: Extended); begin inherited; with Canvas do begin Font.Assign(FFont); TextOut(FX + 2, FY + 2, Name); end; end; class function TfrxSubreport.GetDescription: String; begin Result := frxResources.Get('obSubRep'); end; {$IFDEF FR_COM} function TfrxSubreport.Get_Page(out Value: IfrxReportPage): HResult; stdcall; begin Value := Page; Result := S_OK; end; function TfrxSubreport.Set_Page(const Value: IfrxReportPage): HResult; stdcall; begin Page := (Value as {IfrxComponentSelf} IInterfaceComponentReference).GetComponent{Get_Object} as TfrxReportPage; Result := S_OK; end; function TfrxSubreport.Get_PrintOnparent(out Value: WordBool): HResult; stdcall; begin Value := PrintOnParent; Result := S_OK; end; function TfrxSubreport.Set_PrintOnparent(Value: WordBool): HResult; stdcall; begin PrintOnParent := Value; Result := S_OK; end; { TfrxPage } function TfrxPage.Get_Visible(out Value: WordBool): HResult; stdcall; begin Value := Visible; Result := S_OK; end; function TfrxPage.Set_Visible(Value: WordBool): HResult; stdcall; begin Visible := Value; Result := S_OK; end; {$ENDIF} { TfrxDialogPage } constructor TfrxDialogPage.Create(AOwner: TComponent); var FSaveTag: Integer; begin inherited; FSaveTag := Tag; if (Report <> nil) and Report.EngineOptions.EnableThreadSafe then Tag := 318 else Tag := 0; FForm := TfrxDialogForm.Create(Self); Tag := FSaveTag; FForm.KeyPreview := True; Font.Name := 'Tahoma'; Font.Size := 8; BorderStyle := bsSizeable; Position := poScreenCenter; WindowState := wsNormal; Color := clBtnFace; FForm.ShowHint := True; end; destructor TfrxDialogPage.Destroy; begin {$IFNDEF NO_CRITICAL_SECTION} frxCS.Enter; {$ENDIF} try inherited; FForm.Free; finally {$IFNDEF NO_CRITICAL_SECTION} frxCS.Leave; {$ENDIF} end; end; class function TfrxDialogPage.GetDescription: String; begin Result := frxResources.Get('obDlgPage'); end; procedure TfrxDialogPage.SetLeft(Value: Extended); begin inherited; FForm.Left := Round(Value); end; procedure TfrxDialogPage.SetTop(Value: Extended); begin inherited; FForm.Top := Round(Value); end; procedure TfrxDialogPage.SetWidth(Value: Extended); begin inherited; FForm.Width := Round(Value); end; procedure TfrxDialogPage.SetHeight(Value: Extended); begin inherited; FForm.Height := Round(Value); end; procedure TfrxDialogPage.SetBorderStyle(const Value: TFormBorderStyle); begin FBorderStyle := Value; end; procedure TfrxDialogPage.SetCaption(const Value: String); begin FCaption := Value; FForm.Caption := Value; end; procedure TfrxDialogPage.SetColor(const Value: TColor); begin FColor := Value; FForm.Color := Value; end; function TfrxDialogPage.GetModalResult: TModalResult; begin Result := FForm.ModalResult; end; procedure TfrxDialogPage.SetModalResult(const Value: TModalResult); begin FForm.ModalResult := Value; end; procedure TfrxDialogPage.FontChanged(Sender: TObject); begin inherited; FForm.Font := Font; end; procedure TfrxDialogPage.DoInitialize; begin if FForm.Visible then FForm.Hide; FForm.Position := FPosition; FForm.WindowState := FWindowState; FForm.OnActivate := DoOnActivate; FForm.OnClick := DoOnClick; FForm.OnCloseQuery := DoOnCloseQuery; FForm.OnDeactivate := DoOnDeactivate; FForm.OnHide := DoOnHide; FForm.OnKeyDown := DoOnKeyDown; FForm.OnKeyPress := DoOnKeyPress; FForm.OnKeyUp := DoOnKeyUp; FForm.OnShow := DoOnShow; FForm.OnResize := DoOnResize; end; procedure TfrxDialogPage.Initialize; begin {$IFNDEF FR_COM} // if (Report <> nil) and (Report.EngineOptions.ReportThread <> nil) then // THackThread(Report.EngineOptions.ReportThread).Synchronize(DoInitialize) else {$ENDIF} DoInitialize; end; function TfrxDialogPage.ShowModal: TModalResult; begin Initialize; FForm.BorderStyle := FBorderStyle; FForm.FormStyle := fsNormal; try TfrxDialogForm(FForm).OnModify := DoModify; Result := FForm.ShowModal; finally FForm.FormStyle := fsStayOnTop; end; end; procedure TfrxDialogPage.DoModify(Sender: TObject); begin FLeft := FForm.Left; FTop := FForm.Top; FWidth := FForm.Width; FHeight := FForm.Height; end; procedure TfrxDialogPage.DoOnActivate(Sender: TObject); begin DoModify(nil); Report.DoNotifyEvent(Sender, FOnActivate); end; procedure TfrxDialogPage.DoOnClick(Sender: TObject); begin Report.DoNotifyEvent(Sender, FOnClick); end; procedure TfrxDialogPage.DoOnCloseQuery(Sender: TObject; var CanClose: Boolean); var v: Variant; begin v := VarArrayOf([Integer(Sender), CanClose]); Report.DoParamEvent(FOnCloseQuery, v); CanClose := v[1]; end; procedure TfrxDialogPage.DoOnDeactivate(Sender: TObject); begin Report.DoNotifyEvent(Sender, FOnDeactivate); end; procedure TfrxDialogPage.DoOnHide(Sender: TObject); begin Report.DoNotifyEvent(Sender, FOnHide); end; procedure TfrxDialogPage.DoOnKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); var v: Variant; begin v := VarArrayOf([Integer(Sender), Key, ShiftToByte(Shift)]); if Report <> nil then Report.DoParamEvent(FOnKeyDown, v); Key := v[1]; end; procedure TfrxDialogPage.DoOnKeyPress(Sender: TObject; var Key: Char); var v: Variant; begin v := VarArrayOf([Integer(Sender), Key]); if Report <> nil then Report.DoParamEvent(FOnKeyPress, v); if VarToStr(v[1]) <> '' then Key := VarToStr(v[1])[1] else Key := Chr(0); end; procedure TfrxDialogPage.DoOnKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState); var v: Variant; begin v := VarArrayOf([Integer(Sender), Key, ShiftToByte(Shift)]); if Report <> nil then Report.DoParamEvent(FOnKeyUp, v); Key := v[1]; end; procedure TfrxDialogPage.DoOnShow(Sender: TObject); begin FForm.Perform(CM_FOCUSCHANGED, 0, Longint(FForm.ActiveControl)); Report.DoNotifyEvent(Sender, FOnShow); end; procedure TfrxDialogPage.DoOnResize(Sender: TObject); begin Report.DoNotifyEvent(Sender, FOnResize); end; { TfrxReportPage } constructor TfrxReportPage.Create(AOwner: TComponent); begin inherited; FBackPicture := TfrxPictureView.Create(nil); FBackPicture.Color := clTransparent; FBackPicture.KeepAspectRatio := False; FColumnPositions := TStringList.Create; FOrientation := poPortrait; PaperSize := DMPAPER_A4; FBin := DMBIN_AUTO; FBinOtherPages := DMBIN_AUTO; FBaseName := 'Page'; FSubBands := TList.Create; FVSubBands := TList.Create; FHGuides := TStringList.Create; FVGuides := TStringList.Create; FPrintIfEmpty := True; FTitleBeforeHeader := True; end; destructor TfrxReportPage.Destroy; begin FColumnPositions.Free; FBackPicture.Free; FSubBands.Free; FVSubBands.Free; FHGuides.Free; FVGuides.Free; inherited; end; class function TfrxReportPage.GetDescription: String; begin Result := frxResources.Get('obRepPage'); end; procedure TfrxReportPage.Notification(AComponent: TComponent; Operation: TOperation); begin inherited; if (Operation = opRemove) and (AComponent = FDataSet) then FDataSet := nil; end; procedure TfrxReportPage.SetDataSet(const Value: TfrxDataSet); begin FDataSet := Value; if FDataSet = nil then FDataSetName := '' else FDataSetName := FDataSet.UserName; end; procedure TfrxReportPage.SetDataSetName(const Value: String); begin FDataSetName := Value; FDataSet := frxFindDataSet(FDataSet, FDataSetName, Report); end; function TfrxReportPage.GetDataSetName: String; begin if FDataSet = nil then Result := FDataSetName else Result := FDataSet.UserName; end; procedure TfrxReportPage.SetPaperHeight(const Value: Extended); begin FPaperHeight := Round8(Value); FPaperSize := 256; UpdateDimensions; end; procedure TfrxReportPage.SetPaperWidth(const Value: Extended); begin FPaperWidth := Round8(Value); FPaperSize := 256; UpdateDimensions; end; procedure TfrxReportPage.SetPaperSize(const Value: Integer); var e: Extended; begin FPaperSize := Value; if FPaperSize < DMPAPER_USER then begin if frxGetPaperDimensions(FPaperSize, FPaperWidth, FPaperHeight) then if FOrientation = poLandscape then begin e := FPaperWidth; FPaperWidth := FPaperHeight; FPaperHeight := e; end; UpdateDimensions; end; end; procedure TfrxReportPage.SetSizeAndDimensions(ASize: Integer; AWidth, AHeight: Extended); begin FPaperSize := ASize; FPaperWidth := Round8(AWidth); FPaperHeight := Round8(AHeight); UpdateDimensions; end; procedure TfrxReportPage.SetColumns(const Value: Integer); begin FColumns := Value; FColumnPositions.Clear; if FColumns <= 0 then exit; FColumnWidth := (FPaperWidth - FLeftMargin - FRightMargin) / FColumns; while FColumnPositions.Count < FColumns do FColumnPositions.Add(FloatToStr(FColumnPositions.Count * FColumnWidth)); end; procedure TfrxReportPage.SetOrientation(Value: TPrinterOrientation); var e, m1, m2, m3, m4: Extended; begin if FOrientation <> Value then begin e := FPaperWidth; FPaperWidth := FPaperHeight; FPaperHeight := e; m1 := FLeftMargin; m2 := FRightMargin; m3 := FTopMargin; m4 := FBottomMargin; if Value = poLandscape then begin FLeftMargin := m3; FRightMargin := m4; FTopMargin := m2; FBottomMargin := m1; end else begin FLeftMargin := m4; FRightMargin := m3; FTopMargin := m1; FBottomMargin := m2; end; UpdateDimensions; end; FOrientation := Value; end; procedure TfrxReportPage.UpdateDimensions; begin Width := Round(FPaperWidth * fr01cm); Height := Round(FPaperHeight * fr01cm); end; procedure TfrxReportPage.ClearGuides; begin FHGuides.Clear; FVGuides.Clear; end; procedure TfrxReportPage.SetHGuides(const Value: TStrings); begin FHGuides.Assign(Value); end; procedure TfrxReportPage.SetVGuides(const Value: TStrings); begin FVGuides.Assign(Value); end; function TfrxReportPage.FindBand(Band: TfrxBandClass): TfrxBand; var i: Integer; begin Result := nil; for i := 0 to FObjects.Count - 1 do if TObject(FObjects[i]) is Band then begin Result := FObjects[i]; break; end; end; function TfrxReportPage.IsSubReport: Boolean; begin Result := SubReport <> nil; end; procedure TfrxReportPage.SetColumnPositions(const Value: TStrings); begin FColumnPositions.Assign(Value); end; function TfrxReportPage.GetFrame: TfrxFrame; begin Result := FBackPicture.Frame; end; procedure TfrxReportPage.SetFrame(const Value: TfrxFrame); begin FBackPicture.Frame := Value; end; function TfrxReportPage.GetColor: TColor; begin Result := FBackPicture.Color; end; procedure TfrxReportPage.SetColor(const Value: TColor); begin FBackPicture.Color := Value; end; function TfrxReportPage.GetBackPicture: TPicture; begin Result := FBackPicture.Picture; end; procedure TfrxReportPage.SetBackPicture(const Value: TPicture); begin FBackPicture.Picture := Value; end; procedure TfrxReportPage.Draw(Canvas: TCanvas; ScaleX, ScaleY, OffsetX, OffsetY: Extended); begin FBackPicture.Width := (FPaperWidth - FLeftMargin - FRightMargin) * fr01cm; FBackPicture.Height := (FPaperHeight - FTopMargin - FBottomMargin) * fr01cm; FBackPicture.Draw(Canvas, ScaleX, ScaleY, OffsetX + FLeftMargin * fr01cm * ScaleX, OffsetY + FTopMargin * fr01cm * ScaleY); end; procedure TfrxReportPage.SetDefaults; begin FLeftMargin := 10; FRightMargin := 10; FTopMargin := 10; FBottomMargin := 10; FPaperSize := frxPrinters.Printer.DefPaper; FPaperWidth := frxPrinters.Printer.DefPaperWidth; FPaperHeight := frxPrinters.Printer.DefPaperHeight; FOrientation := frxPrinters.Printer.DefOrientation; UpdateDimensions; end; procedure TfrxReportPage.AlignChildren; var i: Integer; c: TfrxComponent; begin Width := (FPaperWidth - FLeftMargin - FRightMargin) * fr01cm; Height := (FPaperHeight - FTopMargin - FBottomMargin) * fr01cm; inherited; for i := 0 to Objects.Count - 1 do begin c := Objects[i]; if c is TfrxBand then begin if TfrxBand(c).Vertical then c.Height := (FPaperHeight - FTopMargin - FBottomMargin) * fr01cm - c.Top else c.Width := Width - c.Left; // previous bugfix is wrong!!! // if c.Width > Width then // c.Width := Width; // if c.Height > Height then // c.Height := Height; c.AlignChildren; end; end; UpdateDimensions; end; {$IFDEF FR_COM} function TfrxReportPage.IfrxReportPage_SetDefaults: HResult; stdcall; begin SetDefaults; Result := 0; end; function TfrxReportPage.IfrxReportPage_Get_Bin(out Value: SYSINT): HResult; stdcall; begin Value := Bin; Result := S_OK; end; function TfrxReportPage.IfrxReportPage_Set_Bin(Value: SYSINT): HResult; stdcall; begin Bin := Value; Result := S_OK; end; function TfrxReportPage.IfrxReportPage_Get_BinOtherPages(out Value: SYSINT): HResult; stdcall; begin Value := BinOtherPages; Result := S_OK; end; function TfrxReportPage.IfrxReportPage_Set_BinOtherPages(Value: SYSINT): HResult; stdcall; begin BinOtherPages := Value; Result := S_OK; end; function TfrxReportPage.IfrxReportPage_Get_BottomMargin(out Value: Double): HResult; stdcall; begin Value := BottomMargin; Result := S_OK; end; function TfrxReportPage.IfrxReportPage_Set_BottomMargin(Value: Double): HResult; stdcall; begin BottomMargin := Value; Result := S_OK; end; function TfrxReportPage.IfrxReportPage_Get_Columns(out Value: SYSINT): HResult; stdcall; begin Value := Columns; Result := S_OK; end; function TfrxReportPage.IfrxReportPage_Set_Columns(Value: SYSINT): HResult; stdcall; begin Columns := Value; Result := S_OK; end; function TfrxReportPage.IfrxReportPage_Get_ColumnWidth(out Value: Double): HResult; stdcall; begin Value := ColumnWidth; Result := S_OK; end; function TfrxReportPage.IfrxReportPage_Set_ColumnWidth(Value: Double): HResult; stdcall; begin ColumnWidth := Value; Result := S_OK; end; function TfrxReportPage.IfrxReportPage_Get_ColumnPosition(out Value: WideString): HResult; stdcall; begin Value := ColumnPositions.GetText; Result := S_OK; end; function TfrxReportPage.IfrxReportPage_Set_ColumnPosition(const Value: WideString): HResult; stdcall; begin ColumnPositions.SetText(PAnsiChar(String(Value))); Result := S_OK; end; function TfrxReportPage.IfrxReportPage_Get_DataSet(out Value: IfrxDataSet): HResult; stdcall; begin if FDataSet <> nil then Value := DataSet; Result := S_OK; end; function TfrxReportPage.IfrxReportPage_Set_DataSet(const Value: IfrxDataSet): HResult; stdcall; var idsp: {IfrxComponentSelf} IInterfaceComponentReference; comp: TfrxComponent; begin Result := Value.QueryInterface({IfrxComponentSelf} IInterfaceComponentReference, idsp); if Result = S_OK then begin comp := TfrxComponent(idsp.GetComponent {Get_Object}); DataSet := TfrxDataSet(comp); comp.Parent := Self; end; end; function TfrxReportPage.IfrxReportPage_Get_Duplex(out Value: frxDuplexMode): HResult; stdcall; begin Value := frxDuplexMode(Duplex); Result := S_OK; end; function TfrxReportPage.IfrxReportPage_Set_Duplex(Value: frxDuplexMode): HResult; stdcall; begin Duplex := TfrxDuplexMode(Value); Result := S_OK; end; function TfrxReportPage.IfrxReportPage_Get_HGuides(out Value: WideString): HResult; stdcall; begin Value := HGuides.GetText; Result := S_OK; end; function TfrxReportPage.IfrxReportPage_Set_HGuides(const Value: WideString): HResult; stdcall; begin HGuides.SetText(PAnsiChar(String(Value))); Result := S_OK; end; function TfrxReportPage.IfrxReportPage_Get_LargeDesignHeight(out Value: WordBool): HResult; stdcall; begin Value := LargeDesignHeight; Result := S_OK; end; function TfrxReportPage.IfrxReportPage_Set_LargeDesignHeight(Value: WordBool): HResult; stdcall; begin LargeDesignHeight := Value; Result := S_OK; end; function TfrxReportPage.IfrxReportPage_Get_LeftMargin(out Value: Double): HResult; stdcall; begin Value := LeftMargin; Result := S_OK; end; function TfrxReportPage.IfrxReportPage_Set_LeftMargin(Value: Double): HResult; stdcall; begin LeftMargin := Value; Result := S_OK; end; function TfrxReportPage.IfrxReportPage_Get_MirrorMargins(out Value: WordBool): HResult; stdcall; begin Value := MirrorMargins; Result := S_OK; end; function TfrxReportPage.IfrxReportPage_Set_MirrorMargins(Value: WordBool): HResult; stdcall; begin MirrorMargins := Value; Result := S_OK; end; function TfrxReportPage.IfrxReportPage_Get_Orientation(out Value: frxPrinterOrientation): HResult; stdcall; begin Value := frxPrinterOrientation(Orientation); Result := S_OK; end; function TfrxReportPage.IfrxReportPage_Set_Orientation(Value: frxPrinterOrientation): HResult; stdcall; begin Orientation := TPrinterOrientation(Value); Result := S_OK; end; function TfrxReportPage.IfrxReportPage_Get_OutlineText(out Value: WideString): HResult; stdcall; begin Value := OutlineText; Result := S_OK; end; function TfrxReportPage.IfrxReportPage_Set_OutlineText(const Value: WideString): HResult; stdcall; begin OutlineText := Value; Result := S_OK; end; function TfrxReportPage.IfrxReportPage_Get_PrintIfEmpty(out Value: WordBool): HResult; stdcall; begin Value := PrintIfEmpty; Result := S_OK; end; function TfrxReportPage.IfrxReportPage_Set_PrintIfEmpty(Value: WordBool): HResult; stdcall; begin PrintIfEmpty := Value; Result := S_OK; end; function TfrxReportPage.IfrxReportPage_Get_PrintOnPreviousPage(out Value: WordBool): HResult; stdcall; begin Value := PrintOnPreviousPage; Result := S_OK; end; function TfrxReportPage.IfrxReportPage_Set_PrintOnPreviousPage(Value: WordBool): HResult; stdcall; begin PrintOnPreviousPage := Value; Result := S_OK; end; function TfrxReportPage.IfrxReportPage_Get_RightMargin(out Value: Double): HResult; stdcall; begin Value := RightMargin; Result := S_OK; end; function TfrxReportPage.IfrxReportPage_Set_RightMargin(Value: Double): HResult; stdcall; begin RightMargin := Value; Result := S_OK; end; function TfrxReportPage.IfrxReportPage_Get_SubReport(out Value: IfrxSubreport): HResult; stdcall; begin Value := Subreport; Result := S_OK; end; function TfrxReportPage.IfrxReportPage_Set_SubReport(const Value: IfrxSubreport): HResult; stdcall; begin Value.Set_Page(Self); Result := S_OK; end; function TfrxReportPage.IfrxReportPage_Get_TitleBeforeHeader(out Value: WordBool): HResult; stdcall; begin Value := FTitleBeforeHeader; Result := S_OK; end; function TfrxReportPage.IfrxReportPage_Set_TitleBeforeHeader(Value: WordBool): HResult; stdcall; begin FTitleBeforeHeader := Value; Result := S_OK; end; function TfrxReportPage.IfrxReportPage_Get_TopMargin(out Value: Double): HResult; stdcall; begin Value := FTopMargin; Result := S_OK; end; function TfrxReportPage.IfrxReportPage_Set_TopMargin(Value: Double): HResult; stdcall; begin FTopMargin := Value; Result := S_OK; end; function TfrxReportPage.IfrxReportPage_Get_VGuides(out Value: WideString): HResult; stdcall; begin Value := FVGuides.GetText; Result := S_OK; end; function TfrxReportPage.IfrxReportPage_Set_VGuides(const Value: WideString): HResult; stdcall; begin FVGuides.SetText(PAnsiChar(String(Value))); Result := S_OK; end; function TfrxReportPage.IfrxReportPage_Get_BackPickture(out Value: OLE_HANDLE): HResult; stdcall; begin Value := BackPicture.Bitmap.Handle; Result := S_OK; end; function TfrxReportPage.IfrxReportPage_Set_BackPickture(Value: OLE_HANDLE): HResult; stdcall; begin BackPicture.Bitmap.Handle := Value; Result := S_OK; end; function TfrxReportPage.Get_PaperWidth(out Value: Double): HResult; stdcall; begin Value := PaperWidth; Result := S_OK; end; function TfrxReportPage.Set_PaperWidth(Value: Double): HResult; stdcall; begin PaperWidth := Value; Result := S_OK; end; function TfrxReportPage.Get_PaperHeight(out Value: Double): HResult; stdcall; begin Value := PaperHeight; Result := S_OK; end; function TfrxReportPage.Set_PaperHeight(Value: Double): HResult; stdcall; begin PaperHeight := Value; Result := S_OK; end; {$ENDIF} { TfrxDataPage } constructor TfrxDataPage.Create(AOwner: TComponent); begin inherited; Width := 1000; Height := 1000; end; class function TfrxDataPage.GetDescription: String; begin Result := frxResources.Get('obDataPage'); end; { TfrxEngineOptions } constructor TfrxEngineOptions.Create; begin Clear; FMaxMemSize := 10; FPrintIfEmpty := True; FSilentMode := simMessageBoxes; FEnableThreadSafe := False; FTempDir := ''; {$IFDEF FR_COM} inherited Create(IfrxEngineOptions); FUseFileCache := True; {$ELSE} FUseFileCache := False; {$ENDIF} FDestroyForms := True; end; procedure TfrxEngineOptions.Assign(Source: TPersistent); begin if Source is TfrxEngineOptions then begin FConvertNulls := TfrxEngineOptions(Source).ConvertNulls; FDoublePass := TfrxEngineOptions(Source).DoublePass; FMaxMemSize := TfrxEngineOptions(Source).MaxMemSize; FPrintIfEmpty := TfrxEngineOptions(Source).PrintIfEmpty; NewSilentMode := TfrxEngineOptions(Source).NewSilentMode; FTempDir := TfrxEngineOptions(Source).TempDir; FUseFileCache := TfrxEngineOptions(Source).UseFileCache; end; end; procedure TfrxEngineOptions.Clear; begin FConvertNulls := True; FDoublePass := False; end; procedure TfrxEngineOptions.SetSilentMode(Mode: Boolean); begin if Mode = True then FSilentMode := simSilent else FSilentMode := simMessageBoxes; end; function TfrxEngineOptions.GetSilentMode: Boolean; begin if FSilentMode = simSilent then Result := True else Result := False; end; {$IFDEF FR_COM} function TfrxEngineOptions.IfrxEngineOptions_Get_ConvertNulls(out Value: WordBool): HResult; stdcall; begin Value := FConvertNulls; Result := S_OK; end; function TfrxEngineOptions.IfrxEngineOptions_Set_ConvertNulls(Value: WordBool): HResult; stdcall; begin FConvertNulls := Value; Result := S_OK; end; function TfrxEngineOptions.IfrxEngineOptions_Get_DestroyForms(out Value: WordBool): HResult; stdcall; begin Value := FDestroyForms; Result := S_OK; end; function TfrxEngineOptions.IfrxEngineOptions_Set_DestroyForms(Value: WordBool): HResult; stdcall; begin FDestroyForms := Value; Result := S_OK; end; function TfrxEngineOptions.IfrxEngineOptions_Get_DoublePass(out Value: WordBool): HResult; stdcall; begin Value := FDoublePass; Result := S_OK; end; function TfrxEngineOptions.IfrxEngineOptions_Set_DoublePass(Value: WordBool): HResult; stdcall; begin FDoublePass := Value; Result := S_OK; end; function TfrxEngineOptions.IfrxEngineOptions_Get_MaxMemSize(out Value: SYSINT): HResult; stdcall; begin Value := FMaxMemSize; Result := S_OK; end; function TfrxEngineOptions.IfrxEngineOptions_Set_MaxMemSize(Value: SYSINT): HResult; stdcall; begin FMaxMemSize := Value; Result := S_OK; end; function TfrxEngineOptions.IfrxEngineOptions_Get_PrintIfEmpty(out Value: WordBool): HResult; stdcall; begin Value := FPrintIfEmpty; Result := S_OK; end; function TfrxEngineOptions.IfrxEngineOptions_Set_PrintIfEmpty(Value: WordBool): HResult; stdcall; begin FPrintIfEmpty := Value; Result := S_OK; end; function TfrxEngineOptions.IfrxEngineOptions_Get_SilentMode(out Value: frxSilentMode): HResult; stdcall; begin Value := frxSilentMode(FSilentMode); Result := S_OK; end; function TfrxEngineOptions.IfrxEngineOptions_Set_SilentMode(Value: frxSilentMode): HResult; stdcall; begin FSilentMode := TfrxSilentMode(Value); Result := S_OK; end; function TfrxEngineOptions.IfrxEngineOptions_Get_TempDir(out Value: WideString): HResult; stdcall; begin Value := FTempDir; Result := S_OK; end; function TfrxEngineOptions.IfrxEngineOptions_Set_TempDir(const Value: WideString): HResult; stdcall; begin FTempDir := Value; Result := S_OK; end; function TfrxEngineOptions.IfrxEngineOptions_Get_UseFilecache(out Value: WordBool): HResult; stdcall; begin Value := FUseFilecache; Result := S_OK; end; function TfrxEngineOptions.IfrxEngineOptions_Set_UseFilecache(Value: WordBool): HResult; stdcall; begin FUseFilecache := Value; Result := S_OK; end; {$ENDIF} { TfrxPreviewOptions } constructor TfrxPreviewOptions.Create; begin Clear; FAllowEdit := True; FButtons := [pbPrint, pbLoad, pbSave, pbExport, pbZoom, pbFind, pbOutline, pbPageSetup, pbTools, pbEdit, pbNavigator, pbExportQuick]; FDoubleBuffered := True; FMaximized := True; FMDIChild := False; FModal := True; FPagesInCache := 50; FShowCaptions := False; FZoom := 1; FZoomMode := zmDefault; {$IFDEF FR_COM} inherited Create(IfrxPreviewOptions); {$ENDIF} end; procedure TfrxPreviewOptions.Assign(Source: TPersistent); begin if Source is TfrxPreviewOptions then begin FAllowEdit := TfrxPreviewOptions(Source).AllowEdit; FButtons := TfrxPreviewOptions(Source).Buttons; FDoubleBuffered := TfrxPreviewOptions(Source).DoubleBuffered; FMaximized := TfrxPreviewOptions(Source).Maximized; FMDIChild := TfrxPreviewOptions(Source).MDIChild; FModal := TfrxPreviewOptions(Source).Modal; FOutlineExpand := TfrxPreviewOptions(Source).OutlineExpand; FOutlineVisible := TfrxPreviewOptions(Source).OutlineVisible; FOutlineWidth := TfrxPreviewOptions(Source).OutlineWidth; FPagesInCache := TfrxPreviewOptions(Source).PagesInCache; FShowCaptions := TfrxPreviewOptions(Source).ShowCaptions; FThumbnailVisible := TfrxPreviewOptions(Source).ThumbnailVisible; FZoom := TfrxPreviewOptions(Source).Zoom; FZoomMode := TfrxPreviewOptions(Source).ZoomMode; end; end; procedure TfrxPreviewOptions.Clear; begin FOutlineExpand := True; FOutlineVisible := False; FOutlineWidth := 120; FPagesInCache := 50; FThumbnailVisible := False; end; {$IFDEF FR_COM} function TfrxPreviewOptions.IfrxPreviewOptions_Get_AllowEdit(out Value: WordBool): HResult; stdcall; begin Value := FAllowEdit; Result := S_OK; end; function TfrxPreviewOptions.IfrxPreviewOptions_Set_AllowEdit(Value: WordBool): HResult; stdcall; begin FAllowEdit := Value; Result := S_OK; end; function TfrxPreviewOptions.IfrxPreviewOptions_Get_Buttons(out Value: frxPreviewButtons): HResult; stdcall; begin Value := TOleEnum(PInteger(@Buttons)^); Result := S_OK; end; function TfrxPreviewOptions.IfrxPreviewOptions_Set_Buttons(Value: frxPreviewButtons): HResult; stdcall; type PfrxPreviewButtons = ^ TfrxPreviewButtons; begin Buttons := PfrxPreviewButtons(@Value)^; Result := S_OK; end; function TfrxPreviewOptions.IfrxPreviewOptions_Get_DoubleBuffered(out Value: WordBool): HResult; stdcall; begin Value := FDoubleBuffered; Result := S_OK; end; function TfrxPreviewOptions.IfrxPreviewOptions_Set_DoubleBuffered(Value: WordBool): HResult; stdcall; begin FDoubleBuffered := Value; Result := S_OK; end; function TfrxPreviewOptions.IfrxPreviewOptions_Get_Maximazed(out Value: WordBool): HResult; stdcall; begin Value := FMaximized; Result := S_OK; end; function TfrxPreviewOptions.IfrxPreviewOptions_Set_Maximazed(Value: WordBool): HResult; stdcall; begin FMaximized := Value; Result := S_OK; end; function TfrxPreviewOptions.IfrxPreviewOptions_Get_MDIChild(out Value: WordBool): HResult; stdcall; begin Value := FMDIChild; Result := S_OK; end; function TfrxPreviewOptions.IfrxPreviewOptions_Set_MDIChild(Value: WordBool): HResult; stdcall; begin FMDIChild := Value; Result := S_OK; end; function TfrxPreviewOptions.IfrxPreviewOptions_Get_Modal(out Value: WordBool): HResult; stdcall; begin Value := FModal; Result := S_OK; end; function TfrxPreviewOptions.IfrxPreviewOptions_Set_Modal(Value: WordBool): HResult; stdcall; begin FModal := Value; Result := S_OK; end; function TfrxPreviewOptions.IfrxPreviewOptions_Get_OutlineExpand(out Value: WordBool): HResult; stdcall; begin Value := FOutlineExpand; Result := S_OK; end; function TfrxPreviewOptions.IfrxPreviewOptions_Set_OutlineExpand(Value: WordBool): HResult; stdcall; begin FOutlineExpand := Value; Result := S_OK; end; function TfrxPreviewOptions.IfrxPreviewOptions_Get_OutlineVisible(out Value: WordBool): HResult; stdcall; begin Value := FOutlineVisible; Result := S_OK; end; function TfrxPreviewOptions.IfrxPreviewOptions_Set_OutlineVisible(Value: WordBool): HResult; stdcall; begin FOutlineVisible := Value; Result := S_OK; end; function TfrxPreviewOptions.IfrxPreviewOptions_Get_OutlineWidth(out Value: SYSINT): HResult; stdcall; begin Value := FOutlineWidth; Result := S_OK; end; function TfrxPreviewOptions.IfrxPreviewOptions_Set_OutlineWidth(Value: SYSINT): HResult; stdcall; begin FOutlineWidth := Value; Result := S_OK; end; function TfrxPreviewOptions.IfrxPreviewOptions_Get_ShowCaptions(out Value: WordBool): HResult; stdcall; begin Value := FShowCaptions; Result := S_OK; end; function TfrxPreviewOptions.IfrxPreviewOptions_Set_ShowCaptions(Value: WordBool): HResult; stdcall; begin FShowCaptions := Value; Result := S_OK; end; function TfrxPreviewOptions.IfrxPreviewOptions_Get_Zoom(out Value: Double): HResult; stdcall; begin Value := FZoom; Result := S_OK; end; function TfrxPreviewOptions.IfrxPreviewOptions_Set_Zoom(Value: Double): HResult; stdcall; begin FZoom := Value; Result := S_OK; end; function TfrxPreviewOptions.IfrxPreviewOptions_Get_ZoomMode(out Value: frxZoomMode): HResult; stdcall; begin Value := frxZoomMode(FZoomMode); Result := S_OK; end; function TfrxPreviewOptions.IfrxPreviewOptions_Set_ZoomMode(Value: frxZoomMode): HResult; stdcall; begin FZoomMode := TfrxZoomMode(Value); Result := S_OK; end; {$ENDIF} { TfrxPrintOptions } constructor TfrxPrintOptions.Create; begin {$IFDEF FR_COM} inherited Create(IfrxPrintOptions); {$ENDIF} Clear; end; {$IFDEF FR_COM} destructor TfrxPrintOptions.Destroy; begin inherited Destroy; end; {$ENDIF} procedure TfrxPrintOptions.Assign(Source: TPersistent); begin if Source is TfrxPrintOptions then begin FCopies := TfrxPrintOptions(Source).Copies; FCollate := TfrxPrintOptions(Source).Collate; FPageNumbers := TfrxPrintOptions(Source).PageNumbers; FPrinter := TfrxPrintOptions(Source).Printer; FPrintMode := TfrxPrintOptions(Source).PrintMode; FPrintOnSheet := TfrxPrintOptions(Source).PrintOnSheet; FPrintPages := TfrxPrintOptions(Source).PrintPages; FReverse := TfrxPrintOptions(Source).Reverse; FShowDialog := TfrxPrintOptions(Source).ShowDialog; end; end; procedure TfrxPrintOptions.Clear; begin FCopies := 1; FCollate := True; FPageNumbers := ''; FPagesOnSheet := 0; FPrinter := frxResources.Get('prDefault'); FPrintMode := pmDefault; FPrintOnSheet := 0; FPrintPages := ppAll; FReverse := False; FShowDialog := True; end; {$IFDEF FR_COM} function TfrxPrintOptions.IfrxPrintOptions_Get_Copies(out Value: SYSINT): HResult; stdcall; begin Value := Copies; Result := S_OK; end; function TfrxPrintOptions.IfrxPrintOptions_Set_Copies(Value: SYSINT): HResult; stdcall; begin Copies := Value; Result := S_OK; end; function TfrxPrintOptions.IfrxPrintOptions_Get_Collate(out Value: WordBool): HResult; stdcall; begin Value := Collate; Result := S_OK; end; function TfrxPrintOptions.IfrxPrintOptions_Set_Collate(Value: WordBool): HResult; stdcall; begin Collate := Value; Result := S_OK; end; function TfrxPrintOptions.IfrxPrintOptions_Get_PageNumbers(out Value: WideString): HResult; stdcall; begin Value := PageNumbers; Result := S_OK; end; function TfrxPrintOptions.IfrxPrintOptions_Set_PageNumbers(const Value: WideString): HResult; stdcall; begin PageNumbers := Value; Result := S_OK; end; function TfrxPrintOptions.IfrxPrintOptions_Get_Printer(out Value: WideString): HResult; stdcall; begin Value := Printer; Result := S_OK; end; function TfrxPrintOptions.IfrxPrintOptions_Set_Printer(const Value: WideString): HResult; stdcall; begin Printer := Value; Result := S_OK; end; function TfrxPrintOptions.IfrxPrintOptions_Get_PrintPages(out Value: frxPrintPages): HResult; stdcall; begin Value := frxPrintPages(PrintPages); Result := S_OK; end; function TfrxPrintOptions.IfrxPrintOptions_Set_PrintPages(Value: frxPrintPages): HResult; stdcall; begin PrintPages := TfrxPrintPages(Value); Result := S_OK; end; function TfrxPrintOptions.IfrxPrintOptions_Get_Reverse(out Value: WordBool): HResult; stdcall; begin Value := Reverse; Result := S_OK; end; function TfrxPrintOptions.IfrxPrintOptions_Set_Reverse(Value: WordBool): HResult; stdcall; begin Reverse := Value; Result := S_OK; end; function TfrxPrintOptions.IfrxPrintOptions_Get_ShowDialog(out Value: WordBool): HResult; stdcall; begin Value := ShowDialog; Result := S_OK; end; function TfrxPrintOptions.IfrxPrintOptions_Set_ShowDialog(Value: WordBool): HResult; stdcall; begin ShowDialog := Value; Result := S_OK; end; {$ENDIF} { TfrxReportOptions } constructor TfrxReportOptions.Create; begin FDescription := TStringList.Create; FPicture := TPicture.Create; FCreateDate := Now; FLastChange := Now; FPrevPassword := ''; FInfo := False; {$IFDEF FR_COM} inherited Create(IfrxReportOptions); {$ENDIF} end; destructor TfrxReportOptions.Destroy; begin FDescription.Free; FPicture.Free; inherited; end; procedure TfrxReportOptions.Assign(Source: TPersistent); begin if Source is TfrxReportOptions then begin FAuthor := TfrxReportOptions(Source).Author; FCompressed := TfrxReportOptions(Source).Compressed; FConnectionName := TfrxReportOptions(Source).ConnectionName; FCreateDate := TfrxReportOptions(Source).CreateDate; Description := TfrxReportOptions(Source).Description; FInitString := TfrxReportOptions(Source).InitString; FLastChange := TfrxReportOptions(Source).LastChange; FName := TfrxReportOptions(Source).Name; FPassword := TfrxReportOptions(Source).Password; Picture := TfrxReportOptions(Source).Picture; FVersionBuild := TfrxReportOptions(Source).VersionBuild; FVersionMajor := TfrxReportOptions(Source).VersionMajor; FVersionMinor := TfrxReportOptions(Source).VersionMinor; FVersionRelease := TfrxReportOptions(Source).VersionRelease; end; end; procedure TfrxReportOptions.Clear; begin if not FInfo then begin FAuthor := ''; FCompressed := False; FCreateDate := Now; FDescription.Clear; FLastChange := Now; FPicture.Assign(nil); FVersionBuild := ''; FVersionMajor := ''; FVersionMinor := ''; FVersionRelease := ''; end; FConnectionName := ''; FInitString := ''; FName := ''; FPassword := ''; FPrevPassword := ''; end; procedure TfrxReportOptions.SetDescription(const Value: TStrings); begin FDescription.Assign(Value); end; procedure TfrxReportOptions.SetPicture(const Value: TPicture); begin FPicture.Assign(Value); end; function TfrxReportOptions.CheckPassword: Boolean; begin Result := True; if (FPassword <> '') and (FPassword <> FPrevPassword) then with TfrxPasswordForm.Create(Application) do begin if (ShowModal <> mrOk) or (FPassword <> PasswordE.Text) then Result := False else FPrevPassword := FPassword; Free; end; end; procedure TfrxReportOptions.SetConnectionName(const Value: String); var ini: TRegistry; conn: String; begin FConnectionName := Value; if Value <> '' then if Assigned(FReport.OnSetConnection) then begin ini := TRegistry.Create; try ini.RootKey := HKEY_LOCAL_MACHINE; if ini.OpenKeyReadOnly(DEF_REG_CONNECTIONS) then begin conn := ini.ReadString(Value); if conn <> '' then FReport.OnSetConnection( conn ); ini.CloseKey; end; ini.RootKey := HKEY_CURRENT_USER; if ini.OpenKeyReadOnly(DEF_REG_CONNECTIONS) then begin conn := ini.ReadString(Value); if conn <> '' then FReport.OnSetConnection(conn); ini.CloseKey; end; finally ini.Free; end; end; end; {$IFDEF FR_COM} function TfrxReportOptions.IfrxReportOptions_Get_Author(out Value: WideString): HResult; stdcall; begin Value := FAuthor; Result := S_OK; end; function TfrxReportOptions.IfrxReportOptions_Set_Author(const Value: WideString): HResult; stdcall; begin FAuthor := Value; Result := S_OK; end; function TfrxReportOptions.IfrxReportOptions_Get_Compressed(out Value: WordBool): HResult; stdcall; begin Value := FCompressed; Result := S_OK; end; function TfrxReportOptions.IfrxReportOptions_Set_Compressed(Value: WordBool): HResult; stdcall; begin FCompressed := Value; Result := S_OK; end; function TfrxReportOptions.IfrxReportOptions_Get_ConnectionName(out Value: WideString): HResult; stdcall; begin Value := ConnectionName; Result := S_OK; end; function TfrxReportOptions.IfrxReportOptions_Set_ConnectionName(const Value: WideString): HResult; stdcall; begin ConnectionName := Value; Result := S_OK; end; function TfrxReportOptions.IfrxReportOptions_Get_CreationDate(out Value: TDateTime): HResult; stdcall; begin Value := FCreateDate; Result := S_OK; end; function TfrxReportOptions.IfrxReportOptions_Set_CreationDate(Value: TDateTime): HResult; stdcall; begin FCreateDate := Value; Result := S_OK; end; function TfrxReportOptions.IfrxReportOptions_Get_Description(out Value: WideString): HResult; stdcall; begin Value := FDescription.GetText; Result := S_OK; end; function TfrxReportOptions.IfrxReportOptions_Set_Description(const Value: WideString): HResult; stdcall; begin FDescription.SetText(PAnsiChar(String(Value))); Result := S_OK; end; function TfrxReportOptions.IfrxReportOptions_Get_InitString(out Value: WideString): HResult; stdcall; begin Value := FInitString; Result := S_OK; end; function TfrxReportOptions.IfrxReportOptions_Set_InitString(const Value: WideString): HResult; stdcall; begin FInitString := Value; Result := S_OK; end; function TfrxReportOptions.IfrxReportOptions_Get_Name(out Value: WideString): HResult; stdcall; begin Value := FName; Result := S_OK; end; function TfrxReportOptions.IfrxReportOptions_Set_Name(const Value: WideString): HResult; stdcall; begin FName := Value; Result := S_OK; end; function TfrxReportOptions.IfrxReportOptions_Get_LastChange(out Value: TDateTime): HResult; stdcall; begin Value := FLastChange; Result := S_OK; end; function TfrxReportOptions.IfrxReportOptions_Set_LastChange(Value: TDateTime): HResult; stdcall; begin FLastChange := Value; Result := S_OK; end; function TfrxReportOptions.IfrxReportOptions_Get_Password(out Value: WideString): HResult; stdcall; begin Value := FPassword; Result := S_OK; end; function TfrxReportOptions.IfrxReportOptions_Set_Password(const Value: WideString): HResult; stdcall; begin FPassword := Value; Result := S_OK; end; function TfrxReportOptions.IfrxReportOptions_Get_Picture(out Value: IUnknown): HResult; stdcall; begin Result := E_NOTIMPL; end; function TfrxReportOptions.IfrxReportOptions_Set_Picture(const Value: IUnknown): HResult; stdcall; begin Result := E_NOTIMPL; end; function TfrxReportOptions.IfrxReportOptions_Get_VersionBuild(out Value: WideString): HResult; stdcall; begin Value := FVersionBuild; Result := S_OK; end; function TfrxReportOptions.IfrxReportOptions_Set_VersionBuild(const Value: WideString): HResult; stdcall; begin FVersionBuild := Value; Result := S_OK; end; function TfrxReportOptions.IfrxReportOptions_Get_VersionMajor(out Value: WideString): HResult; stdcall; begin Value := FVersionMajor; Result := S_OK; end; function TfrxReportOptions.IfrxReportOptions_Set_VersionMajor(const Value: WideString): HResult; stdcall; begin FVersionMajor := Value; Result := S_OK; end; function TfrxReportOptions.IfrxReportOptions_Get_VersionMinor(out Value: WideString): HResult; stdcall; begin Value := FVersionMinor; Result := S_OK; end; function TfrxReportOptions.IfrxReportOptions_Set_VersionMinor(const Value: WideString): HResult; stdcall; begin FVersionMinor := Value; Result := S_OK; end; function TfrxReportOptions.IfrxReportOptions_Get_VersionRelease(out Value: WideString): HResult; stdcall; begin Value := FVersionRelease; Result := S_OK; end; function TfrxReportOptions.IfrxReportOptions_Set_VersionRelease(const Value: WideString): HResult; stdcall; begin FVersionRelease := Value; Result := S_OK; end; {$ENDIF} { TfrxDataSetItem } procedure TfrxDataSetItem.SetDataSet(const Value: TfrxDataSet); begin FDataSet := Value; if FDataSet = nil then FDataSetName := '' else FDataSetName := FDataSet.UserName; end; procedure TfrxDataSetItem.SetDataSetName(const Value: String); begin FDataSetName := Value; FDataSet := frxFindDataSet(FDataSet, FDataSetName, TfrxReportDataSets(Collection).FReport); end; function TfrxDataSetItem.GetDataSetName: String; begin if FDataSet = nil then Result := FDataSetName else Result := FDataSet.UserName; end; { TfrxReportDatasets } constructor TfrxReportDatasets.Create(AReport: TfrxReport); begin inherited Create(TfrxDatasetItem); FReport := AReport; end; procedure TfrxReportDataSets.Initialize; var i: Integer; begin for i := 0 to Count - 1 do if Items[i].DataSet <> nil then begin Items[i].DataSet.ReportRef := FReport; Items[i].DataSet.Initialize; end; end; procedure TfrxReportDataSets.Finalize; var i: Integer; begin for i := 0 to Count - 1 do if Items[i].DataSet <> nil then Items[i].DataSet.Finalize; end; procedure TfrxReportDatasets.Add(ds: TfrxDataSet); begin TfrxDatasetItem(inherited Add).DataSet := ds; end; function TfrxReportDatasets.GetItem(Index: Integer): TfrxDatasetItem; begin Result := TfrxDatasetItem(inherited Items[Index]); end; function TfrxReportDatasets.Find(ds: TfrxDataSet): TfrxDatasetItem; var i: Integer; begin Result := nil; for i := 0 to Count - 1 do if Items[i].DataSet = ds then begin Result := Items[i]; Exit; end; end; function TfrxReportDatasets.Find(const Name: String): TfrxDatasetItem; var i: Integer; begin Result := nil; for i := 0 to Count - 1 do if Items[i].DataSet <> nil then if CompareText(Items[i].DataSet.UserName, Name) = 0 then begin Result := Items[i]; Exit; end; end; procedure TfrxReportDatasets.Delete(const Name: String); var i: Integer; begin for i := 0 to Count - 1 do if Items[i].DataSet <> nil then if CompareText(Items[i].DataSet.UserName, Name) = 0 then begin Items[i].Free; Exit; end; end; { TfrxStyleItem } constructor TfrxStyleItem.Create(Collection: TCollection); begin inherited; FColor := clNone; FFont := TFont.Create; with FFont do begin Name := DefFontName; Size := DefFontSize; Charset := frxCharset; end; FFrame := TfrxFrame.Create; end; destructor TfrxStyleItem.Destroy; begin FFont.Free; FFrame.Free; inherited; end; procedure TfrxStyleItem.Assign(Source: TPersistent); begin if Source is TfrxStyleItem then begin FName := TfrxStyleItem(Source).Name; FColor := TfrxStyleItem(Source).Color; FFont.Assign(TfrxStyleItem(Source).Font); FFrame.Assign(TfrxStyleItem(Source).Frame); end; end; procedure TfrxStyleItem.SetFont(const Value: TFont); begin FFont.Assign(Value); end; procedure TfrxStyleItem.SetFrame(const Value: TfrxFrame); begin FFrame.Assign(Value); end; procedure TfrxStyleItem.SetName(const Value: String); var Item: TfrxStyleItem; begin Item := TfrxStyles(Collection).Find(Value); if (Item = nil) or (Item = Self) then FName := Value else raise Exception.Create('Duplicate name'); end; procedure TfrxStyleItem.CreateUniqueName; var i: Integer; begin i := 1; while TfrxStyles(Collection).Find('Style' + IntToStr(i)) <> nil do Inc(i); Name := 'Style' + IntToStr(i); end; { TfrxStyles } constructor TfrxStyles.Create(AReport: TfrxReport); begin inherited Create(TfrxStyleItem); FReport := AReport; end; function TfrxStyles.Add: TfrxStyleItem; begin Result := TfrxStyleItem(inherited Add); end; function TfrxStyles.Find(const Name: String): TfrxStyleItem; var i: Integer; begin Result := nil; for i := 0 to Count - 1 do if AnsiCompareText(Items[i].Name, Name) = 0 then begin Result := Items[i]; break; end; end; function TfrxStyles.GetItem(Index: Integer): TfrxStyleItem; begin Result := TfrxStyleItem(inherited Items[Index]); end; procedure TfrxStyles.GetList(List: TStrings); var i: Integer; begin List.Clear; for i := 0 to Count - 1 do List.Add(Items[i].Name); end; procedure TfrxStyles.LoadFromXMLItem(Item: TfrxXMLItem); var xs: TfrxXMLSerializer; i: Integer; begin Clear; xs := TfrxXMLSerializer.Create(nil); try Name := Item.Prop['Name']; for i := 0 to Item.Count - 1 do if CompareText(Item[i].Name, 'item') = 0 then xs.XMLToObj(Item[i].Text, Add); finally xs.Free; end; Apply; end; procedure TfrxStyles.SaveToXMLItem(Item: TfrxXMLItem); var xi: TfrxXMLItem; xs: TfrxXMLSerializer; i: Integer; begin xs := TfrxXMLSerializer.Create(nil); try Item.Name := 'style'; Item.Prop['Name'] := Name; for i := 0 to Count - 1 do begin xi := Item.Add; xi.Name := 'item'; xi.Text := xs.ObjToXML(Items[i]); end; finally xs.Free; end; end; procedure TfrxStyles.LoadFromFile(const FileName: String); var f: TFileStream; begin f := TFileStream.Create(FileName, fmOpenRead); try LoadFromStream(f); finally f.Free; end; end; procedure TfrxStyles.LoadFromStream(Stream: TStream); var x: TfrxXMLDocument; begin Clear; x := TfrxXMLDocument.Create; try x.LoadFromStream(Stream); if CompareText(x.Root.Name, 'style') = 0 then LoadFromXMLItem(x.Root); finally x.Free; end; end; procedure TfrxStyles.SaveToFile(const FileName: String); var f: TFileStream; begin f := TFileStream.Create(FileName, fmCreate); try SaveToStream(f); finally f.Free; end; end; procedure TfrxStyles.SaveToStream(Stream: TStream); var x: TfrxXMLDocument; begin x := TfrxXMLDocument.Create; x.AutoIndent := True; try x.Root.Name := 'style'; SaveToXMLItem(x.Root); x.SaveToStream(Stream); finally x.Free; end; end; procedure TfrxStyles.Apply; var i: Integer; l: TList; begin if FReport <> nil then begin l := FReport.AllObjects; for i := 0 to l.Count - 1 do if TObject(l[i]) is TfrxCustomMemoView then if Find(TfrxCustomMemoView(l[i]).Style) = nil then TfrxCustomMemoView(l[i]).Style := '' else TfrxCustomMemoView(l[i]).Style := TfrxCustomMemoView(l[i]).Style; end; end; { TfrxStyleSheet } constructor TfrxStyleSheet.Create; begin FItems := TList.Create; end; destructor TfrxStyleSheet.Destroy; begin Clear; FItems.Free; inherited; end; procedure TfrxStyleSheet.Clear; begin while Count > 0 do Delete(0); end; procedure TfrxStyleSheet.Delete(Index: Integer); begin Items[Index].Free; FItems.Delete(Index); end; function TfrxStyleSheet.Add: TfrxStyles; begin Result := TfrxStyles.Create(nil); FItems.Add(Result); end; function TfrxStyleSheet.Count: Integer; begin Result := FItems.Count; end; function TfrxStyleSheet.GetItems(Index: Integer): TfrxStyles; begin Result := FItems[Index]; end; function TfrxStyleSheet.Find(const Name: String): TfrxStyles; var i: Integer; begin Result := nil; for i := 0 to Count - 1 do if AnsiCompareText(Items[i].Name, Name) = 0 then begin Result := Items[i]; break; end; end; function TfrxStyleSheet.IndexOf(const Name: String): Integer; var i: Integer; begin Result := -1; for i := 0 to Count - 1 do if AnsiCompareText(Items[i].Name, Name) = 0 then begin Result := i; break; end; end; procedure TfrxStyleSheet.GetList(List: TStrings); var i: Integer; begin List.Clear; for i := 0 to Count - 1 do List.Add(Items[i].Name); end; procedure TfrxStyleSheet.LoadFromFile(const FileName: String); var f: TFileStream; begin f := TFileStream.Create(FileName, fmOpenRead); try LoadFromStream(f); finally f.Free; end; end; procedure TfrxStyleSheet.LoadFromStream(Stream: TStream); var x: TfrxXMLDocument; i: Integer; begin Clear; x := TfrxXMLDocument.Create; try x.LoadFromStream(Stream); if CompareText(x.Root.Name, 'stylesheet') = 0 then for i := 0 to x.Root.Count - 1 do if CompareText(x.Root[i].Name, 'style') = 0 then Add.LoadFromXMLItem(x.Root[i]); finally x.Free; end; end; procedure TfrxStyleSheet.SaveToFile(const FileName: String); var f: TFileStream; begin f := TFileStream.Create(FileName, fmCreate); try SaveToStream(f); finally f.Free; end; end; procedure TfrxStyleSheet.SaveToStream(Stream: TStream); var x: TfrxXMLDocument; i: Integer; begin x := TfrxXMLDocument.Create; x.AutoIndent := True; try x.Root.Name := 'stylesheet'; for i := 0 to Count - 1 do Items[i].SaveToXMLItem(x.Root.Add); x.SaveToStream(Stream); finally x.Free; end; end; { TfrxReport } constructor TfrxReport.Create(AOwner: TComponent); begin inherited; FVersion := FR_VERSION; FDatasets := TfrxReportDatasets.Create(Self); FVariables := TfrxVariables.Create; FScript := TfsScript.Create(nil); FScript.ExtendedCharset := True; FScript.AddRTTI; FTimer := TTimer.Create(nil); FTimer.Interval := 50; FTimer.Enabled := False; FTimer.OnTimer := OnTimer; FEngineOptions := TfrxEngineOptions.Create; FPreviewOptions := TfrxPreviewOptions.Create; FPrintOptions := TfrxPrintOptions.Create; FReportOptions := TfrxReportOptions.Create(Self); FReportOptions.FReport := Self; FIniFile := '\Software\Fast Reports'; FScriptText := TStringList.Create; FExpressionCache := TfrxExpressionCache.Create(FScript); FErrors := TStringList.Create; TStringList(FErrors).Sorted := True; TStringList(FErrors).Duplicates := dupIgnore; FStyles := TfrxStyles.Create(Self); FSysVariables := TStringList.Create; FEnabledDataSets := TfrxReportDataSets.Create(Self); FShowProgress := True; FStoreInDFM := True; FEngine := TfrxEngine.Create(Self); FPreviewPages := TfrxPreviewPages.Create(Self); FEngine.FPreviewPages := FPreviewPages; FPreviewPages.FEngine := FEngine; FDrawText := TfrxDrawText.Create; FDrillState := TStringList.Create; Clear; {$IFDEF FR_COM} FUseDispatchableEvents := False; EngineOptions.DestroyForms := False; Name := 'Report'; if not Assigned(frxDefaultConnection) then begin frxDefaultConnection := TADOConnection.Create(nil); frxDefaultConnection.Name := 'DefaultConnection'; frxDefaultConnection.LoginPrompt := False; end; if not Assigned(frxADOComponent) then begin frxADOComponent := TfrxADOComponents.Create(nil); frxADOComponent.DefaultDatabase := frxDefaultConnection; end; OnSetConnection := OnSetConnectionHandler; OnEditConnection := OnEditConnectionHandler; OnAfterPrint := OnAfterPrintHandler; OnBeforePrint := OnBeforePrintHandler; OnClickObject := OnClickObjectHandler; OnUserFunction := OnUserFunctionHandler; OnBeginDoc := OnBeginDocHandler; OnEndDoc := OnEndDocHandler; OnPrintReport := OnPrintReportHandler; OnAfterPrintReport := OnAfterPrintReportHandler; OnBeforeConnect := OnBeforeConnectHandler; OnProgress := OnProgressHandler; OnProgressStart := OnProgressStartHandler; OnProgressStop := OnProgressStopHandler; // Engine.OnRunDialog := OnRunDialogsEvent; FConnectionPoints := TConnectionPoints.Create(Self); FConnectionPoint := FConnectionPoints.CreateConnectionPoint( IfrxReportEventDispatcher, ckMulti, nil ); FEvent := nil; FConnectionPoints.CreateConnectionPoint( IfrxReportEvents, ckSingle, EventSinkChanged ); {$ENDIF} end; destructor TfrxReport.Destroy; begin inherited; Preview := nil; FDatasets.Free; FEngineOptions.Free; FPreviewOptions.Free; FPrintOptions.Free; FReportOptions.Free; FExpressionCache.Free; FScript.Free; FScriptText.Free; FVariables.Free; FEngine.Free; FPreviewPages.Free; FErrors.Free; FStyles.Free; FSysVariables.Free; FEnabledDataSets.Free; FTimer.Free; TObject(FDrawText).Free; FDrillState.Free; if FParentForm <> nil then FParentForm.Free; {$IFDEF FR_COM} FConnectionPoint.Free; FConnectionPoints.Free; {$ENDIF} end; class function TfrxReport.GetDescription: String; begin Result := frxResources.Get('obReport'); end; procedure TfrxReport.DoClear; begin inherited Clear; FDataSets.Clear; FVariables.Clear; FEngineOptions.Clear; FPreviewOptions.Clear; FPrintOptions.Clear; FReportOptions.Clear; FStyles.Clear; FDataSet := nil; FDataSetName := ''; FDotMatrixReport := False; ParentReport := ''; FScriptLanguage := 'PascalScript'; with FScriptText do begin Clear; Add('begin'); Add(''); Add('end.'); end; with FSysVariables do begin Clear; Add('Date'); Add('Time'); Add('Page'); Add('Page#'); Add('TotalPages'); Add('TotalPages#'); Add('Line'); Add('Line#'); Add('CopyName#'); end; FOnRunDialogs := ''; FOnStartReport := ''; FOnStopReport := ''; end; procedure TfrxReport.Clear; begin {$IFNDEF FR_COM} // if FEngineOptions.ReportThread <> nil then // THackThread(FEngineOptions.ReportThread).Synchronize(DoClear) else {$ENDIF} DoClear; end; procedure TfrxReport.Notification(AComponent: TComponent; Operation: TOperation); begin inherited; if Operation = opRemove then if AComponent is TfrxDataSet then begin if FDataSets.Find(TfrxDataSet(AComponent)) <> nil then FDataSets.Find(TfrxDataSet(AComponent)).Free; if FDataset = AComponent then FDataset := nil; if Designer <> nil then Designer.UpdateDataTree; end else if AComponent is TfrxCustomPreview then if FPreview = AComponent then FPreview := nil; end; procedure TfrxReport.AncestorNotFound(Reader: TReader; const ComponentName: string; ComponentClass: TPersistentClass; var Component: TComponent); begin Component := FindObject(ComponentName); end; procedure TfrxReport.DefineProperties(Filer: TFiler); begin inherited; if (csWriting in ComponentState) and not FStoreInDFM then Exit; Filer.DefineProperty('Datasets', ReadDatasets, WriteDatasets, True); Filer.DefineProperty('Variables', ReadVariables, WriteVariables, True); Filer.DefineProperty('Style', ReadStyle, WriteStyle, True); if Filer is TReader then TReader(Filer).OnAncestorNotFound := AncestorNotFound; end; procedure TfrxReport.ReadDatasets(Reader: TReader); begin frxReadCollection(FDatasets, Reader, Self); end; procedure TfrxReport.ReadStyle(Reader: TReader); begin frxReadCollection(FStyles, Reader, Self); end; procedure TfrxReport.ReadVariables(Reader: TReader); begin frxReadCollection(FVariables, Reader, Self); end; procedure TfrxReport.WriteDatasets(Writer: TWriter); begin frxWriteCollection(FDatasets, Writer, Self); end; procedure TfrxReport.WriteStyle(Writer: TWriter); begin frxWriteCollection(FStyles, Writer, Self); end; procedure TfrxReport.WriteVariables(Writer: TWriter); begin frxWriteCollection(FVariables, Writer, Self); end; function TfrxReport.GetPages(Index: Integer): TfrxPage; begin Result := TfrxPage(Objects[Index]); end; function TfrxReport.GetPagesCount: Integer; begin Result := Objects.Count; end; procedure TfrxReport.SetScriptText(const Value: TStrings); begin FScriptText.Assign(Value); end; procedure TfrxReport.SetEngineOptions(const Value: TfrxEngineOptions); begin FEngineOptions.Assign(Value); end; procedure TfrxReport.SetParentReport(const Value: String); var i: Integer; list: TList; c: TfrxComponent; fName, SaveFileName: String; SaveXMLSerializer: TObject; begin FParentReport := Value; if FParentReportObject <> nil then begin FParentReportObject.Free; FParentReportObject := nil; end; if Value = '' then begin list := AllObjects; for i := 0 to list.Count - 1 do begin c := list[i]; c.FAncestor := False; end; FAncestor := False; Exit; end; SaveFileName := FFileName; SaveXMLSerializer := FXMLSerializer; if Assigned(FOnLoadTemplate) then FOnLoadTemplate(Self, Value) else begin fName := Value; { check relative path } if (Length(fName) > 1) and (fName[2] <> ':') then fName := GetApplicationFolder + Value; LoadFromFile(fName); end; FFileName := SaveFileName; FParentReportObject := TfrxReport.Create(nil); FParentReportObject.AssignAll(Self); { set ancestor flag for parent objects } list := AllObjects; for i := 0 to list.Count - 1 do begin c := list[i]; c.FAncestor := True; end; FAncestor := True; FParentReport := Value; FXMLSerializer := SaveXMLSerializer; end; function TfrxReport.InheritFromTemplate(const templName: String): Boolean; var tempReport: TfrxReport; i: Integer; l: TList; c: TfrxComponent; found, DeleteDuplicates: Boolean; saveScript: String; procedure EnumObjects(ToParent, FromParent: TfrxComponent); var xs: TfrxXMLSerializer; s: String; i: Integer; cFrom, cTo: TfrxComponent; begin xs := TfrxXMLSerializer.Create(nil); { don't serialize ParentReport property! } xs.SerializeDefaultValues := not (ToParent is TfrxReport); s := xs.ObjToXML(FromParent); xs.XMLToObj(s, ToParent); xs.Free; for i := 0 to FromParent.Objects.Count - 1 do begin cFrom := FromParent.Objects[i]; cTo := ToParent.Report.FindObject(cFrom.Name); if (cTo <> nil) and not (cTo is TfrxPage) then begin { skip duplicate object } if DeleteDuplicates then continue; { set empty name for duplicate object, rename later } cFrom.Name := ''; cTo := nil; end; if cTo = nil then begin cTo := TfrxComponent(cFrom.NewInstance); cTo.Create(ToParent); cTo.Name := cFrom.Name; end; EnumObjects(cTo, cFrom); end; end; begin Result := True; tempReport := TfrxReport.Create(nil); tempReport.AssignAll(Self); { load the template } ParentReport := ExtractRelativePath(GetApplicationFolder, templName); { find duplicate objects } found := False; l := tempReport.AllObjects; for i := 0 to l.Count - 1 do begin c := l[i]; if not (c is TfrxPage) and (FindObject(c.Name) <> nil) then begin found := True; break; end; end; deleteDuplicates := False; if found then begin with TfrxInheritErrorForm.Create(nil) do begin Result := ShowModal = mrOk; if Result then deleteDuplicates := DeleteRB.Checked; Free; end; end; if Result then begin saveScript := ScriptText.Text; EnumObjects(Self, tempReport); ScriptText.Text := saveScript; { create unique names for duplicates } l := AllObjects; for i := 0 to l.Count - 1 do begin c := l[i]; if not (c is TfrxPage) and (c.Name = '') then c.CreateUniqueName; end; end else AssignAll(tempReport); tempReport.Free; end; procedure TfrxReport.SetPreviewOptions(const Value: TfrxPreviewOptions); begin FPreviewOptions.Assign(Value); end; procedure TfrxReport.SetPrintOptions(const Value: TfrxPrintOptions); begin FPrintOptions.Assign(Value); end; procedure TfrxReport.SetReportOptions(const Value: TfrxReportOptions); begin FReportOptions.Assign(Value); end; procedure TfrxReport.SetStyles(const Value: TfrxStyles); begin if Value <> nil then begin FStyles.Assign(Value); FStyles.Apply; end else FStyles.Clear; end; procedure TfrxReport.SetDataSet(const Value: TfrxDataSet); begin FDataSet := Value; if FDataSet = nil then FDataSetName := '' else FDataSetName := FDataSet.UserName; end; procedure TfrxReport.SetDataSetName(const Value: String); begin FDataSetName := Value; FDataSet := frxFindDataSet(FDataSet, FDataSetName, Report); end; function TfrxReport.GetDataSetName: String; begin if FDataSet = nil then Result := FDataSetName else Result := FDataSet.UserName; end; function TfrxReport.Calc(const Expr: String; AScript: TfsScript = nil): Variant; var ErrorMsg: String; begin if AScript = nil then AScript := FScript; if not DoGetValue(Expr, Result) then begin Result := FExpressionCache.Calc(Expr, ErrorMsg, AScript); if ErrorMsg <> '' then begin if FCurObject <> '' then ErrorMsg := FCurObject + ': ' + ErrorMsg; FErrors.Add(ErrorMsg); raise Exception.Create(ErrorMsg); end; end; end; function TfrxReport.GetAlias(DataSet: TfrxDataSet): String; var ds: TfrxDataSetItem; begin if DataSet = nil then begin Result := ''; Exit; end; ds := DataSets.Find(DataSet); if ds <> nil then Result := ds.DataSet.UserName else Result := frxResources.Get('clDSNotIncl'); end; function TfrxReport.GetDataset(const Alias: String): TfrxDataset; var ds: TfrxDataSetItem; begin ds := DataSets.Find(Alias); if ds <> nil then Result := ds.DataSet else Result := nil; end; procedure TfrxReport.GetDatasetAndField(const ComplexName: String; var DataSet: TfrxDataSet; var Field: String); var i: Integer; s: String; begin DataSet := nil; Field := ''; { ComplexName has format: dataset name."field name" Spaces are allowed in both parts of the complex name } i := Pos('."', ComplexName); if i <> 0 then begin s := Copy(ComplexName, 1, i - 1); { dataset name } DataSet := GetDataSet(s); Field := Copy(ComplexName, i + 2, Length(ComplexName) - i - 2); end; end; procedure TfrxReport.GetDataSetList(List: TStrings; OnlyDB: Boolean = False); var i: Integer; begin List.Clear; for i := 0 to DataSets.Count - 1 do if Datasets[i].DataSet <> nil then if not OnlyDB or not (DataSets[i].DataSet is TfrxUserDataSet) then List.AddObject(DataSets[i].DataSet.UserName, DataSets[i].DataSet); end; procedure TfrxReport.DoLoadFromStream; var SaveLeftTop: Longint; Loaded: Boolean; begin SaveLeftTop := DesignInfo; Loaded := False; if Assigned(frxFR2Events.OnLoad) then Loaded := frxFR2Events.OnLoad(Self, FLoadStream); if not Loaded then inherited LoadFromStream(FLoadStream); DesignInfo := SaveLeftTop; end; procedure TfrxReport.CheckDataPage; var i, x: Integer; l: TList; hasDataPage, hasDataObjects: Boolean; p: TfrxDataPage; c: TfrxComponent; begin { check if report has datapage and datacomponents } hasDataPage := False; hasDataObjects := False; l := AllObjects; for i := 0 to l.Count - 1 do begin c := l[i]; if c is TfrxDataPage then hasDataPage := True; if c is TfrxDialogComponent then hasDataObjects := True; end; if not hasDataPage then begin { create the datapage } p := TfrxDataPage.Create(Self); if FindObject('Data') = nil then p.Name := 'Data' else p.CreateUniqueName; { make it the first page } Objects.Delete(Objects.Count - 1); Objects.Insert(0, p); { move existing datacomponents to this page } if hasDataObjects then begin x := 60; for i := 0 to l.Count - 1 do begin c := l[i]; if c is TfrxDialogComponent then begin c.Parent := p; c.Left := x; c.Top := 20; Inc(x, 64); end; end; end; end; end; procedure TfrxReport.LoadFromStream(Stream: TStream); var Compressor: TfrxCustomCompressor; Crypter: TfrxCustomCrypter; SaveEngineOptions: TfrxEngineOptions; SavePreviewOptions: TfrxPreviewOptions; SaveConvertNulls: Boolean; SaveDoublePass: Boolean; SaveOutlineVisible, SaveOutlineExpand: Boolean; SaveOutlineWidth, SavePagesInCache: Integer; SaveIni: String; SavePreview: TfrxCustomPreview; SaveOldStyleProgress, SaveShowProgress, SaveStoreInDFM: Boolean; Crypted: Boolean; function DecodePwd(const s: String): String; var i: Integer; begin Result := ''; for i := 1 to Length(s) do Result := Result + Chr(Ord(s[i]) + 10); end; begin FErrors.Clear; Compressor := nil; if frxCompressorClass <> nil then begin Compressor := TfrxCustomCompressor(frxCompressorClass.NewInstance); Compressor.Create(nil); Compressor.Report := Self; Compressor.IsFR3File := True; try Compressor.CreateStream; if Compressor.Decompress(Stream) then Stream := Compressor.Stream; except Compressor.Free; FErrors.Add(frxResources.Get('clDecompressError')); frxCommonErrorHandler(Self, frxResources.Get('clErrors') + #13#10 + FErrors.Text); Exit; end; end; Crypter := nil; Crypted := False; if frxCrypterClass <> nil then begin Crypter := TfrxCustomCrypter(frxCrypterClass.NewInstance); Crypter.Create(nil); try Crypter.CreateStream; Crypted := Crypter.Decrypt(Stream, ReportOptions.Password); if Crypted then Stream := Crypter.Stream; except Crypter.Free; FErrors.Add(frxResources.Get('clDecryptError')); frxCommonErrorHandler(Self, frxResources.Get('clErrors') + #13#10 + FErrors.Text); Exit; end; end; SaveEngineOptions := TfrxEngineOptions.Create; SaveEngineOptions.Assign(FEngineOptions); SavePreviewOptions := TfrxPreviewOptions.Create; SavePreviewOptions.Assign(FPreviewOptions); SaveIni := FIniFile; SavePreview := FPreview; SaveOldStyleProgress := FOldStyleProgress; SaveShowProgress := FShowProgress; SaveStoreInDFM := FStoreInDFM; try FLoadStream := Stream; {$IFNDEF FR_COM} // if FEngineOptions.ReportThread <> nil then // THackThread(FEngineOptions.ReportThread).Synchronize(DoLoadFromStream) else {$ENDIF} try DoLoadFromStream; except on E: Exception do begin if (E is TfrxInvalidXMLException) and Crypted then FErrors.Add('Invalid password') else FErrors.Add(E.Message) end; end; finally if Compressor <> nil then Compressor.Free; if Crypter <> nil then Crypter.Free; CheckDataPage; SaveConvertNulls := FEngineOptions.ConvertNulls; SaveDoublePass := FEngineOptions.DoublePass; FEngineOptions.Assign(SaveEngineOptions); FEngineOptions.ConvertNulls := SaveConvertNulls; FEngineOptions.DoublePass := SaveDoublePass; SaveEngineOptions.Free; SaveOutlineVisible := FPreviewOptions.OutlineVisible; SaveOutlineWidth := FPreviewOptions.OutlineWidth; SaveOutlineExpand := FPreviewOptions.OutlineExpand; SavePagesInCache := FPreviewOptions.PagesInCache; FPreviewOptions.Assign(SavePreviewOptions); FPreviewOptions.OutlineVisible := SaveOutlineVisible; FPreviewOptions.OutlineWidth := SaveOutlineWidth; FPreviewOptions.OutlineExpand := SaveOutlineExpand; FPreviewOptions.PagesInCache := SavePagesInCache; SavePreviewOptions.Free; FIniFile := SaveIni; FPreview := SavePreview; FOldStyleProgress := SaveOldStyleProgress; FShowProgress := SaveShowProgress; FStoreInDFM := SaveStoreInDFM; if not Crypted then ReportOptions.Password := DecodePwd(ReportOptions.Password); if ReportOptions.Info or ((not FReloading) and {$IFNDEF FR_COM} (not FEngineOptions.EnableThreadSafe) and {$ENDIF} (not Crypted and not FReportOptions.CheckPassword)) then Clear else if (FErrors.Count > 0) then frxCommonErrorHandler(Self, frxResources.Get('clErrors') + #13#10 + FErrors.Text); end; end; procedure TfrxReport.SaveToStream(Stream: TStream; SaveChildren: Boolean = True; SaveDefaultValues: Boolean = False); var Compressor: TfrxCustomCompressor; Crypter: TfrxCustomCrypter; StreamTo: TStream; SavePwd: String; SavePreview: TfrxCustomPreview; function EncodePwd(const s: String): String; var i: Integer; begin Result := ''; for i := 1 to Length(s) do Result := Result + Chr(Ord(s[i]) - 10); end; begin StreamTo := Stream; Compressor := nil; if FReportOptions.Compressed and (frxCompressorClass <> nil) then begin Compressor := TfrxCustomCompressor(frxCompressorClass.NewInstance); Compressor.Create(nil); Compressor.Report := Self; Compressor.IsFR3File := True; Compressor.CreateStream; StreamTo := Compressor.Stream; end; Crypter := nil; if (FReportOptions.Password <> '') and (frxCrypterClass <> nil) then begin Crypter := TfrxCustomCrypter(frxCrypterClass.NewInstance); Crypter.Create(nil); Crypter.CreateStream; StreamTo := Crypter.Stream; end; SavePwd := ReportOptions.Password; ReportOptions.PrevPassword := SavePwd; if Crypter = nil then ReportOptions.Password := EncodePwd(SavePwd); SavePreview := FPreview; FPreview := nil; try inherited SaveToStream(StreamTo, SaveChildren, SaveDefaultValues); finally FPreview := SavePreview; ReportOptions.Password := SavePwd; { crypt } if Crypter <> nil then begin try if Compressor <> nil then Crypter.Crypt(Compressor.Stream, ReportOptions.Password) else Crypter.Crypt(Stream, ReportOptions.Password); finally Crypter.Free; end; end; { compress } if Compressor <> nil then begin try Compressor.Compress(Stream); finally Compressor.Free; end; end; end; end; function TfrxReport.LoadFromFile(const FileName: String; ExceptionIfNotFound: Boolean = False): Boolean; var f: TFileStream; begin Clear; FFileName := ''; Result := FileExists(FileName); if Result or ExceptionIfNotFound then begin f := TFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite); try LoadFromStream(f); FFileName := FileName; finally f.Free; end; end; end; procedure TfrxReport.SaveToFile(const FileName: String); var f: TFileStream; begin f := TFileStream.Create(FileName, fmCreate); try SaveToStream(f); finally f.Free; end; end; function TfrxReport.GetIniFile: TCustomIniFile; begin if Pos('\Software\', FIniFile) = 1 then Result := TRegistryIniFile.Create(FIniFile) else Result := TIniFile.Create(FIniFile); end; function TfrxReport.GetApplicationFolder: String; begin if csDesigning in ComponentState then Result := GetCurrentDir + '\' else Result := ExtractFilePath(Application.ExeName); end; procedure TfrxReport.SelectPrinter; begin if frxPrinters.IndexOf(FPrintOptions.Printer) <> -1 then frxPrinters.PrinterIndex := frxPrinters.IndexOf(FPrintOptions.Printer); end; procedure TfrxReport.DoNotifyEvent(Obj: TObject; const EventName: String; RunAlways: Boolean = False); begin {$IFNDEF FR_VER_BASIC} if FEngine.Running or RunAlways then if EventName <> '' then FScript.CallFunction(EventName, VarArrayOf([Integer(Obj)])); {$ENDIF} end; procedure TfrxReport.DoParamEvent(const EventName: String; var Params: Variant; RunAlways: Boolean = False); begin {$IFNDEF FR_VER_BASIC} if FEngine.Running or RunAlways then if EventName <> '' then FScript.CallFunction1(EventName, Params); {$ENDIF} end; procedure TfrxReport.DoBeforePrint(c: TfrxReportComponent); begin if Assigned(FOnBeforePrint) then FOnBeforePrint(c); DoNotifyEvent(c, c.OnBeforePrint); end; procedure TfrxReport.DoAfterPrint(c: TfrxReportComponent); begin if Assigned(FOnAfterPrint) then FOnAfterPrint(c); DoNotifyEvent(c, c.OnAfterPrint); end; procedure TfrxReport.DoPreviewClick(v: TfrxView; Button: TMouseButton; Shift: TShiftState; var Modified: Boolean); var arr: Variant; begin arr := VarArrayOf([Integer(v), Button, ShiftToByte(Shift), Modified]); DoParamEvent(v.OnPreviewClick, arr, True); Modified := arr[3]; if Assigned(FOnClickObject) then FOnClickObject(v, Button, Shift, Modified); end; procedure TfrxReport.DoGetAncestor(const Name: String; var Ancestor: TPersistent); begin if FParentReportObject <> nil then begin if Name = Self.Name then Ancestor := FParentReportObject else Ancestor := FParentReportObject.FindObject(Name); end; end; function TfrxReport.DoGetValue(const Expr: String; var Value: Variant): Boolean; var i: Integer; ds: TfrxDataSet; fld: String; val: Variant; v: TfsCustomVariable; begin Result := False; Value := Null; if Assigned(frxFR2Events.OnGetValue) then begin TVarData(val).VType := varEmpty; frxFR2Events.OnGetValue(Expr, val); if TVarData(val).VType <> varEmpty then begin Value := val; Result := True; Exit; end; end; { maybe it's a dataset/field? } GetDataSetAndField(Expr, ds, fld); if (ds <> nil) and (fld <> '') then begin Value := ds.Value[fld]; if FEngineOptions.ConvertNulls and (Value = Null) then case ds.FieldType[fld] of fftNumeric: Value := 0; fftString: Value := ''; fftBoolean: Value := False; end; Result := True; Exit; end; { searching in the sys variables } i := FSysVariables.IndexOf(Expr); if i <> -1 then begin case i of 0: Value := FEngine.StartDate; { Date } 1: Value := FEngine.StartTime; { Time } 2: Value := FPreviewPages.GetLogicalPageNo; { Page } 3: Value := FPreviewPages.CurPage + 1; { Page# } 4: Value := FPreviewPages.GetLogicalTotalPages; { TotalPages } 5: Value := FEngine.TotalPages; { TotalPages# } 6: Value := FEngine.CurLine; { Line } 7: Value := FEngine.CurLineThrough; { Line# } 8: Value := frxGlobalVariables['CopyName0']; end; Result := True; Exit; end; { value supplied by OnGetValue event } TVarData(val).VType := varEmpty; if Assigned(FOnGetValue) then FOnGetValue(Expr, val); if TVarData(val).VType <> varEmpty then begin Value := val; Result := True; Exit; end; { searching in the variables } i := FVariables.IndexOf(Expr); if i <> -1 then begin val := FVariables.Items[i].Value; if (TVarData(val).VType = varString) or (TVarData(val).VType = varOleStr) then begin if Pos(#13#10, val) <> 0 then Value := val else Value := Calc(val); end else Value := val; Result := True; Exit; end; { searching in the global variables } i := frxGlobalVariables.IndexOf(Expr); if i <> -1 then begin Value := frxGlobalVariables.Items[i].Value; Result := True; Exit; end; if not Assigned(frxFR2Events.OnGetScriptValue) then begin { searching in the script } v := FScript.FindLocal(Expr); if v <> nil then begin Value := v.Value; Result := True; Exit; end; end; end; function TfrxReport.GetScriptValue(Instance: TObject; ClassType: TClass; const MethodName: String; var Params: Variant): Variant; var i: Integer; s: String; begin if not DoGetValue(Params[0], Result) then begin { checking aggregate functions } s := VarToStr(Params[0]); i := Pos('(', s); if i <> 0 then begin s := UpperCase(Trim(Copy(s, 1, i - 1))); if (s = 'SUM') or (s = 'MIN') or (s = 'MAX') or (s = 'AVG') or (s = 'COUNT') then begin Result := Calc(Params[0]); Exit; end; end; if Assigned(frxFR2Events.OnGetScriptValue) then Result := frxFR2Events.OnGetScriptValue(Params) else FErrors.Add(frxResources.Get('clUnknownVar') + ' ' + VarToStr(Params[0])); end; end; function TfrxReport.SetScriptValue(Instance: TObject; ClassType: TClass; const MethodName: String; var Params: Variant): Variant; begin FVariables[Params[0]] := Params[1]; end; function TfrxReport.CallMethod(Instance: TObject; ClassType: TClass; const MethodName: String; var Params: Variant): Variant; var p1, p2, p3: Variant; begin if MethodName = 'IIF' then begin p1 := Params[0]; p2 := Params[1]; p3 := Params[2]; if Calc(p1, FScript.ProgRunning) = True then Result := Calc(p2, FScript.ProgRunning) else Result := Calc(p3, FScript.ProgRunning); end else if (MethodName = 'SUM') or (MethodName = 'AVG') or (MethodName = 'MIN') or (MethodName = 'MAX') then begin p2 := Params[1]; if Trim(VarToStr(p2)) = '' then p2 := 0 else p2 := Calc(p2, FScript.ProgRunning); p3 := Params[2]; if Trim(VarToStr(p3)) = '' then p3 := 0 else p3 := Calc(p3, FScript.ProgRunning); Result := FEngine.GetAggregateValue(MethodName, Params[0], TfrxBand(Integer(p2)), p3); end else if MethodName = 'COUNT' then begin p1 := Params[0]; if Trim(VarToStr(p1)) = '' then p1 := 0 else p1 := Calc(p1, FScript.ProgRunning); p2 := Params[1]; if Trim(VarToStr(p2)) = '' then p2 := 0 else p2 := Calc(p2, FScript.ProgRunning); Result := FEngine.GetAggregateValue(MethodName, '', TfrxBand(Integer(p1)), p2); end end; function TfrxReport.DoUserFunction(Instance: TObject; ClassType: TClass; const MethodName: String; var Params: Variant): Variant; begin if Assigned(FOnUserFunction) then Result := FOnUserFunction(MethodName, Params); end; function TfrxReport.PrepareScript: Boolean; var i: Integer; l: TList; c: TfrxComponent; begin FExpressionCache.Clear; FExpressionCache.FScriptLanguage := FScriptLanguage; FEngine.NotifyList.Clear; FScript.ClearItems(Self); FScript.AddedBy := Self; FScript.MainProg := True; try l := AllObjects; for i := 0 to l.Count - 1 do begin c := l[i]; c.IsDesigning := False; c.BeforeStartReport; if c is TfrxPictureView then TfrxPictureView(c).FPictureChanged := True; FScript.AddObject(c.Name, c); end; FScript.AddObject('Report', Self); FScript.AddObject('Engine', FEngine); FScript.AddObject('Outline', FPreviewPages.Outline); FScript.AddVariable('Value', 'Variant', Null); FScript.AddMethod('function Get(Name: String): Variant', GetScriptValue); FScript.AddMethod('procedure Set(Name: String; Value: Variant)', SetScriptValue); FScript.AddMethod('macrofunction IIF(Expr: Boolean; TrueValue, FalseValue: Variant): Variant', CallMethod); FScript.AddMethod('macrofunction SUM(Expr: Variant; Band: Variant = 0; Flags: Integer = 0): Variant', CallMethod); FScript.AddMethod('macrofunction AVG(Expr: Variant; Band: Variant = 0; Flags: Integer = 0): Variant', CallMethod); FScript.AddMethod('macrofunction MIN(Expr: Variant; Band: Variant = 0; Flags: Integer = 0): Variant', CallMethod); FScript.AddMethod('macrofunction MAX(Expr: Variant; Band: Variant = 0; Flags: Integer = 0): Variant', CallMethod); FScript.AddMethod('macrofunction COUNT(Band: Variant = 0; Flags: Integer = 0): Variant', CallMethod); if Assigned(frxFR2Events.OnPrepareScript) then frxFR2Events.OnPrepareScript(Self); FLocalValue := FScript.Find('Value'); FScript.Lines := FScriptText; FScript.SyntaxType := FScriptLanguage; {$IFNDEF FR_VER_BASIC} Result := FScript.Compile; if not Result then FErrors.Add(Format(frxResources.Get('clScrError'), [FScript.ErrorPos, FScript.ErrorMsg])); {$ELSE} Result := True; {$ENDIF} finally FScript.AddedBy := nil; end; end; {$IFDEF FR_COM} procedure TfrxReport.EventSinkChanged(const Sink: IUnknown; Connecting: Boolean); begin if Connecting then FEvent := Sink as IfrxReportEvents else FEvent := nil; end; function TfrxReport.PrepareReport(ClearLastReport: WordBool = True): HResult; stdcall; var TempStream: TStream; ErrorsText: String; ErrorMessage: String; begin if ClearLastReport then PreviewPages.Clear; FErrors.Clear; FTerminated := False; // FFinished := False; Result := E_FAIL; if FEngineOptions.DestroyForms then begin TempStream := TMemoryStream.Create; SaveToStream(TempStream); end else TempStream := nil; try if Assigned(FOnBeginDoc) then FOnBeginDoc(Self); if PrepareScript then begin if FScript.Statement.Count > 0 then FScript.Execute; if FEngine.Run then begin if Assigned(FOnEndDoc) then FOnEndDoc(Self); Result := S_OK; end else if FPreviewForm <> nil then FPreviewForm.Close; end; except on e: Exception do FErrors.Add(e.Message); end; if TempStream <> nil then begin ErrorsText := FErrors.Text; TempStream.Position := 0; FReloading := True; try LoadFromStream(TempStream); finally FReloading := False; end; TempStream.Free; FErrors.Text := ErrorsText; end; if FErrors.Text <> '' then begin Result := E_FAIL; ErrorMessage := frxResources.Get('clErrors') + #13#10 + FErrors.Text; frxCommonErrorHandler(Self, ErrorMessage); end; end; {$ELSE} // FR_COM function TfrxReport.PrepareReport(ClearLastReport: Boolean = True): Boolean; var TempStream: TStream; ErrorsText: String; ErrorMessage: String; SavePwd: String; function CheckDatasets: Boolean; var i: Integer; begin for i := 0 to FDataSets.Count - 1 do if FDatasets[i].DataSet = nil then FErrors.Add(Format(frxResources.Get('clDSNotExist'), [''])); Result := FErrors.Count = 0; end; begin if ClearLastReport then PreviewPages.Clear; FErrors.Clear; FTerminated := False; Result := False; if CheckDatasets then begin TempStream := nil; SavePwd := ReportOptions.Password; { save the report state } if FEngineOptions.DestroyForms then begin TempStream := TMemoryStream.Create; ReportOptions.Password := ''; SaveToStream(TempStream); end; try if Assigned(FOnBeginDoc) then FOnBeginDoc(Self); if PrepareScript then begin {$IFNDEF FR_VER_BASIC} if FScript.Statement.Count > 0 then FScript.Execute; {$ENDIF} if FEngine.Run then begin if Assigned(FOnEndDoc) then FOnEndDoc(Self); Result := True end else if FPreviewForm <> nil then FPreviewForm.Close; end; except on e: Exception do FErrors.Add(e.Message); end; if FEngineOptions.DestroyForms then begin ErrorsText := FErrors.Text; TempStream.Position := 0; FReloading := True; try // if FEngineOptions.ReportThread = nil then LoadFromStream(TempStream); finally FReloading := False; ReportOptions.Password := SavePwd; end; TempStream.Free; FErrors.Text := ErrorsText; end; end; if FErrors.Text <> '' then begin Result := False; ErrorMessage := frxResources.Get('clErrors') + #13#10 + FErrors.Text; frxCommonErrorHandler(Self, ErrorMessage); end; end; {$ENDIF} // FR_COM {$IFDEF FR_COM} function TfrxReport.ShowPreparedReport: HResult; stdcall; {$ELSE} procedure TfrxReport.ShowPreparedReport; {$ENDIF} begin FPreviewForm := nil; if FPreview <> nil then begin FPreview.FReport := Self; FPreview.FPreviewPages := FPreviewPages; FPreview.Init; end else begin FPreviewForm := TfrxPreviewForm.Create(Application); with TfrxPreviewForm(FPreviewForm) do begin Preview.FReport := Self; Preview.FPreviewPages := FPreviewPages; FPreview := Preview; Init; if Assigned(FOnPreview) then FOnPreview(Self); if PreviewOptions.Maximized then Position := poDesigned; if FPreviewOptions.Modal then begin ShowModal; Free; end else begin FreeOnClose := True; Show; end; end; end; {$IFDEF FR_COM} Result := S_OK; {$ENDIF} end; {$IFDEF FR_COM} function TfrxReport.ShowReport: HResult; stdcall; const ClearLastReport: Boolean = True; {$ELSE} procedure TfrxReport.ShowReport(ClearLastReport: Boolean = True); {$ENDIF} begin if ClearLastReport then PreviewPages.Clear; if FOldStyleProgress then begin {$IFNDEF FR_COM} if PrepareReport(False) then ShowPreparedReport; {$ELSE} Result := PrepareReport(False); if Result = S_OK then Result := ShowPreparedReport; {$ENDIF} end else begin FTimer.Enabled := True; {$IFNDEF FR_COM} ShowPreparedReport; {$ELSE} Result := ShowPreparedReport; {$ENDIF} end; end; procedure TfrxReport.OnTimer(Sender: TObject); begin FTimer.Enabled := False; PrepareReport(False); end; {$HINTS OFF} {$UNDEF FR_RUN_DESIGNER} {$IFDEF FR_LITE} {$DEFINE FR_RUN_DESIGNER} {$ENDIF} {$IFNDEF FR_VER_BASIC} {$DEFINE FR_RUN_DESIGNER} {$ENDIF} {$IFDEF FR_COM} function TfrxReport.DesignReport: HResult; stdcall; {$IFDEF ACTIVATION} const CLASS_E_NOTLICENSED = HRESULT($80040112); var UserKey : PChar = nil; UserName : PChar = nil; ModeName : PChar = nil; ModeStatus : TModeStatus; TrialDaysTotal : Longword = Longword(-1); TrialDaysLeft : Longword = Longword(-1); {$ENDIF} begin {$IFDEF ACTIVATION} {$I include\aspr_crypt_begin1.inc} GetRegistrationInformation( 0, UserKey, UserName ); if (UserKey <> nil) AND (StrLen(UserKey) > 0) then begin Result := DesignReportEx( True, False, Application.Handle ); end else If GetTrialDays( 0, TrialDaysTotal, TrialDaysLeft ) then begin If TrialDaysLeft = 0 then Result := CLASS_E_NOTLICENSED else Result := DesignReportEx( True, False, Application.Handle ); end; {$I include\aspr_crypt_end1.inc} {$ELSE} Result := DesignReportEx( True, False, Application.Handle ); {$ENDIF} end; function TfrxReport.DesignReportEx(Modal: WordBool; MDIChild: WordBool; ParentWindowHandle: Integer): HResult; stdcall; {$ELSE} procedure TfrxReport.DesignReport(Modal: Boolean = True; MDIChild: Boolean = False); {$ENDIF} var l: TList; i: Integer; c: TfrxComponent; begin {$IFDEF FR_COM} Result := S_OK; Application.Handle := HWND(ParentWindowHandle); {$ENDIF} {$IFDEF FR_RUN_DESIGNER} if FDesigner <> nil then Exit; if frxDesignerClass <> nil then begin FScript.ClearItems(Self); l := AllObjects; for i := 0 to l.Count - 1 do begin c := l[i]; if c is TfrxCustomDBDataset then c.BeforeStartReport; end; FModified := False; FDesigner := TfrxCustomDesigner(frxDesignerClass.NewInstance); FDesigner.CreateDesigner(nil, Self); if MDIChild then FDesigner.FormStyle := fsMDIChild; PostMessage(FDesigner.Handle, WM_USER + 1, 0, 0); if Modal then begin FDesigner.ShowModal; FDesigner.Free; Application.ProcessMessages; FDesigner := nil; end else FDesigner.Show; end {$IFNDEF FR_COM} ; {$ELSE} else Result := E_NOINTERFACE; {$ENDIF} {$ENDIF} end; {$HINTS ON} procedure TfrxReport.DesignReportInPanel(Panel: TWinControl); {$IFDEF FR_RUN_DESIGNER} var l: TList; i: Integer; c: TfrxComponent; ct: TControl; {$ENDIF} begin {$IFDEF FR_RUN_DESIGNER} if FDesigner <> nil then Exit; if frxDesignerClass <> nil then begin FScript.ClearItems(Self); l := AllObjects; for i := 0 to l.Count - 1 do begin c := l[i]; if c is TfrxCustomDBDataset then c.BeforeStartReport; end; FModified := False; FDesigner := TfrxCustomDesigner(frxDesignerClass.NewInstance); FDesigner.CreateDesigner(nil, Self); PostMessage(FDesigner.Handle, WM_USER + 1, 0, 0); FDesigner.OnShow(FDesigner); while FDesigner.ControlCount > 0 do begin ct := FDesigner.Controls[0]; ct.Parent := Panel; end; end; {$ENDIF} end; procedure TfrxReport.DesignReport(IDesigner: IUnknown; Editor: TObject); var l: TList; i: Integer; c: TfrxComponent; begin if FDesigner <> nil then begin FDesigner.Activate; Exit; end; if (IDesigner = nil) or (Editor.ClassName <> 'TfrxReportEditor') then Exit; l := AllObjects; for i := 0 to l.Count - 1 do begin c := l[i]; if c is TfrxCustomDBDataset then c.BeforeStartReport; end; FDesigner := TfrxCustomDesigner(frxDesignerClass.NewInstance); FDesigner.CreateDesigner(nil, Self); FDesigner.ShowModal; end; {$HINTS OFF} function TfrxReport.DesignPreviewPage: Boolean; begin Result := False; {$IFNDEF FR_VER_BASIC} if FDesigner <> nil then Exit; if frxDesignerClass <> nil then begin FDesigner := TfrxCustomDesigner(frxDesignerClass.NewInstance); FDesigner.CreateDesigner(nil, Self, True); FDesigner.ShowModal; Result := FModified; end; {$ENDIF} end; {$HINTS ON} function TfrxReport.Export(Filter: TfrxCustomExportFilter): Boolean; begin Result := FPreviewPages.Export(Filter); end; function TfrxReport.Print: Boolean; begin Result := FPreviewPages.Print; end; {$IFDEF FR_COM} function TfrxReport.AddFunction( const FuncName: WideString; const Category: WideString; const Description: WideString): HResult; stdcall; {$ELSE} procedure TfrxReport.AddFunction(const FuncName: String; const Category: String = ''; const Description: String = ''); {$ENDIF} begin FScript.AddedBy := nil; FScript.AddMethod(FuncName, DoUserFunction, Category, Description); {$IFDEF FR_COM} Result := S_OK; {$ENDIF} end; function TfrxReport.GetLocalValue: Variant; begin Result := FLocalValue.Value; end; procedure TfrxReport.SetLocalValue(const Value: Variant); begin FLocalValue.Value := Value; end; procedure TfrxReport.SetTerminated(const Value: Boolean); begin FTerminated := Value; if Value then FScript.Terminate; end; procedure TfrxReport.SetPreview(const Value: TfrxCustomPreview); begin if (FPreview <> nil) and (Value = nil) then begin FPreview.FReport := nil; FPreview.FPreviewPages := nil; FPreviewForm := nil; end; FPreview := Value; if FPreview <> nil then begin FPreview.FReport := Self; FPreview.FPreviewPages := FPreviewPages; FPreview.Init; end; end; procedure TfrxReport.InternalOnProgressStart(ProgressType: TfrxProgressType); begin {$IFNDEF FR_COM} if (FEngineOptions.EnableThreadSafe) then Exit; //(FEngineOptions.ReportThread <> nil) or {$ENDIF} if Assigned(FOnProgressStart) then FOnProgressStart(Self, ProgressType, 0); if OldStyleProgress or (ProgressType <> ptRunning) then begin if FShowProgress then begin if FProgress <> nil then FProgress.Free; FProgress := TfrxProgress.Create(nil); FProgress.Execute(0, '', True, False); end; end; if (FPreview <> nil) and (ProgressType = ptRunning) then FPreview.InternalOnProgressStart(Self, ProgressType, 0); Application.ProcessMessages; end; procedure TfrxReport.InternalOnProgress(ProgressType: TfrxProgressType; Progress: Integer); begin {$IFNDEF FR_COM} if FEngineOptions.EnableThreadSafe then Exit; // if FEngineOptions.ReportThread <> nil then Exit; {$ENDIF} if Assigned(FOnProgress) then FOnProgress(Self, ProgressType, Progress); if OldStyleProgress or (ProgressType <> ptRunning) then begin if FShowProgress then begin case ProgressType of ptRunning: if not Engine.FinalPass then FProgress.Message := Format(frxResources.Get('prRunningFirst'), [Progress]) else FProgress.Message := Format(frxResources.Get('prRunning'), [Progress]); ptPrinting: FProgress.Message := Format(frxResources.Get('prPrinting'), [Progress]); ptExporting: FProgress.Message := Format(frxResources.Get('prExporting'), [Progress]); end; if FProgress.Terminated then Terminated := True; end; end; if (FPreview <> nil) and (ProgressType = ptRunning) then FPreview.InternalOnProgress(Self, ProgressType, Progress - 1); Application.ProcessMessages; end; procedure TfrxReport.InternalOnProgressStop(ProgressType: TfrxProgressType); begin {$IFNDEF FR_COM} if FEngineOptions.EnableThreadSafe then Exit; // if FEngineOptions.ReportThread <> nil then Exit; {$ENDIF} if Assigned(FOnProgressStop) then FOnProgressStop(Self, ProgressType, 0); if OldStyleProgress or (ProgressType <> ptRunning) then begin if FShowProgress then begin FProgress.Free; FProgress := nil; end; end; if (FPreview <> nil) and (ProgressType = ptRunning) then FPreview.InternalOnProgressStop(Self, ProgressType, 0); Application.ProcessMessages; end; procedure TfrxReport.SetProgressMessage(const Value: String); begin {$IFNDEF FR_COM} if FEngineOptions.EnableThreadSafe then Exit; // if FEngineOptions.ReportThread <> nil then Exit; {$ENDIF} if OldStyleProgress and Engine.Running then begin if FShowProgress then FProgress.Message := Value end; if FPreviewForm <> nil then TfrxPreviewForm(FPreviewForm).SetMessageText(Value); Application.ProcessMessages; end; procedure TfrxReport.SetVersion(const Value: String); begin FVersion := FR_VERSION; end; {$IFDEF FR_COM} procedure TfrxReport.OnSetConnectionHandler(const ConnString: String); begin frxDefaultConnection.Connected := False; frxDefaultConnection.ConnectionString := ConnString; end; function TfrxReport.OnEditConnectionHandler(const ConnString: String): String; begin Result := PromptDataSource(0, ConnString); end; procedure TfrxReport.OnAfterPrintHandler(Sender: TfrxReportComponent); var Enum : IEnumConnections; ConnectData : TConnectData; Fetched : Longint; Obj: IfrxComponent; begin if FEvent <> nil then begin if FUseDispatchableEvents = True then begin Obj := DispatchableComponentFactory.CreateComObject(Sender) as IfrxComponent; FEvent.OnAfterPrint(Obj); Obj._Release; end else FEvent.OnAfterPrint(Sender) end else begin OleCheck((FConnectionPoint as IConnectionPoint).EnumConnections(Enum)); while Enum.Next (1, ConnectData, @Fetched) = S_OK do begin (ConnectData.pUnk as IfrxReportEventDispatcher).OnAfterPrint(Sender); ConnectData.pUnk := nil; end; end; end; procedure TfrxReport.OnBeforePrintHandler(Sender: TfrxReportComponent); var Enum : IEnumConnections; ConnectData : TConnectData; Fetched : Longint; Obj: IfrxComponent; begin if FEvent <> nil then begin if FUseDispatchableEvents = True then begin Obj := DispatchableComponentFactory.CreateComObject(Sender) as IfrxComponent; FEvent.OnBeforePrint(Obj); Obj._Release; end else FEvent.OnBeforePrint(Sender); end else begin OleCheck((FConnectionPoint as IConnectionPoint).EnumConnections(Enum)); while Enum.Next (1, ConnectData, @Fetched) = S_OK do begin (ConnectData.pUnk as IfrxReportEventDispatcher).OnBeforePrint(Sender); ConnectData.pUnk := nil; end; end; end; procedure TfrxReport.OnClickObjectHandler(Sender: TfrxView; Button: TMouseButton; Shift: TShiftState; var Modified: Boolean); var Enum : IEnumConnections; ConnectData : TConnectData; Fetched : Longint; Obj: IfrxView; begin if FEvent <> nil then begin if FUseDispatchableEvents = True then begin Obj := DispatchableComponentFactory.CreateComObject(Sender) as IfrxView; FEvent.OnClickObject( Obj, Integer(Button)); Obj._Release; end else FEvent.OnClickObject(Sender as IfrxView, Integer(Button)) end else begin OleCheck((FConnectionPoint as IConnectionPoint).EnumConnections(Enum)); while Enum.Next (1, ConnectData, @Fetched) = S_OK do begin (ConnectData.pUnk as IfrxReportEventDispatcher).OnClickObject(Sender as IfrxView, Integer(Button)); ConnectData.pUnk := nil; end; end; end; function TfrxReport.OnUserFunctionHandler(const MethodName: String; var Params: Variant): Variant; var Enum : IEnumConnections; ConnectData : TConnectData; Fetched : Longint; ResultValue : OleVariant; begin if FEvent <> nil then begin FEvent.OnUserFunction(MethodName, Params, ResultValue); Result := ResultValue; end else begin OleCheck((FConnectionPoint as IConnectionPoint).EnumConnections(Enum)); while Enum.Next (1, ConnectData, @Fetched) = S_OK do begin (ConnectData.pUnk as IfrxReportEventDispatcher).OnUserFunction(MethodName, Params, ResultValue); Result := ResultValue; ConnectData.pUnk := nil; end; end; end; procedure TfrxReport.OnBeginDocHandler(Sender: TObject); var Component: IfrxComponent; Enum : IEnumConnections; ConnectData : TConnectData; Fetched : Longint; // Obj: IfrxComponent; begin try Sender.GetInterface(IfrxComponent, Component); if FEvent <> nil then begin { if FUseDispatchableEvents = True then begin Obj := DispatchableComponentFactory.CreateComObject(Component) as IfrxComponent; FEvent.OnBeginDoc(Obj); Obj._Release; end else } FEvent.OnBeginDoc( Component ) end else begin OleCheck((FConnectionPoint as IConnectionPoint).EnumConnections(Enum)); while Enum.Next (1, ConnectData, @Fetched) = S_OK do begin (ConnectData.pUnk as IfrxReportEventDispatcher).OnBeginDoc(Component); ConnectData.pUnk := nil; end; end; finally Component := nil; end; end; procedure TfrxReport.OnBeforeConnectHandler(Sender: TfrxCustomDatabase; var Connected: Boolean); var Database: IfrxADODatabase; Enum : IEnumConnections; ConnectData : TConnectData; Fetched : Longint; begin try Sender.GetInterface( IfrxADODatabase, Database ); if FEvent <> nil then FEvent.OnBeforeConnect( Database, Connected ) else begin OleCheck((FConnectionPoint as IConnectionPoint).EnumConnections(Enum)); while Enum.Next (1, ConnectData, @Fetched) = S_OK do begin (ConnectData.pUnk as IfrxReportEventDispatcher).OnBeforeConnect( Database, Connected ); ConnectData.pUnk := nil; end; end; finally Database := nil; end; end; procedure TfrxReport.OnEndDocHandler(Sender: TObject); var Component: IfrxComponent; Enum : IEnumConnections; ConnectData : TConnectData; Fetched : Longint; begin try Sender.GetInterface(IfrxComponent, Component); if FEvent <> nil then FEvent.OnEndDoc( Component ) else begin OleCheck((FConnectionPoint as IConnectionPoint).EnumConnections(Enum)); while Enum.Next (1, ConnectData, @Fetched) = S_OK do begin (ConnectData.pUnk as IfrxReportEventDispatcher).OnEndDoc(Component); ConnectData.pUnk := nil; end; end; finally Component := nil; end; end; procedure TfrxReport.OnPrintReportHandler(Sender: TObject); var Component: IfrxComponent; Enum : IEnumConnections; ConnectData : TConnectData; Fetched : Longint; begin try Sender.GetInterface(IfrxComponent, Component); if FEvent <> nil then FEvent.OnEndDoc( Component ) else begin OleCheck((FConnectionPoint as IConnectionPoint).EnumConnections(Enum)); while Enum.Next (1, ConnectData, @Fetched) = S_OK do begin (ConnectData.pUnk as IfrxReportEventDispatcher).OnPrintReport(Component); ConnectData.pUnk := nil; end; end; finally Component := nil; end; end; procedure TfrxReport.OnAfterPrintReportHandler(Sender: TObject); var Component: IfrxComponent; Enum : IEnumConnections; ConnectData : TConnectData; Fetched : Longint; begin try Sender.GetInterface(IfrxComponent, Component); if FEvent <> nil then FEvent.OnAfterPrintReport( Component ) else begin OleCheck((FConnectionPoint as IConnectionPoint).EnumConnections(Enum)); while Enum.Next (1, ConnectData, @Fetched) = S_OK do begin (ConnectData.pUnk as IfrxReportEventDispatcher).OnAfterPrintReport(Component); ConnectData.pUnk := nil; end; end; finally Component := nil; end; end; procedure TfrxReport.OnProgressHandler(Sender: TfrxReport; ProgressType: TfrxProgressType; Progress: Integer); var Enum : IEnumConnections; ConnectData : TConnectData; Fetched : Longint; begin try if FEvent <> nil then FEvent.OnProgress( Sender, Integer(ProgressType), Progress ) else begin OleCheck((FConnectionPoint as IConnectionPoint).EnumConnections(Enum)); while Enum.Next (1, ConnectData, @Fetched) = S_OK do begin (ConnectData.pUnk as IfrxReportEventDispatcher).OnProgress(Sender, Integer(ProgressType), Progress); ConnectData.pUnk := nil; end; end except end; end; procedure TfrxReport.OnProgressStartHandler(Sender: TfrxReport; ProgressType: TfrxProgressType; Progress: Integer); var Enum : IEnumConnections; ConnectData : TConnectData; Fetched : Longint; begin try if FEvent <> nil then FEvent.OnProgressStart( ) else begin OleCheck((FConnectionPoint as IConnectionPoint).EnumConnections(Enum)); while Enum.Next (1, ConnectData, @Fetched) = S_OK do begin (ConnectData.pUnk as IfrxReportEventDispatcher).OnProgressStart(); ConnectData.pUnk := nil; end; end except end; end; procedure TfrxReport.OnProgressStopHandler(Sender: TfrxReport; ProgressType: TfrxProgressType; Progress: Integer); var Enum : IEnumConnections; ConnectData : TConnectData; Fetched : Longint; begin try if FEvent <> nil then FEvent.OnProgressStop( ) else begin OleCheck((FConnectionPoint as IConnectionPoint).EnumConnections(Enum)); while Enum.Next (1, ConnectData, @Fetched) = S_OK do begin (ConnectData.pUnk as IfrxReportEventDispatcher).OnProgressStop(); ConnectData.pUnk := nil; end; end; except end; end; procedure TfrxReport.OnRunDialogsEvent(Page: TfrxDialogPage); var Enum : IEnumConnections; ConnectData : TConnectData; Fetched : Longint; begin try if FEvent <> nil then FEvent.OnRunDialogs( Page ) else begin OleCheck((FConnectionPoint as IConnectionPoint).EnumConnections(Enum)); while Enum.Next (1, ConnectData, @Fetched) = S_OK do begin (ConnectData.pUnk as IfrxReportEventDispatcher).OnRunDialogs(Page); ConnectData.pUnk := nil; end; end; except end; end; function TfrxReport.LoadReportFromFile(const szFileName: WideString): HResult; begin Result := S_OK; try if LoadFromFile(szFileName, False) <> True then Result := E_INVALIDARG; except Result := E_FAIL; end; end; function TfrxReport.SaveReportToFile(const FileName: WideString): HResult; begin try SaveToFile(FileName); Result := S_OK; except Result := E_FAIL; end; end; function TfrxReport.LoadReportFromStream(const Stream: IUnknown): HResult; var ComStream: IStream; OleStream: TOleStream; NetStream: _Stream; ClrStream: TClrStream; begin try Result := Stream.QueryInterface(IStream, ComStream); if Result = S_OK then begin OleStream := TOleStream.Create(ComStream); LoadFromStream(OleStream); OleStream.Free; ComStream := nil; end else begin Result := Stream.QueryInterface(_Stream, NetStream); if Result = S_OK then begin ClrStream := TClrStream.Create(NetStream); LoadFromStream(ClrStream); ClrStream.Free; NetStream._Release(); end; end; except Result := E_FAIL; end; // Result value now depends on errors count if (FErrors.Count > 0) then Result := CONVERT10_E_OLESTREAM_FMT; end; function TfrxReport.SaveReportToStream(const Stream: IUnknown): HResult; var ComStream: IStream; OleStream: TOleStream; NetStream: _Stream; ClrStream: TClrStream; begin try Result := Stream.QueryInterface(IStream, ComStream); if Result = S_OK then begin OleStream := TOleStream.Create(ComStream); SaveToStream(OleStream, True, False); OleStream.Free; ComStream := nil; end else begin Result := Stream.QueryInterface(_Stream, NetStream); if Result = S_OK then begin ClrStream := TClrStream.Create(NetStream); SaveToStream(ClrStream, True, False); ClrStream.Free; NetStream._Release(); end; end; except Result := E_FAIL; end; end; function TfrxReport.LoadPreparedReportFromFile(const szFileName: WideString): HResult; begin try Result := S_OK; if PreviewPages.LoadFromFile( szFileName ) <> True then Result := E_FAIL; except Result := E_FAIL; end; end; function TfrxReport.SavePreparedReportToFile(const szFileName: WideString): HResult; begin try PreviewPages.SaveToFile( szFileName ); Result := S_OK; except Result := E_FAIL; end; end; function TfrxReport.SavePreparedReportToStream(const Stream: IUnknown): HResult; var S: IStream; OleStream: TOleStream; NetStream: _Stream; ClrStream: TClrStream; begin try Result := Stream.QueryInterface(IStream, S); if Result = S_OK then begin OleStream := TOleStream.Create(S); PreviewPages.SaveToStream(OleStream); OleStream.Free; S._Release(); end else begin Result := Stream.QueryInterface(_Stream, NetStream); if Result = S_OK then begin ClrStream := TClrStream.Create(NetStream); PreviewPages.SaveToStream(ClrStream); ClrStream.Free; NetStream._Release(); end; end; except Result := E_FAIL; end; end; function TfrxReport.ClearReport: HResult; begin try Clear; Result := S_OK; except Result := E_FAIL; end; end; function TfrxReport.PrintReport: HResult; var printers: TfrxPrinters; begin try printers := frxPrinters; if printers.HasPhysicalPrinters then begin Print; Result := S_OK; end else begin Errors.Add('There is no printer on system'); Result := E_FAIL; end; except Result := E_FAIL; end; end; function TfrxReport.ExportReport(const Filter: IfrxCustomExportFilter): HResult; begin Result := E_NOTIMPL; end; function TfrxReport.Get_Errors(out Value: WideString): HResult; begin try if Errors <> nil then Value := Errors.GetText else Value := ''; Result := S_OK; except Result := E_FAIL; end; end; function TfrxReport.Get_EngineOptions(out Value: IfrxEngineOptions): HResult; begin Value := EngineOptions as IfrxEngineOptions; Result := S_OK; end; function TfrxReport.Get_Script(out Value: IfsScript): HResult; stdcall; begin Value := Script as IfsScript; Result := S_OK; end; function TfrxReport.Get_Print(out Value: WordBool): HResult; stdcall; begin Value := Print; Result := S_OK; end; function TfrxReport.Set_UseDispatchableEvents(Value: WordBool): HResult; stdcall; begin FUseDispatchableEvents := Value; Result := S_OK; end; function TfrxReport.Get_FileName(out Value: WideString): HResult; stdcall; begin Value := FileName; Result := S_OK; end; function TfrxReport.Set_FileName(const Value: WideString): HResult; stdcall; begin FileName := Value; Result := S_OK; end; function TfrxReport.Set_Terminated(Value: WordBool): HResult; stdcall; begin Terminated := True; Result := S_OK; end; function TfrxReport.Get_PreviewPages(out Value: IfrxCustomPreviewPages): HResult; stdcall; begin Value := PreviewPages as IfrxCustomPreviewPages; Value._AddRef; Result := S_OK; end; function TfrxReport.Get_ReportOptions(out Value: IfrxReportOptions): HResult; begin Value := ReportOptions as IfrxReportOptions; Result := S_OK; end; function TfrxReport.Get_PreviewOptions(out Value: IfrxPreviewOptions): HResult; begin Value := PreviewOptions as IfrxPreviewOptions; Result := S_OK; end; function TfrxReport.Get_PrintOptions( out Value: IfrxPrintOptions): HResult; begin Value := PrintOptions as IfrxPrintOptions; Result := S_OK; end; function TfrxReport.Get_ScriptLanguage(out Value: WideString): HResult; begin try Value:= ScriptLanguage; Result := S_OK; except Result := E_FAIL; end; end; function TfrxReport.Set_ScriptLanguage(const Value: WideString): HResult; begin try ScriptLanguage := Value; Result := S_OK; except Result := E_FAIL; end; end; function TfrxReport.Get_ScriptText(out Value: WideString): HResult; begin try Value := ScriptText.GetText; Result := S_OK; except Result := E_FAIL; end; end; function TfrxReport.Set_ScriptText(const Value: WideString): HResult; begin try ScriptText.SetText(PAnsiChar(String(Value))); Result := S_OK; except Result := E_FAIL; end; end; function TfrxReport.Get_DisableDialogs(out Value: WordBool): HResult; stdcall; begin if Assigned(Engine.OnRunDialog) then Value := True else Value := False; Result := S_OK; end; function TfrxReport.Set_DisableDialogs(Value: WordBool): HResult; stdcall; begin if Value = True then Engine.OnRunDialog := nil else Engine.OnRunDialog := OnRunDialogsEvent; Result := S_OK; end; function TfrxReport.SetVariable(const Index: WideString; Value: OleVariant): HResult; stdcall; begin try Variables[Index] := Variant(Value); Result := S_OK; except Result := E_FAIL; end; end; function TfrxReport.GetVariable(const Index: WideString; out Value: OleVariant): HResult; stdcall; var TempVal: Variant; begin try DoGetValue(Index, TempVal); Value := TempVal; Result := S_OK; except Result := E_FAIL; end; end; function TfrxReport.AddVariable(const Category: WideString; const Name: WideString; Value: OleVariant): HResult; stdcall; var i: Integer; v: TfrxVariable; begin try i := Variables.IndexOf(' ' + Category); if i = -1 then begin v := Variables.Add(); v.Name := ' ' + Category; end; Variables.AddVariable(Category, Name, Value); Result := S_OK; except Result := E_FAIL; end; end; function TfrxReport.DeleteCategory(const Name: WideString): HResult; stdcall; begin try Variables.DeleteCategory(Name); Result := S_OK; except Result := E_FAIL; end; end; function TfrxReport.DeleteVariable(const Name: WideString): HResult; stdcall; begin try Variables.DeleteVariable(Name); Result := S_OK; except Result := E_FAIL; end; end; function TfrxReport.SelectDataset(Selected: WordBool; const DataSet: IfrxDataSet): HResult; var // idsp: IfrxComponentSelf; ds: TfrxDataSet; UserName: WideString; i: Integer; dsList: TStringList; begin try dsList := TStringList.Create; frxGetDataSetList(dsList); UserName := (DataSet as IInterfaceComponentReference).GetComponent.Name; for i := 0 to dsList.Count - 1 do begin ds := TfrxDataSet(dsList.Objects[i]); if ds.UserName = UserName then begin if Selected then Datasets.Add(ds) else Datasets.Delete(UserName); end; end; dsList.Free; Result := S_OK; except Result := E_FAIL; end; end; function TfrxReport.BindObject(const Value: IfrxPlugin): HResult; stdcall; var PluginType: frxPluginType; ds: TfrxNetDataTable; begin try Result := Value.Get_PluginType(PluginType); if Result = S_OK then case PluginType of ptDataSet: begin ds := TfrxNetDataTable.Create( nil ); Result := ds.SetRemoteObject( Value ); end else // put your plugin implementation here Result := E_NOINTERFACE; end; except Result := E_NOINTERFACE; end; end; function TfrxReport.Set_ShowProgress(Value: WordBool): HResult; stdcall; begin try ShowProgress := Value; Result := S_OK; except Result := E_FAIL; end end; function TfrxReport.CreateReportObject( const ParentObject: IfrxComponent; ObjectType: TGUID; const Name: WideString; out GeneratedObject: IfrxComponent): HResult; stdcall; var Obj: TfrxComponent; ParentObj: TfrxComponent; idsp: IInterfaceComponentReference; i: Integer; TempStr: WideString; begin try obj := nil; Result := ParentObject.QueryInterface( IInterfaceComponentReference, idsp); if Result = S_OK then begin ParentObj := TfrxComponent( idsp.GetComponent ); if IsEqualGUID(ObjectType, IfrxReportPage) then obj := TfrxReportPage.Create(ParentObj) else if IsEqualGUID(ObjectType, IfrxReportTitle) then obj := TfrxReportTitle.Create(ParentObj) else if IsEqualGUID(ObjectType, IfrxMemoView) then obj := TfrxMemoView.Create(ParentObj) else if IsEqualGUID(ObjectType, IfrxReportSummary) then obj := TfrxReportSummary.Create(ParentObj) else if IsEqualGUID(ObjectType, IfrxDataBand) then obj := TfrxMasterData.Create(ParentObj) else if IsEqualGUID(ObjectType, IfrxPictureView) then obj := TfrxPictureView.Create(ParentObj) else if IsEqualGUID(ObjectType, IfrxShapeView) then obj := TfrxShapeView.Create(ParentObj) else if IsEqualGUID(ObjectType, IfrxSubreport) then obj := TfrxSubreport.Create(ParentObj) else if IsEqualGUID(ObjectType, IfrxHeader) then obj := TfrxHeader.Create(ParentObj) else if IsEqualGUID(ObjectType, IfrxFooter) then obj := TfrxFooter.Create(ParentObj) else if IsEqualGUID(ObjectType, IfrxMasterData) then obj := TfrxMasterData.Create(ParentObj) else if IsEqualGUID(ObjectType, IfrxDetailData) then obj := TfrxDetailData.Create(ParentObj) else if IsEqualGUID(ObjectType, IfrxSubdetailData) then obj := TfrxSubdetailData.Create(ParentObj) else if IsEqualGUID(ObjectType, IfrxDataBand4) then obj := TfrxDataBand4.Create(ParentObj) else if IsEqualGUID(ObjectType, IfrxDataBand5) then obj := TfrxDataBand5.Create(ParentObj) else if IsEqualGUID(ObjectType, IfrxDataBand6) then obj := TfrxDataBand6.Create(ParentObj) else if IsEqualGUID(ObjectType, IfrxPageHeader) then obj := TfrxPageHeader.Create(ParentObj) else if IsEqualGUID(ObjectType, IfrxPageFooter) then obj := TfrxPageFooter.Create(ParentObj) else if IsEqualGUID(ObjectType, IfrxColumnHeader) then obj := TfrxColumnHeader.Create(ParentObj) else if IsEqualGUID(ObjectType, IfrxColumnFooter) then obj := TfrxColumnFooter.Create(ParentObj) else if IsEqualGUID(ObjectType, IfrxGroupHeader) then obj := TfrxGroupHeader.Create(ParentObj) else if IsEqualGUID(ObjectType, IfrxGroupFooter) then obj := TfrxGroupFooter.Create(ParentObj) else if IsEqualGUID(ObjectType, IfrxChild) then obj := TfrxChild.Create(ParentObj) else if IsEqualGUID(ObjectType, IfrxOverlay) then obj := TfrxOverlay.Create(ParentObj) else if IsEqualGUID(ObjectType, IfrxCrossView) then obj := TfrxCrossView.Create(ParentObj) else if IsEqualGUID(ObjectType, IfrxDBCrossView) then obj := TfrxDBCrossView.Create(ParentObj) else if IsEqualGUID(ObjectType, IfrxRichView) then obj := TfrxRichView.Create(ParentObj) else if IsEqualGUID(ObjectType, IfrxADODatabase) then obj := TfrxADODatabase.Create(ParentObj) else if IsEqualGUID(ObjectType, IfrxADOTable) then obj := TfrxADOTable.Create(ParentObj) else if IsEqualGUID(ObjectType, IfrxADOQuery) then obj := TfrxADOQuery.Create(ParentObj) else if IsEqualGUID(ObjectType, IfrxDMPPage) then obj := TfrxDMPPage.Create(ParentObj) else if IsEqualGUID(ObjectType, IfrxDMPCommand) then obj := TfrxDMPCommand.Create(ParentObj) else if IsEqualGUID(ObjectType, IfrxDMPMemoView) then obj := TfrxDMPMemoView.Create(ParentObj) else if IsEqualGUID(ObjectType, IfrxDMPLineView) then obj := TfrxDMPLineView.Create(ParentObj) {$IFNDEF FR_LITE} else if IsEqualGUID(ObjectType, IfrxChartView) then obj := TfrxChartView.Create(ParentObj) {$ENDIF} else Result := E_INVALIDARG; end; if Result = S_OK then begin TempStr := Name; for i := 0 to length(Name) - 1 do if Name[i] = ' ' then TempStr[i] := '_'; obj.Name := String(TempStr); GeneratedObject := obj as IfrxComponent; end; except Result := E_FAIL; end; end; function TfrxReport.CreateReportObjectEx( const ParentObject: IfrxComponent; const ObjectType: WideString; const Name: WideString; out GeneratedObject: IfrxComponent): HResult; stdcall; begin try if ObjectType = 'TfrxPage' then Result := CreateReportObject(ParentObject, IfrxReportPage, Name, GeneratedObject ) else if ObjectType = 'TfrxMemoView' then Result := CreateReportObject(ParentObject, IfrxMemoView, Name, GeneratedObject ) else if ObjectType = 'TfrxReportTitle' then Result := CreateReportObject(ParentObject, IfrxReportTitle, Name, GeneratedObject ) else if ObjectType = 'TfrxReportSummary' then Result := CreateReportObject(ParentObject, IfrxReportSummary, Name, GeneratedObject ) else if ObjectType = 'TfrxDataBand' then Result := CreateReportObject(ParentObject, IfrxDataBand, Name, GeneratedObject ) else if ObjectType = 'TfrxPictureView' then Result := CreateReportObject(ParentObject, IfrxPictureView, Name, GeneratedObject ) else if ObjectType = 'TfrxShapeView' then Result := CreateReportObject(ParentObject, IfrxShapeView, Name, GeneratedObject ) else if ObjectType = 'TfrxChartView' then Result := CreateReportObject(ParentObject, IfrxChartView, Name, GeneratedObject ) else if ObjectType = 'TfrxSubreport' then Result := CreateReportObject(ParentObject, IfrxSubreport, Name, GeneratedObject ) else if ObjectType = 'TfrxHeader' then Result := CreateReportObject(ParentObject, IfrxHeader, Name, GeneratedObject ) else if ObjectType = 'TfrxFooter' then Result := CreateReportObject(ParentObject, IfrxFooter, Name, GeneratedObject ) else if ObjectType = 'TfrxMasterData' then Result := CreateReportObject(ParentObject, IfrxMasterData, Name, GeneratedObject ) else if ObjectType = 'TfrxDetailData' then Result := CreateReportObject(ParentObject, IfrxDetailData, Name, GeneratedObject ) else if ObjectType = 'TfrxSubdetailData' then Result := CreateReportObject(ParentObject, IfrxSubdetailData, Name, GeneratedObject ) else if ObjectType = 'TfrxDataBand4' then Result := CreateReportObject(ParentObject, IfrxDataBand4, Name, GeneratedObject ) else if ObjectType = 'TfrxDataBand5' then Result := CreateReportObject(ParentObject, IfrxDataBand5, Name, GeneratedObject ) else if ObjectType = 'TfrxDataBand6' then Result := CreateReportObject(ParentObject, IfrxDataBand6, Name, GeneratedObject ) else if ObjectType = 'TfrxPageHeader' then Result := CreateReportObject(ParentObject, IfrxPageHeader, Name, GeneratedObject ) else if ObjectType = 'TfrxPageFooter' then Result := CreateReportObject(ParentObject, IfrxPageFooter, Name, GeneratedObject ) else if ObjectType = 'TfrxColumnHeader' then Result := CreateReportObject(ParentObject, IfrxColumnHeader, Name, GeneratedObject ) else if ObjectType = 'TfrxColumnFooter' then Result := CreateReportObject(ParentObject, IfrxColumnFooter, Name, GeneratedObject ) else if ObjectType = 'TfrxGroupHeader' then Result := CreateReportObject(ParentObject, IfrxGroupHeader, Name, GeneratedObject ) else if ObjectType = 'TfrxGroupFooter' then Result := CreateReportObject(ParentObject, IfrxGroupFooter, Name, GeneratedObject ) else if ObjectType = 'TfrxChild' then Result := CreateReportObject(ParentObject, IfrxChild, Name, GeneratedObject ) else if ObjectType = 'TfrxOverlay' then Result := CreateReportObject(ParentObject, IfrxOverlay, Name, GeneratedObject ) else if ObjectType = 'TfrxCrossView' then Result := CreateReportObject(ParentObject, IfrxCrossView, Name, GeneratedObject ) else if ObjectType = 'TfrxDBCrossView' then Result := CreateReportObject(ParentObject, IfrxDBCrossView, Name, GeneratedObject ) else if ObjectType = 'TfrxRichView' then Result := CreateReportObject(ParentObject, IfrxRichView, Name, GeneratedObject ) { Modified February, 2, 2007 } else if ObjectType = 'TfrxADODatabase' then Result := CreateReportObject(ParentObject, IfrxADODatabase, Name, GeneratedObject ) else if ObjectType = 'TfrxADOTable' then Result := CreateReportObject(ParentObject, IfrxADOTable, Name, GeneratedObject ) else if ObjectType = 'TfrxADOQuery' then Result := CreateReportObject(ParentObject, IfrxADOQuery, Name, GeneratedObject ) { Added October, 05, 2006 } else if ObjectType = 'TfrxDMPPage' then Result := CreateReportObject(ParentObject, IfrxDMPPage, Name, GeneratedObject ) else if ObjectType = 'TfrxDMPCommand' then Result := CreateReportObject(ParentObject, IfrxDMPCommand, Name, GeneratedObject ) else if ObjectType = 'TfrxDMPMemoView' then Result := CreateReportObject(ParentObject, IfrxDMPMemoView, Name, GeneratedObject ) else if ObjectType = 'TfrxDMPLineView' then Result := CreateReportObject(ParentObject, IfrxDMPLineView, Name, GeneratedObject ) {} else Result := E_INVALIDARG; if Result = S_OK then begin GeneratedObject := DispatchableComponentFactory.CreateComObject(GeneratedObject) as IfrxComponent; end except Result := E_FAIL; end; end; function TfrxReport.FindCOMObject(const ObjectName: WideString; out Obj: IfrxComponent): HResult; stdcall; begin try Result := (Self as IfrxComponent).FindObject(ObjectName, obj); except Result := E_FAIL; end end; function TfrxReport.FindObjectEx(const ObjectName: WideString; out Obj: IfrxComponent): HResult; stdcall; begin try Result := (Self as IfrxComponent).FindObject(ObjectName, obj); obj := DispatchableComponentFactory.CreateComObject(obj) as IfrxComponent; except Result := E_FAIL; end end; function TfrxReport.ClearDatasets: HResult; stdcall; begin Datasets.Clear; DatasetList.Destroy; DatasetList := TfrxGlobalDataSetList.Create; Result := S_OK; end; function TfrxReport.LoadLanguageResourcesFromFile(const FileName: WideString): HResult; stdcall; begin Application.MessageBox( PChar('Deprecated Method. Use LoadLanguageResourcesFromFile method of IfrxResources interface.'), 'Beta version message'); Result := E_NOTIMPL; end; function TfrxReport.GetResourceString(const ID: WideString; out ResourceString_: WideString): HResult; stdcall; begin Application.MessageBox( PChar('Deprecated Method. Use LoadLanguageResourcesFromFile method of IfrxResources interface.'), 'Beta version message'); Result := E_NOTIMPL; end; function TfrxReport.Set_MainWindowHandle(Value: Integer): HResult; stdcall; begin Application.Handle := HWND(Value); Result := S_OK; end; function TfrxReport.Get_Resources(out Value: IfrxResources): HResult; stdcall; begin Value := frxResources; Result := S_OK; end; function TfrxReport.Get_Version(out Value: WideString): HResult; stdcall; begin Value := Version; Result := S_OK; end; function TfrxReport.Get_Page(Index: Integer; out Value: IfrxPage): HResult; stdcall; begin Value := Pages[Index]; Result := S_OK; end; function TfrxReport.Get_PagesCount(out Value: Integer): HResult; stdcall; begin Value := PagesCount; Result := S_OK; end; function TfrxReport.ExportToPDF(const FileName: WideString; Compressed, EmbeddedFonts, PrintOptimized: WordBool): HResult; {$IFNDEF FR_LITE} var Export2PDF: TfrxPDFExport; begin try Export2PDF := TfrxPDFExport.Create(nil); Export2PDF.FileName := String(FileName); Export2PDF.ShowDialog := False; Export2PDF.Compressed := Compressed; Export2PDF.EmbeddedFonts := EmbeddedFonts; Export2PDF.PrintOptimized := PrintOptimized; Export2PDF.ShowProgress := ShowProgress; Export(Export2PDF); Export2PDF.Destroy; Result := S_OK; except Result := E_FAIL; end; end; {$ELSE} begin Result := E_NOTIMPL; end; {$ENDIF} function TfrxReport.ExportToBMP(const FileName: WideString; Resolution: SYSINT; Monochrome, CropPages, SeparatePages: WordBool): HResult; {$IFNDEF FR_LITE} var Export2BMP: TfrxBMPExport; begin try Export2BMP := TfrxBMPExport.Create(nil); Export2BMP.FileName := String(FileName); Export2BMP.ShowDialog := False; Export2BMP.Resolution := Resolution; Export2BMP.Monochrome := Monochrome; Export2BMP.CropImages := CropPages; Export2BMP.SeparateFiles := SeparatePages; Export2BMP.ShowProgress := ShowProgress; Export(Export2BMP); Export2BMP.Destroy; Result := S_OK; except Result := E_FAIL; end; end; {$ELSE} begin Result := E_NOTIMPL; end; {$ENDIF} function TfrxReport.ExportToHTML(const FileName: WideString; Pictures, FixedWidth, Multipage, Navigator, PicsInSameFolder, Background: WordBool): HResult; {$IFNDEF FR_LITE} var Export2HTML: TfrxHTMLExport; begin try Export2HTML := TfrxHTMLExport.Create(nil); Export2HTML.FileName := String(FileName); Export2HTML.ShowDialog := False; Export2HTML.ExportPictures := Pictures; Export2HTML.FixedWidth := FixedWidth; Export2HTML.Multipage := Multipage; Export2HTML.Navigator := Navigator; Export2HTML.PicsInSameFolder := PicsInSameFolder; Export2HTML.Background := Background; Export2HTML.ShowProgress := ShowProgress; Export(Export2HTML); Export2HTML.Destroy; Result := S_OK; except Result := E_FAIL; end; end; {$ELSE} begin Result := E_NOTIMPL; end; {$ENDIF} function TfrxReport.ExportToRTF(const FileName: WideString; Pictures, PageBreaks, WYSIWYG: WordBool): HResult; {$IFNDEF FR_LITE} var Export2RTF: TfrxRTFExport; begin try Export2RTF := TfrxRTFExport.Create(nil); Export2RTF.FileName := String(FileName); Export2RTF.ShowDialog := False; Export2RTF.ExportPictures := Pictures; Export2RTF.ExportPageBreaks := PageBreaks; Export2RTF.Wysiwyg := WYSIWYG; Export2RTF.ShowProgress := ShowProgress; Export(Export2RTF); Export2RTF.Destroy; Result := S_OK; except Result := E_FAIL; end; end; {$ELSE} begin Result := E_NOTIMPL; end; {$ENDIF} function TfrxReport.ExportToTXT( const FileName: WideString; PageBreaks: WordBool; Frames: WordBool; OEMCodepage: WordBool; EmptyLines: WordBool): HResult; stdcall; var Export2TXT: TfrxSimpleTextExport; begin try Export2TXT := TfrxSimpleTextExport.Create(nil); Export2TXT.FileName := String(FileName); Export2TXT.ShowDialog := False; Export2TXT.ShowProgress := ShowProgress; Export2TXT.PageBreaks := PageBreaks; Export2TXT.Frames := Frames; Export2TXT.OEMCodepage := OEMCodepage; Export2TXT.EmptyLines := EmptyLines; Export(Export2TXT); Export2TXT.Destroy; Result := S_OK; except Result := E_FAIL; end; end; function TfrxReport.ExportToXLS(const szFileName: WideString; Pictures, PageBreaks, WYSIWYG, AsText, Background: WordBool): HResult; {$IFNDEF FR_LITE} var Export2XLS: TfrxXLSExport; begin try Export2XLS := TfrxXLSExport.Create(nil); Export2XLS.FileName := String(szFileName); Export2XLS.ShowDialog := False; Export2XLS.ExportPictures := Pictures; Export2XLS.PageBreaks := PageBreaks; Export2XLS.Wysiwyg := WYSIWYG; Export2XLS.AsText := AsText; Export2XLS.Background := Background; Export2XLS.ShowProgress := ShowProgress; Export(Export2XLS); Export2XLS.Destroy; Result := S_OK; except Result := E_FAIL; end; end; {$ELSE} begin Result := E_NOTIMPL; end; {$ENDIF} function TfrxReport.ExportToXML(const FileName: WideString; Styles, PageBreaks, WYSIWYG, Background: WordBool): HResult; {$IFNDEF FR_LITE} var Export2XML: TfrxXMLExport; begin try Export2XML := TfrxXMLExport.Create(nil); Export2XML.FileName := String(FileName); Export2XML.ShowDialog := False; Export2XML.ExportStyles := Styles; Export2XML.ExportPageBreaks := PageBreaks; Export2XML.Wysiwyg := WYSIWYG; Export2XML.Background := Background; Export2XML.ShowProgress := ShowProgress; Export(Export2XML); Export2XML.Destroy; Result := S_OK; except Result := E_FAIL; end; end; {$ELSE} begin Result := E_NOTIMPL; end; {$ENDIF} function TfrxReport.ExportToJPEG(const FileName: WideString; Resolution, JpegQuality: SYSINT; Monochrome, CropPages, SeparatePages: WordBool): HResult; {$IFNDEF FR_LITE} var Export2JPEG: TfrxJPEGExport; begin try Export2JPEG := TfrxJPEGExport.Create(nil); Export2JPEG.FileName := String(FileName); Export2JPEG.ShowDialog := False; Export2JPEG.Resolution := Resolution; Export2JPEG.JPEGQuality := JpegQuality; Export2JPEG.Monochrome := Monochrome; Export2JPEG.CropImages := CropPages; Export2JPEG.SeparateFiles := SeparatePages; Export2JPEG.ShowProgress := ShowProgress; Export(Export2JPEG); Export2JPEG.Destroy; Result := S_OK; except Result := E_FAIL; end; end; {$ELSE} begin Result := E_NOTIMPL; end; {$ENDIF} function TfrxReport.ExportToTIFF(const FileName: WideString; Resolution: SYSINT; Monochrome, CropPages, SeparatePages: WordBool): HResult; {$IFNDEF FR_LITE} var Export2TIFF: TfrxTIFFExport; begin try Export2TIFF := TfrxTIFFExport.Create(nil); Export2TIFF.FileName := FileName; Export2TIFF.ShowDialog := False; Export2TIFF.Resolution := Resolution; Export2TIFF.Monochrome := Monochrome; Export2TIFF.CropImages := CropPages; Export2TIFF.SeparateFiles := SeparatePages; Export2TIFF.ShowProgress := ShowProgress; Export(Export2TIFF); Export2TIFF.Destroy; Result := S_OK; except Result := E_FAIL; end; end; {$ELSE} begin Result := E_NOTIMPL; end; {$ENDIF} function TfrxReport.ExportToGIF(const FileName: WideString; Resolution: SYSINT; Monochrome, CropPages, SeparatePages: WordBool): HResult; stdcall; {$IFNDEF FR_LITE} var Export2GIF: TfrxGIFExport; begin try Export2GIF := TfrxGIFExport.Create(nil); Export2GIF.FileName := FileName; Export2GIF.ShowDialog := False; Export2GIF.Resolution := Resolution; Export2GIF.Monochrome := Monochrome; Export2GIF.CropImages := CropPages; Export2GIF.SeparateFiles := SeparatePages; Export2GIF.ShowProgress := ShowProgress; Export(Export2GIF); Export2GIF.Destroy; Result := S_OK; except Result := E_FAIL; end; end; {$ELSE} begin Result := E_NOTIMPL; end; {$ENDIF} function TfrxReport.ExportToCSV(const FileName: WideString; const Separator: WideString; OEMCodepage: WordBool): HResult; stdcall; var Export2CSV: TfrxCSVExport; begin try Export2CSV := TfrxCSVExport.Create(nil); Export2CSV.FileName := FileName; Export2CSV.Separator := Separator; Export2CSV.OEMCodepage := OEMCodepage; Export2CSV.ShowProgress := ShowProgress; Export(Export2CSV); Export2CSV.Destroy; Result := S_OK; except Result := E_FAIL; end; end; function TfrxReport.SendMail(const Server: WideString; Port: SYSINT; const User: WideString; const Password: WideString; const From: WideString; const To_: WideString; const Subject: WideString; const Text: WideString; const FileName: WideString; const AttachName: WideString): HResult; stdcall; {$IFNDEF FR_LITE} begin Export2Mail.ShowProgress := ShowProgress; Export2Mail.Mail(Server, Port, User, Password, From, To_, Subject, Text, FileName, AttachName); Result := S_OK; end; {$ELSE} begin Result := E_NOTIMPL; end; {$ENDIF} function TfrxReport.ExportToDMP(const FileName: WideString): HResult; stdcall; {$IFNDEF FR_LITE} var Export2DMP: TfrxDotMatrixExport; begin try Export2DMP := TfrxDotMatrixExport.Create(nil); Export2DMP.FileName := FileName; Export2DMP.ShowDialog := False; Export2DMP.SaveToFile := True; Export(Export2DMP); Export2DMP.Destroy; Result := S_OK; except Result := E_FAIL; end; end; {$ELSE} begin Result := E_NOTIMPL; end; {$ENDIF} function TfrxReport.Get_OldStyleProgress(out Value: WordBool): HResult; stdcall; begin Value := OldStyleProgress; Result := S_OK; end; function TfrxReport.Set_OldStyleProgress(Value: WordBool): HResult; stdcall; begin OldStyleProgress := Value; Result := S_OK; end; function TfrxReport.Get_Engine(out Value: IfrxCustomEngine): HResult; stdcall; begin Value := Engine; Result := S_OK; end; {$ENDIF} { TfrxCustomDesigner } constructor TfrxCustomDesigner.CreateDesigner(AOwner: TComponent; AReport: TfrxReport; APreviewDesigner: Boolean); begin inherited Create(AOwner); FReport := AReport; FIsPreviewDesigner := APreviewDesigner; FObjects := TList.Create; FSelectedObjects := TList.Create; end; destructor TfrxCustomDesigner.Destroy; begin FObjects.Free; FSelectedObjects.Free; inherited; end; procedure TfrxCustomDesigner.SetModified(const Value: Boolean); begin FModified := Value; if Value then FReport.Modified := True; end; procedure TfrxCustomDesigner.SetPage(const Value: TfrxPage); begin FPage := Value; end; { TfrxCustomEngine } constructor TfrxCustomEngine.Create(AReport: TfrxReport); begin FReport := AReport; FNotifyList := TList.Create; {$IFDEF FR_COM} inherited Create(IfrxCustomEngine); {$ENDIF} end; destructor TfrxCustomEngine.Destroy; begin FNotifyList.Free; inherited; end; function TfrxCustomEngine.GetDoublePass: Boolean; begin Result := FReport.EngineOptions.DoublePass; end; procedure TfrxCustomEngine.ShowBandByName(const BandName: String); begin ShowBand(TfrxBand(Report.FindObject(BandName))); end; procedure TfrxCustomEngine.StopReport; begin Report.Terminated := True; end; {$IFDEF FR_COM} function TfrxCustomEngine.Get_CurColumn(out Value: Integer): HResult; stdcall; begin Value := CurColumn; Result := S_OK; end; function TfrxCustomEngine.Set_CurColumn(Value: Integer): HResult; stdcall; begin CurColumn := Value; Result := S_OK; end; function TfrxCustomEngine.Get_CurVColumn(out Value: Integer): HResult; stdcall; begin Value := CurVColumn; Result := S_OK; end; function TfrxCustomEngine.Set_CurVColumn(Value: Integer): HResult; stdcall; begin CurVColumn := Value; Result := S_OK; end; function TfrxCustomEngine.Get_CurX(out Value: Double): HResult; stdcall; begin Value := CurX; Result := S_OK; end; function TfrxCustomEngine.Set_CurX(Value: Double): HResult; stdcall; begin CurX := Value; Result := S_OK; end; function TfrxCustomEngine.Get_CurY(out Value: Double): HResult; stdcall; begin Value := CurY; Result := S_OK; end; function TfrxCustomEngine.Set_CurY(Value: Double): HResult; stdcall; begin CurY := Value; Result := S_OK; end; function TfrxCustomEngine.Get_DoublePass(out Value: WordBool): HResult; stdcall; begin Value := DoublePass; Result := S_OK; end; function TfrxCustomEngine.Get_FinalPass(out Value: WordBool): HResult; stdcall; begin Value := FinalPass; Result := S_OK; end; function TfrxCustomEngine.Set_FinalPass(Value: WordBool): HResult; stdcall; begin FinalPass := Value; Result := S_OK; end; function TfrxCustomEngine.Get_PageHeight(out Value: Double): HResult; stdcall; begin Value := PageHeight; Result := S_OK; end; function TfrxCustomEngine.Set_PageHeight(Value: Double): HResult; stdcall; begin PageHeight := Value; Result := S_OK; end; function TfrxCustomEngine.Get_PageWidth(out Value: Double): HResult; stdcall; begin Value := PageWidth; Result := S_OK; end; function TfrxCustomEngine.Set_PageWidth(Value: Double): HResult; stdcall; begin PageWIdth := Value; Result := S_OK; end; function TfrxCustomEngine.Get_StartDate(out Value: TDateTime): HResult; stdcall; begin Value := StartDate; Result := S_OK; end; function TfrxCustomEngine.Set_StartDate(Value: TDateTime): HResult; stdcall; begin StartDate := Value; Result := S_OK; end; function TfrxCustomEngine.Get_TotalPages(out Value: Integer): HResult; stdcall; begin Value := TotalPages; Result := S_OK; end; function TfrxCustomEngine.Set_TotalPages(Value: Integer): HResult; stdcall; begin TotalPages := Value; Result := S_OK; end; {$ENDIF} { TfrxCustomOutline } constructor TfrxCustomOutline.Create(APreviewPages: TfrxCustomPreviewPages); begin FPreviewPages := APreviewPages; end; function TfrxCustomOutline.Engine: TfrxCustomEngine; begin Result := FPreviewPages.Engine; end; { TfrxCustomPreviewPages } constructor TfrxCustomPreviewPages.Create(AReport: TfrxReport); begin FReport := AReport; FOutline := TfrxOutline.Create(Self); end; destructor TfrxCustomPreviewPages.Destroy; begin FOutline.Free; inherited; end; {$IFDEF FR_COM} function TfrxCustomPreviewPages.IfrxCustomPreviewPages_AddObject(const Value: IfrxComponent): HResult; stdcall; var idsp: {IfrxComponentSelf} IInterfaceComponentReference; begin try Result := Value.QueryInterface( {IfrxComponentSelf} IInterfaceComponentReference, idsp); if Result = S_OK then AddObject( TfrxComponent(idsp.GetComponent) {Get_Object} ); except Result := E_FAIL; end; end; function TfrxCustomPreviewPages.IfrxCustomPreviewPages_AddPage(const Value: IfrxReportPage): HResult; stdcall; var idsp: {IfrxComponentSelf} IInterfaceComponentReference; begin try Result := Value.QueryInterface( {IfrxComponentSelf} IInterfaceComponentReference, idsp); if Result = S_OK then AddPage( TfrxReportPage(idsp.GetComponent {Get_Object}) ); except Result := E_FAIL; end; end; function TfrxCustomPreviewPages.IfrxCustomPreviewPages_AddEmptyPage(Index: Integer): HResult; stdcall; begin AddEmptyPage(Index); Result := S_OK; end; function TfrxCustomPreviewPages.IfrxCustomPreviewPages_DeletePage(Index: Integer): HResult; stdcall; begin DeletePage(Index); Result := S_OK; end; function TfrxCustomPreviewPages.Get_Count(out Value: Integer): HResult; stdcall; begin Value := Count; Result := S_OK; end; function TfrxCustomPreviewPages.Get_CurrentPage(out Value: Integer): HResult; stdcall; begin Value := CurPage; Result := S_OK; end; function TfrxCustomPreviewPages.Set_CurrentPage(Value: Integer): HResult; stdcall; begin CurPage := Value; Result := S_OK; end; function TfrxCustomPreviewPages.Get_CurPreviewPage(out Value: Integer): HResult; stdcall; begin Value := CurPreviewPage; Result := S_OK; end; function TfrxCustomPreviewPages.Set_CurPreviewPage(Value: Integer): HResult; stdcall; begin CurPreviewPage := Value; Result := S_OK; end; function TfrxCustomPreviewPages.IfrxCustomPreviewPages_Page(Index: Integer; out Value: IfrxReportPage): HResult; stdcall; begin Value := Page[Index] as IfrxReportPage; Result := S_OK; end; {$ENDIF} { TfrxExpressionCache } constructor TfrxExpressionCache.Create(AScript: TfsScript); begin FExpressions := TStringList.Create; FExpressions.Sorted := True; FScript := TfsScript.Create(nil); FScript.ExtendedCharset := True; FMainScript := AScript; end; destructor TfrxExpressionCache.Destroy; begin FExpressions.Free; FScript.Free; inherited; end; procedure TfrxExpressionCache.Clear; begin FExpressions.Clear; FScript.Clear; end; function TfrxExpressionCache.Calc(const Expression: String; var ErrorMsg: String; AScript: TfsScript): Variant; var i: Integer; v: TfsProcVariable; begin ErrorMsg := ''; FScript.Parent := AScript; i := FExpressions.IndexOf(Expression); if i = -1 then begin i := FExpressions.Count; FScript.SyntaxType := FScriptLanguage; if CompareText(FScriptLanguage, 'PascalScript') = 0 then FScript.Lines.Text := 'function fr3f' + IntToStr(i) + ': Variant; begin ' + 'Result := ' + Expression + ' end; begin end.' else if CompareText(FScriptLanguage, 'C++Script') = 0 then FScript.Lines.Text := 'Variant fr3f' + IntToStr(i) + '() { ' + 'return ' + Expression + '; } {}' else if CompareText(FScriptLanguage, 'BasicScript') = 0 then FScript.Lines.Text := 'function fr3f' + IntToStr(i) + #13#10 + 'return ' + Expression + #13#10 + 'end function' else if CompareText(FScriptLanguage, 'JScript') = 0 then FScript.Lines.Text := 'function fr3f' + IntToStr(i) + '() { ' + 'return ' + Expression + '; }'; if FScript.Compile then v := TfsProcVariable(FScript.Find('fr3f' + IntToStr(i))) else begin ErrorMsg := frxResources.Get('clExprError') + ' ''' + Expression + ''': ' + FScript.ErrorMsg; Result := Null; Exit; end; FExpressions.AddObject(Expression, v); end else v := TfsProcVariable(FExpressions.Objects[i]); FMainScript.MainProg := False; try try Result := v.Value; except on e: Exception do ErrorMsg := e.Message; end; finally FMainScript.MainProg := True; end; end; { TfrxCustomExportFilter } constructor TfrxCustomExportFilter.Create(AOwner: TComponent); begin inherited; if not FNoRegister then frxExportFilters.Register(Self); FShowDialog := True; FUseFileCache := True; FDefaultPath := ''; FShowProgress := True; FSlaveExport := False; end; constructor TfrxCustomExportFilter.CreateNoRegister; begin FNoRegister := True; Create(nil); end; destructor TfrxCustomExportFilter.Destroy; begin if not FNoRegister then frxExportFilters.Unregister(Self); inherited; end; class function TfrxCustomExportFilter.GetDescription: String; begin Result := ''; end; procedure TfrxCustomExportFilter.Finish; begin // end; procedure TfrxCustomExportFilter.FinishPage(Page: TfrxReportPage; Index: Integer); begin // end; function TfrxCustomExportFilter.ShowModal: TModalResult; begin Result := mrOk; end; function TfrxCustomExportFilter.Start: Boolean; begin Result := True; end; procedure TfrxCustomExportFilter.StartPage(Page: TfrxReportPage; Index: Integer); begin // end; { TfrxCustomWizard } constructor TfrxCustomWizard.Create(AOwner: TComponent); begin inherited; FDesigner := TfrxCustomDesigner(AOwner); FReport := FDesigner.Report; end; class function TfrxCustomWizard.GetDescription: String; begin Result := ''; end; { TfrxCustomCompressor } constructor TfrxCustomCompressor.Create(AOwner: TComponent); begin inherited; FOldCompressor := frxCompressorClass; frxCompressorClass := TfrxCompressorClass(ClassType); end; destructor TfrxCustomCompressor.Destroy; begin frxCompressorClass := FOldCompressor; if FStream <> nil then FStream.Free; if FTempFile <> '' then SysUtils.DeleteFile(FTempFile); inherited; end; procedure TfrxCustomCompressor.CreateStream; begin if FIsFR3File or not FReport.EngineOptions.UseFileCache then FStream := TMemoryStream.Create else begin FTempFile := frxCreateTempFile(FReport.EngineOptions.TempDir); FStream := TFileStream.Create(FTempFile, fmCreate); end; end; {$IFDEF FR_COM} function TfrxCustomCompressor.CompressStream( const InputStream: IUnknown; const OutputStream: IUnknown; Compression_: Integer; const FileName: WideString): HResult; stdcall; var ComStream: IStream; OleInputStream: TOleStream; OleOutputStream: TOleStream; NetStream: _Stream; ClrInputStream: TClrStream; ClrOutputStream: TClrStream; begin try Result := InputStream.QueryInterface(IStream, ComStream); if Result = S_OK then begin OleInputStream := TOleStream.Create(ComStream); OleOutputStream := TOleStream.Create(OutputStream as IStream); frxCompressStream(OleInputStream, OleOutputStream, gzMax, FileName); OleInputStream.Free; OleOutputStream.Free; ComStream := nil; end else begin Result := InputStream.QueryInterface(_Stream, NetStream); if Result = S_OK then begin ClrInputStream := TClrStream.Create(NetStream); ClrOutputStream := TClrStream.Create(OutputStream as _Stream); frxCompressStream(ClrInputStream, ClrOutputStream, gzMax, FileName); ClrInputStream.Free; ClrOutputStream.Free; NetStream._Release(); end; end; except Result := E_FAIL; end; if FStream <> nil then FStream.Free; if FTempFile <> '' then SysUtils.DeleteFile(FTempFile); end; function TfrxCustomCompressor.DecompressStream(const Stream: IUnknown): HResult; stdcall; var ComStream: IStream; OleStream: TOleStream; NetStream: _Stream; ClrStream: TClrStream; begin try Result := Stream.QueryInterface(IStream, ComStream); if Result = S_OK then begin OleStream := TOleStream.Create(ComStream); Decompress(OleStream); OleStream.Free; ComStream := nil; end else begin Result := Stream.QueryInterface(_Stream, NetStream); if Result = S_OK then begin ClrStream := TClrStream.Create(NetStream); Decompress(ClrStream); ClrStream.Free; NetStream._Release(); end; end; except Result := E_FAIL; end; end; {$ENDIF} { TfrxCustomCrypter } constructor TfrxCustomCrypter.Create(AOwner: TComponent); begin inherited; frxCrypterClass := TfrxCrypterClass(ClassType); end; destructor TfrxCustomCrypter.Destroy; begin if FStream <> nil then FStream.Free; inherited; end; procedure TfrxCustomCrypter.CreateStream; begin FStream := TMemoryStream.Create; end; { TfrxGlobalDataSetList } constructor TfrxGlobalDataSetList.Create; begin {$IFNDEF NO_CRITICAL_SECTION} FCriticalSection := TCriticalSection.Create; {$ENDIF} inherited; end; destructor TfrxGlobalDataSetList.Destroy; begin {$IFNDEF NO_CRITICAL_SECTION} FCriticalSection.Free; FCriticalSection := nil; {$ENDIF} inherited; end; procedure TfrxGlobalDataSetList.Lock; begin {$IFNDEF NO_CRITICAL_SECTION} if FCriticalSection <> nil then FCriticalSection.Enter; {$ENDIF} end; procedure TfrxGlobalDataSetList.Unlock; begin {$IFNDEF NO_CRITICAL_SECTION} if FCriticalSection <> nil then FCriticalSection.Leave; {$ENDIF} end; initialization {$IFNDEF NO_CRITICAL_SECTION} frxCS := TCriticalSection.Create; {$ENDIF} DatasetList := TfrxGlobalDataSetList.Create; frxGlobalVariables := TfrxVariables.Create; { create parent form for OLE and RICH controls in the main thread } frxParentForm; Screen.Cursors[crHand] := LoadCursor(hInstance, 'frxHAND'); Screen.Cursors[crZoom] := LoadCursor(hInstance, 'frxZOOM'); Screen.Cursors[crFormat] := LoadCursor(hInstance, 'frxFORMAT'); RegisterClasses([ TfrxChild, TfrxColumnFooter, TfrxColumnHeader, TfrxCustomMemoView, TfrxMasterData, TfrxDetailData, TfrxSubDetailData, TfrxDataBand4, TfrxDataBand5, TfrxDataBand6, TfrxDialogPage, TfrxFooter, TfrxFrame, TfrxGroupFooter, TfrxGroupHeader, TfrxHeader, TfrxHighlight, TfrxLineView, TfrxMemoView, TfrxOverlay, TfrxPageFooter, TfrxPageHeader, TfrxPictureView, TfrxReport, TfrxReportPage, TfrxReportSummary, TfrxReportTitle, TfrxShapeView, TfrxSubreport, TfrxSysMemoView, TfrxStyleItem, TfrxNullBand, TfrxCustomLineView, TfrxDataPage]); frxResources.UpdateFSResources; frxFR2Events := TfrxFR2Events.Create; {$IFDEF FR_COM} frxGZipCompressor := TfrxGZipCompressor.Create(nil); {$IFNDEF EXT_EXPORTS} {$IFNDEF FR_LITE} Export2PDF := TfrxPDFExport.Create(nil); Export2XLS := TfrxXLSExport.Create(nil); Export2XML := TfrxXMLExport.Create(nil); Export2RTF := TfrxRTFExport.Create(nil); Export2HTML := TfrxHTMLExport.Create(nil); Export2BMP := TfrxBMPExport.Create(nil); Export2JPEG := TfrxJPEGExport.Create(nil); Export2TIFF := TfrxTIFFExport.Create(nil); Export2GIF := TfrxGIFExport.Create(nil); Export2Mail := TfrxMailExport.Create(nil); Export2DMP := TfrxDotMatrixExport.Create(nil); {$ENDIF} Export2TXT := TfrxSimpleTextExport.Create(nil); Export2CSV := TfrxCSVExport.Create(nil); {$ENDIF} try TComponentFactory.Create(ComServer, TfrxReport, Class_TfrxReport, ciMultiInstance, tmApartment); TComponentFactory.Create(ComServer, TfrxUserDataSet, CLASS_TfrxUserDataSet, ciMultiInstance, tmApartment); TComponentFactory.Create(ComServer, TfrxGZipCompressor, CLASS_TfrxGZipCompressor, ciMultiInstance, tmApartment); DispatchableComponentFactory := TComponentFactory.Create(ComServer, TfrxComponent, CLASS_TfrxDispatchableComponent, ciMultiInstance, tmApartment); except end; {$ENDIF} finalization {$IFNDEF NO_CRITICAL_SECTION} frxCS.Free; {$ENDIF} {$IFDEF FR_COM} // if frxDefaultConnection <> nil then frxDefaultConnection.Free; if frxADOComponent <> nil then frxADOComponent.Free; {$IFNDEF EXT_EXPORTS} {$IFNDEF FR_LITE} Export2Gif.Destroy; Export2Mail.Destroy; Export2TIFF.Destroy; Export2JPEG.Destroy; Export2XML.Destroy; Export2XLS.Destroy; Export2RTF.Destroy; Export2HTML.Destroy; Export2BMP.Destroy; Export2PDF.Destroy; Export2DMP.Destroy; {$ENDIF} Export2CSV.Destroy; Export2TXT.Destroy; {$ENDIF} if frxGZipCompressor <> nil then frxGZipCompressor.Destroy; {$ENDIF} frxGlobalVariables.Free; DatasetList.Free; if FParentForm <> nil then begin EmptyParentForm; FParentForm.Free; end; FParentForm := nil; frxFR2Events.Free; end. //862fd5d6aa1a637203d9b08a3c0bcfb0