Solved

drag / drop item within Listview

Posted on 2002-07-24
12
324 Views
Last Modified: 2008-02-01
need to be able to drag item in listview(up or down) to a desired position within the same listview.

full source needed.
0
Comment
Question by:jsopher
  • 4
  • 3
  • 2
  • +2
12 Comments
 
LVL 16

Expert Comment

by:Richie_Simonetti
Comment Utility
This is an example for a treeview. I think is similar. Sorry, i haven't time to check:

' Declara variables globales.
Dim indrag As Boolean 'Indicador de operación de arrastrar y colocar.
Dim nodX As Object ' Elemento que se arrastra.

Private Sub Form_Load()
   ' Carga un mapa de bits en un control Imagelist.
   Dim imgX As ListImage
   Dim BitmapPath As String
   BitmapPath = "icons\mail\mail01a.ico"
   Set imgX = imagelist1.ListImages.Add(, , LoadPicture(BitmapPath))
   
   ' Inicializa el control TreeView y crea varios nodos.
   TreeView1.ImageList = imagelist1
   Dim nodX As Node   ' Crea un árbol.
   Set nodX = TreeView1.Nodes.Add(, , , "Primario 1", 1)
   Set nodX = TreeView1.Nodes.Add(, , , "Primario 2", 1)
   Set nodX = TreeView1.Nodes.Add(1, tvwChild, , "Secundario 1", 1)
   Set nodX = TreeView1.Nodes.Add(1, tvwChild, , "Secundario 2", 1)
   Set nodX = TreeView1.Nodes.Add(2, tvwChild, , "Secundario 3", 1)
   Set nodX = TreeView1.Nodes.Add(2, tvwChild, , "Secundario 4", 1)
   Set nodX = TreeView1.Nodes.Add(3, tvwChild, , "Secundario 5", 1)
   nodX.EnsureVisible ' Expande el árbol para mostrar todos los nodos.
End Sub

Private Sub TreeView1_MouseDown _
(Button As Integer, Shift As Integer, x As Single, y As Single)
   Set nodX = TreeView1.SelectedItem ' Establece el elemento arrastrado.
End Sub

Private Sub TreeView1_MouseMove _
(Button As Integer, Shift As Integer, x As Single, y As Single)
   If Button = vbLeftButton Then ' Indica una operación de arrastrar.
      indrag = True ' Establece el indicador a verdadero.
      ' Establece el icono de arrastre con el método
      ' CreateDragImage.
      TreeView1.DragIcon = TreeView1.SelectedItem.CreateDragImage
      TreeView1.Drag vbBeginDrag ' Operación de arrastre.
   End If
End Sub

Private Sub TreeView1_DragDrop _
(Source As Control, x As Single, y As Single)
   If TreeView1.DropHighlight Is Nothing Then
      Set TreeView1.DropHighlight = Nothing
      indrag = False
      Exit Sub
   Else
      If nodX = TreeView1.DropHighlight Then Exit Sub
      Cls
      Print nodX.Text & " colocado en " & TreeView1.DropHighlight.Text
      Set TreeView1.DropHighlight = Nothing
      indrag = False
   End If
End Sub

Private Sub TreeView1_DragOver(Source As Control, x As Single, y As Single, State As Integer)
   If indrag = True Then
      ' Establece las coordenadas del mouse en
      ' DropHighlight.
      Set TreeView1.DropHighlight = TreeView1.HitTest(x, y)
   End If
End Sub

0
 
LVL 16

Expert Comment

by:Richie_Simonetti
Comment Utility
0
 

Author Comment

by:jsopher
Comment Utility
neither of these were helpful.

please supply code to the question i asked.

thank you.
0
 
LVL 28

Expert Comment

by:vinnyd79
Comment Utility
0
 
LVL 28

Expert Comment

by:vinnyd79
Comment Utility
0
 
LVL 49

Expert Comment

by:Ryan Chong
Comment Utility
Here is my example that posted on previous PAQ question:

Private Sub Check1_Click()
   If Check1.Value = 1 Then ListView1.MultiSelect = True Else ListView1.MultiSelect = False
End Sub

Private Sub Command1_Click()
   For i = 1 To ListView1.ListItems.Count
       If ListView1.ListItems(i).Selected = True Then
           Debug.Print i & ": " & ListView1.ListItems(i).Text & " is selected"
       End If
   Next i
End Sub

