* Apparently, taking code from freeclx is not OK

git-svn-id: trunk@49091 -

packages/fcl-db/src/base/dataset.inc

@@ -881,12 +881,6 @@ 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

@@ -75,7 +75,6 @@ type
   TDataSource = Class;
   TDataLink = Class;
   TDBTransaction = Class;
-  TObjectField = class;
 
 { Exception classes }
 
@@ -170,19 +169,14 @@ type
     FCodePage : TSystemCodePage;
     FDataType : TFieldType;
     FFieldNo : Longint;
-    FChildDefs : TFieldDefs;
     FInternalCalcField : Boolean;
     FPrecision : Longint;
     FRequired : Boolean;
     FSize : Integer;
     function GetCharSize: Word;
-    function GetChildDefs: TFieldDefs;
     Function GetFieldClass : TFieldClass;
-    function GetParentDef: TFieldDef;
-    function GetSize: Integer;
     procedure SetAttributes(AValue: TFieldAttributes);
     procedure SetDataType(AValue: TFieldType);
-    procedure SetChildDefs(AValue: TFieldDefs);
     procedure SetPrecision(const AValue: Longint);
     procedure SetSize(const AValue: Integer);
     procedure SetRequired(const AValue: Boolean);
@@ -192,23 +186,19 @@ type
       ADataType: TFieldType; ASize: Integer; ARequired: Boolean; AFieldNo: Longint;
       ACodePage: TSystemCodePage = CP_ACP); overload;
     destructor Destroy; override;
-    function AddChild: TFieldDef;
     procedure Assign(APersistent: TPersistent); override;
-    function CreateField(AOwner: TComponent; ParentField: TObjectField = nil;  const FieldName: string = ''; CreateChildren: Boolean = True): TField;
+    function CreateField(AOwner: TComponent): TField;
-    function HasChildDefs: Boolean;
     property FieldClass: TFieldClass read GetFieldClass;
     property FieldNo: Longint read FFieldNo;
     property CharSize: Word read GetCharSize;
     property InternalCalcField: Boolean read FInternalCalcField write FInternalCalcField;
-    property ParentDef: TFieldDef read GetParentDef;
     property Required: Boolean read FRequired write SetRequired;
     Property Codepage : TSystemCodePage Read FCodePage;
   Published
     property Attributes: TFieldAttributes read FAttributes write SetAttributes default [];
     property DataType: TFieldType read FDataType write SetDataType;
-    property ChildDefs: TFieldDefs read GetChildDefs write SetChildDefs stored HasChildDefs;
     property Precision: Longint read FPrecision write SetPrecision default 0;
-    property Size: Integer read GetSize write SetSize default 0;
+    property Size: Integer read FSize write SetSize default 0;
   end;
   TFieldDefClass = Class of TFieldDef;
 
@@ -216,14 +206,13 @@ type
 
   TFieldDefs = class(TDefCollection)
   private
-    FParentDef: TFieldDef;
     FHiddenFields : Boolean;
     function GetItem(Index: Longint): TFieldDef;
     procedure SetItem(Index: Longint; const AValue: TFieldDef);
   Protected
     Class Function FieldDefClass : TFieldDefClass; virtual;
   public
-    constructor Create(AOwner: TPersistent);
+    constructor Create(ADataSet: TDataSet);
 //    destructor Destroy; override;
     Function Add(const AName: string; ADataType: TFieldType; ASize, APrecision: Integer; ARequired, AReadOnly: Boolean; AFieldNo : Integer; ACodePage:TSystemCodePage) : TFieldDef; overload;
     Function Add(const AName: string; ADataType: TFieldType; ASize: Word; ARequired: Boolean; AFieldNo : Integer) : TFieldDef; overload;
@@ -239,7 +228,6 @@ type
     Function MakeNameUnique(const AName : String) : string; virtual;
     Property HiddenFields : Boolean Read FHiddenFields Write FHiddenFields;
     property Items[Index: Longint]: TFieldDef read GetItem write SetItem; default;
-    property ParentDef: TFieldDef read FParentDef;
   end;
   TFieldDefsClass = Class of TFieldDefs;
 
@@ -312,8 +300,6 @@ type
     FOnSetText: TFieldSetTextEvent;
     FOnValidate: TFieldNotifyEvent;
     FOrigin : String;
-    FParentField: TObjectField;
-    FProviderFlags : TProviderFlags;
     FReadOnly : Boolean;
     FRequired : Boolean;
     FSize : integer;
