1. First create a new form named Tree. Put your treeview control on the form. In this example, I am using Microsoft Tree Control version 6.0 that comes from mscomctl.ocx. Once you add the treeview control, you will see that mscomctl.ocx will automatically be added the references in your project. (Note: If you are doing this for a project used by anyone other than yourself, you should go back at the end and remove the reference to mscomctl.ocx, and change your code to late binding to avoid reference problems). Right click on your tree control. You should see a menu item named TreeCtrl. Under that menu item, click Properties. Under OLEDragMode pick Automatic, and under OLEDropMode, pick Manual. Close the properties.
2. Next, decide what data you are going to load into your tree. I picked the 1000 most popular names of 2008 so I would have a bunch of data to work with. I put them in my "Names" table. My table has fields for NameID (autonumber, primary key), Name (text), and NameOrder(long).
3. Now write a procedure called LoadTree to load your data into the treeview control. This one is loosely based on the tree loading code provided by Microsoft in the knowledge base:
Public Sub LoadTree()
Dim nnode 'As ComctlLib.Node - eliminate early binding to avoid errors on other computers
Dim rst As DAO.Recordset
Dim sKey As String
Dim sDisplay As String
On Error GoTo EH
Application.Echo False
'First clear any existing nodes
Forms!Tree.TreeView1.Nodes.Clear
'get the data
Set rst = CurrentDb.OpenRecordset("SELECT * FROM Names Order By NameOrder;")
Do While rst.EOF = False
sKey = rst.Fields("[NameID]") & ":" & rst.Fields("[NameOrder]")
sDisplay = rst.Fields("[Name]")
Set nnode = Forms!Tree.TreeView1.Nodes.Add(, 1, sKey, sDisplay)
rst.MoveNext
Loop
rst.Close
Set rst = Nothing
Application.Echo True
Exit Sub
EH:
Application.Echo False
If Err.Number = 35602 Then 'this error doesn't matter, ignore it
Exit Sub
Else
MsgBox "Error Number: " & Err.Number & ". " & _
"Error Description: " & Err.Description, vbOKOnly, "Error"
End If
End Sub
Place a call the LoadTree procedure from the OnLoad event of the Tree form. Now when you open your Tree form, your data should be loaded into the tree.4. The next step is to write the drag and drop procedures for the tree control. In the OLEStartDrag event, write:
Me!TreeView1.Object.selecteditem = Nothing
This is to clear the previous selection. Next, in the OLEDragOver event, write a hit test so the nodes are highlighted as we drag over them:Private Sub TreeView1_OLEDragOver(Data As Object, Effect As Long, _ Button As Integer, Shift As Integer, x As Single, y As Single, State As Integer)
Dim oTree
On Error GoTo EH
Set oTree = Me.TreeView1.Object
'if no node is selected, select the first node you dragged over.
If oTree.SelectedItem Is Nothing Then
Set oTree.SelectedItem = oTree.HitTest(x, y)
End If
'Highlight the node being dragged over as a potential drop target.
Set oTree.DropHighlight = oTree.HitTest(x, y)
Exit Sub
EH:
MsgBox "Error: " & Err.Number & ", " & Err.Description, vbOKOnly, "Error"
End Sub
Next, in the OLEDragDrop event, write a procedure to move the selected node to the selected location. In this example, we will accomplish this using the NameOrder field:
Private Sub TreeView1_OLEDragDrop(Data As Object, Effect As Long, Button As Integer, _ Shift As Integer, x As Single, y As Single)
Dim oTree
Dim sDropKey As String 'node key of drop node
Dim lDropOrder As Long 'order of drop node
Dim sSelKey As String 'node key of selected node
Dim lSelName As Long 'primary key of selected node
Dim lSelOrder As Long 'order of selected node
On Error GoTo EH
'Create a reference to the TreeView control
Set oTree = Me!TreeView1.Object
'If nothing is selected for drag, do nothing
If oTree.SelectedItem Is Nothing Then: Exit Sub
'If the node was dragged to an empty space,do nothing
If oTree.DropHighlight Is Nothing Then: Exit Sub
'if the node was dragged to itself do nothing
If oTree.SelectedItem.Index = oTree.DropHighlight.Index Then: Exit Sub
'Get drop node values
sDropKey = oTree.DropHighlight.Key
lDropOrder = CLng(Mid(sDropKey, InStr(1, sDropKey, ":") + 1))
'Get selected node values
sSelKey = oTree.SelectedItem.Key
lSelName = CLng(Left(sSelKey, InStr(1, sSelKey, ":") - 1))
lSelOrder = CLng(Mid(sSelKey, InStr(1, sSelKey, ":") + 1))
'First, make a space in the order for the selected node behind the drop node
CurrentDb.Execute "UPDATE Names SET NameOrder=NameOrder+1 " & _
"WHERE NameOrder>" & lDropOrder & ";"
'Next, update the order of the selected node:
CurrentDb.Execute "UPDATE Names SET NameOrder=" & lDropOrder + 1 & _
" WHERE NameID=" & lSelName & ";"
'Finally, close the empty space left behind when the selected node was moved
CurrentDb.Execute "UPDATE Names SET NameOrder=NameOrder-1 " & _
"WHERE NameOrder>" & lSelOrder & ";"
'clear the highlight
oTree.DropHighlight = Nothing
'reload the tree
LoadTree
Exit Sub
EH:
MsgBox "Error: " & Err.Number & ", " & Err.Description, vbOKOnly, "Error"
End Sub
Now open your tree form. You should be able to drag and drop the items in your control into whatever order you please. But, if you try to drag an item all the way up or down the list, you can't do it without doing multiple small drags as you work your way up the control.5. To make the treeview scroll while dragging, we have to use the windows api. Put this declaration at the top of your tree form code:
Private Declare Function SendMessage Lib "user32" Alias _
"SendMessageA" (ByVal hWnd As Long, _
ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Dim mfX As Single
Dim mfY As Single
Dim m_iScrollDir As Integer 'Which way to scroll
And write this code in the timer event to scroll the control:Private Sub Form_Timer()
On Error GoTo EH
Me.Form.TimerInterval = 0
Set TreeView1.DropHighlight = TreeView1.HitTest(mfX, mfY)
If m_iScrollDir = -1 Then 'Scroll Up
' Send a WM_VSCROLL message 0 is up and 1 is down
SendMessage TreeView1.hWnd, 277&, 0&, Null
Else 'Scroll Down
SendMessage TreeView1.hWnd, 277&, 1&, Null
End If
Me.Form.TimerInterval = 20
Exit Sub
EH:
MsgBox "Error: " & Err.Number & ", " & Err.Description, vbOKOnly, "Error"
End Sub
Now modify the OLEDragOver event to tell the control when to scroll:mfX = x
mfY = y
If y > 0 And y <>
m_iScrollDir = -1
Me.Form.TimerInterval = 20
ElseIf y > (Me.TreeView1.Height - 500) And y < (Me.TreeView1.Height) Then
'scroll down
m_iScrollDir = 1
Me.Form.TimerInterval = 20
Else
Me.Form.TimerInterval = 0
End If
Finally, turn the timer off at the beginning of the OLEDragDrop event: Me.Form.TimerInterval = 0
That's it. Now, try to drag the first item all the way to the bottom of the list. You may need to play with the greater than value in the timer event to get the scrolling to work appropriately. The value of 500 works well with my control, which is sized to 3.875 inches tall. You can download my project here. You can download mscomctl.ocx from Microsoft.com.
That's it. Now, try to drag the first item all the way to the bottom of the list. You may need to play with the greater than value in the timer event to get the scrolling to work appropriately. The value of 500 works well with my control, which is sized to 3.875 inches tall. You can download my project here. You can download mscomctl.ocx from Microsoft.com.