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

* Apparently, taking code from freeclx is not OK

Browse Source 
git-svn-id: trunk@49091 -
This commit is contained in:
michael 2021-03-30 22:11:26 +00:00
parent bc4a22e24d
commit a8df728548
3 changed files with 9 additions and 205 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,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;

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

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

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

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