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