summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authormichael <michael@3ad0048d-3df7-0310-abae-a5850022a9f2>2021-03-30 22:11:26 +0000
committermichael <michael@3ad0048d-3df7-0310-abae-a5850022a9f2>2021-03-30 22:11:26 +0000
commitf0304b35b1ec432d367055e4e448f2ee7269a162 (patch)
tree88b5c8dd226fa9c1fd663ea78c30a3f5a66a69d3
parentc66fc01ba97f0535f2184beecae08605373b4180 (diff)
downloadfpc-f0304b35b1ec432d367055e4e448f2ee7269a162.tar.gz
* Apparently, taking code from freeclx is not OK
git-svn-id: https://svn.freepascal.org/svn/fpc/trunk@49091 3ad0048d-3df7-0310-abae-a5850022a9f2
-rw-r--r--packages/fcl-db/src/base/dataset.inc6
-rw-r--r--packages/fcl-db/src/base/db.pas62
-rw-r--r--packages/fcl-db/src/base/fields.inc146
3 files changed, 9 insertions, 205 deletions
diff --git a/packages/fcl-db/src/base/dataset.inc b/packages/fcl-db/src/base/dataset.inc
index 3a03fb4873..6f0a4c825b 100644
--- a/packages/fcl-db/src/base/dataset.inc
+++ b/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;
diff --git a/packages/fcl-db/src/base/db.pas b/packages/fcl-db/src/base/db.pas
index 8e6e0229c5..6997da5f21 100644
--- a/packages/fcl-db/src/base/db.pas
+++ b/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 HasChildDefs: Boolean;
+ function CreateField(AOwner: TComponent): TField;
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;
diff --git a/packages/fcl-db/src/base/fields.inc b/packages/fcl-db/src/base/fields.inc
index 4cffb7eece..c6c270ce09 100644
--- a/packages/fcl-db/src/base/fields.inc
+++ b/packages/fcl-db/src/base/fields.inc
@@ -63,35 +63,7 @@ end;
destructor TFieldDef.Destroy;
begin
- FChildDefs.Free;
- 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;
+ Inherited destroy;
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);
-var ADataSet: TDataSet;
+constructor TFieldDefs.Create(ADataSet: TDataSet);
begin
- if AOwner is TFieldDef then
- begin
- FParentDef := TFieldDef(AOwner);
- ADataSet := TFieldDefs(FParentDef.Collection).DataSet;
- end
- else
- ADataSet := AOwner as TDataSet;
- Inherited Create(ADataset, AOwner, FieldDefClass);
+ Inherited Create(ADataset, Owner, 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;