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 -
This commit is contained in:
lacak 2021-04-12 10:15:59 +00:00
parent c8e712f400
commit 5d81c6c43b
3 changed files with 152 additions and 9 deletions

View File

@ -881,6 +881,12 @@ begin
FFieldDefs.Assign(AFieldDefs); FFieldDefs.Assign(AFieldDefs);
end; 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); procedure TDataSet.DoInsertAppendRecord(const Values: array of const; DoAppend : boolean);
var i : integer; var i : integer;
ValuesSize : integer; ValuesSize : integer;

View File

@ -75,6 +75,7 @@ type
TDataSource = Class; TDataSource = Class;
TDataLink = Class; TDataLink = Class;
TDBTransaction = Class; TDBTransaction = Class;
TObjectField = class;
{ Exception classes } { Exception classes }
@ -169,14 +170,19 @@ type
FCodePage : TSystemCodePage; FCodePage : TSystemCodePage;
FDataType : TFieldType; FDataType : TFieldType;
FFieldNo : Longint; FFieldNo : Longint;
FChildDefs : TFieldDefs;
FInternalCalcField : Boolean; FInternalCalcField : Boolean;
FPrecision : Longint; FPrecision : Longint;
FRequired : Boolean; FRequired : Boolean;
FSize : Integer; FSize : Integer;
function GetCharSize: Word; function GetCharSize: Word;
function GetChildDefs: TFieldDefs;
Function GetFieldClass : TFieldClass; Function GetFieldClass : TFieldClass;
function GetParentDef: TFieldDef;
function GetSize: Integer;
procedure SetAttributes(AValue: TFieldAttributes); procedure SetAttributes(AValue: TFieldAttributes);
procedure SetDataType(AValue: TFieldType); procedure SetDataType(AValue: TFieldType);
procedure SetChildDefs(AValue: TFieldDefs);
procedure SetPrecision(const AValue: Longint); procedure SetPrecision(const AValue: Longint);
procedure SetSize(const AValue: Integer); procedure SetSize(const AValue: Integer);
procedure SetRequired(const AValue: Boolean); procedure SetRequired(const AValue: Boolean);
@ -186,19 +192,23 @@ type
ADataType: TFieldType; ASize: Integer; ARequired: Boolean; AFieldNo: Longint; ADataType: TFieldType; ASize: Integer; ARequired: Boolean; AFieldNo: Longint;
ACodePage: TSystemCodePage = CP_ACP); overload; ACodePage: TSystemCodePage = CP_ACP); overload;
destructor Destroy; override; destructor Destroy; override;
function AddChild: TFieldDef;
procedure Assign(APersistent: TPersistent); override; 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 FieldClass: TFieldClass read GetFieldClass;
property FieldNo: Longint read FFieldNo; property FieldNo: Longint read FFieldNo;
property CharSize: Word read GetCharSize; property CharSize: Word read GetCharSize;
property InternalCalcField: Boolean read FInternalCalcField write FInternalCalcField; property InternalCalcField: Boolean read FInternalCalcField write FInternalCalcField;
property ParentDef: TFieldDef read GetParentDef;
property Required: Boolean read FRequired write SetRequired; property Required: Boolean read FRequired write SetRequired;
Property Codepage : TSystemCodePage Read FCodePage; Property Codepage : TSystemCodePage Read FCodePage;
Published Published
property Attributes: TFieldAttributes read FAttributes write SetAttributes default []; property Attributes: TFieldAttributes read FAttributes write SetAttributes default [];
property DataType: TFieldType read FDataType write SetDataType; 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 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; end;
TFieldDefClass = Class of TFieldDef; TFieldDefClass = Class of TFieldDef;
@ -206,13 +216,14 @@ type
TFieldDefs = class(TDefCollection) TFieldDefs = class(TDefCollection)
private private
FParentDef: TFieldDef;
FHiddenFields : Boolean; FHiddenFields : Boolean;
function GetItem(Index: Longint): TFieldDef; function GetItem(Index: Longint): TFieldDef;
procedure SetItem(Index: Longint; const AValue: TFieldDef); procedure SetItem(Index: Longint; const AValue: TFieldDef);
Protected Protected
Class Function FieldDefClass : TFieldDefClass; virtual; Class Function FieldDefClass : TFieldDefClass; virtual;
public public
constructor Create(ADataSet: TDataSet); constructor Create(AOwner: TPersistent);
// destructor Destroy; override; // 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, 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; 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; Function MakeNameUnique(const AName : String) : string; virtual;
Property HiddenFields : Boolean Read FHiddenFields Write FHiddenFields; Property HiddenFields : Boolean Read FHiddenFields Write FHiddenFields;
property Items[Index: Longint]: TFieldDef read GetItem write SetItem; default; property Items[Index: Longint]: TFieldDef read GetItem write SetItem; default;
property ParentDef: TFieldDef read FParentDef;
end; end;
TFieldDefsClass = Class of TFieldDefs; TFieldDefsClass = Class of TFieldDefs;
@ -300,6 +312,8 @@ type
FOnSetText: TFieldSetTextEvent; FOnSetText: TFieldSetTextEvent;
FOnValidate: TFieldNotifyEvent; FOnValidate: TFieldNotifyEvent;
FOrigin : String; FOrigin : String;
FParentField: TObjectField;
FProviderFlags : TProviderFlags;
FReadOnly : Boolean; FReadOnly : Boolean;
FRequired : Boolean; FRequired : Boolean;
FSize : integer; FSize : integer;
@ -307,7 +321,6 @@ type
FValueBuffer : Pointer; FValueBuffer : Pointer;
FValidating : Boolean; FValidating : Boolean;
FVisible : Boolean; FVisible : Boolean;
FProviderFlags : TProviderFlags;
function GetIndex : longint; function GetIndex : longint;
function GetLookup: Boolean; function GetLookup: Boolean;
procedure SetAlignment(const AValue: TAlignMent); procedure SetAlignment(const AValue: TAlignMent);
@ -385,6 +398,7 @@ type
procedure SetNewValue(const AValue: Variant); procedure SetNewValue(const AValue: Variant);
procedure SetSize(AValue: Integer); virtual; procedure SetSize(AValue: Integer); virtual;
procedure SetParentComponent(AParent: TComponent); override; procedure SetParentComponent(AParent: TComponent); override;
procedure SetParentField(AField: TObjectField); virtual;
procedure SetText(const AValue: string); virtual; procedure SetText(const AValue: string); virtual;
procedure SetVarValue(const AValue: Variant); virtual; procedure SetVarValue(const AValue: Variant); virtual;
public public
@ -461,6 +475,7 @@ type
property LookupResultField: string read FLookupResultField write FLookupResultField; property LookupResultField: string read FLookupResultField write FLookupResultField;
property Lookup: Boolean read GetLookup write SetLookup stored false; deprecated; property Lookup: Boolean read GetLookup write SetLookup stored false; deprecated;
property Origin: string read FOrigin write FOrigin; property Origin: string read FOrigin write FOrigin;
property ParentField: TObjectField read FParentField write SetParentField;
property ProviderFlags : TProviderFlags read FProviderFlags write FProviderFlags; property ProviderFlags : TProviderFlags read FProviderFlags write FProviderFlags;
property ReadOnly: Boolean read FReadOnly write SetReadOnly; property ReadOnly: Boolean read FReadOnly write SetReadOnly;
property Required: Boolean read FRequired write FRequired; property Required: Boolean read FRequired write FRequired;
@ -1092,6 +1107,38 @@ type
property AsGuid: TGUID read GetAsGuid write SetAsGuid; property AsGuid: TGUID read GetAsGuid write SetAsGuid;
end; 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 } { TIndexDef }
TIndexDefs = class; TIndexDefs = class;
@ -1560,6 +1607,7 @@ type
FOnPostError: TDataSetErrorEvent; FOnPostError: TDataSetErrorEvent;
FRecordCount: Longint; FRecordCount: Longint;
FIsUniDirectional: Boolean; FIsUniDirectional: Boolean;
FSparseArrays: Boolean;
FState : TDataSetState; FState : TDataSetState;
FInternalOpenComplete: Boolean; FInternalOpenComplete: Boolean;
Procedure DoInsertAppend(DoAppend : Boolean); Procedure DoInsertAppend(DoAppend : Boolean);
@ -1580,6 +1628,7 @@ type
Procedure UpdateFieldDefs; Procedure UpdateFieldDefs;
procedure SetBlockReadSize(AValue: Integer); virtual; procedure SetBlockReadSize(AValue: Integer); virtual;
Procedure SetFieldDefs(AFieldDefs: TFieldDefs); Procedure SetFieldDefs(AFieldDefs: TFieldDefs);
procedure SetSparseArrays(AValue: Boolean);
procedure DoInsertAppendRecord(const Values: array of const; DoAppend : boolean); procedure DoInsertAppendRecord(const Values: array of const; DoAppend : boolean);
protected protected
procedure RecalcBufListSize; procedure RecalcBufListSize;
@ -1804,6 +1853,7 @@ type
property RecordCount: Longint read GetRecordCount; property RecordCount: Longint read GetRecordCount;
property RecNo: Longint read GetRecNo write SetRecNo; property RecNo: Longint read GetRecNo write SetRecNo;
property RecordSize: Word read GetRecordSize; property RecordSize: Word read GetRecordSize;
property SparseArrays: Boolean read FSparseArrays write SetSparseArrays;
property State: TDataSetState read FState; property State: TDataSetState read FState;
property Fields : TFields read FFieldList; property Fields : TFields read FFieldList;
property FieldValues[FieldName : string] : Variant read GetFieldValues write SetFieldValues; default; property FieldValues[FieldName : string] : Variant read GetFieldValues write SetFieldValues; default;
@ -2301,7 +2351,7 @@ const
{ ftWideString} TWideStringField, { ftWideString} TWideStringField,
{ ftLargeint} TLargeIntField, { ftLargeint} TLargeIntField,
{ ftADT} Nil, { ftADT} Nil,
{ ftArray} Nil, { ftArray} TArrayField,
{ ftReference} Nil, { ftReference} Nil,
{ ftDataSet} Nil, { ftDataSet} Nil,
{ ftOraBlob} TBlobField, { ftOraBlob} TBlobField,
@ -2331,6 +2381,8 @@ const
ftBlobTypes = [ftBlob, ftMemo, ftGraphic, ftFmtMemo, ftParadoxOle, ftBlobTypes = [ftBlob, ftMemo, ftGraphic, ftFmtMemo, ftParadoxOle,
ftDBaseOle, ftTypedBinary, ftOraBlob, ftOraClob, ftWideMemo]; ftDBaseOle, ftTypedBinary, ftOraBlob, ftOraClob, ftWideMemo];
ObjectFieldTypes = [ftADT, ftArray, ftReference, ftDataSet];
var var
LoginDialogExProc: function(const ADatabaseName: string; var AUserName, APassword: string; UserNameReadOnly: Boolean): Boolean = nil; LoginDialogExProc: function(const ADatabaseName: string; var AUserName, APassword: string; UserNameReadOnly: Boolean): Boolean = nil;

