如何实现拖放功能

xcfei 2004-05-11 05:47:19
有一树控件,结点表示班级,当点击某班级时,在面边的listview中显示出该班级的学员,现准备实现将某学员拖至某班级结点中,此学员就转班到目标班级中,请问如何实现拖放功能?(清楚拖放是哪个事件,但不会用,不懂其实现的原理。)
...全文
57 2 打赏 收藏 转发到动态 举报
写回复
用AI写文章
2 条回复
切换为时间正序
请发表友善的回复…
发表回复
lilaclone 2004-05-11
  • 打赏
  • 举报
回复
窗体中代码:
Option Explicit
Dim treSource As TreeView '源树状浏览器
Dim nodSource As Node '源节点
Dim keyState As Integer 'Shift键的状态

Private Sub Form_Load()
Dim nodF As Node
Dim intI As Integer
Set nodF = TreeView1(0).Nodes.Add(, , "L0", "家庭")
Set nodF = TreeView1(0).Nodes.Add(1, tvwChild, "L1", "李国", 1, 2)
Set nodF = TreeView1(0).Nodes.Add(1, tvwChild, "L2", "李富", 1, 2)
Set nodF = TreeView1(0).Nodes.Add(1, tvwChild, "L3", "李民", 1, 2)
Set nodF = TreeView1(0).Nodes.Add(1, tvwChild, "L4", "李强", 1, 2)
nodF.EnsureVisible '自节点“李强”起向前展开
Set nodF = TreeView1(0).Nodes.Add("L1", tvwChild, "LL1", "李太", 1, 2)
Set nodF = TreeView1(0).Nodes.Add("L1", tvwChild, "LL2", "李平", 1, 2)
Set nodF = TreeView1(0).Nodes.Add("L1", tvwChild, "LL3", "李盛", 1, 2)
Set nodF = TreeView1(0).Nodes.Add("L1", tvwChild, "LL4", "李世", 1, 2)
Set nodF = TreeView1(0).Nodes.Add("LL1", tvwChild, "LLL1", "李百", 1, 2)
Set nodF = TreeView1(0).Nodes.Add("LL1", tvwChild, "LLL2", "李花", 1, 2)
Set nodF = TreeView1(0).Nodes.Add("LL1", tvwChild, "LLL3", "李争", 1, 2)
Set nodF = TreeView1(0).Nodes.Add("LL1", tvwChild, "LLL4", "李艳", 1, 2)
Set nodF = TreeView1(0).Nodes.Add("LLL1", tvwChild, "LLLL1", "李皆", 1, 2)
Set nodF = TreeView1(0).Nodes.Add("LLL1", tvwChild, "LLLL2", "李大", 1, 2)
Set nodF = TreeView1(0).Nodes.Add("LLL1", tvwChild, "LLLL3", "李欢", 1, 2)
Set nodF = TreeView1(0).Nodes.Add("LLL1", tvwChild, "LLLL4", "李喜", 1, 2)
'为节点集合配展开后的图形
For intI = 1 To TreeView1(0).Nodes.Count
TreeView1(0).Nodes(intI).ExpandedImage = 3
Next
End Sub

'按下鼠标右键进入拖动进程
'Index为0或1表示树状浏览器控件数组的元素
Private Sub TreeView1_MouseDown(Index As Integer, Button As Integer, _
Shift As Integer, x As Single, y As Single)
'在拖放时必须使用鼠标右键
If Button <> 2 Then Exit Sub
'根据当时鼠标所在的位置,确定被拖放的节点nodSource
Set nodSource = TreeView1(Index).HitTest(x, y)
If nodSource Is Nothing Then Exit Sub
'保存当时鼠标所在的树状浏览器作为源treSource
Set treSource = TreeView1(Index)
keyState = Shift '取得Shift键状态
'进入拖放操作进程
TreeView1(Index).OLEDrag
End Sub

