delphi – 在边缘上方/附近拖动时滚动TTreeView
发布时间:2020-12-15 04:01:45 所属栏目:大数据 来源:网络整理
导读:我有一个可以有很多节点的TTreeView,当很多节点被扩展时,树会占用大量的屏幕空间. 现在假设我想将TreeView底部附近的节点拖到顶部,我无法在物理上看到TreeView的顶部,因为我选择的节点位于底部.当将节点拖动到TreeView的顶部时,我希望TreeView在拖动时自动滚
我有一个可以有很多节点的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; (编辑:李大同) 【声明】本站内容均来自网络,其相关言论仅代表作者个人观点,不代表本站立场。若无意侵犯到您的权利,请及时与联系站长删除相关内容! |