@@ -321,6 +307,7 @@ type
     FValueBuffer : Pointer;
     FValidating : Boolean;
     FVisible : Boolean;
+    FProviderFlags : TProviderFlags;
     function GetIndex : longint;
     function GetLookup: Boolean;
     procedure SetAlignment(const AValue: TAlignMent);
@@ -398,7 +385,6 @@ type
     procedure SetNewValue(const AValue: Variant);
     procedure SetSize(AValue: Integer); virtual;
     procedure SetParentComponent(AParent: TComponent); override;
-    procedure SetParentField(AField: TObjectField); virtual;
     procedure SetText(const AValue: string); virtual;
     procedure SetVarValue(const AValue: Variant); virtual;
   public
@@ -475,7 +461,6 @@ type
     property LookupResultField: string read FLookupResultField write FLookupResultField;
     property Lookup: Boolean read GetLookup write SetLookup stored false; deprecated;
     property Origin: string read FOrigin write FOrigin;
-    property ParentField: TObjectField read FParentField write SetParentField;
     property ProviderFlags : TProviderFlags read FProviderFlags write FProviderFlags;
     property ReadOnly: Boolean read FReadOnly write SetReadOnly;
     property Required: Boolean read FRequired write FRequired;
@@ -1107,38 +1092,6 @@ type
     property AsGuid: TGUID read GetAsGuid write SetAsGuid;
   end;
 
-{ TObjectField }
-
-  TObjectField = class(TField)
-  private
-    FFieldFields: TFields;
-    FObjectType: string;
-    FUnNamed: boolean;
-  protected
-    function GetAsVariant: Variant; override;
-    function GetFieldCount: Integer;
-    function GetFields: TFields; virtual;
-    function GetFieldValue(AIndex: Integer): Variant; virtual;
-    procedure SetFieldValue(AIndex: Integer; const AValue: Variant); virtual;
-    procedure SetParentField(AField: TObjectField); override;
-    procedure SetVarValue(const AValue: Variant); override;
-  public
-    property FieldCount: Integer read GetFieldCount;
-    property Fields: TFields read GetFields;
-    property FieldValues[AIndex: Integer]: Variant read GetFieldValue  write SetFieldValue; default;
-    property UnNamed: Boolean read FUnNamed default False;
-  published
-    property ObjectType: string read FObjectType write FObjectType;
-  end;
-
-{ TArrayField }
-
-  TArrayField = class(TObjectField)
-  private
-  public
-    constructor Create(AOwner: TComponent); override;
-  end;
-
 { TIndexDef }
 
   TIndexDefs = class;
@@ -1607,7 +1560,6 @@ type
     FOnPostError: TDataSetErrorEvent;
     FRecordCount: Longint;
     FIsUniDirectional: Boolean;
-    FSparseArrays: Boolean;
     FState : TDataSetState;
     FInternalOpenComplete: Boolean;
     Procedure DoInsertAppend(DoAppend : Boolean);
@@ -1628,7 +1580,6 @@ 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;
@@ -1853,7 +1804,6 @@ 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;
@@ -2351,7 +2301,7 @@ const
       { ftWideString} TWideStringField,
       { ftLargeint} TLargeIntField,
       { ftADT} Nil,
-      { ftArray} TArrayField,
+      { ftArray} Nil,
       { ftReference} Nil,
       { ftDataSet} Nil,
       { ftOraBlob} TBlobField,
@@ -2381,8 +2331,6 @@ 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

@@ -63,35 +63,7 @@ end;
 destructor TFieldDef.Destroy;
 
 begin
-  FChildDefs.Free;
+  Inherited destroy;
-  Inherited Destroy;
-end;
-
-function TFieldDef.AddChild: TFieldDef;
-begin
-  Result := ChildDefs.AddFieldDef;
-end;
-
-function TFieldDef.GetChildDefs: TFieldDefs;
-begin
-  if FChildDefs = nil then
-    FChildDefs := TFieldDefs.Create(Self);
-  Result := FChildDefs;
-end;
-
-procedure TFieldDef.SetChildDefs(AValue: TFieldDefs);
-begin
-  ChildDefs.Assign(AValue);
-end;
-
-function TFieldDef.HasChildDefs: Boolean;
-begin
-  Result := Assigned(FChildDefs) and (FChildDefs.Count > 0);
-end;
-
-function TFieldDef.GetParentDef: TFieldDef;
-begin
-  Result := TFieldDefs(Collection).ParentDef;
 end;
 
 procedure TFieldDef.Assign(APersistent: TPersistent);
