Listview Drag/Drop problems--still! 1

[jadams0173]

Hey again.

I'm still having a hard time understanding and getting my simple listview drag/drop functions to work. I found some examples on the net and have tried to digest them, but I'm still not getting it.

If anyone could help that would be great! Here is what I have so far. You need a form with 2 listviews (listview1 and 2). What I'm trying to do is be able to drag from LV1 to LV2 and from LV2 to LV1. This seems OK.

I also want to be able to drag and drop inside each listview. This is where the problems are. Listview one works fine. But listview2, when I drag and drop inside it (it's the source and destiniation) it keeps adding items from listview 1.

I don't know how to tell the difference between the data being dragged from LV1 to LV2 or if the data source and destination is LV2.

Private Sub Form_Load()

    Dim intLoop As Integer
    Dim objItem As ListItem
    ListView1.OLEDragMode = ccOLEDragAutomatic
    ListView1.OLEDropMode = ccOLEDropManual
    ListView2.OLEDropMode = ccOLEDropManual
    ListView2.OLEDragMode = ccOLEDragAutomatic
    With ListView1
    For intLoop = 1 To 10
        Set objItem = .ListItems.Add(, "Test Item " & intLoop, "Test Item " & intLoop)
        objItem.ListSubItems.Add , "SubItem A" & intLoop, "SubItem A" & intLoop
        objItem.ListSubItems.Add , "SubItem B" & intLoop, "SubItem B" & intLoop
    Next
    Set objItem = Nothing
    End With

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)

    Call LVDragDropSingle(ListView1, x, y)
    
End Sub

Private Sub ListView1_OLEDragOver(Data As MSComctlLib.DataObject, Effect As Long, Button As Integer, Shift As Integer, x As Single, y As Single, State As Integer)

    Set ListView1.DropHighlight = ListView1.HitTest(x, y)

End Sub

Private Sub ListView2_OLEDragDrop(Data As MSComctlLib.DataObject, Effect As Long, Button As Integer, Shift As Integer, x As Single, y As Single)
'Dim strText As String
'Dim objDrag As ListItem
'Dim objSub As ListSubItem
'Dim objNew As ListItem

[blue]
'Pretty sure my problem is here.  I don't know how to tell
'if the source is LV1 or LV2
[/blue]
[red]
If Data.GetFormat(vbCFText) Then
    Call LVDragDropSingleFromTo(ListView1, ListView2, x, y)
End If
[/red]
End Sub

Private Sub ListView2_OLEDragOver(Data As MSComctlLib.DataObject, Effect As Long, Button As Integer, Shift As Integer, x As Single, y As Single, State As Integer)
    Set ListView2.DropHighlight = ListView2.HitTest(x, y)
End Sub

In a module put this. **NOTE: this came from vbcity.com. The only part of this that I've tried to construct is the function LVDragDropSingleFromTo

Public Sub LVDragDropMulti(ByRef lvList As ListView, ByVal x As Single, ByVal y As Single)

    Dim objDrag As ListItem
    Dim objDrop As ListItem
    Dim objNew As ListItem
    Dim objSub As ListSubItem
    Dim intIndex As Integer
    Dim intLoop As Integer
    Dim intCount As Integer
    Dim intSelected As Integer
    Dim arrItems() As ListItem
    
    'Retrieve the original items
    Set objDrop = lvList.HitTest(x, y)
    Set objDrag = lvList.SelectedItem
    If (objDrop Is Nothing) Or (objDrag Is Nothing) Then
        Set lvList.DropHighlight = Nothing
        Set objDrop = Nothing
        Set objDrag = Nothing
        Exit Sub
    End If
    
    'Retrieve the drop position
    intIndex = objDrop.Index
    intCount = lvList.ListItems.Count
    intSelected = 0
    'Remove the drop highlighting
    Set lvList.DropHighlight = Nothing

    'Loop through and retrieve the selected items
    For intLoop = 1 To intCount
        If lvList.ListItems(intLoop).Selected Then
            intSelected = intSelected + 1
            ReDim Preserve arrItems(1 To intSelected) As ListItem
            Set arrItems(intSelected) = lvList.ListItems(intLoop)
        End If
    Next
    'Loop through in reverse and remove the selected items
    'Going in reverse prevents index shifting
    For intLoop = UBound(arrItems) To LBound(arrItems) Step -1
        lvList.ListItems.Remove arrItems(intLoop).Index
    Next
    'Loop through again and add the items back
    'Going in reverse keeps the items in order
    For intLoop = UBound(arrItems) To LBound(arrItems) Step -1
        Set objDrag = arrItems(intLoop)
        'Add it back into the dropped position
        Set objNew = lvList.ListItems.Add(intIndex, objDrag.Key, objDrag.Text, objDrag.Icon, objDrag.SmallIcon)
        'Copy the original subitems to the new item
        If objDrag.ListSubItems.Count > 0 Then
            For Each objSub In objDrag.ListSubItems
                objNew.ListSubItems.Add objSub.Index, objSub.Key, objSub.Text, objSub.ReportIcon, objSub.ToolTipText
            Next
        End If
        objNew.Selected = True
    Next
    
    'Destroy all objects
    ReDim arrItems(1)
    Set arrItems(1) = Nothing
    Set objNew = Nothing
    Set objDrag = Nothing
    Set objDrop = Nothing

End Sub