Private Sub Form_Load()
   ListView1.View = lvwReport
   ListView1.LabelEdit = lvwManual
   For i = 1 To 5
       ListView1.ColumnHeaders.Add i, , "Column" & i
   Next i
   ListView1.FullRowSelect = False
   For i = 1 To 20
       ListView1.ListItems.Add i, , "Item" & i
       For j = 1 To 4
           ListView1.ListItems(i).SubItems(j) = i & " Subitem" & j
       Next j
   Next i
   ListView1.OLEDragMode = ccOLEDragAutomatic
   ListView1.OLEDropMode = ccOLEDropManual
   Check1.Caption = "Allow Multiple Select"
   Command1.Caption = "Get Selected Items"
End Sub

Private Sub Swap(LVitemfrom, LVitemto)
   Dim temp() As String, i As Integer
   Erase temp
   For j = 1 To ListView1.ColumnHeaders.Count
       ReDim Preserve temp(j - 1)
       If j = 1 Then
           temp(j - 1) = ListView1.ListItems(LVitemto).Text
       Else
           temp(j - 1) = ListView1.ListItems(LVitemto).SubItems(j - 1)
       End If
   Next j
   
   For j = 1 To ListView1.ColumnHeaders.Count
       If j = 1 Then
           ListView1.ListItems(LVitemto).Text = ListView1.ListItems(LVitemfrom).Text
       Else
           ListView1.ListItems(LVitemto).SubItems(j - 1) = ListView1.ListItems(LVitemfrom).SubItems(j - 1)
       End If
   Next j
   
   For j = 1 To ListView1.ColumnHeaders.Count
       If j = 1 Then
           ListView1.ListItems(LVitemfrom).Text = temp(0)
       Else
           ListView1.ListItems(LVitemfrom).SubItems(j - 1) = temp(j - 1)
       End If
   Next j
   
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)
   Swap ListView1.SelectedItem.Index, ListView1.HitTest(x, y).Index
End Sub

Amendment:

Private Sub Reposition(LVitemfrom, LVitemto)
   Dim myFrom As Integer, myTo As Integer
   
   If LVitemfrom < LVitemto Then
       myFrom = LVitemfrom
       myTo = LVitemto
   Else
       myFrom = LVitemfrom
       myTo = LVitemto
   End If
   
   For i = myFrom To myTo - 1
       DoEvents
       Swap i, i + 1
   Next i
   
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)
   Reposition ListView1.SelectedItem.Index, ListView1.HitTest(X, Y).Index
End Sub

Hope this helps too.
0
How your wiki can always stay up-to-date

Quip doubles as a “living” wiki and a project management tool that evolves with your organization. As you finish projects in Quip, the work remains, easily accessible to all team members, new and old.
- Increase transparency
- Onboard new hires faster
- Access from mobile/offline

 

Author Comment

by:jsopher
Comment Utility
To ryancys:

can the code be modified so that swapping is not occuring.

for example, if one was to drag the 5th item to the 2nd position, it should move the 5th item to the 2nd spot, the 2nd item to the 3rd spot, the 3rd to the 4th and so on.

 
0
 
LVL 49

Expert Comment

by:Ryan Chong
Comment Utility
jsopher, here not vb installed, will figure it this weekend..
0
 
LVL 5

Expert Comment

by:RainUK
Comment Utility
Hi Jsopher, this should do the trick, just put a listview onto a form and then paste into form code:

Option Explicit

Private lstItemSelected As ListItem

Private Sub Form_Load()

Dim lstItemX As ListItem

    With ListView1
   
        .View = lvwReport
        .FullRowSelect = True
        .ColumnHeaders.Add , , "First Name", .Width * 0.3
        .ColumnHeaders.Add , , "Last Name", .Width * 0.3
        .OLEDragMode = ccOLEDragAutomatic
        .OLEDropMode = ccOLEDropManual
        .HideSelection = False
       
    End With

    ' Dummy Data
    Set lstItemX = ListView1.ListItems.Add(, "K1", "Rain")
    lstItemX.SubItems(1) = "UK"
    Set lstItemX = ListView1.ListItems.Add(, "K2", "Jill")
    lstItemX.SubItems(1) = "Star"
    Set lstItemX = ListView1.ListItems.Add(, "K3", "Sarah")
    lstItemX.SubItems(1) = "Principal"
    Set lstItemX = ListView1.ListItems.Add(, "K4", "Kewl")
    lstItemX.SubItems(1) = "Dude"
    Set lstItemX = ListView1.ListItems.Add(, "K5", "Bob")
    lstItemX.SubItems(1) = "Job"
    Set lstItemX = ListView1.ListItems.Add(, "K6", "Bill")
    lstItemX.SubItems(1) = "S Preston"
    Set lstItemX = ListView1.ListItems.Add(, "K7", "Ted")
    lstItemX.SubItems(1) = "Theodore Logan"

End Sub


Private Sub ListView1_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)

