From f4d5025c95f88df69c8a2d19d7b3f822a19ee28c Mon Sep 17 00:00:00 2001
From: Henrique Gottardi Werlang <henriquewerlang@hotmail.com>
Date: Fri, 8 Jan 2021 10:58:45 -0300
Subject: [PATCH] =?UTF-8?q?Implementa=C3=A7=C3=A3o=20inicial=20do=20DataSe?=
 =?UTF-8?q?tField.?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

---
 packages/fcl-db/db.pas      | 105 +++++++++++++++++++++++++++++++++---
 packages/fcl-db/dbconst.pas |   2 +
 2 files changed, 101 insertions(+), 6 deletions(-)

diff --git a/packages/fcl-db/db.pas b/packages/fcl-db/db.pas
index 56fa3fa..e7ddc03 100644
--- a/packages/fcl-db/db.pas
+++ b/packages/fcl-db/db.pas
@@ -20,10 +20,9 @@ unit DB;
 { $define dsdebug}
 interface
 
-uses Classes, SysUtils, JS, Types, DateUtils;
+uses Generics.Collections, Classes, SysUtils, JS, Types, DateUtils;
 
 const
-
   dsMaxBufferCount = MAXINT div 8;
   dsMaxStringSize = 8192;
 
@@ -34,7 +33,6 @@ const
   SQLDelimiterCharacters = [';',',',' ','(',')',#13,#10,#9];
 
 type
-
 { Misc Dataset types }
 
   TDataSetState = (dsInactive, dsBrowse, dsEdit, dsInsert, dsSetKey,
@@ -729,6 +727,17 @@ type
     constructor Create(AOwner: TComponent); override;
   end;
 
+  TDataSetField = class(TField)
+  private
+    FNestedDataSet: TDataSet;
+
+    procedure AssignNestedDataSet(Value: TDataSet);
+  protected
+    procedure Bind(Binding: Boolean); override;
+  public
+    constructor Create(AOwner: TComponent); override;
+  end;
+
 { TIndexDef }
 
   TIndexDefs = class;
@@ -1054,6 +1063,8 @@ type
   TOnRecordResolveEvent = Procedure (Sender : TDataset; info : TResolveInfo) of object;
   TApplyUpdatesEvent = Procedure (Sender : TDataset; info : TResolveResults) of object;
 
+  TNestedDataSetsList = specialize TList<TDataSet>;
+
 {------------------------------------------------------------------------------}
 
   TDataSet = class(TComponent)
@@ -1127,6 +1138,9 @@ type
     FInApplyupdates : Boolean;
     FLoadCount : Integer;
     FMinLoadID : Integer;
+    FDataSetField: TDataSetField;
+    FNestedDataSets: TNestedDataSetsList;
+    FNestedDataSetClass: TDataSetClass;
     Procedure DoInsertAppend(DoAppend : Boolean);
     Procedure DoInternalOpen;
     Function  GetBuffer (Index : longint) : TDataRecord;
@@ -1146,6 +1160,7 @@ type
     // Callback for Tdataproxy.DoGetData;
     function ResolveRecordUpdate(anUpdate: TRecordUpdateDescriptor): Boolean;
     procedure HandleRequestResponse(ARequest: TDataRequest);
+    function GetNestedDataSets: TNestedDataSetsList;
   protected
     // Proxy methods
     // Override this to integrate package in local data
@@ -1283,6 +1298,7 @@ type
     procedure SetBookmarkData(Var Buffer{%H-}: TDataRecord; Data{%H-}: TBookmark); virtual;
     procedure SetUniDirectional(const Value: Boolean);
     procedure Notification(AComponent: TComponent; Operation: TOperation); override;
+    procedure SetDataSetField(const Value: TDataSetField); virtual;
     // These use the active buffer
     function GetFieldData(Field: TField): JSValue;  virtual; overload;
     procedure SetFieldData(Field: TField; AValue : JSValue);  virtual; overload;
@@ -1290,6 +1306,7 @@ type
     procedure SetFieldData(Field: TField; var Buffer: TDatarecord; AValue : JSValue);  virtual; overload;
     class function FieldDefsClass : TFieldDefsClass; virtual;
     class function FieldsClass : TFieldsClass; virtual;
+    property NestedDataSets: TNestedDataSetsList read GetNestedDataSets;
   protected { abstract methods }
     function GetRecord(var Buffer: TDataRecord; GetMode: TGetMode; DoCheck: Boolean): TGetResult; virtual; abstract;
     procedure InternalClose; virtual; abstract;
@@ -1360,6 +1377,7 @@ type
     procedure UpdateCursorPos;
     procedure UpdateRecord;
     Function GetPendingUpdates : TResolveInfoArray;
+    property DataSetField: TDataSetField read FDataSetField write SetDataSetField;
     Property Loading : Boolean Read GetIsLoading;
     property BlockReadSize: Integer read FBlockReadSize write SetBlockReadSize;
     property BOF: Boolean read FBOF;
@@ -2343,10 +2361,9 @@ begin
   FIsUniDirectional := False;
   FAutoCalcFields := True;
   FDataRequestID:=0;
+  FNestedDataSetClass := TDataSetClass(Self.ClassType);
 end;
 
-
-
 destructor TDataSet.Destroy;
 
 var
@@ -2356,6 +2373,7 @@ begin
   Active:=False;
   FFieldDefs.Free;
   FFieldList.Free;
+  FNestedDataSets.Free;
   With FDataSources do
     begin
     While Count>0 do
@@ -2544,9 +2562,16 @@ procedure TDataSet.DataEvent(Event: TDataEvent; Info: JSValue);
   end;
   
   procedure HandleScrollOrChange;
+  var
+    NestedDataSet: TDataSet;
   begin
     if State <> dsInsert then
       UpdateCursorPos;
+
+    if Assigned(FNestedDataSets) then
+      for NestedDataSet in FNestedDataSets do
+        if NestedDataSet.Active then
+          NestedDataSet.DataEvent(deParentScroll, 0);
   end;
 
 var
@@ -3157,6 +3182,35 @@ begin
   // empty stub
 end;
 
+procedure TDataSet.SetDataSetField(const Value: TDataSetField);
+begin
+  if Value <> FDataSetField then
+  begin
+    if (Value <> nil) and ((Value.DataSet = Self) or
+       ((Value.DataSet.GetDataSource <> nil) and
+        (Value.DataSet.GetDataSource.DataSet = Self))) then
+      DatabaseError(SCircularDataLink, Self);
+    if Assigned(Value) and not InheritsFrom(Value.DataSet.FNestedDataSetClass) then
+      DatabaseErrorFmt(SNestedDataSetClass, [Value.DataSet.FNestedDataSetClass.ClassName], Self);
+    if Active then Close;
+    if Assigned(FDataSetField) then
+      FDataSetField.AssignNestedDataSet(nil);
+    FDataSetField := Value;
+    if Assigned(Value) then
+    begin
+      Value.AssignNestedDataSet(Self);
+      if Value.DataSet.Active then Open;
+    end;
+  end;
+end;
+
+function TDataSet.GetNestedDataSets: TNestedDataSetsList;
+begin
+  if not Assigned(FNestedDataSets) then
+    FNestedDataSets := TNestedDataSetsList.Create;
+
+  Result := FNestedDataSets;
+end;
 
 function TDataSet.GetFieldData(Field: TField; Buffer: TDatarecord): JSValue;
 
@@ -9001,6 +9055,45 @@ begin
     end;
 end;
 
-initialization
+{ TDataSetField }
+
+constructor TDataSetField.Create(AOwner: TComponent);
+begin
+  inherited;
+
+  SetDataType(ftDataSet);
+end;
+
+procedure TDataSetField.Bind(Binding: Boolean);
+begin
+  inherited;
+  if Assigned(FNestedDataSet) then
+    if Binding then
+    begin
+      if FNestedDataSet.State = dsInActive then
+        FNestedDataSet.Open;
+    end
+    else
+      FNestedDataSet.Close;
+end;
+
+procedure TDataSetField.AssignNestedDataSet(Value: TDataSet);
+begin
+  if Assigned(FNestedDataSet) then
+  begin
+    FNestedDataSet.Close;
+    FNestedDataSet.FDataSetField := nil;
+    if Assigned(DataSet) then
+      DataSet.NestedDataSets.Remove(FNestedDataSet);
+  end;
+  if Assigned(Value) then
+  begin
+    DataSet.NestedDataSets.Add(Value);
+    FFields := Value.Fields;
+  end
+  else
+    FFields := nil;
+  FNestedDataSet := Value;
+end;
 
 end.
diff --git a/packages/fcl-db/dbconst.pas b/packages/fcl-db/dbconst.pas
index 19443ad..3e8f02d 100644
--- a/packages/fcl-db/dbconst.pas
+++ b/packages/fcl-db/dbconst.pas
@@ -128,6 +128,8 @@ Resourcestring
   SatEOFInternalOnly          = 'loAtEOF is for internal use only.';
   SErrInsertingSameRecordtwice = 'Attempt to insert the same record twice.';
   SErrDoApplyUpdatesNeedsProxy = 'Cannot apply updates without Data proxy';
+  SNestedDataSetClass = 'Nested dataset must inherit from %s';
+  SCircularDataLink = 'Circular datalinks are not allowed';
 
 Implementation
 
-- 
2.29.2.windows.2