Public Sub LVDragDropSingle(ByRef lvList As ListView, ByVal x As Single, ByVal y As Single)

    Dim objDrag As ListItem
    Dim objDrop As ListItem
    Dim objNew As ListItem
    Dim objSub As ListSubItem
    Dim intIndex As Integer
    
    'Retrieve the original items
    Set objDrop = lvList.HitTest(x, y)
    Set objDrag = lvList.SelectedItem
    If (objDrop Is Nothing) Or (objDrag Is Nothing) Then
        Set lvList.DropHighlight = Nothing
        Set objDrop = Nothing
        Set objDrag = Nothing
        Exit Sub
    End If
    
    'Retrieve the drop position
    intIndex = objDrop.Index
    
    'Remove the dragged item
    lvList.ListItems.Remove objDrag.Index
    'Add it back into the dropped position
    Set objNew = lvList.ListItems.Add(intIndex, objDrag.Key, objDrag.Text, objDrag.Icon, objDrag.SmallIcon)
    'Copy the original subitems to the new item
    If objDrag.ListSubItems.Count > 0 Then
        For Each objSub In objDrag.ListSubItems
            objNew.ListSubItems.Add objSub.Index, objSub.Key, objSub.Text, objSub.ReportIcon, objSub.ToolTipText
        Next
    End If
    'Reselect the item
    objNew.Selected = True
    
    'Destroy all objects
    Set objNew = Nothing
    Set objDrag = Nothing
    Set objDrop = Nothing
    Set lvList.DropHighlight = Nothing

End Sub

Public Sub LVDragDropSingleFromTo(ByRef lvList As ListView, ByRef lvListDest As ListView, _
                                    ByVal x As Single, ByVal y As Single)

    Dim objDrag As ListItem
    Dim objDrop As ListItem
    Dim objNew As ListItem
    Dim objSub As ListSubItem
    Dim intIndex As Integer
    
    'Retrieve the original items
    Set objDrop = lvList.HitTest(x, y)
    Set objDrag = lvList.SelectedItem
    If (objDrop Is Nothing) Or (objDrag Is Nothing) Then
        Set lvList.DropHighlight = Nothing
        Set objDrop = Nothing
        Set objDrag = Nothing
        Exit Sub
    End If
    
    'Retrieve the drop position
    intIndex = lvListDest.ListItems.Count + 1 'objDrop.Index
    
    'Remove the dragged item
    lvList.ListItems.Remove objDrag.Index
    'Add it back into the dropped position
    Set objNew = lvListDest.ListItems.Add(intIndex, objDrag.Key, objDrag.Text, objDrag.Icon, objDrag.SmallIcon)
    'Copy the original subitems to the new item
    If objDrag.ListSubItems.Count > 0 Then
        For Each objSub In objDrag.ListSubItems
            objNew.ListSubItems.Add objSub.Index, objSub.Key, objSub.Text, objSub.ReportIcon, objSub.ToolTipText
        Next
    End If
    'Reselect the item
    objNew.Selected = True
    
    'Destroy all objects
    Set objNew = Nothing
    Set objDrag = Nothing
    Set objDrop = Nothing
    Set lvList.DropHighlight = Nothing

End Sub

 

[Hypetia]

As both of your listviews behave exactly the same, I would suggest you to make them part of a control array. This will dramatically reduce and simplify your code and will ensure that both of your listviews behave exactly the same way.

Start a new project and add version 6 common controls to your toolbox.
Draw a listview of suitable size on your form. Copy the listview and paste on your form. Choose Yes when prompted to create a control array. Now you have two identical listviews on your form ListView1(0) and ListView1(1).

Insert the following code in your form.
___
[tt]
Option Explicit
Dim DragSource As Integer
Private Sub Form_Load()
Dim intLoop As Integer
For intLoop = 0 To 1
With ListView1(intLoop)
.OLEDragMode = ccOLEDragAutomatic
.OLEDropMode = ccOLEDropManual
.ColumnHeaders.Add
.ColumnHeaders.Add
.ColumnHeaders.Add
.View = lvwReport
End With
Next
For intLoop = 1 To 10
With ListView1(0).ListItems.Add(, "Test Item " & intLoop, "Test Item " & intLoop)
.ListSubItems.Add , "SubItem A" & intLoop, "SubItem A" & intLoop
.ListSubItems.Add , "SubItem B" & intLoop, "SubItem B" & intLoop
End With
Next
End Sub

Private Sub ListView1_OLEDragDrop(Index As Integer, Data As MSComctlLib.DataObject, Effect As Long, Button As Integer, Shift As Integer, x As Single, y As Single)
Dim N As Long, li As ListItem
Set li = ListView1(DragSource).SelectedItem
ListView1(DragSource).ListItems.Remove li.Index
If ListView1(Index).DropHighlight Is Nothing Then
N = ListView1(Index).ListItems.Count + 1
Else
N = ListView1(Index).DropHighlight.Index
End If
With ListView1(Index).ListItems.Add(N, li.Key, li.Text, li.Icon, li.SmallIcon)
For N = 1 To li.ListSubItems.Count
.ListSubItems.Add , li.ListSubItems(N).Key, li.ListSubItems(N).Text
Next
.Selected = True
End With
Set ListView1(Index).DropHighlight = Nothing
End Sub

Private Sub ListView1_OLEDragOver(Index As Integer, Data As MSComctlLib.DataObject, Effect As Long, Button As Integer, Shift As Integer, x As Single, y As Single, State As Integer)
Set ListView1(Index).DropHighlight = ListView1(Index).HitTest(x, y)
End Sub

Private Sub ListView1_OLEStartDrag(Index As Integer, Data As MSComctlLib.DataObject, AllowedEffects As Long)
DragSource = Index
AllowedEffects = vbDropEffectMove
End Sub[/tt]
___

You don't need any additional function or code module. Just run the program and test it.

 

[jadams0173]

Thanks Hypetia for the help. I'm on vacation (holiday) at the moment but will try when I get back to work!

 

[jadams0173]

That made it much easier to try to understand. Thanks!