Я написал пользовательские компоненты TfrxDBC с помощью TFrxCustomQuery.Компонент отлично устанавливается, объект FrxReport распознает мой новый компонент TFrxCustomQuery, и я могу использовать его на странице данных с предложением SQL, чтобы получить данные из базы данных и идеально отобразить отчет.
Проблема в том, что у меня естькогда я добавляю более одного собственного TFrxCustomQuery, потому что последний добавленный компонент всегда получает значение свойства SQL из ранее добавленного TFrxCustomQuery, то есть Query2 получает значение свойства SQL из Query1, Query3получает значение свойства SQL из Query2 и т. д.
Если я изменяю значение свойства SQL нового компонента, он получает поля правильно, проблема появляется только с новыми компонентами.
Я написал этот компонент с использованием документации FastReports, я не знаю, нужно ли мне использовать другой учебник или мастер
Я присоединяю источник
unit UDwFrxDBComponents;
interface
Uses
System.Classes, System.SysUtils, frxClass, Data.DB, Datasnap.Win.MConnect, Datasnap.DBClient,
frxCustomDB, USClientDataSet
{IFDEF QBUILDER}
, fqbClass
{ENDIF}
;
type
TDwFrxDBComponents = class(TfrxDBComponents)
private
FDefaultDatabase: TCustomRemoteServer;
FOldComponents: TDwFrxDBComponents;
protected
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
function GetDescription: String; override;
published
property DefaultDatabase: TCustomRemoteServer read FDefaultDatabase write FDefaultDatabase;
end;
TDwFrxDBDataSet = class(TfrxCustomQuery)
private
FDataBase: TCustomRemoteServer;
FQuery: SClientDataSet;
FStrings: TStrings;
FLock: Boolean;
procedure SetDataBase(Value: TCustomRemoteServer);
protected
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
procedure OnChangeSQL(Sender: TObject); override;
procedure SetSQL(Value: TStrings); override;
function GetSQL: TStrings; override;
procedure Loaded; override;
public
constructor Create(AOwner: TComponent); override;
constructor DesignCreate(AOwner: TComponent; Flags: Word); override;
destructor Destroy; override;
class function GetDescription: String; override;
procedure UpdateParams; override;
procedure BeforeStartReport; override;
{$IFDEF QBUILDER}
function QBEngine: TfqbEngine;
{$ENDIF}
property Query: SClientDataSet read FQuery;
published
//property SQL;// : TStrings read FStrings write SetSQL;
property DataBase: TCustomRemoteServer read FDataBase write SetDataBase;
end;
{$IFDEF QBUILDER}
TDwfrxDBEngine = class(TfqbEngine)
private
FQuery: SClientDataSet;
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 Value: string); override;
end;
{$ENDIF}
procedure frxParamsToTParameters(Query: TDwFrxDBDataSet; Params: TParams);
var
DwFrxDBComponents: TDwFrxDBComponents;
implementation
uses
UDwFrxDBComponentsRTTI,
{$IFNDEF NO_EDITORS}
UDwFrxDBComponentsEditor,
{$ENDIF}
frxDsgnIntf, frxRes;
{ frxParamsToTParameters }
procedure frxParamsToTParameters(Query: TDwFrxDBDataSet; Params: TParams);
var
i: Integer;
Item: TfrxParamItem;
begin
for i := 0 to Params.Count - 1 do
if Query.Params.IndexOf(Params[i].Name) <> -1 then
begin
Item := Query.Params[Query.Params.IndexOf(Params[i].Name)];
Params[i].DataType := Item.DataType;
Params[i].ParamType := ptInput;
if Trim(Item.Expression) <> '' then
if not (Query.IsLoading or Query.IsDesigning) then
begin
Query.Report.CurObject := Query.Name;
Item.Value := Query.Report.Calc(Item.Expression);
end;
Params[i].Value := Item.Value;
end;
end;
{ TDwFrxDBComponents }
constructor TDwFrxDBComponents.Create(AOwner: TComponent);
begin
inherited;
FOldComponents := DwFrxDBComponents;
FDefaultDatabase := nil;
DwFrxDBComponents := Self;
end;
destructor TDwFrxDBComponents.Destroy;
begin
if DwFrxDBComponents = Self then
DwFrxDBComponents := FOldComponents;
inherited;
end;
function TDwFrxDBComponents.GetDescription: String;
begin
Result := 'Digital Ware FrxDBComponents';
end;
{ TDwFrxDBDataSet }
procedure TDwFrxDBDataSet.BeforeStartReport;
begin
SetDatabase(FDatabase);
{ needed to update parameters }
//SQL.Text := SQL.Text;
end;
constructor TDwFrxDBDataSet.Create(AOwner: TComponent);
begin
FStrings := TStringList.Create;
FQuery := SClientDataSet.Create(nil);
FQuery.ProviderName := 'DtsPTemporal';
FQuery.Close;
Dataset := FQuery;
SetDataBase(nil);
FLock := False;
inherited;
//SQL.Clear;
end;
constructor TDwFrxDBDataSet.DesignCreate(AOwner: TComponent; Flags: Word);
var
i: Integer;
l: TList;
begin
inherited;
l := Report.AllObjects;
for i := 0 to l.Count - 1 do
if TObject(l[i]) is TCustomRemoteServer then
begin
SetDataBase(TCustomRemoteServer(l[i]));
break;
end;
end;
destructor TDwFrxDBDataSet.Destroy;
begin
FStrings.Free;
inherited;
end;
class function TDwFrxDBDataSet.GetDescription: String;
begin
Result := 'Digital Ware FrxDBDataset';
end;
function TDwFrxDBDataSet.GetSQL: TStrings;
begin
FLock := True;
//FStrings.Assign(FQuery.SQL);
FLock := False;
Result := FQuery.SQL;
end;
procedure TDwFrxDBDataSet.Loaded;
begin
inherited Loaded;
OnChangeSQL(nil);// update params after load
end;
procedure TDwFrxDBDataSet.Notification(AComponent: TComponent;
Operation: TOperation);
begin
inherited;
if (Operation = opRemove) and (AComponent = FDataBase) then
SetDataBase(nil);
end;
procedure TDwFrxDBDataSet.OnChangeSQL(Sender: TObject);
var
i, ind: Integer;
Param: TfrxParamItem;
QParam: TParam;
begin
if not FLock then
begin
{ needed to update parameters }
//FQuery.SQL.Text := '';
//FQuery.SQL.Assign(FStrings);
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 (QParam.DataType <> ftUnknown) then
Param.DataType := QParam.DataType;
end;
end;
end;
end;
{$IFDEF QBUILDER}
function TDwFrxDBDataSet.QBEngine: TfqbEngine;
begin
Result := TDwfrxDBEngine.Create(nil);
TDwfrxDBEngine(Result).FQuery.RemoteServer := FQuery.RemoteServer;
end;
{$ENDIF}
procedure TDwFrxDBDataSet.SetDataBase(Value: TCustomRemoteServer);
begin
if Value <> nil then
FQuery.RemoteServer := Value
else if DwFrxDBComponents <> nil then
begin
FQuery.RemoteServer := DwFrxDBComponents.DefaultDatabase;
end
else
FQuery.RemoteServer := nil;
FDataBase := FQuery.RemoteServer;
DBConnected := FQuery.RemoteServer <> nil;
end;
procedure TDwFrxDBDataSet.SetSQL(Value: TStrings);
begin
FQuery.SQL := Value;
//FStrings := FQuery.SQL;
end;
procedure TDwFrxDBDataSet.UpdateParams;
begin
inherited;
frxParamsToTParameters(Self, FQuery.Params);
end;
{ TDwfrxDBEngine }
{$IFDEF QBUILDER}
constructor TDwfrxDBEngine.Create(AOwner: TComponent);
begin
inherited;
FQuery := SClientDataSet.Create(Self);
end;
destructor TDwfrxDBEngine.Destroy;
begin
FQuery.Free;
inherited;
end;
procedure TDwfrxDBEngine.ReadFieldList(const ATableName: string;
var AFieldList: TfqbFieldList);
var
TempTable: SClientDataSet;
Fields: TFieldDefs;
i: Integer;
tmpField: TfqbField;
begin
AFieldList.Clear;
TempTable := SClientDataSet.Create(Self);
TempTable.RemoteServer := FQuery.RemoteServer;
TempTable.ProviderName := 'DtsPTemporal';
TempTable.SQL.Text := ' SELECT * FROM ' + ATableName + ' WHERE 1=0';
TempTable.Open;
Fields := TempTable.FieldDefs;
try
try
TempTable.Active := True;
tmpField:= TfqbField(AFieldList.Add);
tmpField.FieldName := '*';
for i := 0 to Fields.Count - 1 do
begin
tmpField := TfqbField(AFieldList.Add);
tmpField.FieldName := Fields.Items[i].Name;
tmpField.FieldType := Ord(Fields.Items[i].DataType)
end;
except
end;
finally
TempTable.Free;
end;
end;
procedure TDwfrxDBEngine.ReadTableList(ATableList: TStrings);
begin
inherited;
ATableList.Clear;
end;
function TDwfrxDBEngine.ResultDataSet: TDataSet;
begin
Result := FQuery;
end;
procedure TDwfrxDBEngine.SetSQL(const Value: string);
begin
inherited;
FQuery.SQL.Text := Value;
end;
{$ENDIF}
initialization
{ use standard pictures indexes 37,38,39 instead of pictures}
frxObjects.RegisterObject1(TDwFrxDBDataSet, nil, '', '', 0, 39);
finalization
frxObjects.Unregister(TDwFrxDBDataSet);
end.