mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-12-04 13:47:23 +01:00
* merges from 1.0.x branch
This commit is contained in:
peter
parent
0c0c01980f
commit
c693d9e131
@ -27,6 +27,7 @@ begin
|
||||
Inherited Create(AOwner);
|
||||
FFieldDefs:=TFieldDefs.Create(Self);
|
||||
FFieldList:=TFields.Create(Self);
|
||||
FDataSources:=TList.Create;
|
||||
end;
|
||||
|
||||
|
||||
@ -37,6 +38,12 @@ begin
|
||||
Active:=False;
|
||||
FFieldDefs.Free;
|
||||
FFieldList.Free;
|
||||
With FDatasources do
|
||||
begin
|
||||
While Count>0 do
|
||||
TDatasource(Items[Count - 1]).DataSet:=Nil;
|
||||
Free;
|
||||
end;
|
||||
Inherited Destroy;
|
||||
end;
|
||||
|
||||
@ -143,8 +150,27 @@ end;
|
||||
|
||||
Procedure TDataset.DataEvent(Event: TDataEvent; Info: Longint);
|
||||
|
||||
Var
|
||||
i : longint;
|
||||
|
||||
begin
|
||||
//!! To be implemented
|
||||
// Do some bookkeeping;
|
||||
case Event of
|
||||
deFieldChange :
|
||||
begin
|
||||
if TField(Info).FieldKind in [fkData,fkInternalCalc] then
|
||||
SetModified(True);
|
||||
if FInternalCalcFields and (TField(Info).FieldKind = fkData) then
|
||||
RefreshInternalCalcFields(ActiveBuffer)
|
||||
else if (FCalcFieldsSize <> 0) and FAutoCalcFields and
|
||||
(TField(Info).FieldKind = fkData) then
|
||||
CalculateFields(ActiveBuffer);
|
||||
TField(Info).Change;
|
||||
end;
|
||||
end;
|
||||
// Distribute event to datasets;
|
||||
for I := 0 to FDataSources.Count - 1 do
|
||||
TDataSource(FDataSources[I]).ProcessEvent(Event, Info);
|
||||
end;
|
||||
|
||||
Procedure TDataset.DestroyFields;
|
||||
@ -775,6 +801,7 @@ begin
|
||||
If Value<>FState then
|
||||
begin
|
||||
FState:=Value;
|
||||
DataEvent(deUpdateState,0);
|
||||
end;
|
||||
end;
|
||||
|
||||
@ -840,6 +867,7 @@ Procedure TDataset.Cancel;
|
||||
begin
|
||||
If State in [dsEdit,dsInsert] then
|
||||
begin
|
||||
DataEvent(deCheckBrowseMode,0);
|
||||
DoBeforeCancel;
|
||||
UpdateCursorPos;
|
||||
InternalCancel;
|
||||
@ -854,6 +882,7 @@ Procedure TDataset.CheckBrowseMode;
|
||||
|
||||
begin
|
||||
CheckActive;
|
||||
DataEvent(deCheckBrowseMode,0);
|
||||
If State In [dsedit,dsinsert] then
|
||||
begin
|
||||
UpdateRecord;
|
||||
@ -908,21 +937,29 @@ Procedure TDataset.DisableControls;
|
||||
|
||||
|
||||
begin
|
||||
//!! To be implemented
|
||||
If FDisableControlsCount=0 then
|
||||
begin
|
||||
{ Save current state,
|
||||
needed to detect change of state when enabling controls.
|
||||
}
|
||||
FDisableControlsState:=FState;
|
||||
FEnableControlsEvent:=deDatasetChange;
|
||||
end;
|
||||
Inc(FDisableControlsCount);
|
||||
end;
|
||||
|
||||
Procedure TDataset.DoInsertAppend(DoAppend : Boolean);
|
||||
|
||||
Var Buffer : PChar;
|
||||
BookBeforeInsert : TBookmarkStr;
|
||||
|
||||
|
||||
begin
|
||||
If Not CanModify then
|
||||
DatabaseError(SDatasetReadOnly,Self);
|
||||
CheckBrowseMode;
|
||||
DoBeforeInsert;
|
||||
DoBeforeScroll;
|
||||
If Not DoAppend then
|
||||
If Not DoAppend then
|
||||
begin
|
||||
{$ifdef dsdebug}
|
||||
Writeln ('going to insert mode');
|
||||
@ -939,7 +976,7 @@ begin
|
||||
else
|
||||
SetBookMarkData(ActiveBuffer,Pointer(BookBeforeInsert));
|
||||
// update buffer count.
|
||||
If FRecordCount<FBufferCount then
|
||||
If FRecordCount<FBufferCount then
|
||||
Inc(FRecordCount);
|
||||
end
|
||||
else
|
||||
@ -962,7 +999,7 @@ begin
|
||||
FactiveRecord:=FRecordCount-1;
|
||||
end;
|
||||
SetState(dsInsert);
|
||||
try
|
||||
try
|
||||
DoOnNewRecord;
|
||||
except
|
||||
UpdateCursorPos;
|
||||
@ -972,6 +1009,7 @@ begin
|
||||
// mark as not modified.
|
||||
FModified:=False;
|
||||
// Final events.
|
||||
DataEvent(deDatasetChange,0);
|
||||
DoAfterInsert;
|
||||
DoAfterScroll;
|
||||
{$ifdef dsdebug}
|
||||
@ -992,9 +1030,10 @@ begin
|
||||
end;
|
||||
CheckBrowseMode;
|
||||
DoBeforeEdit;
|
||||
If Not TryDoing(@InternalEdit,OnEditError) then
|
||||
If Not TryDoing(@InternalEdit,OnEditError) then
|
||||
exit;
|
||||
SetState(dsedit);
|
||||
DataEvent(deRecordChange,0);
|
||||
DoAfterEdit;
|
||||
end;
|
||||
|
||||
@ -1002,7 +1041,18 @@ Procedure TDataset.EnableControls;
|
||||
|
||||
|
||||
begin
|
||||
//!! To be implemented
|
||||
If FDisableControlsCount>0 then
|
||||
begin
|
||||
Dec(FDisableControlsCount);
|
||||
If FDisableControlsCount=0 then
|
||||
begin
|
||||
// State changed since disablecontrols ?
|
||||
If FDisableControlsState<>FState then
|
||||
DataEvent(deUpdateState,0);
|
||||
If (FDisableControlsState<>dsInactive) and (FState<>dsInactive) then
|
||||
DataEvent(FEnableControlsEvent,0);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
Function TDataset.FieldByName(const FieldName: string): TField;
|
||||
@ -1061,6 +1111,7 @@ begin
|
||||
GetNextRecords;
|
||||
finally
|
||||
FBOF:=True;
|
||||
DataEvent(deDatasetChange,0);
|
||||
DoAfterScroll;
|
||||
end;
|
||||
end;
|
||||
@ -1157,15 +1208,17 @@ begin
|
||||
FActiveRecord:=FRecordCount-1;
|
||||
finally
|
||||
FEOF:=true;
|
||||
DataEvent(deDataSetChange, 0);
|
||||
DoAfterScroll;
|
||||
end;
|
||||
end;
|
||||
|
||||
Function TDataset.MoveBy(Distance: Longint): Longint;
|
||||
|
||||
Procedure Scrollforward;
|
||||
Function Scrollforward : Integer;
|
||||
|
||||
begin
|
||||
Result:=0;
|
||||
{$ifdef dsdebug}
|
||||
Writeln('Scrolling forward :',Distance);
|
||||
Writeln('Active buffer : ',FActiveRecord);
|
||||
@ -1176,25 +1229,29 @@ Function TDataset.MoveBy(Distance: Longint): Longint;
|
||||
If FActiveRecord<FRecordCount-1 then
|
||||
begin
|
||||
Inc(FActiveRecord);
|
||||
Dec(Distance)
|
||||
Dec(Distance);
|
||||
Inc(Result);
|
||||
end
|
||||
else
|
||||
begin
|
||||
{$ifdef dsdebug}
|
||||
Writeln('Moveby : need next record');
|
||||
Writeln('Moveby : need next record');
|
||||
{$endif}
|
||||
If GetNextRecord then
|
||||
Dec(Distance)
|
||||
begin
|
||||
Dec(Distance);
|
||||
Inc(result);
|
||||
end
|
||||
else
|
||||
FEOF:=true;
|
||||
end;
|
||||
end
|
||||
end;
|
||||
|
||||
Procedure ScrollBackward;
|
||||
Function ScrollBackward : Integer;
|
||||
|
||||
begin
|
||||
|
||||
Result:=0;
|
||||
{$ifdef dsdebug}
|
||||
Writeln('Scrolling backward:',Abs(Distance));
|
||||
Writeln('Active buffer : ',FActiveRecord);
|
||||
@ -1205,34 +1262,47 @@ Function TDataset.MoveBy(Distance: Longint): Longint;
|
||||
If FActiveRecord>0 then
|
||||
begin
|
||||
Dec(FActiveRecord);
|
||||
Inc(Distance)
|
||||
Inc(Distance);
|
||||
Dec(Result);
|
||||
end
|
||||
else
|
||||
begin
|
||||
{$ifdef dsdebug}
|
||||
Writeln('Moveby : need next record');
|
||||
Writeln('Moveby : need next record');
|
||||
{$endif}
|
||||
If GetPriorRecord then
|
||||
Inc(Distance)
|
||||
begin
|
||||
Inc(Distance);
|
||||
Dec(Result);
|
||||
end
|
||||
else
|
||||
FBOF:=true;
|
||||
end;
|
||||
end
|
||||
end;
|
||||
|
||||
Var
|
||||
PrevRecordCount : Integer;
|
||||
Scrolled : Integer;
|
||||
|
||||
begin
|
||||
CheckBrowseMode;
|
||||
Result:=0;
|
||||
PrevRecordCount:=0;
|
||||
DoBeforeScroll;
|
||||
If ((Distance>0) and FEOF) or
|
||||
((Distance<0) and FBOF) then
|
||||
exit;
|
||||
Try
|
||||
If Distance>0 then
|
||||
ScrollForward
|
||||
Scrolled:=ScrollForward
|
||||
else
|
||||
ScrollBackward;
|
||||
Scrolled:=ScrollBackward;
|
||||
finally
|
||||
If FRecordCount<>PrevRecordCount then
|
||||
DataEvent(deDatasetChange,0)
|
||||
else
|
||||
DataEvent(deDatasetScroll,Scrolled);
|
||||
DoAfterScroll;
|
||||
end;
|
||||
end;
|
||||
@ -1250,38 +1320,39 @@ begin
|
||||
end;
|
||||
|
||||
Procedure TDataset.Post;
|
||||
|
||||
|
||||
Procedure Checkrequired;
|
||||
|
||||
|
||||
Var I : longint;
|
||||
|
||||
|
||||
begin
|
||||
For I:=0 to FFieldList.Count-1 do
|
||||
With FFieldList[i] do
|
||||
With FFieldList[i] do
|
||||
// Required fields that are NOT autoinc !! Autoinc cannot be set !!
|
||||
if Required and not ReadOnly and
|
||||
(FieldKind=fkData) and Not (DataType=ftAutoInc) then
|
||||
DatabaseErrorFmt(SNeedField,[DisplayName],Self);
|
||||
end;
|
||||
end;
|
||||
|
||||
begin
|
||||
if State in [dsEdit,dsInsert] then
|
||||
begin
|
||||
{$ifdef dsdebug}
|
||||
DataEvent(deCheckBrowseMode,0);
|
||||
{$ifdef dsdebug}
|
||||
writeln ('Post: checking required fields');
|
||||
{$endif}
|
||||
CheckRequired;
|
||||
DoBeforePost;
|
||||
If Not TryDoing(@InternalPost,OnPostError) then exit;
|
||||
{$ifdef dsdebug}
|
||||
{$ifdef dsdebug}
|
||||
writeln ('Post: Internalpost succeeded');
|
||||
{$endif}
|
||||
FreeFieldBuffers;
|
||||
{$ifdef dsdebug}
|
||||
{$ifdef dsdebug}
|
||||
writeln ('Post: Freeing field buffers');
|
||||
{$endif}
|
||||
SetState(dsBrowse);
|
||||
{$ifdef dsdebug}
|
||||
{$ifdef dsdebug}
|
||||
writeln ('Post: Browse mode set');
|
||||
{$endif}
|
||||
Resync([]);
|
||||
@ -1304,6 +1375,13 @@ begin
|
||||
Resync([]);
|
||||
end;
|
||||
|
||||
Procedure TDataset.RegisterDataSource(ADatasource : TDataSource);
|
||||
|
||||
begin
|
||||
FDatasources.Add(ADataSource);
|
||||
end;
|
||||
|
||||
|
||||
Procedure TDataset.Resync(Mode: TResyncMode);
|
||||
|
||||
Var Count,ShiftCount : Longint;
|
||||
@ -1326,6 +1404,7 @@ begin
|
||||
begin
|
||||
// nothing found, invalidate buffer and bail out.
|
||||
ClearBuffers;
|
||||
DataEvent(deDatasetChange,0);
|
||||
Exit;
|
||||
end;
|
||||
If (rmCenter in Mode) then
|
||||
@ -1336,14 +1415,21 @@ begin
|
||||
// Reposition on 0
|
||||
ShiftBuffers(0,FRecordCount-1);
|
||||
ActivateBuffers;
|
||||
Count:=0;
|
||||
Writeln ('Getting previous',ShiftCount,' records');
|
||||
While (Count<ShiftCount) and GetPriorRecord do Inc(Count);
|
||||
FActiveRecord:=Count;
|
||||
// fill rest of buffers, adjust ActiveBuffer.
|
||||
SetCurrentRecord(FRecordCount-1);
|
||||
GetNextRecords;
|
||||
Inc(FActiveRecord,GetPriorRecords);
|
||||
try
|
||||
Count:=0;
|
||||
{$ifdef dsdebug}
|
||||
Writeln ('Getting previous',ShiftCount,' records');
|
||||
{$endif}
|
||||
While (Count<ShiftCount) and GetPriorRecord do Inc(Count);
|
||||
FActiveRecord:=Count;
|
||||
// fill rest of buffers, adjust ActiveBuffer.
|
||||
SetCurrentRecord(FRecordCount-1);
|
||||
GetNextRecords;
|
||||
Inc(FActiveRecord,GetPriorRecords);
|
||||
finally
|
||||
// Notify Everyone
|
||||
DataEvent(deDatasetChange,0);
|
||||
end;
|
||||
end;
|
||||
|
||||
Procedure TDataset.SetFields(const Values: array of const);
|
||||
@ -1376,7 +1462,7 @@ begin
|
||||
Result:=True;
|
||||
Retry:=daRetry;
|
||||
while Retry=daRetry do
|
||||
Try
|
||||
Try
|
||||
{$ifdef dsdebug}
|
||||
Writeln ('Trying : updatecursorpos');
|
||||
{$endif dsdebug}
|
||||
@ -1387,7 +1473,7 @@ begin
|
||||
P;
|
||||
exit;
|
||||
except
|
||||
On E : EDatabaseError do
|
||||
On E : EDatabaseError do
|
||||
begin
|
||||
retry:=daFail;
|
||||
If Assigned(Ev) then
|
||||
@ -1398,7 +1484,7 @@ begin
|
||||
end;
|
||||
end;
|
||||
else
|
||||
Raise;
|
||||
Raise;
|
||||
end;
|
||||
{$ifdef dsdebug}
|
||||
Writeln ('Exit Trying to do');
|
||||
@ -1415,7 +1501,8 @@ end;
|
||||
Procedure TDataset.UpdateRecord;
|
||||
|
||||
begin
|
||||
//!! To be implemented
|
||||
if not (State in dsEditModes) then DatabaseError(SNotInEditState, Self);
|
||||
DataEvent(deUpdateRecord, 0);
|
||||
end;
|
||||
|
||||
Procedure TDataset.RemoveField (Field : TField);
|
||||
@ -1473,9 +1560,18 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
Procedure TDataset.UnRegisterDataSource(ADatasource : TDatasource);
|
||||
|
||||
begin
|
||||
FDataSources.Remove(ADataSource);
|
||||
end;
|
||||
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.2 2000-07-13 11:32:56 michael
|
||||
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
|
||||
+ removed logs
|
||||
|
||||
}
|
||||
|
||||
169
fcl/db/db.pp
169
fcl/db/db.pp
@ -43,6 +43,7 @@ type
|
||||
TDataSetState = (dsInactive, dsBrowse, dsEdit, dsInsert, dsSetKey,
|
||||
dsCalcFields, dsFilter, dsNewValue, dsOldValue, dsCurValue);
|
||||
|
||||
|
||||
TDataEvent = (deFieldChange, deRecordChange, deDataSetChange,
|
||||
deDataSetScroll, deLayoutChange, deUpdateRecord, deUpdateState,
|
||||
deCheckBrowseMode, dePropertyChange, deFieldListChange, deFocusControl);
|
||||
@ -57,6 +58,8 @@ type
|
||||
TFields = Class;
|
||||
TDataSet = class;
|
||||
TDataBase = Class;
|
||||
TDatasource = Class;
|
||||
TDatalink = Class;
|
||||
|
||||
{ Exception classes }
|
||||
|
||||
@ -176,6 +179,7 @@ type
|
||||
FVisible : Boolean;
|
||||
Function GetIndex : longint;
|
||||
Procedure SetDataset(VAlue : TDataset);
|
||||
function GetDisplayText: String;
|
||||
protected
|
||||
function AccessError(const TypeName: string): EDatabaseError;
|
||||
procedure CheckInactive;
|
||||
@ -191,7 +195,7 @@ type
|
||||
function GetCanModify: Boolean; virtual;
|
||||
function GetDataSize: Word; virtual;
|
||||
function GetDefaultWidth: Longint; virtual;
|
||||
function GetDisplayName : String;
|
||||
function GetDisplayName : String;
|
||||
function GetIsNull: Boolean; virtual;
|
||||
function GetParentComponent: TComponent; override;
|
||||
procedure GetText(var AText: string; ADisplayText: Boolean); virtual;
|
||||
@ -231,6 +235,8 @@ type
|
||||
property DataSet: TDataSet read FDataSet write SetDataSet;
|
||||
property DataSize: Word read GetDataSize;
|
||||
property DataType: TFieldType read FDataType;
|
||||
property DisplayName: String Read GetDisplayName;
|
||||
property DisplayText: String read GetDisplayText;
|
||||
property FieldNo: Longint read FFieldNo;
|
||||
property IsIndexField: Boolean read FIsIndexField;
|
||||
property IsNull: Boolean read GetIsNull;
|
||||
@ -244,7 +250,6 @@ type
|
||||
property ConstraintErrorMessage: string read FConstraintErrorMessage write FConstraintErrorMessage;
|
||||
property DefaultExpression: string read FDefaultExpression write FDefaultExpression;
|
||||
property DisplayLabel : string read FDisplayLabel write FDisplayLabel;
|
||||
property DisplayName : String Read GetDisplayName;
|
||||
property DisplayWidth: Longint read FDisplayWidth write FDisplayWidth;
|
||||
property FieldKind: TFieldKind read FFieldKind write FFieldKind;
|
||||
property FieldName: string read FFieldName write FFieldName;
|
||||
@ -278,7 +283,7 @@ type
|
||||
function GetAsString: string; override;
|
||||
function GetDataSize: Word; override;
|
||||
function GetDefaultWidth: Longint; override;
|
||||
procedure GetText(var AText: string; DisplayText: Boolean); override;
|
||||
procedure GetText(var AText: string; ADisplayText: Boolean); override;
|
||||
function GetValue(var AValue: string): Boolean;
|
||||
procedure SetAsBoolean(AValue: Boolean); override;
|
||||
procedure SetAsDateTime(AValue: TDateTime); override;
|
||||
@ -323,7 +328,7 @@ type
|
||||
function GetAsLongint: Longint; override;
|
||||
function GetAsString: string; override;
|
||||
function GetDataSize: Word; override;
|
||||
procedure GetText(var AText: string; DisplayText: Boolean); override;
|
||||
procedure GetText(var AText: string; ADisplayText: Boolean); override;
|
||||
function GetValue(var AValue: Longint): Boolean;
|
||||
procedure SetAsFloat(AValue: Extended); override;
|
||||
procedure SetAsLongint(AValue: Longint); override;
|
||||
@ -377,7 +382,7 @@ type
|
||||
function GetAsLongint: Longint; override;
|
||||
function GetAsString: string; override;
|
||||
function GetDataSize: Word; override;
|
||||
procedure GetText(var theText: string; DisplayText: Boolean); override;
|
||||
procedure GetText(var theText: string; ADisplayText: Boolean); override;
|
||||
procedure SetAsFloat(AValue: Extended); override;
|
||||
procedure SetAsLongint(AValue: Longint); override;
|
||||
procedure SetAsString(const AValue: string); override;
|
||||
@ -425,7 +430,7 @@ type
|
||||
function GetAsFloat: Extended; override;
|
||||
function GetAsString: string; override;
|
||||
function GetDataSize: Word; override;
|
||||
procedure GetText(var theText: string; DisplayText: Boolean); override;
|
||||
procedure GetText(var theText: string; ADisplayText: Boolean); override;
|
||||
procedure SetAsDateTime(AValue: TDateTime); override;
|
||||
procedure SetAsFloat(AValue: Extended); override;
|
||||
procedure SetAsString(const AValue: string); override;
|
||||
@ -460,7 +465,7 @@ type
|
||||
protected
|
||||
class procedure CheckTypeSize(AValue: Longint); override;
|
||||
function GetAsString: string; override;
|
||||
procedure GetText(var TheText: string; DisplayText: Boolean); override;
|
||||
procedure GetText(var TheText: string; ADisplayText: Boolean); override;
|
||||
procedure SetAsString(const AValue: string); override;
|
||||
procedure SetText(const AValue: string); override;
|
||||
public
|
||||
@ -498,7 +503,7 @@ type
|
||||
function GetAsString: string; override;
|
||||
function GetDataSize: Word; override;
|
||||
function GetDefaultWidth: Longint; override;
|
||||
procedure GetText(var TheText: string; DisplayText: Boolean); override;
|
||||
procedure GetText(var TheText: string; ADisplayText: Boolean); override;
|
||||
procedure SetAsFloat(AValue: Extended); override;
|
||||
procedure SetAsLongint(AValue: Longint); override;
|
||||
procedure SetAsString(const AValue: string); override;
|
||||
@ -525,7 +530,7 @@ type
|
||||
function GetAsString: string; override;
|
||||
function GetBlobSize: Longint; virtual;
|
||||
function GetIsNull: Boolean; override;
|
||||
procedure GetText(var TheText: string; DisplayText: Boolean); override;
|
||||
procedure GetText(var TheText: string; ADisplayText: Boolean); override;
|
||||
procedure SetAsString(const AValue: string); override;
|
||||
procedure SetText(const AValue: string); override;
|
||||
public
|
||||
@ -749,9 +754,13 @@ type
|
||||
FCalcFieldsSize: Longint;
|
||||
FCanModify: Boolean;
|
||||
FConstraints: TCheckConstraints;
|
||||
FDisableControlsCount : Integer;
|
||||
FDisableControlsState : TDatasetState;
|
||||
FCurrentRecord: Longint;
|
||||
FDataSources : TList;
|
||||
FDefaultFields: Boolean;
|
||||
FEOF: Boolean;
|
||||
FEnableControlsEvent : TDataEvent;
|
||||
FFieldList : TFields;
|
||||
FFieldCount : Longint;
|
||||
FFieldDefs: TFieldDefs;
|
||||
@ -770,17 +779,19 @@ type
|
||||
FRecNo: Longint;
|
||||
FRecordCount: Longint;
|
||||
FRecordSize: Word;
|
||||
FState: TDataSetState;
|
||||
FState : TDataSetState;
|
||||
Procedure DoInsertAppend(DoAppend : Boolean);
|
||||
Procedure DoInternalOpen;
|
||||
Procedure DoInternalClose;
|
||||
Function GetBuffer (Index : longint) : Pchar;
|
||||
Function GetField (Index : Longint) : TField;
|
||||
Procedure RegisterDataSource(ADatasource : TDataSource);
|
||||
Procedure RemoveField (Field : TField);
|
||||
Procedure SetActive (Value : Boolean);
|
||||
Procedure SetField (Index : Longint;Value : TField);
|
||||
Procedure ShiftBuffers (Offset,Distance : Longint);
|
||||
Function TryDoing (P : TDataOperation; Ev : TDatasetErrorEvent) : Boolean;
|
||||
Procedure UnRegisterDataSource(ADatasource : TDatasource);
|
||||
Procedure UpdateFieldDefs;
|
||||
protected
|
||||
procedure ActivateBuffers; virtual;
|
||||
@ -982,6 +993,135 @@ type
|
||||
property OnPostError: TDataSetErrorEvent read FOnPostError write FOnPostError;
|
||||
end;
|
||||
|
||||
TDataLink = class(TPersistent)
|
||||
private
|
||||
FFIrstRecord,
|
||||
FBufferCount : Integer;
|
||||
FActive,
|
||||
FDataSourceFixed,
|
||||
FEditing,
|
||||
FReadOnly,
|
||||
FUpdatingRecord,
|
||||
FVisualControl : Boolean;
|
||||
FDataSource : TDataSource;
|
||||
Function CalcFirstRecord(Index : Integer) : Integer;
|
||||
Procedure CheckActiveAndEditing;
|
||||
Function GetDataset : TDataset;
|
||||
procedure SetDataSource(Value : TDatasource);
|
||||
Procedure SetReadOnly(Value : Boolean);
|
||||
protected
|
||||
procedure ActiveChanged; virtual;
|
||||
procedure CheckBrowseMode; virtual;
|
||||
procedure DataEvent(Event: TDataEvent; Info: Longint); virtual;
|
||||
procedure DataSetChanged; virtual;
|
||||
procedure DataSetScrolled(Distance: Integer); virtual;
|
||||
procedure EditingChanged; virtual;
|
||||
procedure FocusControl(Field: TFieldRef); virtual;
|
||||
function GetActiveRecord: Integer; virtual;
|
||||
function GetBOF: Boolean; virtual;
|
||||
function GetBufferCount: Integer; virtual;
|
||||
function GetEOF: Boolean; virtual;
|
||||
function GetRecordCount: Integer; virtual;
|
||||
procedure LayoutChanged; virtual;
|
||||
function MoveBy(Distance: Integer): Integer; virtual;
|
||||
procedure RecordChanged(Field: TField); virtual;
|
||||
procedure SetActiveRecord(Value: Integer); virtual;
|
||||
procedure SetBufferCount(Value: Integer); virtual;
|
||||
procedure UpdateData; virtual;
|
||||
property VisualControl: Boolean read FVisualControl write FVisualControl;
|
||||
public
|
||||
constructor Create;
|
||||
destructor Destroy; override;
|
||||
function Edit: Boolean;
|
||||
procedure UpdateRecord;
|
||||
property Active: Boolean read FActive;
|
||||
property ActiveRecord: Integer read GetActiveRecord write SetActiveRecord;
|
||||
property BOF: Boolean read GetBOF;
|
||||
property BufferCount: Integer read FBufferCount write SetBufferCount;
|
||||
property DataSet: TDataSet read GetDataSet;
|
||||
property DataSource: TDataSource read FDataSource write SetDataSource;
|
||||
property DataSourceFixed: Boolean read FDataSourceFixed write FDataSourceFixed;
|
||||
property Editing: Boolean read FEditing;
|
||||
property Eof: Boolean read GetEOF;
|
||||
property ReadOnly: Boolean read FReadOnly write SetReadOnly;
|
||||
property RecordCount: Integer read GetRecordCount;
|
||||
end;
|
||||
|
||||
{ TDetailDataLink }
|
||||
|
||||
TDetailDataLink = class(TDataLink)
|
||||
protected
|
||||
function GetDetailDataSet: TDataSet; virtual;
|
||||
public
|
||||
property DetailDataSet: TDataSet read GetDetailDataSet;
|
||||
end;
|
||||
|
||||
{ TMasterDataLink }
|
||||
|
||||
TMasterDataLink = class(TDetailDataLink)
|
||||
private
|
||||
FDataSet: TDataSet;
|
||||
FFieldNames: string;
|
||||
FFields: TList;
|
||||
FOnMasterChange: TNotifyEvent;
|
||||
FOnMasterDisable: TNotifyEvent;
|
||||
procedure SetFieldNames(const Value: string);
|
||||
protected
|
||||
procedure ActiveChanged; override;
|
||||
procedure CheckBrowseMode; override;
|
||||
function GetDetailDataSet: TDataSet; override;
|
||||
procedure LayoutChanged; override;
|
||||
procedure RecordChanged(Field: TField); override;
|
||||
public
|
||||
constructor Create(ADataSet: TDataSet);
|
||||
destructor Destroy; override;
|
||||
property FieldNames: string read FFieldNames write SetFieldNames;
|
||||
property Fields: TList read FFields;
|
||||
property OnMasterChange: TNotifyEvent read FOnMasterChange write FOnMasterChange;
|
||||
property OnMasterDisable: TNotifyEvent read FOnMasterDisable write FOnMasterDisable;
|
||||
end;
|
||||
|
||||
{ TDataSource }
|
||||
|
||||
TDataChangeEvent = procedure(Sender: TObject; Field: TField) of object;
|
||||
|
||||
TDataSource = class(TComponent)
|
||||
private
|
||||
FDataSet: TDataSet;
|
||||
FDataLinks: TList;
|
||||
FEnabled: Boolean;
|
||||
FAutoEdit: Boolean;
|
||||
FState: TDataSetState;
|
||||
FOnStateChange: TNotifyEvent;
|
||||
FOnDataChange: TDataChangeEvent;
|
||||
FOnUpdateData: TNotifyEvent;
|
||||
procedure DistributeEvent(Event: TDataEvent; Info: Longint);
|
||||
procedure RegisterDataLink(DataLink: TDataLink);
|
||||
Procedure ProcessEvent(Event : TDataEvent; Info : longint);
|
||||
procedure SetDataSet(ADataSet: TDataSet);
|
||||
procedure SetEnabled(Value: Boolean);
|
||||
procedure UnregisterDataLink(DataLink: TDataLink);
|
||||
protected
|
||||
Procedure DoDataChange (Info : Pointer);virtual;
|
||||
Procedure DoStateChange; virtual;
|
||||
Procedure DoUpdateData;
|
||||
property DataLinks: TList read FDataLinks;
|
||||
public
|
||||
constructor Create(AOwner: TComponent); override;
|
||||
destructor Destroy; override;
|
||||
procedure Edit;
|
||||
function IsLinkedTo(ADataSet: TDataSet): Boolean;
|
||||
property State: TDataSetState read FState;
|
||||
published
|
||||
property AutoEdit: Boolean read FAutoEdit write FAutoEdit default True;
|
||||
property DataSet: TDataSet read FDataSet write SetDataSet;
|
||||
property Enabled: Boolean read FEnabled write SetEnabled default True;
|
||||
property OnStateChange: TNotifyEvent read FOnStateChange write FOnStateChange;
|
||||
property OnDataChange: TDataChangeEvent read FOnDataChange write FOnDataChange;
|
||||
property OnUpdateData: TNotifyEvent read FOnUpdateData write FOnUpdateData;
|
||||
end;
|
||||
|
||||
|
||||
{ TDBDataset }
|
||||
|
||||
TDBDatasetClass = Class of TDBDataset;
|
||||
@ -1069,6 +1209,8 @@ Const
|
||||
'TypedBinary',
|
||||
'Cursor'
|
||||
);
|
||||
|
||||
dsEditModes = [dsEdit, dsInsert];
|
||||
{ Auxiliary functions }
|
||||
|
||||
Procedure DatabaseError (Const Msg : String);
|
||||
@ -1254,17 +1396,20 @@ end;
|
||||
|
||||
{$i dataset.inc}
|
||||
{$i fields.inc}
|
||||
{$i datasource.inc}
|
||||
{$i database.inc}
|
||||
|
||||
end.
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.3 2000-09-02 09:36:36 sg
|
||||
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
|
||||
* Changed all occurences of TAbstractReader to TReader, as FCL streaming
|
||||
is source compatible to VCL streaming now (for quite a while, BTW)
|
||||
|
||||
Revision 1.2 2000/07/13 11:32:56 michael
|
||||
+ removed logs
|
||||
|
||||
}
|
||||
|
||||
@ -5,7 +5,7 @@
|
||||
Free Pascal development team
|
||||
|
||||
Constants used for displaying messages in DB unit
|
||||
|
||||
|
||||
See the file COPYING.FPC, included in this distribution,
|
||||
for details about the copyright.
|
||||
|
||||
@ -18,7 +18,7 @@
|
||||
Const
|
||||
SUnknownFieldType = 'Unknown field type : %s';
|
||||
SUnknownField = 'No field named "%s" was found in dataset "%s"';
|
||||
SNeedFieldName = 'Field needs a name';
|
||||
SNeedFieldName = 'Field needs a name';
|
||||
SInvalidTypeConversion = 'Invalid type conversion to %s in field %s';
|
||||
SReadOnlyField = 'Field %s cannot be modified, it is read-only.';
|
||||
SInvalidFieldSize = 'Invalid field size : %d';
|
||||
@ -39,13 +39,15 @@ Const
|
||||
SNoDatasetRegistered = 'No such dataset registered : "%s"';
|
||||
SNotConnected = 'Operation cannot be performed on an disconnected database';
|
||||
SConnected = 'Operation cannot be performed on an connected database';
|
||||
SNoSuchRecord = 'Could not find the requested record.';
|
||||
SNoSuchRecord = 'Could not find the requested record.';
|
||||
SDatasetReadOnly = 'Dataset is read-only.';
|
||||
SNeedField = 'Field %s is required, but not supplied.';
|
||||
|
||||
SNotInEditState = 'Operation not allowed, dataset "%s" is not in an edit state.';
|
||||
{
|
||||
$Log$
|
||||
Revision 1.2 2000-07-13 11:32:56 michael
|
||||
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
|
||||
+ removed logs
|
||||
|
||||
}
|
||||
|
||||
File diff suppressed because it is too large
Load Diff
@ -186,7 +186,8 @@ override EXAMPLEOBJECTS+=testib
|
||||
|
||||
# Install
|
||||
|
||||
PACKAGENAME=interbase
|
||||
UNITSUBDIR=fcl
|
||||
PACKAGENAME=fcl
|
||||
ZIPTARGET=install
|
||||
|
||||
# Defaults
|
||||
@ -201,7 +202,7 @@ endif
|
||||
|
||||
# Packages
|
||||
|
||||
override PACKAGES+=rtl fcl ibase
|
||||
override PACKAGES+=rtl ibase
|
||||
|
||||
# Libraries
|
||||
|
||||
@ -506,7 +507,6 @@ endif
|
||||
# PACKAGESDIR packages
|
||||
|
||||
PACKAGERTL=1
|
||||
PACKAGEFCL=1
|
||||
PACKAGEIBASE=1
|
||||
|
||||
ifdef PACKAGERTL
|
||||
@ -538,35 +538,6 @@ ifdef UNITDIR_RTL
|
||||
override NEEDUNITDIR+=$(UNITDIR_RTL)
|
||||
endif
|
||||
endif
|
||||
ifdef PACKAGEFCL
|
||||
ifneq ($(wildcard $(FPCDIR)/fcl),)
|
||||
ifneq ($(wildcard $(FPCDIR)/fcl/$(OS_TARGET)),)
|
||||
PACKAGEDIR_FCL=$(FPCDIR)/fcl/$(OS_TARGET)
|
||||
else
|
||||
PACKAGEDIR_FCL=$(FPCDIR)/fcl
|
||||
endif
|
||||
ifeq ($(wildcard $(PACKAGEDIR_FCL)/$(FPCMADE)),)
|
||||
override COMPILEPACKAGES+=package_fcl
|
||||
package_fcl:
|
||||
$(MAKE) -C $(PACKAGEDIR_FCL) all
|
||||
endif
|
||||
UNITDIR_FCL=$(PACKAGEDIR_FCL)
|
||||
else
|
||||
PACKAGEDIR_FCL=
|
||||
ifneq ($(wildcard $(UNITSDIR)/fcl),)
|
||||
ifneq ($(wildcard $(UNITSDIR)/fcl/$(OS_TARGET)),)
|
||||
UNITDIR_FCL=$(UNITSDIR)/fcl/$(OS_TARGET)
|
||||
else
|
||||
UNITDIR_FCL=$(UNITSDIR)/fcl
|
||||
endif
|
||||
else
|
||||
UNITDIR_FCL=
|
||||
endif
|
||||
endif
|
||||
ifdef UNITDIR_FCL
|
||||
override NEEDUNITDIR+=$(UNITDIR_FCL)
|
||||
endif
|
||||
endif
|
||||
ifdef PACKAGEIBASE
|
||||
ifneq ($(wildcard $(PACKAGESDIR)/ibase),)
|
||||
ifneq ($(wildcard $(PACKAGESDIR)/ibase/$(OS_TARGET)),)
|
||||
|
||||
@ -7,11 +7,11 @@ examples=testib
|
||||
|
||||
[require]
|
||||
options=-S2
|
||||
packages=fcl ibase
|
||||
packages=ibase
|
||||
|
||||
[install]
|
||||
unitssubdir=fcl
|
||||
packagename=interbase
|
||||
unitsubdir=fcl
|
||||
packagename=fcl
|
||||
|
||||
[dirs]
|
||||
fpcdir=../../..
|
||||
|
||||
Loading…
Reference in New Issue
Block a user