diff --git a/Source/VirtualTrees.BaseTree.pas b/Source/VirtualTrees.BaseTree.pas index d82bc984..c765ff93 100644 --- a/Source/VirtualTrees.BaseTree.pas +++ b/Source/VirtualTrees.BaseTree.pas @@ -541,6 +541,8 @@ TBaseVirtualTree = class abstract(TVTBaseAncestor) FEffectiveOffsetX: TDimension; // Actual position of the horizontal scroll bar (varies depending on bidi mode). FRangeX, FRangeY: TNodeHeight; // current virtual width and height of the tree + FHorzRangeGrowOnly: Boolean; // True while updating scroll bars in reaction to scrolling: the + // horizontal range may then only grow, never shrink. See issue #983. FBottomSpace: TDimension; // Extra space below the last node. FDefaultPasteMode: TVTNodeAttachMode; // Used to determine where to add pasted nodes to. @@ -8344,7 +8346,12 @@ procedure TBaseVirtualTree.WMVScroll(var Message: TWMVScroll); DoStateChange([], [tsThumbTracking]); // Avoiding to adjust the horizontal scroll position while tracking makes scrolling much smoother // but we need to adjust the final position here then. - UpdateScrollBars(True); + FHorzRangeGrowOnly := True; // issue #983, see UpdateHorizontalRange + try + UpdateScrollBars(True); + finally + FHorzRangeGrowOnly := False; + end; // Really weird invalidation needed here (and I do it only because it happens so rarely), because // when showing the horizontal scrollbar while scrolling down using the down arrow button, // the button will be repainted on mouse up (at the wrong place in the far right lower corner)... @@ -11216,7 +11223,14 @@ function TBaseVirtualTree.DoSetOffsetXY(Value: TPoint; Options: TScrollUpdateOpt UpdateVerticalScrollBar(suoRepaintScrollBars in Options); if not (FHeader.UseColumns or IsMouseSelecting) and (FScrollBarOptions.ScrollBars in [System.UITypes.TScrollStyle.ssHorizontal, System.UITypes.TScrollStyle.ssBoth]) then - UpdateHorizontalScrollBar(suoRepaintScrollBars in Options); + begin + FHorzRangeGrowOnly := True; // issue #983, see UpdateHorizontalRange + try + UpdateHorizontalScrollBar(suoRepaintScrollBars in Options); + finally + FHorzRangeGrowOnly := False; + end; + end; end; end; @@ -23301,6 +23315,14 @@ procedure TBaseVirtualTree.UpdateHorizontalRange; begin if FHeader.UseColumns then SetRangeX(FHeader.Columns.TotalWidth) + else if FHorzRangeGrowOnly then + // Issue #983: while scrolling vertically the horizontal range may only grow. Shrinking it + // would hide the horizontal scroll bar as soon as the widest node scrolls out of view; the + // resulting taller client area then clamps the scroll position back up, which scrolls the + // widest node into view again, which brings the scroll bar back - the tree oscillates and + // the user can never reach the bottom. Any other trigger (resize, structure or content + // change) recomputes the range from scratch as before. + SetRangeX(Max(FRangeX, GetMaxRightExtend)) else SetRangeX(GetMaxRightExtend); end; diff --git a/Tests/Tests.dpr b/Tests/Tests.dpr index 6db736ba..81ebb90b 100644 --- a/Tests/Tests.dpr +++ b/Tests/Tests.dpr @@ -21,6 +21,7 @@ uses VTPaintTreeIssue1074Tests in 'VTPaintTreeIssue1074Tests.pas', VTBandsIssue1091Tests in 'VTBandsIssue1091Tests.pas', VTFixedColumnDragIssue1377Tests in 'VTFixedColumnDragIssue1377Tests.pas', + VTScrollRangeIssue983Tests in 'VTScrollRangeIssue983Tests.pas', VTCellSelectionTests in 'VTCellSelectionTests.pas', VTSelectedCountIssue1197Tests in 'VTSelectedCountIssue1197Tests.pas', VTPaintToIssue632Tests in 'VTPaintToIssue632Tests.pas', diff --git a/Tests/VTScrollRangeIssue983Tests.pas b/Tests/VTScrollRangeIssue983Tests.pas new file mode 100644 index 00000000..754fb1c2 --- /dev/null +++ b/Tests/VTScrollRangeIssue983Tests.pas @@ -0,0 +1,154 @@ +unit VTScrollRangeIssue983Tests; + +// Regression test for issue #983 "Vertical Scroll Bar Cannot Scroll To Bottom In +// Select Circumstances". +// +// Without columns the horizontal scroll range is the width of the currently +// visible nodes. When the only over-wide node scrolls out of view, the range +// shrinks, the horizontal scroll bar disappears, the taller client area clamps +// the vertical offset back up - which scrolls the wide node into view again and +// brings the bar back. The tree oscillates between both states and the user can +// never reach the bottom. +// +// The fix makes the horizontal range grow-only while the update is caused by +// scrolling; every other trigger (resize, structure change) recomputes it from +// scratch as before. The tests assert both halves of that contract. + +interface + +uses + DUnitX.TestFramework, + Classes, + System.Types, + Vcl.Controls, + Vcl.Forms, + Vcl.Graphics, + VirtualTrees; + +type + [TestFixture] + TVTScrollRangeIssue983Tests = class + strict private + fForm: TForm; + fTree: TVirtualStringTree; + procedure OnGetText(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; + TextType: TVSTTextType; var CellText: string); + function HorzBarVisible: Boolean; + procedure ScrollToBottom; + public + [Setup] + procedure Setup; + [TearDown] + procedure TearDown; + + /// The core symptom: line-scrolling down must reach the last node. + [Test] + procedure ScrollToBottomReachesLastNode; + + /// Releasing the scroll bar (SB_ENDSCROLL) must not pull the position back up. + [Test] + procedure EndScrollKeepsPosition; + + /// The other half of the contract: enlarging the window must still recompute + /// the range from scratch and drop the horizontal scroll bar. + [Test] + procedure WideningTheWindowDropsHorizontalScrollBar; + end; + +implementation + +uses + Winapi.Windows, + Winapi.Messages, + System.SysUtils, + VirtualTrees.Types; + +procedure TVTScrollRangeIssue983Tests.Setup; +begin + fForm := TForm.Create(nil); + fForm.SetBounds(0, 0, 320, 160); + fTree := TVirtualStringTree.Create(fForm); + fTree.Parent := fForm; + fTree.Align := alClient; + fTree.BorderStyle := bsNone; + fTree.DefaultNodeHeight := 18; + fTree.OnGetText := OnGetText; + // Node 0 is the only node wider than the client area; six short nodes below make + // the tree just tall enough that node 0 can scroll completely out of view. + fTree.RootNodeCount := 7; + fForm.Show; + Application.ProcessMessages; +end; + +procedure TVTScrollRangeIssue983Tests.TearDown; +begin + FreeAndNil(fForm); +end; + +procedure TVTScrollRangeIssue983Tests.OnGetText(Sender: TBaseVirtualTree; Node: PVirtualNode; + Column: TColumnIndex; TextType: TVSTTextType; var CellText: string); +begin + if Node.Index = 0 then + CellText := 'A long node name to fill the entire width of the tree window and then some' + else + CellText := Format('n%d', [Node.Index]); +end; + +function TVTScrollRangeIssue983Tests.HorzBarVisible: Boolean; +begin + Result := (GetWindowLong(fTree.Handle, GWL_STYLE) and WS_HSCROLL) <> 0; +end; + +procedure TVTScrollRangeIssue983Tests.ScrollToBottom; +var + I: Integer; + LastOffsetY: TDimension; +begin + LastOffsetY := 1; // never a valid offset, forces at least two iterations + for I := 1 to 20 do + begin + fTree.Perform(WM_VSCROLL, SB_LINEDOWN, 0); + Application.ProcessMessages; + if fTree.OffsetY = LastOffsetY then + Break; + LastOffsetY := fTree.OffsetY; + end; +end; + +procedure TVTScrollRangeIssue983Tests.ScrollToBottomReachesLastNode; +var + R: TRect; +begin + Assert.IsTrue(HorzBarVisible, 'Sanity: the over-wide node 0 must produce a horizontal scroll bar.'); + ScrollToBottom; + R := fTree.GetDisplayRect(fTree.GetLast, NoColumn, False); + Assert.IsTrue(R.Bottom <= fTree.ClientHeight, + Format('After scrolling down the last node (%d..%d) must be fully inside the client area (height %d) - issue #983.', + [R.Top, R.Bottom, fTree.ClientHeight])); +end; + +procedure TVTScrollRangeIssue983Tests.EndScrollKeepsPosition; +var + OffsetAtBottom: TDimension; +begin + ScrollToBottom; + OffsetAtBottom := fTree.OffsetY; + fTree.Perform(WM_VSCROLL, SB_ENDSCROLL, 0); + Application.ProcessMessages; + Assert.AreEqual(Integer(OffsetAtBottom), Integer(fTree.OffsetY), + 'Releasing the scroll bar must not pull the scroll position back up (issue #983).'); +end; + +procedure TVTScrollRangeIssue983Tests.WideningTheWindowDropsHorizontalScrollBar; +begin + Assert.IsTrue(HorzBarVisible, 'Sanity: the over-wide node 0 must produce a horizontal scroll bar.'); + fForm.Width := fForm.Width + 400; + Application.ProcessMessages; + Assert.IsFalse(HorzBarVisible, + 'After enlarging the window no node is over-wide anymore, the horizontal scroll bar must disappear.'); +end; + +initialization + TDUnitX.RegisterTestFixture(TVTScrollRangeIssue983Tests); + +end.