@@ -117,10 +89,9 @@ begin
     inherited Assign(APersistent);
 end;
 
-function TFieldDef.CreateField(AOwner: TComponent; ParentField: TObjectField = nil; const FieldName: string = ''; CreateChildren: Boolean = True): TField;
+function TFieldDef.CreateField(AOwner: TComponent): TField;
 
 var TheField : TFieldClass;
-    i,n: integer;
 
 begin
 {$ifdef dsdebug}
@@ -154,21 +125,6 @@ begin
       TBCDField(Result).Precision := FPrecision
     else if (Result is TFmtBCDField) then
       TFmtBCDField(Result).Precision := FPrecision;
-
-    if CreateChildren and HasChildDefs then
-      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;
@@ -193,17 +149,8 @@ begin
   Changed(False);
 end;
 
-function TFieldDef.GetSize: Integer;
-begin
-  if HasChildDefs and (FSize = 0) then
-    Result := FChildDefs.Count
-  else
-    Result := FSize;
-end;
-
 procedure TFieldDef.SetSize(const AValue: Integer);
 begin
-  if HasChildDefs and (DataType <> ftArray) then Exit;
   FSize := AValue;
   Changed(False);
 end;
@@ -302,17 +249,9 @@ begin
   Result:=TFieldDef;
 end;
 
-constructor TFieldDefs.Create(AOwner: TPersistent);
+constructor TFieldDefs.Create(ADataSet: TDataSet);
-var ADataSet: TDataSet;
 begin
-  if AOwner is TFieldDef then
+  Inherited Create(ADataset, Owner, FieldDefClass);
-  begin
-    FParentDef := TFieldDef(AOwner);
-    ADataSet := TFieldDefs(FParentDef.Collection).DataSet;
-  end
-  else
-    ADataSet := AOwner as TDataSet;
-  Inherited Create(ADataset, AOwner, FieldDefClass);
 end;
 
 function TFieldDefs.Add(const AName: string; ADataType: TFieldType; ASize, APrecision: Integer;
@@ -1161,25 +1100,6 @@ begin
   FieldKind := ValueToLookupMap[AValue];
 end;
 
-procedure TField.SetParentField(AField: TObjectField);
-begin
-  if AField <> FParentField then
-  begin
-    if FDataSet <> nil then FDataSet.CheckInactive;
-    if AField <> nil then
-    begin
-      if AField.DataSet <> nil then AField.DataSet.CheckInactive;
-      AField.Fields.CheckFieldName(FFieldName);
-      AField.Fields.Add(Self);
-      if FDataSet <> nil then FDataSet.Fields.Remove(Self);
-      FDataSet := AField.DataSet;
-    end
-    else if FDataSet <> nil then FDataSet.Fields.Add(Self);
-    if FParentField <> nil then FParentField.Fields.Remove(Self);
-    FParentField := AField;
-  end;
-end;
-
 procedure TField.SetReadOnly(const AValue: Boolean);
 begin
   if (FReadOnly<>AValue) then
@@ -3743,64 +3663,6 @@ begin
   SetData(@aValue);
 end;
 
-{ TObjectField }
-
-function TObjectField.GetFieldCount: Integer;
-begin
-  Result := Fields.Count;
-end;
-
-function TObjectField.GetFields: TFields;
-begin
-  Result := FFieldFields;
-end;
-
-function TObjectField.GetFieldValue(AIndex: Integer): Variant;
-begin
-  Result := FFieldFields[AIndex].Value;
-end;
-
-procedure TObjectField.SetFieldValue(AIndex: Integer; const AValue: Variant);
-begin
-  FFieldFields[AIndex].Value := AValue;
-end;
-
-procedure TObjectField.SetParentField(AField: TObjectField);
-begin
-  inherited SetParentField(AField);
-end;
-
-function TObjectField.GetAsVariant: Variant;
-var I: integer;
-begin
-  if IsNull then
-    Result := Null
-  else
-  begin
-    Result := VarArrayCreate([0, FieldCount - 1], varVariant);
-    for I := 0 to FieldCount - 1 do
-      Result[I] := GetFieldValue(I);
-  end;
-end;
-
-procedure TObjectField.SetVarValue(const AValue: Variant);
-var N,I: integer;
-begin
-  N := VarArrayHighBound(AValue, 1) + 1;
-  if N > Size then N := Size;
-  for I := 0 to N - 1  do
-    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;