* Fix bug ID #35769

git-svn-id: trunk@42886 -

packages/fcl-db/src/base/bufdataset.pas

@@ -614,6 +614,7 @@ type
     function Fetch : boolean; virtual;
     function LoadField(FieldDef : TFieldDef;buffer : pointer; out CreateBlob : boolean) : boolean; virtual;
     procedure LoadBlobIntoBuffer(FieldDef: TFieldDef;ABlobBuf: PBufBlobField); virtual; abstract;
+    function DoLocate(const KeyFields: string; const KeyValues: Variant; Options: TLocateOptions; DoEvents : Boolean) : boolean;
     Property Refreshing : Boolean Read FRefreshing;
   public
     constructor Create(AOwner: TComponent); override;
@@ -3756,8 +3757,14 @@ begin
   end;
 end;
 
-function TCustomBufDataset.Locate(const KeyFields: string;
-  const KeyValues: Variant; Options: TLocateOptions): boolean;
+function TCustomBufDataset.Locate(const KeyFields: string; const KeyValues: Variant; Options: TLocateOptions): boolean;
+
+begin
+  Result:=DoLocate(keyfields,KeyValues,Options,True);
+end;
+
+function TCustomBufDataset.DoLocate(const KeyFields: string; const KeyValues: Variant; Options: TLocateOptions; DoEvents : Boolean) : boolean;
+
 
 var SearchFields    : TList;
     DBCompareStruct : TDBCompareStruct;
@@ -3768,7 +3775,7 @@ var SearchFields    : TList;
 
 begin
   // Call inherited to make sure the dataset is bi-directional
-  Result := inherited;
+  Result := inherited Locate(KeyFields,KeyValues,Options);
   CheckActive;
   if IsEmpty then exit;
 
@@ -3825,7 +3832,13 @@ begin
   if Result then
     begin
     ABookmark.BookmarkFlag := bfCurrent;
-    GotoBookmark(@ABookmark);
+    if DoEvents then
+      GotoBookmark(@ABookmark)
+    else
+      begin
+      InternalGotoBookMark(@ABookmark);
+      Resync([rmExact,rmCenter]);
+      end;
     end;
 end;
 
@@ -3838,12 +3851,13 @@ begin
   bm:=GetBookmark;
   DisableControls;
   try
-    if Locate(KeyFields,KeyValues,[]) then
+    if DoLocate(KeyFields,KeyValues,[],False) then
       begin
       //  CalculateFields(ActiveBuffer); // not needed, done by Locate more than once
       result:=FieldValues[ResultFields];
       end;
-    GotoBookmark(bm);
+    InternalGotoBookMark(pointer(bm));
+    Resync([rmExact,rmCenter]);
     FreeBookmark(bm);
   finally
     EnableControls;

packages/fcl-db/tests/testspecifictbufdataset.pas

@@ -33,6 +33,10 @@ type
 
   TTestSpecificTBufDataset = class(TDBBasicsTestCase)
   private
+    FAfterScrollCount:integer;
+    FBeforeScrollCount:integer;
+    procedure DoAfterScrollCount(DataSet: TDataSet);
+    procedure DoBeforeScrollCount(DataSet: TDataSet);
     procedure TestDataset(ABufDataset: TBufDataset; AutoInc: boolean = false);
     function GetAutoIncDataset: TBufDataset;
     procedure IntTestAutoIncFieldStreaming(XML: boolean);
@@ -47,6 +51,8 @@ type
     procedure TestAutoIncField;
     procedure TestAutoIncFieldStreaming;
     procedure TestAutoIncFieldStreamingXML;
+    Procedure TestLocateScrollEventCount;
+    Procedure TestLookupScrollEventCount;
     Procedure TestRecordCount;
     Procedure TestClear;
     procedure TestCopyFromDataset; //is copied dataset identical to original?
@@ -94,6 +100,16 @@ begin
   CheckTrue(ABufDataset.EOF);
 end;
 
+procedure TTestSpecificTBufDataset.DoAfterScrollCount(DataSet: TDataSet);
+begin
+  Inc(FAfterScrollCount);
+end;
+
+procedure TTestSpecificTBufDataset.DoBeforeScrollCount(DataSet: TDataSet);
+begin
+  Inc(FBeforeScrollCount);
+end;
+
 function TTestSpecificTBufDataset.GetAutoIncDataset: TBufDataset;
 var
   ds : TBufDataset;
@@ -142,6 +158,8 @@ end;
 
 procedure TTestSpecificTBufDataset.SetUp;
 begin
+  FAfterScrollCount:=0;
+  FBeforeScrollCount:=0;
   DBConnector.StartTest(TestName);
 end;
 
@@ -270,6 +288,46 @@ begin
   IntTestAutoIncFieldStreaming(true);
 end;
 
+procedure TTestSpecificTBufDataset.TestLocateScrollEventCount;
+
+begin
+  with DBConnector.GetNDataset(10) as TBufDataset do
+    begin
+    Open;
+    AfterScroll:=DoAfterScrollCount;
+    BeforeScroll:=DoBeforeScrollCount;
+    Locate('ID',5,[]);
+    AssertEquals('Current record OK',5,FieldByName('ID').AsInteger);
+    AssertEquals('After scroll count',1,FAfterScrollCount);
+    AssertEquals('After scroll count',1,FBeforeScrollCount);
+    end;
+end;
+
+
+procedure TTestSpecificTBufDataset.TestLookupScrollEventCount;
+
+Var
+  V : Variant;
+  S : String;
+  ID : Integer;
+
+begin
+  with DBConnector.GetNDataset(10) as TBufDataset do
+    begin
+    Open;
+    ID:=FieldByName('ID').AsInteger;
+    AfterScroll:=DoAfterScrollCount;
+    BeforeScroll:=DoBeforeScrollCount;
+    V:=Lookup('ID',5,'NAME');
+    AssertTrue('Not null',Null<>V);
+    S:=V;
+    AssertEquals('Result','TestName5',S);
+    AssertEquals('After scroll count',0,FAfterScrollCount);
+    AssertEquals('After scroll count',0,FBeforeScrollCount);
+    AssertEquals('Current record unchanged',ID,FieldByName('ID').AsInteger);
+    end;
+end;
+
 procedure TTestSpecificTBufDataset.TestRecordCount;
 var
   BDS:TBufDataSet;