FastReport Custom DB Engine Компонент запроса SQL Ошибка свойства - PullRequest
0 голосов
/ 19 сентября 2018

Я написал пользовательские компоненты 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.
...