1326 lines
43 KiB
ObjectPascal
1326 lines
43 KiB
ObjectPascal
{ --------------------------------------------------------------------------- }
|
|
{ AnyDAC FastReport v 4.0 enduser components }
|
|
{ }
|
|
{ (c)opyright DA-SOFT Technologies 2004-2013. }
|
|
{ All rights reserved. }
|
|
{ }
|
|
{ Initially created by: Serega Glazyrin <glserega@mezonplus.ru> }
|
|
{ Extended by: Francisco Armando Duenas Rodriguez <fduenas@gmxsoftware.com> }
|
|
{ --------------------------------------------------------------------------- }
|
|
{$I frx.inc}
|
|
{$I fmx.inc}
|
|
|
|
unit FMX.frxFDComponents;
|
|
|
|
interface
|
|
|
|
uses
|
|
System.Classes, System.SysUtils, FMX.frxClass, FMX.frxCustomDB, Data.DB, FireDAC.DatS,
|
|
FireDAC.Comp.Client, FireDAC.Stan.Option, FireDAC.Comp.DataSet
|
|
{$IFDEF Delphi6}
|
|
, System.Variants
|
|
{$ENDIF}
|
|
{$IFDEF QBUILDER}
|
|
, fqbClass
|
|
{$ENDIF};
|
|
|
|
type
|
|
{$I frxFMX_PlatformsAttribute.inc}
|
|
TfrxFDComponents = class(TfrxDBComponents)
|
|
private
|
|
FDefaultDatabase: TFDConnection;
|
|
FOldComponents: TfrxFDComponents;
|
|
FDesignTimeExpr: Boolean;
|
|
procedure SetDefaultDatabase(const AValue: TFDConnection);
|
|
protected
|
|
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
|
|
public
|
|
constructor Create(AOwner: TComponent); override;
|
|
destructor Destroy; override;
|
|
function GetDescription: String; override;
|
|
published
|
|
property DefaultDatabase: TFDConnection read FDefaultDatabase write SetDefaultDatabase;
|
|
// whether or not to calc expressions at design-time
|
|
property DesignTimeExpr: Boolean read FDesignTimeExpr write FDesignTimeExpr
|
|
stored True default True;
|
|
end;
|
|
|
|
TfrxFDDatabase = class(TfrxCustomDatabase)
|
|
private
|
|
FDatabase: TFDConnection;
|
|
function GetDriverName: string;
|
|
procedure SetDriverName(const AValue: string);
|
|
function GetConnectionDefName: string;
|
|
procedure SetConnectionDefName(const AValue: string);
|
|
protected
|
|
procedure SetConnected(AValue: Boolean); override;
|
|
procedure SetDatabaseName(const AValue: String); override;
|
|
procedure SetLoginPrompt(AValue: Boolean); override;
|
|
procedure SetParams(AValue: TStrings); override;
|
|
function GetConnected: Boolean; override;
|
|
function GetDatabaseName: String; override;
|
|
function GetLoginPrompt: Boolean; override;
|
|
function GetParams: TStrings; override;
|
|
public
|
|
constructor Create(AOwner: TComponent); override;
|
|
destructor Destroy; override;
|
|
class function GetDescription: String; override;
|
|
procedure SetLogin(const ALogin, APassword: String); override;
|
|
function ToString: WideString; override;
|
|
procedure FromString(const AConnection: WideString); override;
|
|
property Database: TFDConnection read FDatabase;
|
|
published
|
|
property ConnectionDefName: string read GetConnectionDefName write SetConnectionDefName;
|
|
property DriverName: string read GetDriverName write SetDriverName;
|
|
property DatabaseName;
|
|
property Params;
|
|
property LoginPrompt;
|
|
property Connected;
|
|
end;
|
|
|
|
TfrxFDQuery = class(TfrxCustomQuery)
|
|
private
|
|
FDatabase: TfrxFDDatabase;
|
|
FQuery: TFDQuery;
|
|
procedure SetDatabase(const AValue: TfrxFDDatabase);
|
|
function GetUniDirectional: boolean;
|
|
procedure SetUniDirectional(const AValue: boolean);
|
|
procedure DoMasterSetValues(ASender: TFDDataSet);
|
|
protected
|
|
FLocked: Boolean;
|
|
FStrings: TStrings;
|
|
procedure Notification(AComponent: TComponent; AOperation: TOperation); override;
|
|
procedure OnChangeSQL(Sender: TObject); override;
|
|
procedure SetMaster(const AValue: TDataSource); override;
|
|
procedure SetMasterFields(const AValue: String); override;
|
|
procedure SetSQL(AValue: TStrings); override;
|
|
function GetSQL: TStrings; override;
|
|
public
|
|
constructor Create(AOwner: TComponent); override;
|
|
constructor DesignCreate(AOwner: TComponent; AFlags: Word); override;
|
|
destructor Destroy; override;
|
|
class function GetDescription: String; override;
|
|
procedure BeforeStartReport; override;
|
|
procedure FetchParams; virtual;
|
|
procedure UpdateParams; override;
|
|
{$IFDEF QBUILDER}
|
|
function QBEngine: TfqbEngine; override;
|
|
{$ENDIF}
|
|
property Query: TFDQuery read FQuery;
|
|
published
|
|
property SQL;
|
|
property Database: TfrxFDDatabase read FDatabase write SetDatabase;
|
|
property UniDirectional: Boolean read GetUniDirectional write SetUniDirectional default False;
|
|
property MasterFields;
|
|
end;
|
|
|
|
TfrxFDTable = class(TfrxCustomTable)
|
|
private
|
|
FDatabase: TfrxFDDatabase;
|
|
FTable: TFDTable;
|
|
procedure SetDatabase(const AValue: TfrxFDDatabase);
|
|
function GetCatalogName: String;
|
|
function GetSchemaName: String;
|
|
procedure SetCatalogName(const AValue: String);
|
|
procedure SetSchemaName(const AValue: String);
|
|
protected
|
|
procedure Notification(AComponent: TComponent; AOperation: TOperation); override;
|
|
procedure SetMaster(const AValue: TDataSource); override;
|
|
procedure SetMasterFields(const AValue: String); override;
|
|
procedure SetIndexFieldNames(const AValue: String); override;
|
|
procedure SetIndexName(const AValue: String); override;
|
|
procedure SetTableName(const AValue: String); override;
|
|
function GetIndexFieldNames: String; override;
|
|
function GetIndexName: String; override;
|
|
function GetTableName: String; override;
|
|
public
|
|
constructor Create(AOwner: TComponent); override;
|
|
destructor Destroy; override;
|
|
constructor DesignCreate(AOwner: TComponent; AFlags: Word); override;
|
|
class function GetDescription: String; override;
|
|
procedure BeforeStartReport; override;
|
|
property Table: TFDTable read FTable;
|
|
published
|
|
property Database: TfrxFDDatabase read FDatabase write SetDatabase;
|
|
property CatalogName: String read GetCatalogName write SetCatalogName;
|
|
property SchemaName: String read GetSchemaName write SetSchemaName;
|
|
end;
|
|
|
|
TfrxCustomStoredProc = class(TfrxCustomDataset)
|
|
private
|
|
FParams: TfrxParams;
|
|
FSaveOnBeforeOpen: TDataSetNotifyEvent;
|
|
FSaveOnAfterOpen: TDataSetNotifyEvent;
|
|
procedure ReadParamData(AReader: TReader);
|
|
procedure WriteParamData(AWriter: TWriter);
|
|
procedure SetParams(AValue: TfrxParams);
|
|
protected
|
|
procedure DefineProperties(AFiler: TFiler); override;
|
|
function GetStoredProcName: string; virtual;
|
|
procedure SetStoredProcName(const AValue: string); virtual;
|
|
procedure TriggerOnBeforeOpen(ADataSet: TDataSet); virtual;
|
|
procedure TriggerOnAfterOpen(ADataSet: TDataSet); virtual;
|
|
public
|
|
constructor Create(AOwner: TComponent); override;
|
|
destructor Destroy; override;
|
|
procedure ExecProc; virtual;
|
|
procedure UpdateParams; virtual;
|
|
procedure Prepare; virtual;
|
|
procedure FetchParams; virtual;
|
|
function ParamByName(const AValue: String): TfrxParamItem;
|
|
published
|
|
property Params: TfrxParams read FParams write SetParams;
|
|
property StoredProcName: string read GetStoredProcName write SetStoredProcName; {added by fduenas}
|
|
end;
|
|
|
|
TfrxFDStoredProc = class(TfrxCustomStoredProc)
|
|
private
|
|
FDatabase: TfrxFDDatabase;
|
|
FStoredProc: TFDStoredProc;
|
|
// added for Master-Detail relationship
|
|
procedure DoMasterSetValues(ASender: TFDDataSet);
|
|
procedure SetDatabase(const AValue: TfrxFDDatabase);
|
|
function GetPackageName: String;
|
|
procedure SetPackageName(const AValue: String);
|
|
function GetCatalogName: String;
|
|
function GetSchemaName: String;
|
|
procedure SetCatalogName(const AValue: String);
|
|
procedure SetSchemaName(const AValue: String);
|
|
protected
|
|
procedure Notification(AComponent: TComponent; AOperation: TOperation); override;
|
|
function GetStoredProcName: string; override;
|
|
procedure SetStoredProcName(const AValue: string); override;
|
|
// added for Master-Detail RelationShip
|
|
procedure SetMaster(const AValue: TDataSource); override;
|
|
procedure TriggerOnAfterOpen(ADataSet: TDataSet); override;
|
|
public
|
|
constructor Create(AOwner: TComponent); override;
|
|
constructor DesignCreate(AOwner: TComponent; AFlags: Word); override;
|
|
class function GetDescription: String; override;
|
|
procedure BeforeStartReport; override;
|
|
procedure ExecProc; override;
|
|
procedure Prepare; override;
|
|
procedure UpdateParams; override;
|
|
procedure FetchParams; override;
|
|
property StoredProc: TFDStoredProc read FStoredProc;
|
|
published
|
|
property Database: TfrxFDDatabase read FDatabase write SetDatabase;
|
|
property CatalogName: String read GetCatalogName write SetCatalogName;
|
|
property SchemaName: String read GetSchemaName write SetSchemaName;
|
|
property PackageName: String read GetPackageName write SetPackageName;
|
|
end;
|
|
|
|
{$IFDEF QBUILDER}
|
|
TfrxEngineFD = class(TfqbEngine)
|
|
private
|
|
FQuery: TFDQuery;
|
|
public
|
|
constructor Create(AOwner: TComponent); override;
|
|
destructor Destroy; override;
|
|
procedure ReadTableList(ATableList: TStrings); override;
|
|
procedure ReadFieldList(const ATableName: string; var AFieldList: TfqbFieldList); override;
|
|
function ResultDataSet: TDataSet; override;
|
|
procedure SetSQL(const AValue: string); override;
|
|
end;
|
|
{$ENDIF}
|
|
|
|
var
|
|
GFDComponents: TfrxFDComponents;
|
|
|
|
implementation
|
|
|
|
{$R *.res}
|
|
|
|
uses
|
|
FMX.Dialogs, System.StrUtils,
|
|
FMX.frxFDRTTI,
|
|
{$IFNDEF NO_EDITORS}
|
|
FMX.frxFDEditor,
|
|
{$ENDIF}
|
|
FMX.frxDsgnIntf, FMX.frxUtils, FMX.frxRes,
|
|
FireDAC.Stan.Param, FireDAC.Stan.Def, FireDAC.Stan.Util,
|
|
FireDAC.Phys;
|
|
|
|
type
|
|
TfrxHackFDDataSet = Class(TFDDataSet);
|
|
|
|
{-------------------------------------------------------------------------------}
|
|
{ TfrxFDComponents }
|
|
{-------------------------------------------------------------------------------}
|
|
constructor TfrxFDComponents.Create(AOwner: TComponent);
|
|
begin
|
|
inherited Create(AOwner);
|
|
FOldComponents := GFDComponents;
|
|
FDesignTimeExpr := True;
|
|
GFDComponents := Self;
|
|
end;
|
|
|
|
{-------------------------------------------------------------------------------}
|
|
destructor TfrxFDComponents.Destroy;
|
|
begin
|
|
if GFDComponents = Self then
|
|
GFDComponents := FOldComponents;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
{-------------------------------------------------------------------------------}
|
|
procedure TfrxFDComponents.Notification(AComponent: TComponent;
|
|
Operation: TOperation);
|
|
begin
|
|
inherited Notification(AComponent, Operation);
|
|
if (AComponent = FDefaultDatabase) and (Operation = opRemove) then
|
|
FDefaultDatabase := nil;
|
|
end;
|
|
|
|
{-------------------------------------------------------------------------------}
|
|
function TfrxFDComponents.GetDescription: String;
|
|
begin
|
|
Result := 'FD';
|
|
end;
|
|
|
|
{-------------------------------------------------------------------------------}
|
|
procedure TfrxFDComponents.SetDefaultDatabase(const AValue: TFDConnection);
|
|
begin
|
|
if FDefaultDatabase <> AValue then begin
|
|
if FDefaultDatabase <> nil then
|
|
FDefaultDatabase.RemoveFreeNotification(Self);
|
|
FDefaultDatabase := AValue;
|
|
if FDefaultDatabase <> nil then
|
|
FDefaultDatabase.FreeNotification(Self);
|
|
end;
|
|
end;
|
|
|
|
{-------------------------------------------------------------------------------}
|
|
{ TfrxFDDatabase }
|
|
{-------------------------------------------------------------------------------}
|
|
constructor TfrxFDDatabase.Create(AOwner: TComponent);
|
|
begin
|
|
inherited Create(AOwner);
|
|
FDatabase := TFDConnection.Create(nil);
|
|
Component := FDatabase;
|
|
end;
|
|
|
|
{-------------------------------------------------------------------------------}
|
|
destructor TfrxFDDatabase.Destroy;
|
|
begin
|
|
// FDatabase.Free;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
{-------------------------------------------------------------------------------}
|
|
class function TfrxFDDatabase.GetDescription: String;
|
|
begin
|
|
Result := 'FD Database';
|
|
end;
|
|
|
|
{-------------------------------------------------------------------------------}
|
|
function TfrxFDDatabase.GetConnectionDefName: string;
|
|
begin
|
|
Result := FDatabase.ConnectionDefName;
|
|
end;
|
|
|
|
{-------------------------------------------------------------------------------}
|
|
procedure TfrxFDDatabase.SetConnectionDefName(const AValue: string);
|
|
begin
|
|
FDatabase.ConnectionDefName := AValue;
|
|
end;
|
|
|
|
{-------------------------------------------------------------------------------}
|
|
function TfrxFDDatabase.GetDriverName: string;
|
|
begin
|
|
Result := FDatabase.DriverName;
|
|
end;
|
|
|
|
{-------------------------------------------------------------------------------}
|
|
procedure TfrxFDDatabase.SetDriverName(const AValue: string);
|
|
begin
|
|
FDatabase.DriverName := AValue;
|
|
end;
|
|
|
|
{-------------------------------------------------------------------------------}
|
|
function TfrxFDDatabase.GetDatabaseName: String;
|
|
begin
|
|
{$IFDEF DELPHI21}
|
|
Result := FDatabase.ResultConnectionDef.Params.Database;
|
|
{$ELSE}
|
|
Result := FDatabase.ResultConnectionDef.Database;
|
|
{$ENDIF}
|
|
end;
|
|
|
|
{-------------------------------------------------------------------------------}
|
|
procedure TfrxFDDatabase.SetDatabaseName(const AValue: String);
|
|
begin
|
|
{$IFDEF DELPHI21}
|
|
FDatabase.ResultConnectionDef.Params.Database := AValue;
|
|
{$ELSE}
|
|
FDatabase.ResultConnectionDef.Database := AValue;
|
|
{$ENDIF}
|
|
end;
|
|
|
|
{-------------------------------------------------------------------------------}
|
|
function TfrxFDDatabase.GetParams: TStrings;
|
|
begin
|
|
Result := FDatabase.Params;
|
|
end;
|
|
|
|
{-------------------------------------------------------------------------------}
|
|
procedure TfrxFDDatabase.SetParams(AValue: TStrings);
|
|
begin
|
|
{$IFDEF DELPHI21}
|
|
FDatabase.Params.Assign(AValue);
|
|
{$ELSE}
|
|
FDatabase.Params := AValue;
|
|
{$ENDIF}
|
|
end;
|
|
|
|
{-------------------------------------------------------------------------------}
|
|
function TfrxFDDatabase.GetLoginPrompt: Boolean;
|
|
begin
|
|
Result := FDatabase.LoginPrompt;
|
|
end;
|
|
|
|
{-------------------------------------------------------------------------------}
|
|
procedure TfrxFDDatabase.SetLoginPrompt(AValue: Boolean);
|
|
begin
|
|
FDatabase.LoginPrompt := AValue;
|
|
end;
|
|
|
|
{-------------------------------------------------------------------------------}
|
|
function TfrxFDDatabase.GetConnected: Boolean;
|
|
begin
|
|
Result := FDatabase.Connected;
|
|
end;
|
|
|
|
{-------------------------------------------------------------------------------}
|
|
procedure TfrxFDDatabase.SetConnected(AValue: Boolean);
|
|
begin
|
|
BeforeConnect(AValue);
|
|
FDatabase.Connected := AValue;
|
|
end;
|
|
|
|
{-------------------------------------------------------------------------------}
|
|
procedure TfrxFDDatabase.SetLogin(const ALogin, APassword: String);
|
|
begin
|
|
{$IFDEF DELPHI21}
|
|
FDatabase.ResultConnectionDef.Params.UserName := ALogin;
|
|
FDatabase.ResultConnectionDef.Params.Password := APassword;
|
|
{$ELSE}
|
|
FDatabase.ResultConnectionDef.UserName := ALogin;
|
|
FDatabase.ResultConnectionDef.Password := APassword;
|
|
{$ENDIF}
|
|
end;
|
|
|
|
{-------------------------------------------------------------------------------}
|
|
procedure TfrxFDDatabase.FromString(const AConnection: WideString);
|
|
begin
|
|
FDatabase.ResultConnectionDef.ParseString(AConnection);
|
|
end;
|
|
|
|
{-------------------------------------------------------------------------------}
|
|
function TfrxFDDatabase.ToString: WideString;
|
|
begin
|
|
Result := FDatabase.ResultConnectionDef.BuildString();
|
|
end;
|
|
|
|
{-------------------------------------------------------------------------------}
|
|
{ TfrxFDQuery }
|
|
{-------------------------------------------------------------------------------}
|
|
procedure frxParamsToFDParams(ADataSet: TfrxCustomDataset; AFrxParams: TfrxParams;
|
|
AFDParams: TFDParams; AMasterDetail: boolean=false);
|
|
var
|
|
i, j, iFld: Integer;
|
|
oFDParam: TFDParam;
|
|
oFrxParam: TfrxParamItem;
|
|
oMasterFields: TStringList;
|
|
lSkip, lDesignTime, lDesignTimeExpr: Boolean;
|
|
oQuery: TFDQuery;
|
|
sExpr: String;
|
|
vRes: Variant;
|
|
|
|
function CanExpandEscape(AReport: TfrxReport; AExpr: String;
|
|
out ARes: Variant): Boolean;
|
|
var
|
|
sVar: String;
|
|
i: Integer;
|
|
lIsVar: Boolean;
|
|
begin
|
|
Result := oQuery.Connection <> nil;
|
|
if Result then begin
|
|
sVar := AExpr;
|
|
// 1st iteration of check
|
|
lIsVar := (sVar[1] = '<') and (sVar[Length(sVar)] = '>');
|
|
if lIsVar then begin
|
|
i := AReport.Variables.IndexOf(Copy(sVar, 2, Length(sVar) - 2));
|
|
Result := i <> -1;
|
|
if Result then
|
|
sVar := VarToStr(AReport.Variables.Items[i].Value)
|
|
else
|
|
Exit;
|
|
end;
|
|
// 2nd iteration
|
|
Result := (Length(sVar) >= 5) and (sVar[1] = '{') and
|
|
(sVar[Length(sVar)] = '}') and not(FDInSet(sVar[2], ['0' .. '9']));
|
|
if Result then begin
|
|
oQuery.SQL.Text := 'SELECT ' + sVar;
|
|
try
|
|
oQuery.Open;
|
|
except
|
|
Result := False;
|
|
end;
|
|
Result := Result and (oQuery.RecordCount = 1);
|
|
if Result then
|
|
ARes := oQuery.Fields[0].Value;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
begin
|
|
lDesignTime := (ADataSet.IsLoading or ADataSet.IsDesigning);
|
|
lDesignTimeExpr := Assigned(GFDComponents) and GFDComponents.DesignTimeExpr;
|
|
oQuery := TFDQuery.Create(nil);
|
|
oQuery.Connection := TfrxFDQuery(ADataSet).FQuery.Connection;
|
|
oQuery.ResourceOptions.EscapeExpand := True;
|
|
try
|
|
for i := 0 to AFDParams.Count - 1 do begin
|
|
oFDParam := AFDParams[i];
|
|
j := AFrxParams.IndexOf(oFDParam.Name);
|
|
if j <> -1 then begin
|
|
oFrxParam := AFrxParams[j];
|
|
oFDParam.Clear;
|
|
oFDParam.DataType := oFrxParam.DataType;
|
|
oFDParam.Bound := lDesignTime;
|
|
|
|
if AMasterDetail and (ADataSet is TfrxFDQuery) then begin
|
|
oMasterFields := TStringList.Create;
|
|
try
|
|
oMasterFields.Delimiter := ';';
|
|
oMasterFields.DelimitedText := TfrxFDQuery(ADataSet).FQuery.MasterFields;
|
|
lSkip := False;
|
|
for iFld := 0 to oMasterFields.Count - 1 do begin
|
|
lSkip := {$IFDEF AnyDAC_NOLOCALE_META} FDCompareText {$ELSE} AnsiCompareText {$ENDIF}
|
|
(oFDParam.Name, oMasterFields[iFld]) = 0;
|
|
if lSkip then
|
|
Break;
|
|
end;
|
|
if lSkip then
|
|
Continue;
|
|
finally
|
|
oMasterFields.Free;
|
|
end;
|
|
end;
|
|
|
|
sExpr := oFrxParam.Expression;
|
|
if Trim(sExpr) <> '' then begin
|
|
if ADataSet.Report <> nil then
|
|
if CanExpandEscape(ADataSet.Report, sExpr, vRes) then
|
|
oFrxParam.Value := vRes
|
|
else if (lDesignTime and lDesignTimeExpr or not lDesignTime) then begin
|
|
ADataSet.Report.CurObject := ADataSet.Name;
|
|
try
|
|
oFrxParam.Value := ADataSet.Report.Calc(sExpr);
|
|
except
|
|
oFrxParam.Value := null;
|
|
end;
|
|
end
|
|
else
|
|
oFrxParam.Value := sExpr;
|
|
end;
|
|
|
|
if not VarIsEmpty(oFrxParam.Value) then begin
|
|
oFDParam.Bound := True;
|
|
oFDParam.Value := oFrxParam.Value;
|
|
end;
|
|
end;
|
|
end;
|
|
finally
|
|
oQuery.Free;
|
|
end;
|
|
end;
|
|
|
|
{-------------------------------------------------------------------------------}
|
|
{
|
|
function used to recreate a TFrxParams collection from a TFDParams collection
|
|
useful when borrowing TFDparams from any TFDQuery and TFDStoredProc objects after assigning
|
|
a new SQL Text that can contain parameters (:paramName1, :paramName2, :paramNameN)
|
|
}
|
|
|
|
procedure frxFDParamsToParams(ADataSet: TfrxCustomDataSet; AFDParams: TFDParams;
|
|
AfrxParams: TfrxParams; AIgnoreDuplicates: Boolean = True; AMasterDataSet: TDataset=nil );
|
|
var
|
|
i, j: Integer;
|
|
NewParams: TfrxParams;
|
|
begin
|
|
if AfrxParams = nil then
|
|
Exit;
|
|
{ create new TfrxParams object and copy all params to it }
|
|
NewParams := TfrxParams.Create;
|
|
try
|
|
for i := 0 to AFDParams.Count - 1 do
|
|
if not ((NewParams.IndexOf(AFDParams[i].Name) <> -1) and AIgnoreDuplicates) then
|
|
with NewParams.Add do begin
|
|
Name := AFDParams[i].Name;
|
|
j := AfrxParams.IndexOf(Name);
|
|
DataType := AFDParams.Items[i].DataType;
|
|
if assigned( AMasterDataSet ) and
|
|
assigned( AMasterDataSet.FindField(Name) ) and
|
|
(DataType = ftUnknown) then
|
|
DataType := AMasterDataSet.FindField(Name).DataType;
|
|
|
|
if j <> -1 then begin
|
|
Value := AfrxParams.Items[j].Value;
|
|
Expression := AfrxParams.Items[j].Expression;
|
|
end
|
|
else
|
|
Value := AFDParams.Items[i].Value;
|
|
end;
|
|
AfrxParams.Clear;
|
|
AfrxParams.Assign(NewParams);
|
|
finally
|
|
NewParams.Free;
|
|
end;
|
|
end;
|
|
|
|
{-------------------------------------------------------------------------------}
|
|
{
|
|
function borrow only values from any TFDparams to TfrxParams
|
|
used normally when calling TfrxFDStoredProc.ExecProc and the stored
|
|
procedure returns values by Parameters )
|
|
}
|
|
|
|
procedure frxFDParamValuesToParams(ADataSet: TfrxCustomDataSet; AFDParams: TFDParams;
|
|
AfrxParams: TfrxParams; AOnlyOutputParams: Boolean = False);
|
|
var
|
|
i, j: Integer;
|
|
begin
|
|
if AfrxParams = nil then
|
|
Exit;
|
|
for i := 0 to AFDParams.Count - 1 do
|
|
if not AOnlyOutputParams or
|
|
(AFDParams[i].ParamType in [ptInputOutput, ptOutput]) then begin
|
|
j := AfrxParams.IndexOf(AFDParams[i].Name);
|
|
if j > -1 then begin
|
|
AfrxParams.Items[j].DataType := AFDParams.Items[i].DataType;
|
|
AfrxParams.Items[j].Value := AFDParams.Items[i].Value;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
{-------------------------------------------------------------------------------}
|
|
{ Code to assign current Master field values for Master-Detail Relationship }
|
|
|
|
procedure frxDoMasterSetValues(ADetailDataSet: TFDDataSet);
|
|
var
|
|
i: Integer;
|
|
oParam: TFDParam;
|
|
oField: TField;
|
|
begin
|
|
with ADetailDataSet do begin
|
|
if (MasterSource = nil) or (MasterLink = nil) then
|
|
Exit;
|
|
for i := 0 to MasterLink.Fields.Count - 1 do begin
|
|
oField := TField(MasterLink.Fields[i]);
|
|
oParam := FindParam(oField.FieldName);
|
|
if oParam <> nil then
|
|
oParam.AssignFieldValue(oField, oField.Value);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
{-------------------------------------------------------------------------------}
|
|
constructor TfrxFDQuery.Create(AOwner: TComponent);
|
|
begin
|
|
FLocked := false;
|
|
FStrings := TStringList.Create;
|
|
FQuery := TFDQuery.Create(nil);
|
|
FQuery.OnMasterSetValues := DoMasterSetValues;
|
|
Dataset := FQuery;
|
|
SetDatabase(nil);
|
|
inherited Create(AOwner);
|
|
end;
|
|
|
|
{-------------------------------------------------------------------------------}
|
|
procedure TfrxFDQuery.DoMasterSetValues(ASender: TFDDataSet);
|
|
begin
|
|
frxParamsToFDParams(Self, Params, FQuery.Params, true);
|
|
// Code to assign current Master field values for Master-Detail Relationship
|
|
frxDoMasterSetValues(FQuery);
|
|
end;
|
|
|
|
{-------------------------------------------------------------------------------}
|
|
procedure TfrxFDQuery.FetchParams;
|
|
begin
|
|
frxFDParamsToParams(Self, FQuery.Params, Params, IgnoreDupParams);
|
|
end;
|
|
|
|
{-------------------------------------------------------------------------------}
|
|
constructor TfrxFDQuery.DesignCreate(AOwner: TComponent; AFlags: Word);
|
|
var
|
|
i: Integer;
|
|
l: TList;
|
|
begin
|
|
inherited DesignCreate(AOwner, AFlags);
|
|
l := Report.AllObjects;
|
|
for i := 0 to l.Count - 1 do
|
|
if TObject(l[i]) is TfrxFDDatabase then begin
|
|
SetDatabase(TfrxFDDatabase(l[i]));
|
|
Break;
|
|
end;
|
|
end;
|
|
|
|
{-------------------------------------------------------------------------------}
|
|
destructor TfrxFDQuery.Destroy;
|
|
begin
|
|
FStrings.Clear;
|
|
FreeAndNil(FStrings);
|
|
inherited Destroy;
|
|
end;
|
|
|
|
{-------------------------------------------------------------------------------}
|
|
class function TfrxFDQuery.GetDescription: String;
|
|
begin
|
|
Result := 'FD Query';
|
|
end;
|
|
|
|
{-------------------------------------------------------------------------------}
|
|
procedure TfrxFDQuery.Notification(AComponent: TComponent; AOperation: TOperation);
|
|
begin
|
|
inherited Notification(AComponent, AOperation);
|
|
if (AOperation = opRemove) and (AComponent = FDatabase) then
|
|
SetDatabase(nil);
|
|
end;
|
|
|
|
{-------------------------------------------------------------------------------}
|
|
procedure TfrxFDQuery.OnChangeSQL(Sender: TObject);
|
|
var
|
|
i, ind: Integer;
|
|
Param: TfrxParamItem;
|
|
QParam: TFDParam;
|
|
begin
|
|
// code borrowed from TfrxFDOquery component
|
|
if not FLocked then begin
|
|
// needed to update parameters
|
|
FQuery.SQL.Text := '';
|
|
FQuery.SQL.Assign(FStrings);
|
|
|
|
frxParamsToFDParams(Self, Params, FQuery.Params);
|
|
inherited;
|
|
// fill datatype automatically, if possible
|
|
for i := 0 to FQuery.Params.Count - 1 do
|
|
begin
|
|
|
|
QParam := FQuery.Params[i];
|
|
ind := Params.IndexOf(QParam.Name);
|
|
|
|
if ind <> -1 then
|
|
begin
|
|
Param := Params[ind];
|
|
|
|
if (Param.DataType = ftUnknown) and Self.IsDesigning then
|
|
begin
|
|
if assigned( self.Master ) and assigned( self.Master.DataSet ) then
|
|
begin
|
|
if (not Self.Master.DataSet.Active) and
|
|
(Self.Master.DataSet.FieldCount=0) and
|
|
( Self.Master.FieldAliases.IndexOfName(QParam.Name) > -1 ) then
|
|
Self.Master.DataSet.Active := true;
|
|
if assigned( Self.Master.DataSet.FindField(QParam.Name) ) then
|
|
begin
|
|
Param.DataType := self.master.DataSet.FindField(QParam.Name).DataType;
|
|
QParam.DataType := self.master.DataSet.FindField(QParam.Name).DataType;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
if (Param.DataType = ftUnknown) and (QParam.DataType <> ftUnknown) then
|
|
Param.DataType := QParam.DataType;
|
|
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
{-------------------------------------------------------------------------------}
|
|
procedure TfrxFDQuery.SetDatabase(const AValue: TfrxFDDatabase);
|
|
begin
|
|
FDatabase := AValue;
|
|
if AValue <> nil then
|
|
FQuery.Connection := AValue.Database
|
|
else if GFDComponents <> nil then
|
|
FQuery.Connection := GFDComponents.DefaultDatabase
|
|
else
|
|
FQuery.Connection := nil;
|
|
DBConnected := FQuery.Connection <> nil;
|
|
end;
|
|
|
|
{-------------------------------------------------------------------------------}
|
|
function TfrxFDQuery.GetSQL: TStrings;
|
|
begin
|
|
FLocked := True;
|
|
try
|
|
FStrings.Assign(FQuery.SQL);
|
|
finally
|
|
FLocked := False;
|
|
end;
|
|
Result := FStrings;
|
|
end;
|
|
|
|
{-------------------------------------------------------------------------------}
|
|
procedure TfrxFDQuery.SetSQL(AValue: TStrings);
|
|
begin
|
|
FQuery.SQL.Assign(AValue);
|
|
FStrings.Assign(FQuery.SQL);
|
|
end;
|
|
|
|
{-------------------------------------------------------------------------------}
|
|
procedure TfrxFDQuery.SetMaster(const AValue: TDataSource);
|
|
begin
|
|
FQuery.MasterSource := AValue;
|
|
end;
|
|
|
|
{-------------------------------------------------------------------------------}
|
|
procedure TfrxFDQuery.SetMasterFields(const AValue: String);
|
|
begin
|
|
FQuery.MasterFields := AValue;
|
|
end;
|
|
|
|
{-------------------------------------------------------------------------------}
|
|
function TfrxFDQuery.GetUniDirectional: boolean;
|
|
begin
|
|
Result := FQuery.FetchOptions.Unidirectional;
|
|
end;
|
|
|
|
{-------------------------------------------------------------------------------}
|
|
procedure TfrxFDQuery.SetUniDirectional(const AValue: Boolean);
|
|
begin
|
|
FQuery.FetchOptions.Unidirectional := AValue;
|
|
end;
|
|
|
|
{-------------------------------------------------------------------------------}
|
|
procedure TfrxFDQuery.UpdateParams;
|
|
begin
|
|
frxParamsToFDParams(Self, Params, FQuery.Params, ASSIGNED(Master));
|
|
end;
|
|
|
|
{-------------------------------------------------------------------------------}
|
|
procedure TfrxFDQuery.BeforeStartReport;
|
|
begin
|
|
SetDatabase(FDatabase);
|
|
end;
|
|
|
|
{-------------------------------------------------------------------------------}
|
|
{$IFDEF QBUILDER}
|
|
function TfrxFDQuery.QBEngine: TfqbEngine;
|
|
begin
|
|
Result := TfrxEngineFD.Create(nil);
|
|
TfrxEngineFD(Result).FQuery.Connection := FQuery.Connection;
|
|
if (FQuery.Connection <> nil) and not FQuery.Connection.Connected then
|
|
FQuery.Connection.Connected := True;
|
|
end;
|
|
{$ENDIF}
|
|
|
|
{-------------------------------------------------------------------------------}
|
|
{ TfrxFDTable }
|
|
{-------------------------------------------------------------------------------}
|
|
constructor TfrxFDTable.Create(AOwner: TComponent);
|
|
begin
|
|
FTable := TFDTable.Create(nil);
|
|
DataSet := FTable;
|
|
SetDatabase(nil);
|
|
inherited Create(AOwner);
|
|
end;
|
|
|
|
{-------------------------------------------------------------------------------}
|
|
destructor TfrxFDTable.Destroy;
|
|
begin
|
|
if Assigned(FTable) then
|
|
inherited;
|
|
end;
|
|
|
|
{-------------------------------------------------------------------------------}
|
|
constructor TfrxFDTable.DesignCreate(AOwner: TComponent; AFlags: Word);
|
|
var
|
|
i: Integer;
|
|
l: TList;
|
|
begin
|
|
inherited DesignCreate(AOwner, AFlags);
|
|
l := Report.AllObjects;
|
|
for i := 0 to l.Count - 1 do
|
|
if TObject(l[i]) is TfrxFDDatabase then begin
|
|
SetDatabase(TfrxFDDatabase(l[i]));
|
|
break;
|
|
end;
|
|
end;
|
|
|
|
{-------------------------------------------------------------------------------}
|
|
class function TfrxFDTable.GetDescription: String;
|
|
begin
|
|
Result := 'FD Table';
|
|
end;
|
|
|
|
{-------------------------------------------------------------------------------}
|
|
procedure TfrxFDTable.Notification(AComponent: TComponent; AOperation: TOperation);
|
|
begin
|
|
inherited Notification(AComponent, AOperation);
|
|
if (AOperation = opRemove) and (AComponent = FDatabase) then
|
|
SetDatabase(nil);
|
|
end;
|
|
|
|
{-------------------------------------------------------------------------------}
|
|
procedure TfrxFDTable.SetDatabase(const AValue: TfrxFDDatabase);
|
|
begin
|
|
FDatabase := AValue;
|
|
if AValue <> nil then
|
|
FTable.Connection := AValue.Database
|
|
else if GFDComponents <> nil then
|
|
FTable.Connection := GFDComponents.DefaultDatabase
|
|
else
|
|
FTable.Connection := nil;
|
|
DBConnected := FTable.Connection <> nil;
|
|
end;
|
|
|
|
{-------------------------------------------------------------------------------}
|
|
function TfrxFDTable.GetIndexFieldNames: String;
|
|
begin
|
|
Result := FTable.IndexFieldNames;
|
|
end;
|
|
|
|
{-------------------------------------------------------------------------------}
|
|
function TfrxFDTable.GetIndexName: String;
|
|
begin
|
|
Result := FTable.IndexName;
|
|
end;
|
|
|
|
{-------------------------------------------------------------------------------}
|
|
function TfrxFDTable.GetCatalogName: String;
|
|
begin
|
|
Result := FTable.CatalogName;
|
|
end;
|
|
|
|
{-------------------------------------------------------------------------------}
|
|
function TfrxFDTable.GetSchemaName: String;
|
|
begin
|
|
Result := FTable.SchemaName;
|
|
end;
|
|
|
|
{-------------------------------------------------------------------------------}
|
|
function TfrxFDTable.GetTableName: String;
|
|
begin
|
|
Result := FTable.TableName;
|
|
end;
|
|
|
|
{-------------------------------------------------------------------------------}
|
|
procedure TfrxFDTable.SetIndexFieldNames(const AValue: String);
|
|
begin
|
|
FTable.IndexFieldNames := AValue;
|
|
end;
|
|
|
|
{-------------------------------------------------------------------------------}
|
|
procedure TfrxFDTable.SetIndexName(const AValue: String);
|
|
begin
|
|
FTable.IndexName := AValue;
|
|
end;
|
|
|
|
{-------------------------------------------------------------------------------}
|
|
procedure TfrxFDTable.SetCatalogName(const AValue: String);
|
|
begin
|
|
FTable.CatalogName := AValue;
|
|
end;
|
|
|
|
{-------------------------------------------------------------------------------}
|
|
procedure TfrxFDTable.SetSchemaName(const AValue: String);
|
|
begin
|
|
FTable.SchemaName := AValue;
|
|
end;
|
|
|
|
{-------------------------------------------------------------------------------}
|
|
procedure TfrxFDTable.SetTableName(const AValue: String);
|
|
begin
|
|
FTable.TableName := AValue;
|
|
end;
|
|
|
|
{-------------------------------------------------------------------------------}
|
|
procedure TfrxFDTable.SetMaster(const AValue: TDataSource);
|
|
begin
|
|
FTable.MasterSource := AValue;
|
|
end;
|
|
|
|
{-------------------------------------------------------------------------------}
|
|
procedure TfrxFDTable.SetMasterFields(const AValue: String);
|
|
begin
|
|
FTable.MasterFields := AValue;
|
|
end;
|
|
|
|
{-------------------------------------------------------------------------------}
|
|
procedure TfrxFDTable.BeforeStartReport;
|
|
begin
|
|
SetDatabase(FDatabase);
|
|
end;
|
|
|
|
{-------------------------------------------------------------------------------}
|
|
{ TfrxCustomStoredProc }
|
|
{-------------------------------------------------------------------------------}
|
|
constructor TfrxCustomStoredProc.Create(AOwner: TComponent);
|
|
begin
|
|
FParams := TfrxParams.Create;
|
|
inherited Create(AOwner);
|
|
if DataSet <> nil then
|
|
begin
|
|
FSaveOnBeforeOpen := DataSet.BeforeOpen;
|
|
FSaveOnAfterOpen := DataSet.AfterOpen;
|
|
DataSet.BeforeOpen := TriggerOnBeforeOpen;
|
|
end;
|
|
end;
|
|
|
|
{-------------------------------------------------------------------------------}
|
|
destructor TfrxCustomStoredProc.Destroy;
|
|
begin
|
|
FParams.Free;
|
|
if DataSet <> nil then
|
|
DataSet.BeforeOpen := FSaveOnBeforeOpen;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
{-------------------------------------------------------------------------------}
|
|
procedure TfrxCustomStoredProc.ExecProc;
|
|
begin
|
|
// Do nothing, code Should be added on inherited Classes;
|
|
end;
|
|
|
|
{-------------------------------------------------------------------------------}
|
|
procedure TfrxCustomStoredProc.DefineProperties(AFiler: TFiler);
|
|
begin
|
|
inherited DefineProperties(AFiler);
|
|
AFiler.DefineProperty('Parameters', ReadParamData, WriteParamData, True);
|
|
end;
|
|
|
|
{-------------------------------------------------------------------------------}
|
|
procedure TfrxCustomStoredProc.ReadParamData(AReader: TReader);
|
|
begin
|
|
frxReadCollection(FParams, AReader, Self);
|
|
UpdateParams;
|
|
end;
|
|
|
|
{-------------------------------------------------------------------------------}
|
|
procedure TfrxCustomStoredProc.WriteParamData(AWriter: TWriter);
|
|
begin
|
|
frxWriteCollection(FParams, AWriter, Self);
|
|
end;
|
|
|
|
{-------------------------------------------------------------------------------}
|
|
procedure TfrxCustomStoredProc.TriggerOnAfterOpen(ADataSet: TDataSet);
|
|
begin
|
|
if Assigned(FSaveOnAfterOpen) then
|
|
FSaveOnAfterOpen(DataSet);
|
|
end;
|
|
|
|
{-------------------------------------------------------------------------------}
|
|
procedure TfrxCustomStoredProc.TriggerOnBeforeOpen(ADataSet: TDataSet);
|
|
begin
|
|
UpdateParams;
|
|
if Assigned(FSaveOnBeforeOpen) then
|
|
FSaveOnBeforeOpen(DataSet);
|
|
end;
|
|
|
|
{-------------------------------------------------------------------------------}
|
|
function TfrxCustomStoredProc.ParamByName(const AValue: String): TfrxParamItem;
|
|
begin
|
|
Result := FParams.Find(AValue);
|
|
if Result = nil then
|
|
raise Exception.Create('Parameter "' + AValue + '" not found');
|
|
end;
|
|
|
|
{-------------------------------------------------------------------------------}
|
|
procedure TfrxCustomStoredProc.Prepare;
|
|
begin
|
|
// Do nothing, code Should be added on inherited Classes;
|
|
end;
|
|
|
|
{-------------------------------------------------------------------------------}
|
|
procedure TfrxCustomStoredProc.FetchParams;
|
|
begin
|
|
// Do nothing, code Should be added on inherited Classes;
|
|
end;
|
|
|
|
{-------------------------------------------------------------------------------}
|
|
function TfrxCustomStoredProc.GetStoredProcName: string;
|
|
begin
|
|
// Do nothing, code Should be added on inherited Classes;
|
|
end;
|
|
|
|
{-------------------------------------------------------------------------------}
|
|
procedure TfrxCustomStoredProc.SetParams(AValue: TfrxParams);
|
|
begin
|
|
FParams.Assign(AValue);
|
|
end;
|
|
|
|
{-------------------------------------------------------------------------------}
|
|
procedure TfrxCustomStoredProc.SetStoredProcName(const AValue: string);
|
|
begin
|
|
// Do nothing, code Should be added on inherited Classes;
|
|
end;
|
|
|
|
{-------------------------------------------------------------------------------}
|
|
procedure TfrxCustomStoredProc.UpdateParams;
|
|
begin
|
|
// Do nothing, code Should be added on inherited Classes;
|
|
end;
|
|
|
|
{-------------------------------------------------------------------------------}
|
|
{ TfrxFDStoredProc }
|
|
{-------------------------------------------------------------------------------}
|
|
constructor TfrxFDStoredProc.Create(AOwner: TComponent);
|
|
begin
|
|
FStoredProc := TFDStoredProc.Create(nil);
|
|
FStoredProc.OnMasterSetValues := DoMasterSetValues;
|
|
Dataset := FStoredProc;
|
|
SetDatabase(nil);
|
|
inherited Create(AOwner);
|
|
end;
|
|
|
|
{-------------------------------------------------------------------------------}
|
|
constructor TfrxFDStoredProc.DesignCreate(AOwner: TComponent; AFlags: Word);
|
|
var
|
|
i: Integer;
|
|
l: TList;
|
|
begin
|
|
inherited DesignCreate(AOwner, AFlags);
|
|
l := Report.AllObjects;
|
|
for i := 0 to l.Count - 1 do
|
|
if TObject(l[i]) is TfrxFDDatabase then begin
|
|
SetDatabase(TfrxFDDatabase(l[i]));
|
|
Break;
|
|
end;
|
|
end;
|
|
|
|
{-------------------------------------------------------------------------------}
|
|
procedure TfrxFDStoredProc.DoMasterSetValues(ASender: TFDDataSet);
|
|
begin
|
|
if FStoredProc = nil then Exit;
|
|
// Code to assign current Master field values for Master-Detail Relationship
|
|
frxDoMasterSetValues( FStoredProc );
|
|
end;
|
|
|
|
{-------------------------------------------------------------------------------}
|
|
procedure TfrxFDStoredProc.ExecProc;
|
|
begin
|
|
if FStoredProc = nil then Exit;
|
|
UpdateParams;
|
|
FStoredProc.ExecProc;
|
|
frxFDParamValuesToParams(Self, FStoredProc.Params, Params, True);
|
|
end;
|
|
|
|
{-------------------------------------------------------------------------------}
|
|
class function TfrxFDStoredProc.GetDescription: String;
|
|
begin
|
|
Result := 'FD StoredProc';
|
|
end;
|
|
|
|
{-------------------------------------------------------------------------------}
|
|
procedure TfrxFDStoredProc.Notification(AComponent: TComponent;
|
|
AOperation: TOperation);
|
|
begin
|
|
inherited Notification(AComponent, AOperation);
|
|
if (AOperation = opRemove) and (AComponent = FDatabase) then
|
|
SetDatabase(nil);
|
|
end;
|
|
|
|
{-------------------------------------------------------------------------------}
|
|
procedure TfrxFDStoredProc.Prepare;
|
|
begin
|
|
FetchParams;
|
|
end;
|
|
|
|
{-------------------------------------------------------------------------------}
|
|
procedure TfrxFDStoredProc.FetchParams;
|
|
begin
|
|
if FStoredProc = nil then Exit;
|
|
if csDesigning in ComponentState then
|
|
Exit;
|
|
FStoredProc.Unprepare;
|
|
if (StoredProcName <> '') and (FStoredProc.Connection <> nil) then
|
|
FStoredProc.Prepare;
|
|
if (StoredProcName = '') or FStoredProc.Prepared then
|
|
frxFDParamsToParams(Self, FStoredProc.Params, FParams, True);
|
|
end;
|
|
|
|
{-------------------------------------------------------------------------------}
|
|
procedure TfrxFDStoredProc.SetCatalogName(const AValue: String);
|
|
begin
|
|
if FStoredProc = nil then Exit;
|
|
FStoredProc.CatalogName := AValue;
|
|
end;
|
|
|
|
{-------------------------------------------------------------------------------}
|
|
procedure TfrxFDStoredProc.SetSchemaName(const AValue: String);
|
|
begin
|
|
if FStoredProc = nil then Exit;
|
|
FStoredProc.SchemaName := AValue;
|
|
end;
|
|
|
|
{-------------------------------------------------------------------------------}
|
|
procedure TfrxFDStoredProc.TriggerOnAfterOpen(ADataSet: TDataSet);
|
|
begin
|
|
if FStoredProc = nil then Exit;
|
|
// copy Values from Output Type TFDParams to TfrxParams, only for SP that return values
|
|
frxFDParamValuesToParams(Self, FStoredProc.Params, Params, true);
|
|
inherited;
|
|
end;
|
|
|
|
{-------------------------------------------------------------------------------}
|
|
procedure TfrxFDStoredProc.SetDatabase(const AValue: TfrxFDDatabase);
|
|
begin
|
|
if FStoredProc = nil then Exit;
|
|
FDatabase := AValue;
|
|
if AValue <> nil then
|
|
FStoredProc.Connection := AValue.Database
|
|
else if GFDComponents <> nil then
|
|
FStoredProc.Connection := GFDComponents.DefaultDatabase
|
|
else
|
|
FStoredProc.Connection := nil;
|
|
FetchParams;
|
|
end;
|
|
|
|
{-------------------------------------------------------------------------------}
|
|
procedure TfrxFDStoredProc.SetMaster(const AValue: TDataSource);
|
|
begin
|
|
if FStoredProc = nil then Exit;
|
|
FStoredProc.MasterSource := AValue;
|
|
end;
|
|
|
|
{-------------------------------------------------------------------------------}
|
|
function TfrxFDStoredProc.GetPackageName: String;
|
|
begin
|
|
if FStoredProc = nil then Exit;
|
|
Result := FStoredProc.PackageName;
|
|
end;
|
|
|
|
{-------------------------------------------------------------------------------}
|
|
procedure TfrxFDStoredProc.SetPackageName(const AValue: String);
|
|
begin
|
|
if FStoredProc = nil then Exit;
|
|
FStoredProc.PackageName := AValue;
|
|
end;
|
|
|
|
{-------------------------------------------------------------------------------}
|
|
function TfrxFDStoredProc.GetCatalogName: String;
|
|
begin
|
|
if FStoredProc = nil then Exit;
|
|
Result := FStoredProc.CatalogName;
|
|
end;
|
|
|
|
{-------------------------------------------------------------------------------}
|
|
function TfrxFDStoredProc.GetSchemaName: String;
|
|
begin
|
|
if FStoredProc = nil then Exit;
|
|
Result := FStoredProc.SchemaName;
|
|
end;
|
|
|
|
{-------------------------------------------------------------------------------}
|
|
function TfrxFDStoredProc.GetStoredProcName: string;
|
|
begin
|
|
Result := FStoredProc.StoredProcName;
|
|
end;
|
|
|
|
{-------------------------------------------------------------------------------}
|
|
procedure TfrxFDStoredProc.SetStoredProcName(const AValue: string);
|
|
begin
|
|
FStoredProc.StoredProcName := AValue;
|
|
FetchParams;
|
|
end;
|
|
|
|
{-------------------------------------------------------------------------------}
|
|
procedure TfrxFDStoredProc.UpdateParams;
|
|
begin
|
|
if FStoredProc = nil then Exit;
|
|
frxParamsToFDParams(Self, Params, FStoredProc.Params);
|
|
end;
|
|
|
|
{-------------------------------------------------------------------------------}
|
|
procedure TfrxFDStoredProc.BeforeStartReport;
|
|
begin
|
|
if FStoredProc = nil then Exit;
|
|
inherited BeforeStartReport;
|
|
SetDatabase(FDatabase);
|
|
end;
|
|
|
|
{-------------------------------------------------------------------------------}
|
|
{ TfrxEngineFD }
|
|
{-------------------------------------------------------------------------------}
|
|
{$IFDEF QBUILDER}
|
|
constructor TfrxEngineFD.Create(AOwner: TComponent);
|
|
begin
|
|
inherited Create(AOwner);
|
|
FQuery := TFDQuery.Create(nil);
|
|
end;
|
|
|
|
{-------------------------------------------------------------------------------}
|
|
destructor TfrxEngineFD.Destroy;
|
|
begin
|
|
FreeAndNil(FQuery);
|
|
inherited Destroy;
|
|
end;
|
|
|
|
{-------------------------------------------------------------------------------}
|
|
procedure TfrxEngineFD.ReadFieldList(const ATableName: string;
|
|
var AFieldList: TfqbFieldList);
|
|
var
|
|
oTab: TFDTable;
|
|
oDefs: TFieldDefs;
|
|
i: Integer;
|
|
oQBField: TfqbField;
|
|
begin
|
|
AFieldList.Clear;
|
|
oTab := TFDTable.Create(Self);
|
|
oTab.Connection := FQuery.Connection;
|
|
oTab.TableName := ATableName;
|
|
oDefs := oTab.FieldDefs;
|
|
try
|
|
try
|
|
oTab.Active := True;
|
|
oQBField := TfqbField(AFieldList.Add);
|
|
oQBField.FieldName := '*';
|
|
for i := 0 to oDefs.Count - 1 do begin
|
|
oQBField := TfqbField(AFieldList.Add);
|
|
oQBField.FieldName := oDefs.Items[i].Name;
|
|
oQBField.FieldType := Ord(oDefs.Items[i].DataType)
|
|
end;
|
|
except
|
|
end;
|
|
finally
|
|
oTab.Free;
|
|
end;
|
|
end;
|
|
|
|
{-------------------------------------------------------------------------------}
|
|
procedure TfrxEngineFD.ReadTableList(ATableList: TStrings);
|
|
begin
|
|
ATableList.Clear;
|
|
FQuery.Connection.GetTableNames(FQuery.ConnectionName, '', '', ATableList);
|
|
end;
|
|
|
|
{-------------------------------------------------------------------------------}
|
|
function TfrxEngineFD.ResultDataSet: TDataSet;
|
|
begin
|
|
Result := FQuery;
|
|
end;
|
|
|
|
{-------------------------------------------------------------------------------}
|
|
procedure TfrxEngineFD.SetSQL(const AValue: string);
|
|
begin
|
|
FQuery.SQL.Text := AValue;
|
|
end;
|
|
{$ENDIF}
|
|
|
|
{-------------------------------------------------------------------------------}
|
|
initialization
|
|
frxObjects.RegisterObject1(TfrxFDDataBase, nil, '', {$IFDEF DB_CAT}'DATABASES'{$ELSE}''{$ENDIF}, 0, 250);
|
|
frxObjects.RegisterObject1(TfrxFDTable, nil, '', {$IFDEF DB_CAT}'QUERIES'{$ELSE}''{$ENDIF}, 0, 251);
|
|
frxObjects.RegisterObject1(TfrxFDQuery, nil, '', {$IFDEF DB_CAT}'QUERIES'{$ELSE}''{$ENDIF}, 0, 252);
|
|
frxObjects.RegisterObject1(TfrxFDStoredProc, nil, '', {$IFDEF DB_CAT}'QUERIES'{$ELSE}''{$ENDIF}, 0, 252);
|
|
finalization
|
|
frxObjects.UnRegister(TfrxFDDataBase);
|
|
frxObjects.UnRegister(TfrxFDTable);
|
|
frxObjects.UnRegister(TfrxFDQuery);
|
|
frxObjects.UnRegister(TfrxFDStoredProc);
|
|
end.
|