jsopher
asked on
drag / drop item within Listview
need to be able to drag item in listview(up or down) to a desired position within the same listview.
full source needed.
full source needed.
ASKER
neither of these were helpful.
please supply code to the question i asked.
thank you.
please supply code to the question i asked.
thank you.
Maybe this will help
http://www.planetsourcecode.com/vb/scripts/ShowCode.asp?txtCodeId=28294&lngWId=1
http://www.planetsourcecode.com/vb/scripts/ShowCode.asp?txtCodeId=28294&lngWId=1
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).Sel ected = True Then
Debug.Print i & ": " & ListView1.ListItems(i).Tex t & " 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.Ad d 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).Sub Items(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.Co unt
ReDim Preserve temp(j - 1)
If j = 1 Then
temp(j - 1) = ListView1.ListItems(LVitem to).Text
Else
temp(j - 1) = ListView1.ListItems(LVitem to).SubIte ms(j - 1)
End If
Next j
For j = 1 To ListView1.ColumnHeaders.Co unt
If j = 1 Then
ListView1.ListItems(LVitem to).Text = ListView1.ListItems(LVitem from).Text
Else
ListView1.ListItems(LVitem to).SubIte ms(j - 1) = ListView1.ListItems(LVitem from).SubI tems(j - 1)
End If
Next j
For j = 1 To ListView1.ColumnHeaders.Co unt
If j = 1 Then
ListView1.ListItems(LVitem from).Text = temp(0)
Else
ListView1.ListItems(LVitem from).SubI tems(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.Ind ex, 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.Ind ex, ListView1.HitTest(X, Y).Index
End Sub
Hope this helps too.
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).Sel
Debug.Print i & ": " & ListView1.ListItems(i).Tex
End If
Next i
End Sub
Private Sub Form_Load()
ListView1.View = lvwReport
ListView1.LabelEdit = lvwManual
For i = 1 To 5
ListView1.ColumnHeaders.Ad
Next i
ListView1.FullRowSelect = False
For i = 1 To 20
ListView1.ListItems.Add i, , "Item" & i
For j = 1 To 4
ListView1.ListItems(i).Sub
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.Co
ReDim Preserve temp(j - 1)
If j = 1 Then
temp(j - 1) = ListView1.ListItems(LVitem
Else
temp(j - 1) = ListView1.ListItems(LVitem
End If
Next j
For j = 1 To ListView1.ColumnHeaders.Co
If j = 1 Then
ListView1.ListItems(LVitem
Else
ListView1.ListItems(LVitem
End If
Next j
For j = 1 To ListView1.ColumnHeaders.Co
If j = 1 Then
ListView1.ListItems(LVitem
Else
ListView1.ListItems(LVitem
End If
Next j
End Sub
Private Sub ListView1_OLEDragDrop(Data
Swap ListView1.SelectedItem.Ind
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
Reposition ListView1.SelectedItem.Ind
End Sub
Hope this helps too.
ASKER
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.
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.
jsopher, here not vb installed, will figure it this weekend..
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(iN ewIndex, 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
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
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
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(iN
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
' 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
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
thx for the help!! nice code.
Glad could make help and Thanks for grade 'A' :) cheers
' 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(
' 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.Cre
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.Te
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