Delphi 如何使列表视图在向上或向下拖动项目时滚动？

我正在使用

TListView

，它具有拖放功能，可以将一个或多个项目拖到另一个项目中，作为一种合并形式。当您将一个项目拖到控件的顶部或底部时，我需要它自动向上或向下滚动，但它不会。这同样适用于在某些视图样式中向右或向左滚动。如何使其自动向用户拖动项目的方向滚动

---

PS：我也启用了VCL主题

没有进行太多测试，但下面的try在项目被拖到其父项（在示例中为表单）的控件之外时启用计时器，计时器事件测试光标位置，以确定是否应将滚动消息发送到listview

procedure TForm1.FormCreate(Sender: TObject);
begin
  Timer1.Enabled := False;
  Timer1.Interval := 500;
end;

procedure TForm1.FormDragOver(Sender, Source: TObject; X, Y: Integer;
  State: TDragState; var Accept: Boolean);
begin
  if Source = ListView1 then 
    Timer1.Enabled := True
  else
    Timer1.Enabled := False;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var
  Pt: TPoint;
begin
  // Stop timer and exit if not dragging any more
  if not ListView1.Dragging then begin
    Timer1.Enabled := False;
    Exit;
  end;

  Pt := ListView1.ScreenToClient(Mouse.CursorPos);
  if Pt.Y < 0 then
    ListView1.Perform(WM_VSCROLL, SB_LINEUP, 0)
  else
    if Pt.Y > ListView1.ClientHeight then
      ListView1.Perform(WM_VSCROLL, SB_LINEDOWN, 0)
    else
      Timer1.Enabled := False;
end;

procedure TForm1.FormDragDrop(Sender, Source: TObject; X, Y: Integer);
begin
  Timer1.Enabled := False;
end;

过程TForm1.FormCreate（发送方：TObject）；
开始
Timer1.Enabled:=False；
计时器1.间隔：=500；
结束；
过程TForm1.FormDragOver（发送方，源：TObject；X，Y：整数；
状态：TDragState；变量接受：Boolean）；
开始
如果Source=ListView1，则
Timer1.Enabled:=真
其他的
Timer1.Enabled:=False；
结束；
程序TForm1.Timer1Timer（发送方：TObject）；
变量
Pt:TPoint；
开始
//停止计时器，如果不再拖动，则退出
如果不是ListView1。则开始拖动
Timer1.Enabled:=False；
出口
结束；
Pt:=ListView1.ScreenToClient（Mouse.CursorPos）；
如果Pt.Y<0，则
ListView1.Perform（WM_VSCROLL，SB_阵容，0）
其他的
如果Pt.Y>ListView1.ClientHeight，则
ListView1.Perform（WM_VSCROLL，SB_LINEDOWN，0）
其他的
Timer1.Enabled:=False；
结束；
过程TForm1.FormDragDrop（发送方，源：TObject；X，Y：整数）；
开始
Timer1.Enabled:=False；
结束；

---

如果它工作正常，您也可以合并水平滚动。

+1谢谢，我还对它进行了修改，通过设置计时器间隔，您将鼠标移离边缘越远，滚动速度就越快。工作起来很有魅力。