Hej
Någon som har något tips på hur man kan flytta en rad i en listbox. Alltså antag att det finns två rader, på den översta står det rad1 och på den understa rad2. Jag vill att användaren skall kunna drag&drop'a rad1 så att den kommer under rad2. Det hade varit super om ItemData't hängde med oxå!

Det skall även fungera att "klämma in en rad emellan"

Du kan lägga ett par knapper på sidan om ListView. Markera en rad i listan och klicka på en av knapperna för att flytta upp resp. ned.
ItemData flyttas också.

cmdNed_Click
Dim readitemindex As Integer
Dim readitem As String
Dim readitemData As Integer
If List2.ListIndex = -1 Then Exit Sub 'inget är valt i listan
If List2.ListCount > 1 Then 'Det finns fler än två rader i listan
'Kolla om man redan står på sista raden
If Not List2.ListIndex + 1 = List2.ListCount Then
'Spara texten, indexet och ItemData
readitem = List2.List(List2.ListIndex)
readitemindex = List2.ListIndex
readitemData = List2.ItemData(List2.ListIndex)
'ta bort raden
List2.RemoveItem (List2.ListIndex)
'den nedanför åker upp och jag lägger dit min nya
List2.AddItem readitem, readitemindex + 1
'tala om att nytt index ska gälla
List2.ListIndex = readitemindex + 1
List2.ItemData(List2.NewIndex) = readitemData
End If
End If
End Sub


cmdUpp_Click
Dim readitemindex As Integer
Dim readitem As String
Dim readitemData As Integer
If List2.ListIndex = -1 Then Exit Sub 'inget är valt i listan
If Not List2.ListIndex = 0 'Man står redan längst upp
'Spara texten, indexet och ItemData
readitem = List2.List(List2.ListIndex)
readitemindex = List2.ListIndex
readitemData = List2.ItemData(List2.ListIndex)
'ta bort raden
List2.RemoveItem (List2.ListIndex)
'den nedanför åker upp och jag lägger dit min nya
List2.AddItem readitem, readitemindex - 1
'tala om att nytt index ska gälla
List2.ListIndex = readitemindex - 1
List2.ItemData(List2.NewIndex) = readitemData
End If
End If
End Sub


Du kan säkert snygga till det så att även multiselect och dra och släpp fungerar. Den här koden fungerar bara om listan har egenskapen multiselect = 0

Du kan säkert baka ihop bägge delarna till en procedur och skicka med upp resp ned som parametrar.


/Lasse

Tack skall du ha!

Men det hade nog ändå varit smidigare om man kunde darg & drop'a. Någon som har koll på detta?

'Modul: Module1 -------------------
Option Explicit

Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
(ByVal hWnd As Long, ByVal wMsg As Long, _
ByVal wParam As Long, lParam As Long) As Long

Private Const LB_GETITEMHEIGHT = &H1A1

Public Function ListRowCalc(lstTemp As ListBox, ByVal Y As Single) As Integer
Dim ItemHeight As Integer
'Determines the height of each item in ListBox control in pixels
ItemHeight = SendMessage(lstTemp.hWnd, LB_GETITEMHEIGHT, 0&, 0&)
ListRowCalc = Min(((Y / Screen.TwipsPerPixelY) \ ItemHeight) + lstTemp.TopIndex, lstTemp.ListCount - 1)
End Function

Function Min(X As Integer, Y As Integer) As Integer
If X > Y Then Min = Y Else Min = X
End Function

Sub ListRowMove(lstTemp As ListBox, ByVal OldRow As Integer, ByVal NewRow As Integer)
Dim List As String
Dim ItemData As Long
Dim i As Integer
If OldRow <> NewRow Then
List = lstTemp.List(OldRow)
ItemData = lstTemp.ItemData(OldRow)
If OldRow > NewRow Then
For i = OldRow To NewRow + 1 Step -1
lstTemp.List(i) = lstTemp.List(i - 1)
lstTemp.ItemData(i) = lstTemp.ItemData(i - 1)
Next i
Else
For i = OldRow To NewRow - 1
lstTemp.List(i) = lstTemp.List(i + 1)
lstTemp.ItemData(i) = lstTemp.ItemData(i + 1)
Next i
End If
lstTemp.List(NewRow) = List
lstTemp.ItemData(NewRow) = ItemData
End If
End Sub


'Form: Form1 -------------------

Option Explicit

Private DragIndex As Integer

Private Sub Form_Load()
List1.Clear
List1.AddItem "Adam"
List1.AddItem "Bob"
List1.AddItem "Charles"
List1.AddItem "David"
List1.AddItem "Eric"
List1.AddItem "Frank"
List1.AddItem "George"
End Sub

Private Sub List1_DragDrop(Source As Control, X As Single, Y As Single)
ListRowMove Source, DragIndex, ListRowCalc(Source, Y)
End Sub

Private Sub List1_MouseDown(Button As Integer, Shift As Integer, _
X As Single, Y As Single)
If Button = vbRightButton Then
DragIndex = ListRowCalc(List1, Y)
List1.Drag
End If
End Sub


Laggt till ItemData, annars skiljer sig den inte mycket från orginal artikeln på :

http://support.microsoft.com/support/kb/articles/q167/7/46.asp

Tackar!