Scroll TTreeView while dragging around the edges

Question

I have a TTreeView that can have many nodes, when many nodes expand, the tree uses a lot of screen space.

Now suppose I want to drag the node that is at the bottom of the TreeView at the top, I cannot physically see the top of the TreeView, because the node that I select is at the bottom. When dragging a node to the beginning of a TreeView, I would like the TreeView to automatically scroll me when dragging, by default this does not seem to happen.

A great example of this behavior is observed in Windows Explorer. If you try to drag a file or folder when you move the dragged item (node), it will automatically scroll up or down depending on the position of the cursor.

Hope this makes sense.

PS, I already know how to drag nodes, I want the TreeView to scroll with me when dragging, if it hovers near the top or bottom of the TreeView.

Thanks.

Answer 1

This is the code I'm using. It will work for any TWinControl descendant: list, tree view, list view, etc.

 type TAutoScrollTimer = class(TTimer) private FControl: TWinControl; FScrollCount: Integer; procedure InitialiseTimer; procedure Timer(Sender: TObject); public constructor Create(Control: TWinControl); end; { TAutoScrollTimer } constructor TAutoScrollTimer.Create(Control: TWinControl); begin inherited Create(Control); FControl := Control; InitialiseTimer; end; procedure TAutoScrollTimer.InitialiseTimer; begin FScrollCount := 0; Interval := 250; Enabled := True; OnTimer := Timer; end; procedure TAutoScrollTimer.Timer(Sender: TObject); procedure DoScroll; var WindowEdgeTolerance: Integer; Pos: TPoint; begin WindowEdgeTolerance := Min(25, FControl.Height div 4); GetCursorPos(Pos); Pos := FControl.ScreenToClient(Pos); if not InRange(Pos.X, 0, FControl.Width) then begin exit; end; if Pos.Y<WindowEdgeTolerance then begin SendMessage(FControl.Handle, WM_VSCROLL, SB_LINEUP, 0); end else if Pos.Y>FControl.Height-WindowEdgeTolerance then begin SendMessage(FControl.Handle, WM_VSCROLL, SB_LINEDOWN, 0); end else begin InitialiseTimer; exit; end; if FScrollCount<50 then begin inc(FScrollCount); if FScrollCount mod 5=0 then begin //speed up the scrolling by reducing the timer interval Interval := MulDiv(Interval, 3, 4); end; end; if Win32MajorVersion<6 then begin //in XP we need to clear up transient "fluff"; results in flickering so only do it in XP where it is needed FControl.Invalidate; end; end; begin if Mouse.IsDragging then begin DoScroll; end else begin Free; end; end; 

Then, to use it, you add an OnStartDrag event OnStartDrag for the control and implement it as follows:

 procedure TMyForm.SomeControlStartDrag(Sender: TObject; var DragObject: TDragObject); begin TAutoScrollTimer.Create(Sender as TWinControl); end; 

Answer 2

Here, the alternative is based on the fact that the selected node always scrolls automatically.

 type TForm1 = class(TForm) TreeView1: TTreeView; TreeView2: TTreeView; procedure TreeViewDragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); procedure TreeViewEndDrag(Sender, Target: TObject; X, Y: Integer); procedure TreeViewMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); private FDragNode: TTreeNode; FNodeHeight: Integer; end; ... procedure TForm1.TreeViewMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin with TTreeView(Sender) do begin FDragNode := GetNodeAt(X, Y); if FDragNode <> nil then begin Selected := FDragNode; with FDragNode.DisplayRect(False) do FNodeHeight := Bottom - Top; BeginDrag(False, Mouse.DragThreshold); end; end; end; procedure TForm1.TreeViewDragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); var Pt: TPoint; DropNode: TTreeNode; begin Accept := Source is TTreeView; if Accept then with TTreeView(Source) do begin if Sender <> Source then Pt := ScreenToClient(Mouse.CursorPos) else Pt := Point(X, Y); if Pt.Y < FNodeHeight then DropNode := Selected.GetPrevVisible else if Pt.Y > (ClientHeight - FNodeHeight) then DropNode := Selected.GetNextVisible else DropNode := GetNodeAt(Pt.X, Pt.Y); if DropNode <> nil then Selected := DropNode; end; end; procedure TForm1.TreeViewEndDrag(Sender, Target: TObject; X, Y: Integer); var DropNode: TTreeNode; begin with TTreeView(Sender) do if Target <> nil then begin DropNode := Selected; DropNode := Items.Insert(DropNode, ''); DropNode.Assign(FDragNode); Selected := DropNode; Items.Delete(FDragNode); end else Selected := FDragNode; end; 

You might want to associate the OnDragOver event handler with the parent TreeView, which will scroll and delete when the mouse is outside the TreeView. If you want to scroll but not crash when the mouse is outside the TreeView, check if Target = Sender in the OnEndDrag event handler.