VBA Drag Drop From TreeView to ListView & ListView to TreeView (ActiveX Controls)

Question

Trying to drag a child node only from a ActiveX TreeView Control to an ActiveX ListView control in VBA for Excel. It works occasionally, but something is wrong. I'm unable to consistently get the drag event to fire (sometimes it works, sometimes not) or, when it does, determine what was selected to add to the listivew.

My TreeView has the following nodes

-US (tag='parent')
   -West (tag='parent')
       -CA (tag='child')
       -WA (tag='child')
   -East (tag='parent')
       -NY (tag='child')
       -FL (tag='child')

In the above, I only want the drag to work on the nodes taged as 'child'. My attempted code is as follows:

Dim MyTreeNode As Node
Dim MyText As String

Private Sub TreeView1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As stdole.OLE_XPOS_PIXELS, ByVal Y As stdole.OLE_YPOS_PIXELS)
    Dim MyDataObject As DataObject
    Dim Effect As Integer

    If Button = 1 Then
        'For some reason this executes multple times even though I'm only picking one node.
        Debug.Print TreeView1.SelectedItem.Text

        If InStr(1, TreeView1.SelectedItem.Tag, "Child") > 0 Then
            Set MyTreeNode = TreeView1.SelectedItem
            Set MyDataObject = New DataObject

            MyText = TreeView1.SelectedItem.Text
            MyDataObject.SetText MyText
            Effect = MyDataObject.StartDrag
        End If
    End If
End Sub

Private Sub ListView1_OLEDragDrop(Data As MSComctlLib.DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single)
    Dim MyListViewItem As ListItem
    Set MyListViewItem = ListView1.ListItems.Add(1, "M" & MyTreeNode.Key, MyTreeNode.Text)
End Sub

Also trying to do this in reverse as well, but starting with TreeView to ListView

Answer 1

Whew! After a few days of playing around and research I was able to find the answer on my own. Here it is for others who may have the same problem.

First, a few important notes:

1). You must set the following OLE properties for the TreeView and ListView.

TreeView1.OLEDragMode = 1  'Automatic 
ListView1.OLEDropMode = 1  'Manual

2). In order to determine the selected node from the TreeView, you must use the HitTest method during the MouseDown event.

This was causing a large part of my problem because I couldn't ever get it to give me the right selected node to then know what data to add to my ListView.

To determine the selected node you use the TreeView.SelectedItem property. The quirky thing with that though is that unless you set it during the MouseDown event, VB will always think the previously item you selected item is the current selected item and add the wrong data to the ListView. Why?

The TreeView.SelectedItem is determined on the MouseUp event. If, for example, you do a full mouse click and release on "Node 1", both the MouseDown and MouseUp events fire and the MouseUp event will set the TreeView.SelectedItem to "Node 1". Then, if you down click and HOLD the mouse button on "Node 2" and then immediately begin dragging (without releasing the mouse button), only the MouseDown event triggers. Since the MouseUp event never triggers, the TreeView.SelectedItem property stays as "Node 1" even though you are dragging "Node 2". Therefore, when you try to use the SelectedItem property later to determine what to add to the target ListView (in my case) it gets the wrong data.

3). When using the HitTest method during the MouseDown event, you must convert the Pixels to TWIPS.

The MouseDown method returns the x-y coordinates in pixels, however, in VBA the HitTest method uses TWIPS (apparently .NET which now uses pixels so no conversion is needed there). So in order to determine the correct node, you have to convert it. I've read most to almost all Windows computers have a 15 to 1 ratio so you can simply use the following:

Set TreeView1.SelectedItem = TreeView1.HitTest(x * 15, y * 15)

However, if you don't want to take the chance that the 15 to 1 ratio will work for all Windows computers, you can calculate it using Windows API calls which I demonstrate below.

Here's the stripped down version of the code.

Note I'm keeping it simple by using the 'Automatic' drag property and settings so I don't have to use the 'DataObject' methods to set the cursor, determine the drag effects, etc... I'm just using the defaults and keeping it simple.

Private Sub TreeView1_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As stdole.OLE_XPOS_PIXELS, ByVal y As stdole.OLE_YPOS_PIXELS)
    Set TreeView1.SelectedItem = Nothing
    If TreeView1.SelectedItem Is Nothing Then
        Set TreeView1.SelectedItem = TreeView1.HitTest(x * 15, y * 15)
    End If
End Sub

Private Sub TreeView1_OLEStartDrag(Data As MSComctlLib.DataObject, AllowedEffects As Long)
    Data.SetData TreeView1.SelectedItem.Text, 1
End Sub

