delphi – 在边缘上方/附近拖动时滚动TTreeView

我有一个可以有很多节点的TTreeView,当很多节点被扩展时,树会占用大量的屏幕空间.

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

在Windows资源管理器中可以看到这种行为的完美示例.如果您尝试拖动文件或文件夹,当您将拖动的项目(节点)悬停时,它会根据光标位置自动向上或向下滚动.

希望有道理.

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

谢谢.

解决方法

这是我使用的代码.它适用于任何TWinControl后代：列表框,树视图,列表视图等.

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,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,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;

然后使用它为控件添加一个OnStartDrag事件处理程序,并按如下方式实现：

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

原文地址：https://www.jb51.cc/delphi/102310.html