'OLEDrag方法引发OLEStartDrag事件
'Index为0或1表示树状浏览器控件数组的元素
Private Sub TreeView1_OLEStartDrag(Index As Integer, _
Data As MSComctlLib.DataObject, AllowedEffects As Long)
' pass the Key property of the Node being dragged
'将nodSource.Key插入DataObject对象
Data.SetData nodSource.Key
If keyState And vbCtrlMask Then
'使用了Ctrl键,这时是复制操作
AllowedEffects = vbDropEffectCopy
Else
'没有使用Ctrl键,这时是移动操作
'删除拖放的源数据
AllowedEffects = vbDropEffectMove
End If
End Sub

'当一个部件在另一个部件上拖动时引发
'Index为0或1表示树状浏览器控件数组的元素
Private Sub TreeView1_OLEDragOver(Index As Integer, _
Data As MSComctlLib.DataObject, Effect As Long, _
Button As Integer, Shift As Integer, x As Single, y As Single, _
State As Integer)
'当鼠光标位于节点上时,节点高亮显示
Set TreeView1(Index).DropHighlight = TreeView1(Index).HitTest(x, y)
End Sub

'源部件放到目标部件时引发
'Index为0或1表示树状浏览器控件数组的元素
Private Sub TreeView1_OLEDragDrop(Index As Integer, _
Data As MSComctlLib.DataObject, Effect As Long, _
Button As Integer, Shift As Integer, x As Single, y As Single)
Dim nodDest As Node, nodA As Node
'拖放的目标节点
Set nodDest = TreeView1(Index).DropHighlight
If nodDest Is Nothing Then
'将该节点作为目标树状浏览器的根节点
Set nodA = TreeView1(Index).Nodes.Add(, , , nodSource.Text, _
nodSource.Image)
Else
'检查目标节点是不是与源节点等同
If treSource Is TreeView1(Index) Then
Set nodA = nodDest
Do
If nodA Is nodSource Then '目标节点与源节点等同
MsgBox "不能拖放!", vbExclamation
Exit Sub
End If
Set nodA = nodA.Parent
Loop Until nodA Is Nothing
End If
Set nodA = TreeView1(Index).Nodes.Add(nodDest.Index, _
tvwChild, , nodSource.Text, nodSource.Image)
End If
nodA.ExpandedImage = 2 '展开图形
nodA.Expanded = True

treCopySub treSource, nodSource, TreeView1(Index), nodA
' if this is a move operation, delete the source subtree
If Effect = vbDropEffectMove Then
treDeleSub treSource, nodSource
End If
Set TreeView1(Index).DropHighlight = Nothing
End Sub

全部贴过去后在窗体中加相应控件即可
lilaclone 2004-05-11
  • 打赏
  • 举报
回复
给你一个树形控件拖放的例子,你看看就明白了:
模块中内容:
Option Explicit

'复制或移动一个节点的所有子节点的递归过程
Sub treCopySub(treSource As TreeView, nodSource As Node, _
treDest As TreeView, nodDest As Node)
Dim intI As Integer
Dim nodS As Node '源节点
Dim nodD As Node '目标节点
If nodSource.Children = 0 Then Exit Sub

Set nodS = nodSource.Child
For intI = 1 To nodSource.Children
'在目标树状浏览器增加一个节点
Set nodD = treDest.Nodes.Add(nodDest, tvwChild, , _
nodS.Text, nodS.Image, nodS.SelectedImage)
nodD.ExpandedImage = nodS.ExpandedImage
'以递归的方式加该节点的所有子节点
treCopySub treSource, nodS, treDest, nodD
'引用下一个相邻的同层节点
Set nodS = nodS.Next
Next intI
End Sub

'递归删除节点的子树
Sub treDeleSub(treA As TreeView, nodA As Node)
Dim intI As Integer, nodB As Node, nodC As Node
'首先删除子节点
Set nodB = nodA.Child
For intI = 1 To nodA.Children
'在删除一个节点之前,引用该节点的同层的下一个相邻节点
Set nodC = nodB.Next
treDeleSub treA, nodB
Set nodB = nodC
Next intI
'删除该节点
treA.Nodes.Remove nodA.Index
End Sub

1,451

社区成员

发帖
与我相关
我的任务
社区描述
VB 控件
社区管理员
  • 控件
加入社区
  • 近7日
  • 近30日
  • 至今
社区公告
暂无公告

试试用AI创作助手写篇文章吧