From d32f2867f529557c2e1c0d533f57c5fc6fc575f2 Mon Sep 17 00:00:00 2001 From: lacak Date: Mon, 12 Apr 2021 10:15:59 +0000 Subject: [PATCH] fcl-db: Introduce TObjectField and TArrayField. Only essential interface parts (added new objects, new properties and methods according to Delphi documentation). There is no implementation of methods in fields.inc and dataset.inc. Only references to Delphi documentation is added as comments. These comments should be deleted after implementation. git-svn-id: trunk@49188 - (cherry picked from commit 5d81c6c43b1f97dcce0df3a816aa72fc3eba4935) --- packages/fcl-db/src/base/dataset.inc | 6 ++ packages/fcl-db/src/base/db.pas | 62 +++++++++++++++++-- packages/fcl-db/src/base/fields.inc | 93 ++++++++++++++++++++++++++-- 3 files changed, 152 insertions(+), 9 deletions(-) diff --git a/packages/fcl-db/src/base/dataset.inc b/packages/fcl-db/src/base/dataset.inc index 6f0a4c825b..a53493f211 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 + // http://docwiki.embarcadero.com/Libraries/Sydney/en/Data.DB.TDataSet.SparseArrays + 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 63f5286462..1e17158313 100644 --- a/packages/fcl-db/src/base/db.pas +++ b/packages/fcl-db/src/base/db.pas @@ -75,6 +75,7 @@ type TDataSource = Class; TDataLink = Class; TDBTransaction = Class; + TObjectField = class; { Exception classes } @@ -169,14 +170,19 @@ 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); @@ -186,19 +192,23 @@ 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): TField; + function CreateField(AOwner: TComponent; ParentField: TObjectField = nil; const FieldName: string = ''; CreateChildren: Boolean = True): 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 FSize write SetSize default 0; + property Size: Integer read GetSize write SetSize default 0; end; TFieldDefClass = Class of TFieldDef; @@ -206,13 +216,14 @@ 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(ADataSet: TDataSet); + constructor Create(AOwner: TPersistent); // 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; @@ -228,6 +239,7 @@ 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; @@ -300,6 +312,8 @@ type FOnSetText: TFieldSetTextEvent; FOnValidate: TFieldNotifyEvent; FOrigin : String; + FParentField: TObjectField; + FProviderFlags : TProviderFlags; FReadOnly : Boolean; FRequired : Boolean; FSize : integer; @@ -307,7 +321,6 @@ type FValueBuffer : Pointer; FValidating : Boolean; FVisible : Boolean; - FProviderFlags : TProviderFlags; function GetIndex : longint; function GetLookup: Boolean; procedure SetAlignment(const AValue: TAlignMent); @@ -385,6 +398,7 @@ 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 @@ -461,6 +475,7 @@ 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; @@ -1092,6 +1107,38 @@ 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; @@ -1562,6 +1609,7 @@ type FOnPostError: TDataSetErrorEvent; FRecordCount: Longint; FIsUniDirectional: Boolean; + FSparseArrays: Boolean; FState : TDataSetState; FInternalOpenComplete: Boolean; Procedure DoInsertAppend(DoAppend : Boolean); @@ -1582,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; @@ -1806,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; @@ -2303,7 +2353,7 @@ const { ftWideString} TWideStringField, { ftLargeint} TLargeIntField, { ftADT} Nil, - { ftArray} Nil, + { ftArray} TArrayField, { ftReference} Nil, { ftDataSet} Nil, { ftOraBlob} TBlobField, @@ -2333,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 c6c270ce09..9a94d9abed 100644 --- a/packages/fcl-db/src/base/fields.inc +++ b/packages/fcl-db/src/base/fields.inc @@ -63,7 +63,32 @@ end; destructor TFieldDef.Destroy; begin - Inherited destroy; + Inherited Destroy; +end; + +function TFieldDef.AddChild: TFieldDef; +begin + // Adds a new TFieldDef object to the ChildDefs array. +end; + +function TFieldDef.GetChildDefs: TFieldDefs; +begin + +end; + +procedure TFieldDef.SetChildDefs(AValue: TFieldDefs); +begin + +end; + +function TFieldDef.HasChildDefs: Boolean; +begin + // http://docwiki.embarcadero.com/Libraries/Sydney/en/Data.DB.TFieldDef.HasChildDefs +end; + +function TFieldDef.GetParentDef: TFieldDef; +begin + // http://docwiki.embarcadero.com/Libraries/Sydney/en/Data.DB.TFieldDef.ParentDef end; procedure TFieldDef.Assign(APersistent: TPersistent); @@ -89,7 +114,7 @@ begin inherited Assign(APersistent); end; -function TFieldDef.CreateField(AOwner: TComponent): TField; +function TFieldDef.CreateField(AOwner: TComponent; ParentField: TObjectField = nil; const FieldName: string = ''; CreateChildren: Boolean = True): TField; var TheField : TFieldClass; @@ -149,6 +174,11 @@ begin Changed(False); end; +function TFieldDef.GetSize: Integer; +begin + Result := FSize; +end; + procedure TFieldDef.SetSize(const AValue: Integer); begin FSize := AValue; @@ -249,9 +279,11 @@ begin Result:=TFieldDef; end; -constructor TFieldDefs.Create(ADataSet: TDataSet); +constructor TFieldDefs.Create(AOwner: TPersistent); +var ADataSet: TDataSet; begin - Inherited Create(ADataset, Owner, FieldDefClass); + ADataSet := AOwner as TDataSet; + Inherited Create(ADataset, AOwner, FieldDefClass); end; function TFieldDefs.Add(const AName: string; ADataType: TFieldType; ASize, APrecision: Integer; @@ -1100,6 +1132,11 @@ begin FieldKind := ValueToLookupMap[AValue]; end; +procedure TField.SetParentField(AField: TObjectField); +begin + // http://docwiki.embarcadero.com/Libraries/Sydney/en/Data.DB.TField.ParentField +end; + procedure TField.SetReadOnly(const AValue: Boolean); begin if (FReadOnly<>AValue) then @@ -3663,6 +3700,54 @@ begin SetData(@aValue); end; +{ TObjectField } + +function TObjectField.GetFieldCount: Integer; +begin + // http://docwiki.embarcadero.com/Libraries/Sydney/en/Data.DB.TObjectField.GetFieldCount +end; + +function TObjectField.GetFields: TFields; +begin + // http://docwiki.embarcadero.com/Libraries/Sydney/en/Data.DB.TObjectField.GetFields + Result := FFieldFields; +end; + +function TObjectField.GetFieldValue(AIndex: Integer): Variant; +begin + // http://docwiki.embarcadero.com/Libraries/Sydney/en/Data.DB.TObjectField.GetFieldValue +end; + +procedure TObjectField.SetFieldValue(AIndex: Integer; const AValue: Variant); +begin + // http://docwiki.embarcadero.com/Libraries/Sydney/en/Data.DB.TObjectField.SetFieldValue +end; + +procedure TObjectField.SetParentField(AField: TObjectField); +begin + // http://docwiki.embarcadero.com/Libraries/Sydney/en/Data.DB.TObjectField.SetParentField + inherited SetParentField(AField); +end; + +function TObjectField.GetAsVariant: Variant; +begin + // http://docwiki.embarcadero.com/Libraries/Sydney/en/Data.DB.TObjectField.GetAsVariant +end; + +procedure TObjectField.SetVarValue(const AValue: Variant); +begin + // http://docwiki.embarcadero.com/Libraries/Sydney/en/Data.DB.TObjectField.SetVarValue +end; + +{ TArrayField } + +constructor TArrayField.Create(AOwner: TComponent); +begin + inherited Create(AOwner); + SetDataType(ftArray); + Size := 10; +end; + { TFieldsEnumerator } function TFieldsEnumerator.GetCurrent: TField;