Drag and Drop
This one look me a while to work out, but here it is.
Firstly, add a TreeView control to your project and name it tvProject.
Next, add an Image List Control, set the image size to 16x16, add a 3
images, and set their keys to Root, FolderClosed and Item.
Then, set the TreeView's OLEDragMode to 1-ccOLEDragAutomatic, and its
OLEDropMode to 1-ccOLEDropManual. Also, set its ImageList property to the
ImageList control you have just added.
The following code will allow you to move nodes and its children around
on the control (like in explorer when you drag folders to new locations
etc).
'// variable that tells us if
'// we are dragging (ie the user is dragging a node from this treeview
control
'// or not (ie the user is trying to drag an object from another
'// control and/or program)
Private blnDragging As Boolean
Private Sub Form_Load()
'// fill the control with some dummy nodes
With tvProject.Nodes
.Add , , "Root",
"Root Item", "Root"
'// add some child folders
.Add "Root", tvwChild,
"ChildFolder1", "Child Folder 1", "FolderClosed"
.Add "Root", tvwChild,
"ChildFolder2", "Child Folder 2", "FolderClosed"
.Add "Root", tvwChild,
"ChildFolder3", "Child Folder 3", "FolderClosed"
'// add some children to the
folders
.Add "ChildFolder1",
tvwChild, "Child1OfFolder1", "Child 1 Of Folder 1",
"Item"
.Add "ChildFolder1",
tvwChild, "Child2OfFolder1", "Child 2 Of Folder 1",
"Item"
.Add "ChildFolder2",
tvwChild, "Child1OfFolder2", "Child 1 Of Folder 2",
"Item"
End With
End Sub
Private Sub tvProject_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
Dim nodNode As Node
'// get the node we are over
Set nodNode = tvProject.HitTest(x, y)
If nodNode Is Nothing Then Exit Sub '// no node
'// ensure node is actually selected, just incase we
start dragging.
nodNode.Selected = True
End Sub
'// occurs when the user starts dragging
'// this is where you assign the effect and the data.
Private Sub tvProject_OLEStartDrag(Data As MSComctlLib.DataObject,
AllowedEffects As Long)
'// Set the effect to move
AllowedEffects = vbDropEffectMove
'// Assign the selected item's key to the DataObject
Data.SetData tvProject.SelectedItem.Key
'// we are dragging from this control
blnDragging = True
End Sub
'// occurs when the object is dragged over the
control.
'// this is where you check to see if the mouse is over
'// a valid drop object
Private Sub tvProject_OLEDragOver(Data As MSComctlLib.DataObject, Effect As
Long, Button As Integer, Shift As Integer, x As Single, y As Single, State
As Integer)
Dim nodNode As Node
'// set the effect
Effect = vbDropEffectMove
'// get the node that the object is being dragged over
Set nodNode = tvProject.HitTest(x, y)
If nodNode Is Nothing Or blnDragging = False Then
'// the dragged object is not
over a node, invalid drop target
'// or the object is not from
this control.
Effect = vbDropEffectNone
End If
End Sub
'// occurs when the user drops the object
'// this is where you move the node and its children.
'// this will not occur if Effect = vbDropEffectNone
Private Sub tvProject_OLEDragDrop(Data As MSComctlLib.DataObject, Effect As
Long, Button As Integer, Shift As Integer, x As Single, y As Single)
Dim strSourceKey As String
Dim nodTarget As Node
'// get the carried data
strSourceKey = Data.GetData(vbCFText)
'// get the target node
Set nodTarget = tvProject.HitTest(x, y)
'// if the target node is not a folder or the root item
'// then get it's parent (that is a folder or the root
item)
If nodTarget.Image <> "FolderClosed" And
nodTarget.Key <> "Root" Then
Set nodTarget = nodTarget.Parent
End If
'// move the source node to the target node
Set tvProject.Nodes(strSourceKey).Parent = nodTarge
'// NOTE: You will also need to update the key to reflect
the changes
'// if you are using it
'// we are not dragging from this control any more
blnDragging = False
'// cancel effect so that VB doesn't muck up your
transfer
Effect = 0
End Sub