Dragging TreeView nodes

Something that is not particularly easy, but nearly everyone wants to be able to do is to enable the user to rearrange items around on a treeview by dropping and dragging. This code reveals one method of doing this.

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. 

'// 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