Article ID: 167746
Article Last Modified on 6/29/2004
#If Win16 Then
Declare Function SendMessage& Lib "User" (ByVal hWnd%, ByVal _
wMsg%, ByVal wParam%, lParam As Any)
#Else
Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
(ByVal hWnd As Long, ByVal wMsg As Long, _
ByVal wParam As Long, lParam As Long) As Long
#End If
Function ListRowCalc(lstTemp As Control, ByVal Y As Single) As Integer
#If Win16 Then
Const WM_USER = &H400
Const LB_GETITEMHEIGHT = (WM_USER + 34)
#Else
Const LB_GETITEMHEIGHT = &H1A1
'Determines the height of each item in ListBox control in pixels
#End If
Dim ItemHeight As Integer
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 Control, ByVal OldRow As Integer, _
ByVal NewRow As Integer)
Dim SaveList As String, i As Integer
If OldRow = NewRow Then Exit Sub
SaveList = lstTemp.List(OldRow)
If OldRow > NewRow Then
For i = OldRow To NewRow + 1 Step -1
lstTemp.List(i) = lstTemp.List(i - 1)
Next i
Else
For i = OldRow To NewRow - 1
lstTemp.List(i) = lstTemp.List(i + 1)
Next i
End If
lstTemp.List(NewRow) = SaveList
End Sub
Dim 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
80187 : How To Drop Item into Specified Location in VB List Box
Additional query words: kbVBp500 kbVBp600 kbdse kbDSupport kbVBp kbVBp400
Keywords: kbhowto KB167746