• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 214
  • Last Modified:

Re-Arranging Lines in ListView

I am using a list view object. I want to use drag and drop to re-arrange the list items. For example, say there are three lines in the list:

Before drag-and-drop
Line 1
Line 2
Line 3

I want the user to be able to re-arrange the list using drag and drop so that it looks like this:

After drag and drop
Line 1
Line 3
Line 2

This way they can re-order the list any way they like.

Any help would be appreciated.
0
mtriviso
Asked:
mtriviso
  • 7
  • 6
1 Solution
 
mtrivisoAuthor Commented:
This should work with multiple line also. For example:

Before Drag and Drop
Line 1
Line 2
Line 3
Line 4
Line 5

After Drag and Drop
Line 1
Line 3
Line 4
Line 5
Line 2
0
 
caraf_gCommented:
Put a list view on your form, and copy the following into your form module.

Option Explicit

Private Sub Form_Load()

With Me.ListView1
    .View = lvwReport
    .ColumnHeaders.Add , , "hi"
    .ListItems.Add , , "Item1"
    .ListItems.Add , , "Item2"
    .ListItems.Add , , "Item3"
    .ListItems.Add , , "Item4"
    .ListItems.Add , , "Item5"
    .ListItems.Add , , "Item6"
    .ListItems.Add , , "Item7"
    .ListItems.Add , , "Item8"
    .ListItems.Add , , "Item9"
    .ListItems.Add , , "Item10"
    .ListItems.Add , , "Item11"
    .OLEDragMode = ccOLEDragAutomatic
    .OLEDropMode = ccOLEDropManual
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)

Dim lngcount As Long
Dim objItem As MSComctlLib.ListItem
Dim objItem2 As MSComctlLib.ListItem
Dim objItem3 As MSComctlLib.ListItem
Dim strOld As String

strOld = Data.GetData(1)
For lngcount = 1 To Me.ListView1.ListItems.Count
    Set objItem2 = Me.ListView1.ListItems(lngcount)
    If objItem2.Text = strOld Then
        Exit For
    End If
Next

For lngcount = 1 To Me.ListView1.ListItems.Count
    Set objItem = Me.ListView1.ListItems(lngcount)
    If objItem.Top <= y And objItem.Top + objItem.Height >= y Then
        Exit For
    End If
Next

If objItem2.Index < objItem.Index Then
    strOld = objItem2.Text
    For lngcount = objItem2.Index To objItem.Index - 1
        Me.ListView1.ListItems(lngcount).Text = Me.ListView1.ListItems(lngcount + 1).Text
    Next
    objItem.Text = strOld
    objItem.Selected = True
ElseIf objItem2.Index > objItem.Index Then
    strOld = objItem2.Text
    For lngcount = objItem2.Index To objItem.Index + 1 Step -1
        Me.ListView1.ListItems(lngcount).Text = Me.ListView1.ListItems(lngcount - 1).Text
    Next
    objItem.Text = strOld
    objItem.Selected = True
End If

End Sub


Let me know if you need to know how to handle sub-items; I presumed you know.
0
 
caraf_gCommented:
PS - you're in trouble if the items can have different texts. This can only work if the text uniquely identifies list items.
0
The new generation of project management tools

With monday.com’s project management tool, you can see what everyone on your team is working in a single glance. Its intuitive dashboards are customizable, so you can create systems that work for you.

 
mtrivisoAuthor Commented:
I'll Try this out and let you know.
0
 
mtrivisoAuthor Commented:
Ack. The text items do not uniquely identify the list items. I don't think this approach will work.
0
 
caraf_gCommented:
Try the following...

'Replace this code:
'strOld = Data.GetData(1)
'For lngcount = 1 To Me.ListView1.ListItems.Count
'    Set objItem2 = Me.ListView1.ListItems(lngcount)
'    If objItem2.Text = strOld Then
'        Exit For
'    End If
'Next
'With this:
strOld = Data.GetData(1)
Set objItem2 = Me.ListView1.SelectedItem

The list view cannot be multi select, but I think that's a small sacrifice..
0
 
caraf_gCommented:
The following example handles subitems also. Again, just put a list view on to a form and paste the following code:

Option Explicit

Private Sub Form_Load()

Dim objItem As MSComctlLib.ListItem
With Me.ListView1
    .View = lvwReport
    .ColumnHeaders.Add , , "Item"
    .ColumnHeaders.Add , , "SubItem"
    Set objItem = .ListItems.Add(, , "Item1")
    objItem.SubItems(1) = "Subitem1"
    Set objItem = .ListItems.Add(, , "Item2")
    objItem.SubItems(1) = "Subitem2"
    Set objItem = .ListItems.Add(, , "Item3")
    objItem.SubItems(1) = "Subitem3"
    Set objItem = .ListItems.Add(, , "Item4")
    objItem.SubItems(1) = "Subitem4"
    Set objItem = .ListItems.Add(, , "Item5")
    objItem.SubItems(1) = "Subitem5"
    Set objItem = .ListItems.Add(, , "Item6")
    objItem.SubItems(1) = "Subitem6"
    Set objItem = .ListItems.Add(, , "Item7")
    objItem.SubItems(1) = "Subitem7"
    Set objItem = .ListItems.Add(, , "Item8")
    objItem.SubItems(1) = "Subitem8"
    Set objItem = .ListItems.Add(, , "Item9")
    objItem.SubItems(1) = "Subitem9"
    Set objItem = .ListItems.Add(, , "Item10")
    objItem.SubItems(1) = "Subitem10"
    Set objItem = .ListItems.Add(, , "Item11")
    objItem.SubItems(1) = "Subitem11"
    .OLEDragMode = ccOLEDragAutomatic
    .OLEDropMode = ccOLEDropManual
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)

