mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-11 09:06:14 +02:00
* Implemented InitFieldDefsFromFields, bug #8221
git-svn-id: trunk@6443 -
This commit is contained in:
parent
56b380c79e
commit
5c31c25849
@ -775,6 +775,30 @@ begin
|
|||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
procedure TDataSet.InitFieldDefsFromfields;
|
||||||
|
var i : integer;
|
||||||
|
begin
|
||||||
|
if FieldDefs.count = 0 then
|
||||||
|
begin
|
||||||
|
FieldDefs.BeginUpdate;
|
||||||
|
try
|
||||||
|
for i := 0 to Fields.Count-1 do with fields[i] do
|
||||||
|
begin
|
||||||
|
with TFieldDef.Create(FieldDefs,FieldName,DataType,Size,Required,i+1) do
|
||||||
|
begin
|
||||||
|
if Required then Attributes := attributes + [faRequired];
|
||||||
|
if ReadOnly then Attributes := attributes + [faReadOnly];
|
||||||
|
if DataType = ftBCD then precision := (fields[i] as TBCDField).Precision
|
||||||
|
// this must change if TFMTBcdfield is implemented
|
||||||
|
else if DataType = ftFMTBcd then precision := (fields[i] as TBCDField).Precision;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
finally
|
||||||
|
FieldDefs.EndUpdate;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
Procedure TDataset.InitRecord(Buffer: PChar);
|
Procedure TDataset.InitRecord(Buffer: PChar);
|
||||||
|
|
||||||
begin
|
begin
|
||||||
|
@ -1072,6 +1072,7 @@ type
|
|||||||
function GetRecordCount: Longint; virtual;
|
function GetRecordCount: Longint; virtual;
|
||||||
function GetRecNo: Longint; virtual;
|
function GetRecNo: Longint; virtual;
|
||||||
procedure InitFieldDefs; virtual;
|
procedure InitFieldDefs; virtual;
|
||||||
|
procedure InitFieldDefsFromfields;
|
||||||
procedure InitRecord(Buffer: PChar); virtual;
|
procedure InitRecord(Buffer: PChar); virtual;
|
||||||
procedure InternalCancel; virtual;
|
procedure InternalCancel; virtual;
|
||||||
procedure InternalEdit; virtual;
|
procedure InternalEdit; virtual;
|
||||||
|
@ -19,12 +19,14 @@ type
|
|||||||
protected
|
protected
|
||||||
published
|
published
|
||||||
procedure TestParseSQL;
|
procedure TestParseSQL;
|
||||||
|
procedure TestInitFielddefsFromFields;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
implementation
|
implementation
|
||||||
|
|
||||||
uses db, toolsunit;
|
uses db, toolsunit;
|
||||||
|
|
||||||
|
Type HackedDataset = class(TDataset);
|
||||||
|
|
||||||
{ TTestBasics }
|
{ TTestBasics }
|
||||||
|
|
||||||
@ -91,6 +93,52 @@ begin
|
|||||||
Params.Free;
|
Params.Free;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
procedure TTestBasics.TestInitFielddefsFromFields;
|
||||||
|
|
||||||
|
var ds : TDataset;
|
||||||
|
F1,F2,F3 : Tfield;
|
||||||
|
|
||||||
|
Procedure CompareFieldAndFieldDef(Fld: TField; FldDef : TFieldDef);
|
||||||
|
|
||||||
|
begin
|
||||||
|
AssertEquals(Fld.FieldName,FldDef.Name);
|
||||||
|
AssertEquals(Fld.Size,FldDef.Size);
|
||||||
|
AssertEquals(Fld.Required,FldDef.Required);
|
||||||
|
AssertTrue(Fld.DataType=FldDef.DataType);
|
||||||
|
end;
|
||||||
|
|
||||||
|
begin
|
||||||
|
ds := TDataset.Create(nil);
|
||||||
|
|
||||||
|
F1:=TStringField.Create(ds);
|
||||||
|
F1.Size := 10;
|
||||||
|
F1.Name := 'StringFld';
|
||||||
|
F1.FieldName := 'FStringFld';
|
||||||
|
F1.Required := false;
|
||||||
|
F1.Dataset:=ds;
|
||||||
|
|
||||||
|
F2:=TIntegerField.Create(ds);
|
||||||
|
F2.Name := 'IntegerFld';
|
||||||
|
F2.FieldName := 'FIntegerFld';
|
||||||
|
F2.Required := True;
|
||||||
|
F2.Dataset:=ds;
|
||||||
|
|
||||||
|
F3:=TBCDField.Create(ds);
|
||||||
|
F3.Name := 'BCDFld';
|
||||||
|
F3.FieldName := 'FBCDFld';
|
||||||
|
F3.Required := false;
|
||||||
|
F3.Dataset:=ds;
|
||||||
|
(f3 as TBCDField).Precision := 2;
|
||||||
|
|
||||||
|
HackedDataset(ds).InitFieldDefsFromfields;
|
||||||
|
|
||||||
|
AssertEquals(3,ds.FieldDefs.Count);
|
||||||
|
|
||||||
|
CompareFieldAndFieldDef(F1,ds.FieldDefs[0]);
|
||||||
|
CompareFieldAndFieldDef(F2,ds.FieldDefs[1]);
|
||||||
|
CompareFieldAndFieldDef(F3,ds.FieldDefs[2]);
|
||||||
|
end;
|
||||||
|
|
||||||
initialization
|
initialization
|
||||||
RegisterTest(TTestBasics);
|
RegisterTest(TTestBasics);
|
||||||
end.
|
end.
|
||||||
|
Loading…
Reference in New Issue
Block a user