paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-07 11:08:02 +02:00
Code Issues Packages Projects Releases Wiki Activity

fcl-db: Introduce TObjectField and TArrayField. Only essential interface parts (added new objects, new properties and methods according to Delphi documentation).

Browse Source 
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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
packages/fcl-db/src/base/dataset.inc
View File

@ -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;

62
packages/fcl-db/src/base/db.pas
View File

@ -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;
@ -1560,6 +1607,7 @@ type
FOnPostError: TDataSetErrorEvent;
FRecordCount: Longint;
FIsUniDirectional: Boolean;
FSparseArrays: Boolean;
FState : TDataSetState;
FInternalOpenComplete: Boolean;
Procedure DoInsertAppend(DoAppend : Boolean);
@ -1580,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;
@ -1804,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;
@ -2301,7 +2351,7 @@ const
{ ftWideString} TWideStringField,
{ ftLargeint} TLargeIntField,
{ ftADT} Nil,
{ ftArray} Nil,
{ ftArray} TArrayField,
{ ftReference} Nil,
{ ftDataSet} Nil,
{ ftOraBlob} TBlobField,
@ -2331,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;

93
packages/fcl-db/src/base/fields.inc
View File

@ -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;