mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-20 18:09:27 +02:00
+ Fixes to make dbase working merged from fixbranch
This commit is contained in:
michael
parent
77812493b5
commit
3aed976417
@ -72,9 +72,10 @@ begin
|
||||
Here some magic will be needed later; for now just simply set
|
||||
Just set fieldno from listindex...
|
||||
Later we should take it from the fielddefs.
|
||||
}
|
||||
// ATM Set by CreateField ...
|
||||
For I:=0 to FFieldList.Count-1 do
|
||||
FFieldList[i].FFieldNo:=I;
|
||||
}
|
||||
end;
|
||||
|
||||
Function TDataset.BookmarkAvailable: Boolean;
|
||||
@ -141,11 +142,17 @@ Var I : longint;
|
||||
begin
|
||||
{$ifdef DSDebug}
|
||||
Writeln ('Creating fields');
|
||||
Writeln ('Count : ',fielddefs.Count);
|
||||
For I:=0 to FieldDefs.Count-1 do
|
||||
Writeln('Def ',I,' : ',Fielddefs.items[i].Name,'(',Fielddefs.items[i].FieldNo,')');
|
||||
{$endif}
|
||||
For I:=0 to fielddefs.Count-1 do
|
||||
With Fielddefs.Items[I] do
|
||||
If DataType<>ftUnknown then
|
||||
begin
|
||||
Writeln('About to create field',FieldDefs.Items[i].Name);
|
||||
CreateField(self);
|
||||
end;
|
||||
end;
|
||||
|
||||
Procedure TDataset.DataEvent(Event: TDataEvent; Info: Longint);
|
||||
@ -1375,10 +1382,27 @@ begin
|
||||
Resync([]);
|
||||
end;
|
||||
|
||||
procedure TDataSet.RecalcBufListSize;
|
||||
var
|
||||
i, j, MaxValue: Integer;
|
||||
DataLink: TDataLink;
|
||||
begin
|
||||
MaxValue := 0;
|
||||
for i := 0 to FDataSources.Count - 1 do
|
||||
for j := 0 to TDataSource(FDataSources[i]).DataLinks.Count - 1 do
|
||||
begin
|
||||
DataLink := TDataLink(TDataSource(FDataSources[i]).DataLinks[j]);
|
||||
if DataLink.BufferCount > MaxValue then
|
||||
MaxValue := DataLink.BufferCount;
|
||||
end;
|
||||
SetBufListSize(MaxValue);
|
||||
end;
|
||||
|
||||
Procedure TDataset.RegisterDataSource(ADatasource : TDataSource);
|
||||
|
||||
begin
|
||||
FDatasources.Add(ADataSource);
|
||||
RecalcBufListSize;
|
||||
end;
|
||||
|
||||
|
||||
@ -1569,7 +1593,10 @@ end;
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.3 2000-12-24 12:45:19 peter
|
||||
Revision 1.4 2001-01-18 22:10:07 michael
|
||||
+ Fixes to make dbase working merged from fixbranch
|
||||
|
||||
Revision 1.3 2000/12/24 12:45:19 peter
|
||||
* merges from 1.0.x branch
|
||||
|
||||
Revision 1.2 2000/07/13 11:32:56 michael
|
||||
|
||||
@ -86,6 +86,7 @@ begin
|
||||
RecordChanged(TField(Info));
|
||||
deDataSetChange:
|
||||
begin
|
||||
SetActive(DataSource.DataSet.Active);
|
||||
CalcFirstRecord(Info);
|
||||
DatasetChanged;
|
||||
end;
|
||||
@ -216,6 +217,16 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TDataLink.SetActive(AActive: Boolean);
|
||||
begin
|
||||
if Active <> AActive then
|
||||
begin
|
||||
FActive := AActive;
|
||||
// !!!: Set internal state
|
||||
ActiveChanged;
|
||||
end;
|
||||
end;
|
||||
|
||||
Procedure TDataLink.SetDataSource(Value : TDatasource);
|
||||
|
||||
begin
|
||||
@ -397,8 +408,8 @@ procedure TDatasource.RegisterDataLink(DataLink: TDataLink);
|
||||
|
||||
begin
|
||||
FDatalinks.Add(DataLink);
|
||||
If DataSet<>Nil then
|
||||
Dataset.SetBufListSize(Datalink.BufferCount);
|
||||
if Assigned(DataSet) then
|
||||
DataSet.RecalcBufListSize;
|
||||
end;
|
||||
|
||||
|
||||
@ -409,7 +420,7 @@ begin
|
||||
FDataset.UnRegisterDataSource(Self);
|
||||
If ADataset<>Nil Then
|
||||
ADataset.RegisterDatasource(Self);
|
||||
FDataSet:=ADAtaset;
|
||||
FDataSet:=ADataset;
|
||||
ProcessEvent(deUpdateState,0);
|
||||
end;
|
||||
|
||||
|
||||
65
fcl/db/db.pp
65
fcl/db/db.pp
@ -34,6 +34,8 @@ const
|
||||
YesNoChars : Array[Boolean] of char = ('Y','N');
|
||||
|
||||
type
|
||||
{LargeInt}
|
||||
LargeInt = Int64;
|
||||
|
||||
{ Auxiliary type }
|
||||
TStringFieldBuffer = Array[0..dsMaxStringSize] of Char;
|
||||
@ -69,10 +71,20 @@ type
|
||||
|
||||
TFieldClass = class of TField;
|
||||
|
||||
{
|
||||
TFieldType = (ftUnknown, ftString, ftSmallint, ftInteger, ftWord,
|
||||
ftBoolean, ftFloat, ftDate, ftTime, ftDateTime,
|
||||
ftBytes, ftVarBytes, ftAutoInc, ftBlob, ftMemo, ftGraphic,
|
||||
ftFmtMemo, ftParadoxOle, ftDBaseOle, ftTypedBinary, ftCursor);
|
||||
}
|
||||
|
||||
TFieldType = (ftUnknown, ftString, ftSmallint, ftInteger, ftWord,
|
||||
ftBoolean, ftFloat, ftCurrency, ftBCD, ftDate, ftTime, ftDateTime,
|
||||
ftBytes, ftVarBytes, ftAutoInc, ftBlob, ftMemo, ftGraphic, ftFmtMemo,
|
||||
ftParadoxOle, ftDBaseOle, ftTypedBinary, ftCursor, ftFixedChar,
|
||||
ftWideString, ftLargeint, ftADT, ftArray, ftReference,
|
||||
ftDataSet, ftOraBlob, ftOraClob, ftVariant, ftInterface,
|
||||
ftIDispatch, ftGuid, ftTimeStamp, ftFMTBcd);
|
||||
|
||||
TFieldDef = class(TComponent)
|
||||
Private
|
||||
@ -785,6 +797,7 @@ type
|
||||
Procedure DoInternalClose;
|
||||
Function GetBuffer (Index : longint) : Pchar;
|
||||
Function GetField (Index : Longint) : TField;
|
||||
procedure RecalcBufListSize;
|
||||
Procedure RegisterDataSource(ADatasource : TDataSource);
|
||||
Procedure RemoveField (Field : TField);
|
||||
Procedure SetActive (Value : Boolean);
|
||||
@ -1007,7 +1020,8 @@ type
|
||||
Function CalcFirstRecord(Index : Integer) : Integer;
|
||||
Procedure CheckActiveAndEditing;
|
||||
Function GetDataset : TDataset;
|
||||
procedure SetDataSource(Value : TDatasource);
|
||||
procedure SetActive(AActive: Boolean);
|
||||
procedure SetDataSource(Value: TDataSource);
|
||||
Procedure SetReadOnly(Value : Boolean);
|
||||
protected
|
||||
procedure ActiveChanged; virtual;
|
||||
@ -1187,7 +1201,47 @@ type
|
||||
|
||||
Const
|
||||
Fieldtypenames : Array [TFieldType] of String[15] =
|
||||
( 'Unknown',
|
||||
(
|
||||
'Unknown',
|
||||
'String',
|
||||
'Smallint',
|
||||
'Integer',
|
||||
'Word',
|
||||
'Boolean',
|
||||
'Float',
|
||||
'Currency',
|
||||
'BCD',
|
||||
'Date',
|
||||
'Time',
|
||||
'DateTime',
|
||||
'Bytes',
|
||||
'VarBytes',
|
||||
'AutoInc',
|
||||
'Blob',
|
||||
'Memo',
|
||||
'Graphic',
|
||||
'FmtMemo',
|
||||
'ParadoxOle',
|
||||
'DBaseOle',
|
||||
'TypedBinary',
|
||||
'Cursor',
|
||||
'FixedChar',
|
||||
'WideString',
|
||||
'Largeint',
|
||||
'ADT',
|
||||
'Array',
|
||||
'Reference',
|
||||
'DataSet',
|
||||
'OraBlob',
|
||||
'OraClob',
|
||||
'Variant',
|
||||
'Interface',
|
||||
'IDispatch',
|
||||
'Guid',
|
||||
'TimeStamp',
|
||||
'FMTBcd'
|
||||
);
|
||||
{ 'Unknown',
|
||||
'String',
|
||||
'Smallint',
|
||||
'Integer',
|
||||
@ -1208,7 +1262,7 @@ Const
|
||||
'DBaseOle',
|
||||
'TypedBinary',
|
||||
'Cursor'
|
||||
);
|
||||
);}
|
||||
|
||||
dsEditModes = [dsEdit, dsInsert];
|
||||
{ Auxiliary functions }
|
||||
@ -1403,7 +1457,10 @@ end.
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.4 2000-12-24 12:45:19 peter
|
||||
Revision 1.5 2001-01-18 22:10:07 michael
|
||||
+ Fixes to make dbase working merged from fixbranch
|
||||
|
||||
Revision 1.4 2000/12/24 12:45:19 peter
|
||||
* merges from 1.0.x branch
|
||||
|
||||
Revision 1.3 2000/09/02 09:36:36 sg
|
||||
|
||||
@ -36,6 +36,9 @@ Constructor TFieldDef.Create(AOwner: TFieldDefs; const AName: string;
|
||||
|
||||
begin
|
||||
Inherited Create(AOwner);
|
||||
{$ifdef dsdebug }
|
||||
Writeln('TFieldDef.Create : ',Aname,'(',AFieldNo,')');
|
||||
{$endif}
|
||||
FName:=Aname;
|
||||
FDatatype:=ADatatype;
|
||||
FSize:=ASize;
|
||||
@ -48,6 +51,7 @@ begin
|
||||
end
|
||||
else If FDataType in [ftWord,ftsmallint,ftinteger] Then
|
||||
If Not (FSize in [1,2,4]) then FSize:=4;
|
||||
|
||||
FFieldNo:=AFieldNo;
|
||||
AOwner.FItems.Add(Self);
|
||||
end;
|
||||
@ -65,7 +69,7 @@ Function TFieldDef.CreateField(AOwner: TComponent): TField;
|
||||
Var TheField : TFieldClass;
|
||||
|
||||
begin
|
||||
Writeln ('Creating field');
|
||||
Writeln ('Creating field'+FNAME);
|
||||
TheField:=GetFieldClass;
|
||||
if TheField=Nil then
|
||||
DatabaseErrorFmt(SUnknownFieldType,[FName]);
|
||||
@ -74,8 +78,14 @@ begin
|
||||
Result.Size:=FSize;
|
||||
Result.Required:=FRequired;
|
||||
Result.FieldName:=FName;
|
||||
Result.FFieldNo:=Self.FieldNo;
|
||||
Result.SetFieldType(DataType);
|
||||
Writeln ('Trying to set dataset');
|
||||
{$ifdef dsdebug}
|
||||
Writeln ('TFieldDef.CReateField : Trying to set dataset');
|
||||
{$endif dsdebug}
|
||||
{$ifdef dsdebug}
|
||||
Writeln ('TFieldDef.CReateField : Result Fieldno : ',Result.FieldNo,' Self : ',FieldNo);
|
||||
{$endif dsdebug}
|
||||
Result.Dataset:=TFieldDefs(Owner).FDataset;
|
||||
If Result is TFloatField then
|
||||
TFloatField(Result).Precision:=FPrecision;
|
||||
@ -83,6 +93,7 @@ begin
|
||||
Result.Free;
|
||||
Raise;
|
||||
end;
|
||||
|
||||
end;
|
||||
|
||||
Function TFieldDef.GetFieldClass : TFieldClass;
|
||||
@ -112,12 +123,11 @@ procedure TFieldDefs.Add(const AName: string; ADataType: TFieldType; ASize: Word
|
||||
ARequired: Boolean);
|
||||
|
||||
begin
|
||||
Writeln ('Adding fielddef');
|
||||
If Length(Name)=0 Then
|
||||
If Length(AName)=0 Then
|
||||
DatabaseError(SNeedFieldName);
|
||||
// the fielddef will register itself here as a owned component.
|
||||
// fieldno is 1 based !
|
||||
FItems.Add(TFieldDef.Create(Self,AName,ADataType,ASize,Arequired,FItems.Count+1));
|
||||
TFieldDef.Create(Self,AName,ADataType,ASize,Arequired,FItems.Count+1);
|
||||
end;
|
||||
|
||||
function TFieldDefs.GetCount: Longint;
|
||||
@ -453,7 +463,9 @@ end;
|
||||
Procedure TField.SetDataset (Value : TDataset);
|
||||
|
||||
begin
|
||||
{$ifdef dsdebug}
|
||||
Writeln ('Setting dataset');
|
||||
{$endif}
|
||||
If Value=FDataset then exit;
|
||||
If Assigned(FDataset) Then FDataset.CheckInactive;
|
||||
If Assigned(Value) then
|
||||
@ -464,12 +476,9 @@ begin
|
||||
end;
|
||||
If Assigned(FDataset) then
|
||||
FDataset.FFieldList.Remove(Self);
|
||||
If Assigned(Value) then
|
||||
begin
|
||||
Writeln('Adding field to list..');
|
||||
If Assigned(Value) then
|
||||
Value.FFieldList.Add(Self);
|
||||
end;
|
||||
FDataset:=Value;
|
||||
FDataset:=Value;
|
||||
end;
|
||||
|
||||
procedure TField.SetDataType(AValue: TFieldType);
|
||||
@ -1764,7 +1773,10 @@ end;
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.4 2000-12-24 12:45:19 peter
|
||||
Revision 1.5 2001-01-18 22:10:07 michael
|
||||
+ Fixes to make dbase working merged from fixbranch
|
||||
|
||||
Revision 1.4 2000/12/24 12:45:19 peter
|
||||
* merges from 1.0.x branch
|
||||
|
||||
Revision 1.3 2000/09/02 09:36:36 sg
|
||||
|
||||
Loading…
Reference in New Issue
Block a user