在拖动/靠近边缘时滚动TTreeView [英] Scroll TTreeView while dragging over/near the edges

问题描述

我有一个TTreeView可以有很多节点，当很多节点被扩展时，树使用了很多屏幕空间。

现在假设我想将树视图底部附近的节点拖到顶部，我无法物理上看到TreeView的顶部，因为我正在选择的节点在底部。当将节点拖动到TreeView的顶部时，我希望TreeView在拖动时自动滚动，默认情况下似乎不会发生。

完美的例子的这种行为是在Windows资源管理器中看到的。如果您尝试拖动文件或文件夹，当您悬停拖动的项目（节点）时，会根据光标位置自动向上或向下滚动。

希望这是有道理的。

PS，我已经知道如何拖动节点，如果在TreeView的顶部或底部附近悬停，我希望TreeView与我一起滚动。

谢谢。

解决方案

这是我使用的代码。它将适用于任何 TWinControl descendent：列表框，树视图，列表视图等。

 code> type 
 TAutoScrollTimer = class（TTimer）
 private 
 FControl：TWinControl; 
 FScrollCount：Integer; 
 procedure InitialiseTimer; 
 procedure Timer（Sender：TObject）; 
 public 
构造函数Create（Control：TWinControl）; 
结束
 
 {TAutoScrollTimer} 
 
构造函数TAutoScrollTimer.Create（控件：TWinControl）; 
 begin 
继承Create（Control）; 
 FControl：=控制; 
 InitialiseTimer; 
结束
 
程序TAutoScrollTimer.InitialiseTimer; 
 begin 
 FScrollCount：= 0; 
间隔：= 250; 
启用：= True; 
 OnTimer：= Timer; 
结束
 
程序TAutoScrollTimer.Timer（Sender：TObject）; 
 
程序DoScroll; 
 var 
 WindowEdgeTolerance：Integer; 
 Pos：TPoint; 
 begin 
 WindowEdgeTolerance：= Min（25，FControl.Height div 4）; 
 GetCursorPos（Pos）; 
 Pos：= FControl.ScreenToClient（Pos）; 
如果不是InRange（Pos.X，0，FControl.Width）然后开始
 exit; 
结束
如果Pos.Y< WindowEdgeTolerance然后开始
 SendMessage（FControl.Handle，WM_VSCROLL，SB_LINEUP，0）; 
 end else如果Pos.Y> FControl.Height-WindowEdgeTolerance然后开始
 SendMessage（FControl.Handle，WM_VSCROLL，SB_LINEDOWN，0）; 
 end else begin 
 InitialiseTimer; 
退出; 
结束
 
如果FScrollCount< 50然后开始
 inc（FScrollCount）; 
如果FScrollCount mod 5 = 0，则开始
 //通过减少定时器间隔来加快滚动速度
间隔：= MulDiv（间隔，3，4）; 
结束
结束
 
如果Win32MajorVersion< 6然后在XP中开始
 //我们需要清除短暂的绒毛;导致闪烁，所以只需要在XP中需要它
 FControl.Invalidate; 
结束
结束
 
 begin 
如果Mouse.IsDragging然后开始
 DoScroll; 
 end else begin 
自由; 
结束
结束
  

然后使用它添加一个 OnStartDrag 控件的事件处理程序，如下所示：

 程序TMyForm.SomeControlStartDrag（Sender：TObject; var DragObject：TDragObject）; 
 begin 
 TAutoScrollTimer.Create（发件人为TWinControl）; 
结束
  

I have a TTreeView that can have lots of nodes, when a lot of nodes are expanded the tree uses a lot of screen space.

Now suppose I want to drag a node that is near the bottom of the TreeView to the top, I can't physically see the top part of the TreeView because the node I am selecting is at the bottom. When dragging the node to the top of the TreeView I would like the TreeView to automatically scroll with me when dragging, by default this does not seem to happen.

A perfect example of this behaviour is seen in Windows Explorer. If you try to drag a file or folder, when you hover the dragged item (node) it automatically scrolls up or down depending on cursor position.

Hope that makes sense.

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

Thanks.

解决方案

This is the code I use. It will work for any TWinControl descendent: list box, 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 handler for the control and implement it like this:

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

这篇关于在拖动/靠近边缘时滚动TTreeView的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！