Private Sub ListView1_OLEDragDrop(Data As MSComctlLib.DataObject, Effect As Long, Button As Integer, Shift As Integer, x As Single, y As Single)
    ListView1.ListItems.Add ListView1.ListItems.Count + 1, , Data.GetData(1)
End Sub

That's it!

You should be able to take it from there to add any additional features you want. Below, I've given a couple more alternatives.

Alternative 1 - Giving a Highlight Effect

An alternative approach could be used to give the visual to the user that highlights the tree node before selecting. (Note: You could do this during the TreeView OLEDragOver event as well, but I'm using the MouseMove Event)

Private Sub TreeView1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As stdole.OLE_XPOS_PIXELS, ByVal y As stdole.OLE_YPOS_PIXELS)
    If Not (TreeView1.HitTest(x * TwipsPerPixelX, y * TwipsPerPixelY) Is Nothing) Then
        Dim MyNode As Node
        Set MyNode = TreeView1.HitTest(x * 15, y * 15)
        MyNode.Selected = True
        Set MyNode = Nothing
    End If
End Sub

Private Sub TreeView1_OLEStartDrag(Data As MSComctlLib.DataObject, AllowedEffects As Long)
    Data.SetData TreeView1.SelectedItem.Text, 1
End Sub

Private Sub ListView1_OLEDragDrop(Data As MSComctlLib.DataObject, Effect As Long, Button As Integer, Shift As Integer, x As Single, y As Single)
    ListView1.ListItems.Add ListView1.ListItems.Count + 1, , Data.GetData(1)
End Sub

Alternative 2 - Calculating the Pixels to TWIPS Conversion

Remember, this is only needed in VBA. You don't need to do this in .NET because I believe it uses pixels in both the Events and the HitTest methods.

Instead of explicitly stating the conversion as 15 as in the above:

Set MyNode = TreeView1.HitTest(x * 15, y * 15)

You could calculate it using a combination of Windows API calls and your own function. Here's how.

First, the Windows API calls and user defined function placed in Module1:

Public Declare Function GetDesktopWindow Lib "user32" () As Long
Public Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Public Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal nIndex As Long) As Long
Public Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long

Const LOGPIXELSX = 88
Const LOGPIXELSY = 90

Public Function TwipsPerPixelX() As Integer
    Dim MyDesktopWindowHandle As Long, MyDesktopWindowDeviceContext As Long
    Dim MyWidthOfScreen As Long, MyUsedToReleaseDeviceContext As Long
   'Get the handle of the desktop window
    MyDesktopWindowHandle = GetDesktopWindow()
    'Get the desktop window's device context
    MyDesktopWindowDeviceContext = GetDC(MyDesktopWindowHandle)
    'Get the width of the screen
    MyWidthOfScreen = GetDeviceCaps(MyDesktopWindowDeviceContext, LOGPIXELSX)
    'Release the device context
    MyUsedToReleaseDeviceContext = ReleaseDC(MyDesktopWindowHandle, MyDesktopWindowDeviceContext)

    TwipsPerPixelX = 1440 / MyWidthOfScreen '1 inch is always 1440 twips
End Function

Public Function TwipsPerPixelY() As Integer
    Dim MyDesktopWindowHandle As Long, MyDesktopWindowDeviceContext As Long
    Dim MyHeightOfScreen As Long, MyUsedToReleaseDeviceContext As Long

    'Get the handle of the desktop window
    MyDesktopWindowHandle = GetDesktopWindow()
    'Get the desktop window's device context
    MyDesktopWindowDeviceContext = GetDC(MyDesktopWindowHandle)
    'Get the width of the screen
    MyHeightOfScreen = GetDeviceCaps(MyDesktopWindowDeviceContext, LOGPIXELSY)
    'Release the device context
    MyUsedToReleaseDeviceContext = ReleaseDC(MyDesktopWindowHandle, MyDesktopWindowDeviceContext)

    TwipsPerPixelY = 1440 / MyHeightOfScreen '1 inch is always 1440 twips
End Function

Then change the HitTest part of the code to the following:

Set TreeView1.SelectedItem = TreeView1.HitTest(x * TwipsPerPixelX, y * TwipsPerPixelY)

Hope that helps!

References:

Here are the references that helped piece this together and I must give credit where credit is due.

Creating a 'mouse over' effect on a VB TreeView node

http://forums.ni.com/t5/facebookforums/facebooksingletopicpage/facebook-app/417075545007603/message-uid/78682/tab/board/page/4806

http://vbcity.com/forums/t/49091.aspx

http://www.experts-exchange.com/questions/20497792/TwipsPerPixelX-Y-via-the-API-for-VBA.html