diff options
author | michael <michael@3ad0048d-3df7-0310-abae-a5850022a9f2> | 2021-03-30 22:11:26 +0000 |
---|---|---|
committer | michael <michael@3ad0048d-3df7-0310-abae-a5850022a9f2> | 2021-03-30 22:11:26 +0000 |
commit | f0304b35b1ec432d367055e4e448f2ee7269a162 (patch) | |
tree | 88b5c8dd226fa9c1fd663ea78c30a3f5a66a69d3 | |
parent | c66fc01ba97f0535f2184beecae08605373b4180 (diff) | |
download | fpc-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.inc | 6 | ||||
-rw-r--r-- | packages/fcl-db/src/base/db.pas | 62 | ||||
-rw-r--r-- | packages/fcl-db/src/base/fields.inc | 146 |
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; |