View File

@ -63,7 +63,32 @@ end;
destructor TFieldDef.Destroy; destructor TFieldDef.Destroy;
begin 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; end;
procedure TFieldDef.Assign(APersistent: TPersistent); procedure TFieldDef.Assign(APersistent: TPersistent);
@ -89,7 +114,7 @@ begin
inherited Assign(APersistent); inherited Assign(APersistent);
end; 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; var TheField : TFieldClass;
@ -149,6 +174,11 @@ begin
Changed(False); Changed(False);
end; end;
function TFieldDef.GetSize: Integer;
begin
Result := FSize;
end;
procedure TFieldDef.SetSize(const AValue: Integer); procedure TFieldDef.SetSize(const AValue: Integer);
begin begin
FSize := AValue; FSize := AValue;
@ -249,9 +279,11 @@ begin
Result:=TFieldDef; Result:=TFieldDef;
end; end;
constructor TFieldDefs.Create(ADataSet: TDataSet); constructor TFieldDefs.Create(AOwner: TPersistent);
var ADataSet: TDataSet;
begin begin
Inherited Create(ADataset, Owner, FieldDefClass); ADataSet := AOwner as TDataSet;
Inherited Create(ADataset, AOwner, FieldDefClass);
end; end;
function TFieldDefs.Add(const AName: string; ADataType: TFieldType; ASize, APrecision: Integer; function TFieldDefs.Add(const AName: string; ADataType: TFieldType; ASize, APrecision: Integer;
@ -1100,6 +1132,11 @@ begin
FieldKind := ValueToLookupMap[AValue]; FieldKind := ValueToLookupMap[AValue];
end; 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); procedure TField.SetReadOnly(const AValue: Boolean);
begin begin
if (FReadOnly<>AValue) then if (FReadOnly<>AValue) then
@ -3663,6 +3700,54 @@ begin
SetData(@aValue); SetData(@aValue);
end; 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 } { TFieldsEnumerator }
function TFieldsEnumerator.GetCurrent: TField; function TFieldsEnumerator.GetCurrent: TField;