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 -

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;

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;
@@ -1599,6 +1607,7 @@ type
     FOnPostError: TDataSetErrorEvent;
     FRecordCount: Longint;
     FIsUniDirectional: Boolean;
+    FSparseArrays: Boolean;
     FState : TDataSetState;
     FInternalOpenComplete: Boolean;
     Procedure DoInsertAppend(DoAppend : Boolean);
@@ -1619,6 +1628,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;
@@ -1843,6 +1853,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;
@@ -2340,7 +2351,7 @@ const
       { ftWideString} TWideStringField,
       { ftLargeint} TLargeIntField,
       { ftADT} Nil,
-      { ftArray} Nil,
+      { ftArray} TArrayField,
       { ftReference} Nil,
       { ftDataSet} Nil,
       { ftOraBlob} TBlobField,
@@ -2370,6 +2381,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;
 

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;