delphi - 如何在向上或向下拖动项目时使 ListView 滚动？

Question

我正在使用一个TListView，它具有拖/放功能，可以将一个或多个项目拖到另一个项目中，作为一种合并形式。当您将项目拖动到控件的顶部或底部时，我需要它自动向上或向下滚动，但事实并非如此。这同样适用于在某些 View 样式中向右或向左滚动。如何让它自动沿着用户拖动项目的方向滚动？

PS:我也启用了 VCL 主题

Answer 1

没有进行太多测试，但是当一个项目被拖动到其父项(在本例中为表单)的控件之外时，下面的尝试会启用计时器，并且计时器事件测试光标位置以查明是否应将滚动消息发送到 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;

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