VBA Drag Drop От TreeView до ListView & ListView в TreeView (элементы управления ActiveX)

Question

Попытка перетащить дочерний узел только из элемента управления ActiveX TreeView в элемент управления ListView ActiveX в VBA для Excel. Он работает иногда, но что-то не так. Я не могу последовательно активировать событие перетаскивания (иногда это работает, иногда нет) или, когда он это делает, определить, что было выбрано для добавления в список.

Мой TreeView имеет следующие узлы

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

В выше, я только хочу, чтобы перетащить работать на узлах TAged, как «ребенок». Моя попытка код выглядит следующим образом:

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). Вы должны установить следующие свойства OLE для TreeView и ListView.

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

2). Чтобы определить выбранный узел из TreeView, вы должны использовать метод HitTest во время события MouseDown.

Это вызывало значительную часть моей проблемы, потому что я не мог заставить его дать мне правильный выбранный узел, чтобы узнать, какие данные добавить в мой ListView.

Чтобы определить выбранный узел, вы используете свойство TreeView.SelectedItem. Причудливая вещь с этим заключается в том, что, если вы не установите его во время события MouseDown, VB всегда будет думать, что ранее выбранный элемент, выбранный вами, является текущим выбранным элементом и добавляет неверные данные в ListView. Зачем?

Элемент TreeView.SelectedItem определяется событием MouseUp. Если, например, вы делаете полный щелчок мыши и освобождаетесь на «Узле 1», срабатывают события MouseDown и MouseUp, а событие MouseUp устанавливает TreeView.SelectedItem в «Узел 1». Затем, если вы нажмете вниз и удерживаете кнопку мыши на «Узле 2», а затем сразу начнете перетаскивать (не отпуская кнопку мыши), запускается только событие MouseDown. Поскольку событие MouseUp никогда не запускается, свойство TreeView.SelectedItem остается «Узлом 1», даже если вы перетаскиваете «Узел 2». Поэтому, когда вы попытаетесь использовать свойство SelectedItem позже, чтобы определить, что добавить в целевой ListView (в моем случае), он получает неверные данные.

3). При использовании метода HitTest во время события MouseDown вы должны преобразовать пиксели в TWIPS.

Метод MouseDown возвращает координаты x-y в пикселях, однако в VBA метод HitTest использует TWIPS (по-видимому, .NET, который теперь использует пиксели, поэтому там не требуется преобразование). Поэтому, чтобы определить правильный узел, вы должны его преобразовать.Я самый читаемый почти все компьютеры Windows, имеют отношение к 15 к 1, так что вы можете просто использовать следующее:

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

Однако, если вы не хотите рисковать, что соотношение 15 к 1 будет работайте на всех компьютерах Windows, вы можете рассчитать его с помощью вызовов Windows API, которые я демонстрирую ниже.

Вот урезанная версия кода.

Примечание. Я сохраняю это просто, используя свойство «Автоматическое» перетаскивание, поэтому мне не нужно использовать методы DataObject для установки курсора, определения эффектов перетаскивания и т. Д. ... I «Просто используйте настройки по умолчанию и сохраняйте их просто.

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 - Предоставление изюминкой Effect

Альтернативный подход может быть использован, чтобы дать визуальное пользователю, который подчеркивает узел дерева, прежде чем выбрать. (Примечание: Вы можете сделать это во время мероприятия 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 - Расчет Пиксели в твипы Конверсия

Помните, что это требуется только в VBA. Вам не нужно делать это в .NET, потому что я считаю, что он использует пиксели в методах Events и HitTest.

Вместо явного указания преобразования, как 15, как описано выше:

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

Вы можете рассчитать его с помощью комбинации API вызовов для Windows и вашей собственной функции. Вот как.

Во-первых, Windows API вызовы и определенные пользователем функции помещены в 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 

Затем измените Трассировка часть кода на следующее:

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

Надежда, что помогает!

Ссылки:

Вот ссылки, которые помогли кусок это вместе, и я должен дать кредит, где кредит должен.

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