From 24e680d510e8934ae5e5f1c47d020987cfb2cf3d Mon Sep 17 00:00:00 2001
From: lacak <lacak@idefix.freepascal.org>
Date: Tue, 30 Mar 2021 11:30:19 +0000
Subject: [PATCH] fcl-db: Introduce TArrayField. Only essential parts (added
 new object properties according to Delphi documentation). Some code taken
 from FreeCLX project (https://sourceforge.net/projects/freeclx/)

git-svn-id: trunk@49085 -
(cherry picked from commit 89fc5b7f8d60971b555b7da24970e3b7f2f83b17)
---
 packages/fcl-db/src/base/dataset.inc |  6 ++++++
 packages/fcl-db/src/base/db.pas      | 15 ++++++++++++++-
 packages/fcl-db/src/base/fields.inc  | 28 +++++++++++++++++++++++-----
 3 files changed, 43 insertions(+), 6 deletions(-)

diff --git a/packages/fcl-db/src/base/dataset.inc b/packages/fcl-db/src/base/dataset.inc
index 6f0a4c825b..3a03fb4873 100644
--- a/packages/fcl-db/src/base/dataset.inc
+++ b/packages/fcl-db/src/base/dataset.inc
@@ -881,6 +881,12 @@ begin
   FFieldDefs.Assign(AFieldDefs);
 end;
 
+procedure TDataSet.SetSparseArrays(AValue: Boolean);
+begin
+ CheckInactive;
+ FSparseArrays := AValue;
+end;
+
 procedure TDataSet.DoInsertAppendRecord(const Values: array of const; DoAppend : boolean);
 var i : integer;
     ValuesSize : integer;
diff --git a/packages/fcl-db/src/base/db.pas b/packages/fcl-db/src/base/db.pas
index 5f428de61e..1e17158313 100644
--- a/packages/fcl-db/src/base/db.pas
+++ b/packages/fcl-db/src/base/db.pas
@@ -1131,6 +1131,14 @@ type
     property ObjectType: string read FObjectType write FObjectType;
   end;
 
+{ TArrayField }
+
+  TArrayField = class(TObjectField)
+  private
+  public
+    constructor Create(AOwner: TComponent); override;
+  end;
+
 { TIndexDef }
 
   TIndexDefs = class;
@@ -1601,6 +1609,7 @@ type
     FOnPostError: TDataSetErrorEvent;
     FRecordCount: Longint;
     FIsUniDirectional: Boolean;
+    FSparseArrays: Boolean;
     FState : TDataSetState;
     FInternalOpenComplete: Boolean;
     Procedure DoInsertAppend(DoAppend : Boolean);
@@ -1621,6 +1630,7 @@ type
     Procedure UpdateFieldDefs;
     procedure SetBlockReadSize(AValue: Integer); virtual;
     Procedure SetFieldDefs(AFieldDefs: TFieldDefs);
+    procedure SetSparseArrays(AValue: Boolean);
     procedure DoInsertAppendRecord(const Values: array of const; DoAppend : boolean);
   protected
     procedure RecalcBufListSize;
@@ -1845,6 +1855,7 @@ type
     property RecordCount: Longint read GetRecordCount;
     property RecNo: Longint read GetRecNo write SetRecNo;
     property RecordSize: Word read GetRecordSize;
+    property SparseArrays: Boolean read FSparseArrays write SetSparseArrays;
     property State: TDataSetState read FState;
     property Fields : TFields read FFieldList;
     property FieldValues[FieldName : string] : Variant read GetFieldValues write SetFieldValues; default;
@@ -2342,7 +2353,7 @@ const
       { ftWideString} TWideStringField,
       { ftLargeint} TLargeIntField,
       { ftADT} Nil,
-      { ftArray} Nil,
+      { ftArray} TArrayField,
       { ftReference} Nil,
       { ftDataSet} Nil,
       { ftOraBlob} TBlobField,
@@ -2372,6 +2383,8 @@ const
   ftBlobTypes = [ftBlob, ftMemo, ftGraphic, ftFmtMemo, ftParadoxOle,
     ftDBaseOle, ftTypedBinary, ftOraBlob, ftOraClob, ftWideMemo];
 
+  ObjectFieldTypes = [ftADT, ftArray, ftReference, ftDataSet];
+
 var
   LoginDialogExProc: function(const ADatabaseName: string; var AUserName, APassword: string; UserNameReadOnly: Boolean): Boolean = nil;
 
diff --git a/packages/fcl-db/src/base/fields.inc b/packages/fcl-db/src/base/fields.inc
index cb123815ce..4cffb7eece 100644
--- a/packages/fcl-db/src/base/fields.inc
+++ b/packages/fcl-db/src/base/fields.inc
@@ -120,7 +120,7 @@ end;
 function TFieldDef.CreateField(AOwner: TComponent; ParentField: TObjectField = nil; const FieldName: string = ''; CreateChildren: Boolean = True): TField;
 
 var TheField : TFieldClass;
-    i: integer;
+    i,n: integer;
 
 begin
 {$ifdef dsdebug}
@@ -156,10 +156,19 @@ begin
       TFmtBCDField(Result).Precision := FPrecision;
 
     if CreateChildren and HasChildDefs then
-    begin
-      for i := 0 to ChildDefs.Count - 1 do
-        ChildDefs[i].CreateField(nil, TObjectField(Result), '');
-    end;
+      if DataType = ftArray then
+      begin
+        if TFieldDefs(Collection).DataSet.SparseArrays then
+          n := 1
+        else
+          n := Size; // created field for each array element
+        for i := 0 to n - 1 do
+          // all array elements are of same type
+          ChildDefs[0].CreateField(nil, TObjectField(Result), Format('%s[%d]', [Result.FieldName, i]));
+      end
+      else
+        for i := 0 to ChildDefs.Count - 1 do
+          ChildDefs[i].CreateField(nil, TObjectField(Result), '');
   except
     Result.Free;
     Raise;
@@ -3783,6 +3792,15 @@ begin
     SetFieldValue(I, AValue[I]);
 end;
 
+{ TArrayField }
+
+constructor TArrayField.Create(AOwner: TComponent);
+begin
+  inherited Create(AOwner);
+  SetDataType(ftArray);
+  Size := 10;
+end;
+
 { TFieldsEnumerator }
 
 function TFieldsEnumerator.GetCurrent: TField;