Dim lstItemX As ListItem

    If Button = vbLeftButton Then
        ' Check that the left button is being used to drag
        ' If so and a list item is selected for drag then set form level
        ' lstitem
        Set lstItemSelected = ListView1.HitTest(x, y)
    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 lstItemX As ListItem
Dim lstItemNew As ListItem
Dim strOriginalKey As String
Dim iNewIndex As Integer

    ' Test to see if the drag drop is actually over another list item
    Set lstItemX = ListView1.HitTest(x, y)
    ' If so then test the fact that A. A listitem was selected and dragged (The form level listitem)
    ' B. The drop operation has hit another valid listitem
    If Not (lstItemX Is Nothing) And Not (lstItemSelected Is Nothing) Then
       
        ' Check to see that drop list item is not the same as the one dragged
        If Not (lstItemX.Key = lstItemSelected.Key) Then
           
            ' Change original listitem key value so error does not occur when
            ' adding listitem to new position
            strOriginalKey = lstItemSelected.Key
            lstItemSelected.Key = lstItemSelected.Key & "Dummy"
           
            ' Compensate new position depending on current position
            ' as the way this is done a new listitem is added before
            ' the old one is removed
            Select Case (lstItemSelected.Index - lstItemX.Index)

                Case 1
                    iNewIndex = lstItemX.Index
               
                Case ListView1.ListItems.Count
                    iNewIndex = ListView1.ListItems.Count + 1
                   
                Case Is < 0
                    iNewIndex = lstItemX.Index + 1
                    If iNewIndex = 0 Then
                        iNewIndex = 1
                    End If

                Case Is > 0
                    iNewIndex = lstItemX.Index

            End Select
           
            ' Add the selected  listitem to the new index position, with original key
            ' copy all subitems or icons etc here
            Set lstItemNew = ListView1.ListItems.Add(iNewIndex, strOriginalKey, lstItemSelected.Text)
            lstItemNew.SubItems(1) = lstItemSelected.SubItems(1)
           
            ' Now remove original lstitem position of object
            ' The reason you have to change the key value is because in the ListView1_MouseDown
            ' you set the form level listItem variable (lstItemSelected) by reference
            ' so calling the remove with the original key will cause an error
            ' if you did the list item copy stuff after calling remove.
            ListView1.ListItems.Remove lstItemSelected.Key
           
            ' Optional sets focus and selected on the item you moved
            lstItemNew.Selected = True
           
            Set lstItemNew = Nothing
       
        End If
       
        Set lstItemSelected = Nothing
       
    End If
   
End Sub



0
 
LVL 49

Accepted Solution

by:
Ryan Chong earned 250 total points
Comment Utility
Hi jsopher,

Here is the final amendment:

Private Sub Reposition2(LVitemfrom, LVitemto)
    If LVitemfrom < LVitemto Then
        For i = LVitemfrom To LVitemto - 1
            DoEvents
            Swap i, i + 1
        Next i
    Else
        For i = LVitemfrom To LVitemto + 1 Step -1
            DoEvents
            Swap i, i - 1
        Next i
    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)
'    Swap ListView1.SelectedItem.Index, ListView1.HitTest(X, Y).Index
'    Reposition ListView1.SelectedItem.Index, ListView1.HitTest(X, Y).Index
    Reposition2 ListView1.SelectedItem.Index, ListView1.HitTest(X, Y).Index
End Sub

Try and see if it reach your requirement. Hope this helps
0
 

Author Comment

by:jsopher
Comment Utility
thx for the help!!  nice code.
0
 
LVL 49

Expert Comment

by:Ryan Chong
Comment Utility
Glad could make help and Thanks for grade 'A' :) cheers
0

Featured Post

Highfive Gives IT Their Time Back

Highfive is so simple that setting up every meeting room takes just minutes and every employee will be able to start or join a call from any room with ease. Never be called into a meeting just to get it started again. This is how video conferencing should work!

Join & Write a Comment

I’ve seen a number of people looking for examples of how to access web services from VB6.  I’ve been using a test harness I built in VB6 (using many resources I found online) that I use for small projects to work out how to communicate with web serv…
Enums (shorthand for ‘enumerations’) are not often used by programmers but they can be quite valuable when they are.  What are they? An Enum is just a type of variable like a string or an Integer, but in this case one that you create that contains…
Show developers how to use a criteria form to limit the data that appears on an Access report. It is a common requirement that users can specify the criteria for a report at runtime. The easiest way to accomplish this is using a criteria form that a…
This lesson covers basic error handling code in Microsoft Excel using VBA. This is the first lesson in a 3-part series that uses code to loop through an Excel spreadsheet in VBA and then fix errors, taking advantage of error handling code. This l…

772 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

15 Experts available now in Live!

Get 1:1 Help Now