VBA从TreeView拖放到ListView和ListView到TreeView(ActiveX控件)

Question

尝试将子节点仅从ActiveX TreeView控件拖动到VBA for Excel中的ActiveX ListView控件.它偶尔会起作用,但有些事情是错误的.我无法始终将阻止事件触发(有时它可以工作,有时不工作),或者,当它确实时,确定选择添加到listivew的内容.

我的TreeView具有以下节点

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

在上面,我只想让拖动工作在作为'child'的节点上工作.我尝试的代码如下:

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

也尝试反向执行此操作,但从TreeView开始到ListView

Answer 1

呼!经过几天的研究和研究后,我能够自己找到答案.这是针对可能遇到同样问题的其他人.

首先,一些重要的注意事项:

1).您必须为TreeView和ListView设置以下OLE属性.

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

2).要从TreeView确定所选节点,必须在MouseDown事件期间使用HitTest方法.

这导致我的大部分问题,因为我无法让它给我正确的选定节点,然后知道要添加到我的ListView的数据.

要确定所选节点,请使用TreeView.SelectedItem属性.虽然古怪的是,除非你在MouseDown事件期间设置它,否则VB将始终认为您选择的项目之前的项目是当前所选项目,并将错误的数据添加到ListView.为什么？

TreeView.SelectedItem是在MouseUp事件上确定的.例如,如果您在"节点1"上执行完整的鼠标单击和释放,则会触发MouseDown和MouseUp事件,并且MouseUp事件会将TreeView.SelectedItem设置为"节点1".然后,如果您在"节点2"上单击并按住鼠标按钮,然后立即开始拖动(不释放鼠标按钮),则只触发MouseDown事件.由于MouseUp事件永远不会触发,即使您正在拖动"节点2",TreeView.SelectedItem属性仍保持为"节点1".因此,当您稍后尝试使用SelectedItem属性来确定要添加到目标ListView的内容时(在我的情况下),它会获取错误的数据.

3).在MouseDown事件期间使用HitTest方法时,必须将像素转换为TWIPS.

MouseDown方法以像素为单位返回xy坐标,但是,在VBA中HitTest方法使用TWIPS(显然.NET现在使用像素,因此不需要转换).因此,为了确定正确的节点,您必须转换它.我读过的几乎所有Windows计算机都有15比1的比例,所以你可以简单地使用以下内容:

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

但是,如果您不希望15比1的比例适用于所有Windows计算机,则可以使用我在下面演示的Windows API调用来计算它.

这是代码的精简版本.

注意我通过使用'自动'拖动属性和设置保持简单,所以我不必使用'DataObject'方法设置光标,确定拖动效果等...我只是使用默认并保持简单.

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

而已!

您应该可以从那里添加任何其他功能.下面,我给了几个替代品.

备选方案1 - 突出显示效果

可以使用替代方法向用户提供在选择之前突出显示树节点的视觉.(注意:您也可以在TreeView OLEDragOver事件期间执行此操作,但我正在使用MouseMove事件)

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

备选方案2 - 计算像素到TWIPS转换

请记住,这仅在VBA中需要.您不需要在.NET中执行此操作,因为我相信它在Events和HitTest方法中都使用像素.

而不是像上面那样明确地将转换声明为15:

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

您可以使用Windows API调用和您自己的函数的组合来计算它.这是如何做.

首先,放置在Module1中的Windows API调用和用户定义函数:

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

然后将代码的HitTest部分更改为以下内容:

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

希望有所帮助!

参考文献:

以下是帮助将这些内容组合在一起的参考资料,我必须在信用到期时给予信任.

在VB TreeView节点上创建"鼠标悬停"效果

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