VB ListBox 借助winAPI实现鼠标自由拖放改变顺序

Option Explicit

Public item_height As Single
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_GETITEMHEIGHT = &H1A1

Private Sub Form_Load()

List1.AddItem "China"
List1.AddItem "America"
List1.AddItem "Japan"
List1.AddItem "Soccer"
List1.AddItem "Tennis"
List1.AddItem "Basketball"

item_height = Screen.TwipsPerPixelX * _
SendMessage(List1.hwnd, LB_GETITEMHEIGHT, 0, vbNullString)

End Sub

'从list1拖到Form上就删掉
Public Sub Form_DragDrop(Source As Control, X As Single, Y As Single)

If Not (Source Is List1) Then Exit Sub
If List1.ListIndex >= 0 Then List1.RemoveItem List1.ListIndex

End Sub

'从list1拖到list1上
Private Sub List1_DragDrop(Source As Control, X As Single, Y As Single)

Dim newpos As Integer
If Not (Source Is List1) Then Exit Sub
newpos = Y / item_height

If newpos > List1.ListCount Then
List1.AddItem List1.List(List1.ListIndex)
Else
List1.AddItem List1.List(List1.ListIndex), newpos
End If

If List1.ListIndex >= 0 Then List1.RemoveItem List1.ListIndex

End Sub

'鼠标按下就开始拖
Private Sub List1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)

List1.Drag

End Sub