我有一个可以有很多节点的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;