在拖动/靠近边缘时滚动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屋!