* Merging revisions 1068,1070,1072, from trunk:

    ------------------------------------------------------------------------
    r1068 | michael | 2021-01-23 11:32:10 +0100 (Sat, 23 Jan 2021) | 1 line
    
    * Patch from Henrique Werlang to implement TDatasetField
    ------------------------------------------------------------------------
    r1070 | michael | 2021-01-23 11:45:24 +0100 (Sat, 23 Jan 2021) | 1 line
    
    * Patch from Henrique Werlang to implement getting method parameters info (bug ID 38313) 
    ------------------------------------------------------------------------
    r1072 | michael | 2021-02-07 13:20:26 +0100 (Sun, 07 Feb 2021) | 1 line
    
    * Fix in TDataSet.DefaultBytesToBlobData, index out of range
    ------------------------------------------------------------------------

packages/fcl-db/db.pas

@@ -23,7 +23,6 @@ interface
 uses 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,16 @@ 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 +1062,8 @@ type
   TOnRecordResolveEvent = Procedure (Sender : TDataset; info : TResolveInfo) of object;
   TApplyUpdatesEvent = Procedure (Sender : TDataset; info : TResolveResults) of object;
 
+  TNestedDataSetsList = TFPList;
+
 {------------------------------------------------------------------------------}
 
   TDataSet = class(TComponent)
@@ -1127,6 +1137,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 +1159,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 +1297,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 +1305,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 +1376,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 +2360,9 @@ begin
   FIsUniDirectional := False;
   FAutoCalcFields := True;
   FDataRequestID:=0;
+  FNestedDataSetClass := TDataSetClass(Self.ClassType);
 end;
 
-
-
 destructor TDataSet.Destroy;
 
 var
@@ -2356,6 +2372,7 @@ begin
   Active:=False;
   FFieldDefs.Free;
   FFieldList.Free;
+  FNestedDataSets.Free;
   With FDataSources do
     begin
     While Count>0 do
@@ -2544,9 +2561,23 @@ procedure TDataSet.DataEvent(Event: TDataEvent; Info: JSValue);
   end;
   
   procedure HandleScrollOrChange;
+  var
+    A: Integer;
+
+    NestedDataSet: TDataSet;
+
   begin
     if State <> dsInsert then
       UpdateCursorPos;
+
+    if Assigned(FNestedDataSets) then
+      for A := 0 to Pred(NestedDataSets.Count) do
+      begin
+        NestedDataSet := TDataSet(NestedDataSets[A]);
+
+        if NestedDataSet.Active then
+          NestedDataSet.DataEvent(deParentScroll, 0);
+      end;
   end;
 
 var
@@ -3157,6 +3188,35 @@ begin
   // empty stub
 end;
 
+procedure TDataSet.SetDataSetField(const Value: TDataSetField);
+begin
+  if Value = FDataSetField then
+    exit;
+  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;
+
+function TDataSet.GetNestedDataSets: TNestedDataSetsList;
+begin
+  if not Assigned(FNestedDataSets) then
+    FNestedDataSets := TNestedDataSetsList.Create;
+  Result := FNestedDataSets;
+end;
 
 function TDataSet.GetFieldData(Field: TField; Buffer: TDatarecord): JSValue;
 
@@ -3998,7 +4058,7 @@ begin
   else
     begin
     S:='';
-    For I:=0 to Length(AValue) do
+    For I:=0 to Length(AValue)-1 do
       TJSString(S).Concat(IntToHex(aValue[i],2));
     Result:=S;
     end;
@@ -9001,6 +9061,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.

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
 

packages/rtl/rtti.pas

@@ -134,12 +134,28 @@ type
     //procedure SetValue(Instance: Pointer; const AValue: TValue);
     //function ToString: string; override;
   end;
-  TRttiFieldArray = array of TRttiField;
+  TRttiFieldArray = specialize TArray<TRttiField>;
+
+  TRttiParameter = class(TRttiNamedObject)
+  private
+    FParamType: TRttiType;
+    FFlags: TParamFlags;
+    FName: String;
+  protected
+    function GetName: string; override;
+  public
+    property Flags: TParamFlags read FFlags;
+    property ParamType: TRttiType read FParamType;
+  end;
+
+  TRttiParameterArray = specialize TArray<TRttiParameter>;
 
   { TRttiMethod }
 
   TRttiMethod = class(TRttiMember)
   private
+    FParameters: TRttiParameterArray;
+
     function GetMethodTypeInfo: TTypeMemberMethod;
     function GetIsClassMethod: boolean;
     function GetIsConstructor: boolean;
@@ -149,7 +165,10 @@ type
     function GetIsVarArgs: boolean;
     function GetMethodKind: TMethodKind;
     function GetReturnType: TRttiType;
+
+    procedure LoadParameters;
   public
+    function GetParameters: TRttiParameterArray;
     property MethodTypeInfo: TTypeMemberMethod read GetMethodTypeInfo;
     property ReturnType: TRttiType read GetReturnType;
     property MethodKind: TMethodKind read GetMethodKind;
@@ -159,7 +178,6 @@ type
     property IsExternal: boolean read GetIsExternal;
     property IsStatic: boolean read GetIsStatic;// true = has Self argument
     property IsVarArgs: boolean read GetIsVarArgs;
-    //function GetParameters:
   end;
 
   TRttiMethodArray = specialize TArray<TRttiMethod>;
@@ -1065,6 +1083,13 @@ begin
   Result := GRttiContext.GetType(FTypeInfo);
 end;
 
+{ TRttiParameter }
+
+function TRttiParameter.GetName: String;
+begin
+  Result := FName;
+end;
+
 { TRttiMethod }
 
 function TRttiMethod.GetMethodTypeInfo: TTypeMemberMethod;
@@ -1112,6 +1137,43 @@ begin
   Result := GRttiContext.GetType(MethodTypeInfo.ProcSig.ResultType);
 end;
 
+procedure TRttiMethod.LoadParameters;
+const
+  FLAGS_CONVERSION: array[TParamFlag] of Integer = (1, 2, 4, 8, 16, 32);
+
+var
+  A, Flag: Integer;
+
+  Param: TProcedureParam;
+
+  RttiParam: TRttiParameter;
+
+begin
+  SetLength(FParameters, Length(MethodTypeInfo.ProcSig.Params));
+
+  for A := Low(FParameters) to High(FParameters) do
+  begin
+    Param := MethodTypeInfo.ProcSig.Params[A];
+    RttiParam := TRttiParameter.Create;
+    RttiParam.FName := Param.Name;
+    RttiParam.FParamType := GRttiContext.GetType(Param.TypeInfo);
+
+    for Flag in FLAGS_CONVERSION do
+      if Flag and Param.Flags > 0 then
+        RttiParam.FFlags := RttiParam.FFlags + [TParamFlag(A)];
+
+    FParameters[A] := RttiParam;
+  end;
+end;
+
+function TRttiMethod.GetParameters: TRttiParameterArray;
+begin
+  if not Assigned(FParameters) then
+    LoadParameters;
+
+  Result := FParameters;
+end;
+
 { TRttiProperty }
 
 constructor TRttiProperty.Create(AParent: TRttiType; ATypeInfo: TTypeMember);