|
Option Explicit
Private Declare Function SendMessage Lib "user32" Alias _
"SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, _
ByVal wParam As Long, lParam As Any) As Long
Private Const LB_GETSELCOUNT = &H190
Private Const LB_GETSELITEMS = &H191
Private Const LB_ITEMFROMPOINT = &H1A9
Private Const LB_SELITEMRANGE = &H19B
Private m_lngMouseIndexOld As Long
Private m_blnDrag As Boolean
Private Sub Form_Load()
Dim i As Integer
List1.OLEDragMode = vbOLEDragAutomatic
List1.OLEDropMode = vbOLEDropManual
For i = 1 To 30
List1.AddItem CStr(i) & ". Zeile "
Next i
End Sub
Private Sub List1_MouseMove(Button As Integer, Shift As Integer, _
X As Single, Y As Single)
Dim posY As Long
posY = CLng(Y / Screen.TwipsPerPixelY)
m_lngMouseIndexOld = SendMessage(List1.hwnd, LB_ITEMFROMPOINT, _
0, ByVal &H10000 * posY)
End Sub
Private Sub List1_OLEDragOver(Data As DataObject, _
Effect As Long, Button As Integer, Shift As Integer, _
X As Single, Y As Single, State As Integer)
Dim posY As Long
Dim lngMouseIndexNew As Long
Dim aIndexesSel() As Long
Dim lngIndexDif As Long
Dim lngIndexNew As Long
Dim lngSelItemsCnt As Long
Dim n As Long
Dim strTemp As String
If m_blnDrag = False Then Exit Sub
posY = CLng(Y / Screen.TwipsPerPixelY)
lngMouseIndexNew = SendMessage(List1.hwnd, LB_ITEMFROMPOINT, _
0, ByVal &H10000 * posY)
If m_lngMouseIndexOld = lngMouseIndexNew Then Exit Sub
lngIndexDif = m_lngMouseIndexOld - lngMouseIndexNew
m_lngMouseIndexOld = lngMouseIndexNew
lngSelItemsCnt = SendMessage(List1.hwnd, LB_GETSELCOUNT, 0, 0)
If lngSelItemsCnt < 1 Then Exit Sub
ReDim aIndexesSel(lngSelItemsCnt - 1)
SendMessage List1.hwnd, LB_GETSELITEMS, lngSelItemsCnt, _
aIndexesSel(0)
If aIndexesSel(0) - lngIndexDif < 0 Or _
aIndexesSel(UBound(aIndexesSel)) - lngIndexDif >= _
List1.ListCount Then
Exit Sub
End If
If lngIndexDif < 0 Then
For n = lngSelItemsCnt - 1 To 0 Step -1
SendMessage List1.hwnd, LB_SELITEMRANGE, 0, _
ByVal CLng(n) + &H10000 * CLng(n)
strTemp = List1.List(aIndexesSel(n))
lngIndexNew = aIndexesSel(n) - lngIndexDif
List1.RemoveItem aIndexesSel(n)
List1.AddItem strTemp, lngIndexNew
Next n
End If
If lngIndexDif > 0 Then
For n = 0 To lngSelItemsCnt - 1
SendMessage List1.hwnd, LB_SELITEMRANGE, 0, _
ByVal CLng(n) + &H10000 * CLng(n)
strTemp = List1.List(aIndexesSel(n))
lngIndexNew = aIndexesSel(n) - lngIndexDif
List1.RemoveItem aIndexesSel(n)
List1.AddItem strTemp, lngIndexNew
Next n
End If
For n = 0 To UBound(aIndexesSel)
SendMessage List1.hwnd, LB_SELITEMRANGE, 1, _
ByVal CLng((aIndexesSel(n)) - lngIndexDif) + _
&H10000 * CLng((aIndexesSel(n)) - lngIndexDif)
Next n
End Sub
Private Sub List1_OLEStartDrag(Data As DataObject, _
AllowedEffects As Long)
m_blnDrag = True
End Sub
Private Sub List1_OLECompleteDrag(Effect As Long)
m_blnDrag = False
End Sub
|
|