Dim lngCount As Long
Dim lngSubItemCount As Long
Dim objItem As MSComctlLib.ListItem
Dim objItem2 As MSComctlLib.ListItem
Dim objItem3 As MSComctlLib.ListItem
Dim strOldText As String
Dim strOldSubItems() As String

With Me.ListView1

    Set objItem2 = .SelectedItem
    strOldText = objItem2.Text
   
    If .ColumnHeaders.Count > 1 Then
        ReDim strOldSubItems(1 To .ColumnHeaders.Count - 1)
        For lngSubItemCount = 1 To .ColumnHeaders.Count - 1
            strOldSubItems(lngSubItemCount) = objItem2.SubItems(lngSubItemCount)
        Next
    End If
   
    For lngCount = 1 To .ListItems.Count
        Set objItem = .ListItems(lngCount)
        If objItem.Top <= y And objItem.Top + objItem.Height >= y Then
            Exit For
        End If
    Next
   
    If objItem2.Index < objItem.Index Then
        strOldText = objItem2.Text
        For lngCount = objItem2.Index To objItem.Index - 1
            .ListItems(lngCount).Text = .ListItems(lngCount + 1).Text
            For lngSubItemCount = 1 To .ColumnHeaders.Count - 1
                .ListItems(lngCount).SubItems(lngSubItemCount) = .ListItems(lngCount + 1).SubItems(lngSubItemCount)
            Next
        Next
        objItem.Text = strOldText
        For lngSubItemCount = 1 To .ColumnHeaders.Count - 1
            objItem.SubItems(lngSubItemCount) = strOldSubItems(lngSubItemCount)
        Next
        objItem.Selected = True
    ElseIf objItem2.Index > objItem.Index Then
        strOldText = objItem2.Text
        For lngCount = objItem2.Index To objItem.Index + 1 Step -1
            .ListItems(lngCount).Text = .ListItems(lngCount - 1).Text
            For lngSubItemCount = 1 To .ColumnHeaders.Count - 1
                .ListItems(lngCount).SubItems(lngSubItemCount) = .ListItems(lngCount - 1).SubItems(lngSubItemCount)
            Next
        Next
        objItem.Text = strOldText
        For lngSubItemCount = 1 To .ColumnHeaders.Count - 1
            objItem.SubItems(lngSubItemCount) = strOldSubItems(lngSubItemCount)
        Next
        objItem.Selected = True
    End If
End With

End Sub
0
 
mtrivisoAuthor Commented:
I am going to re-visit this issue at a lter time. Thanks for all your help though.
0
 
caraf_gCommented:
Thanks for the "A"!

Just post another comment to this question if you have any further questions; I'll get the notification and I'll see if I can help you out.

Pino
0
 
mtrivisoAuthor Commented:
Ok. I'll do that. thanks for the help!
0
 
mtrivisoAuthor Commented:
Hello,

I had a chance to try out the code and it works pretty well. i haven't had a chance to examine it or anything but it seems to do the job.

I have a couple of questions that I hope you can answer for me.

- the application I am working requires that the multi-select property be turned on. Can you try this and let me know if you see any anomolous behavior? When I have the multi-select property turned on, after selecting and dragging an item, there are two lines selected instead of just one: the line that was dropped and the line that was dragged. Other than that, the code works as expected.

- will your code work with any number of subitems? From what I can gather it looks like it will. I just want to verify if I am right.

- if there's anything else I should know about the code please fill me in.

- when I am done with the application, if you want a free copy, just let me know. The application will allow one to organize image files, create thumbnails, move, and rename files, etc. just send me an email to indigo2@mindspring.com
0
 
mtrivisoAuthor Commented:
Also, I have noticed that while dragging if the item is dragged below the bottom of the list the list does not scroll.
0
 
caraf_gCommented:
Hello mtrivisio,

I'm just logging on for 5 minutes and noticed this... But I'm on holiday and won't have a chance to look at it for at least another week. I'm afraid I'll forget that this is outstanding....

If you post another comment in a couple of days, I'll get another notification which I should have when I get back, so I'll be reminded to look at this question again.

Sorry I can't help you right now!

Good luck


Pino
0

Featured Post

The new generation of project management tools

With monday.com’s project management tool, you can see what everyone on your team is working in a single glance. Its intuitive dashboards are customizable, so you can create systems that work for you.

  • 7
  • 6
Tackle projects and never again get stuck behind a technical roadblock.
Join Now