7,759
社区成员
发帖
与我相关
我的任务
分享
Option Explicit
Private Const LVM_FIRST As Long = &H1000
Private Const LVM_HITTEST As Long = LVM_FIRST + 18
Private Type LVHITTESTINFO
x As Long
y As Long
flags As Long
iItem As Long
iSubItem As Long
End Type
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 Declare Function SetCapture Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function ReleaseCapture Lib "user32" () As Long
Private m_bMouseDowned As Boolean
Private m_nSelIndex As Long
Private Sub Form_Load()
Dim o As ListItem
Dim i As Long
With ListView1.ListItems
For i = 0 To 10
Set o = .Add(, , Str(i))
o.SubItems(1) = Chr(Asc("a") + i)
Next
End With
End Sub
Private Sub ListView1_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
Debug.Print "MouseDown: " & " x->" & x & "; y->" & y
Dim lIndex As Long
lIndex = ConvPointToIndex(x, y)
If (lIndex <> -1) Then
m_bMouseDowned = True
m_nSelIndex = lIndex
Screen.MousePointer = 13 '5
SetCapture ListView1.hwnd
End If
End Sub
Private Sub ListView1_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
Dim lIndex As Long
lIndex = ConvPointToIndex(x, y)
If m_bMouseDowned Then
Screen.MousePointer = IIf(lIndex < 0, 12, 13)
End If
End Sub
Private Sub ListView1_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
Dim lIndex As Long
lIndex = ConvPointToIndex(x, y)
If (lIndex >= 0 And m_bMouseDowned And m_nSelIndex >= 0) Then
SwapListviewItem m_nSelIndex, lIndex
End If
m_bMouseDowned = False
m_nSelIndex = -1
Screen.MousePointer = 0
ReleaseCapture
End Sub
' 通过鼠标指针返回鼠标所在条目的索引
' 返回-1 鼠标指针所在区域不为有效的索引号 其他为正常索引
' 注意该索引为基于0的索引, VB listview控件中的索引需+1
Private Function ConvPointToIndex(ByVal x As Single, y As Single) As Long
Dim hit As LVHITTESTINFO
hit.x = x / Screen.TwipsPerPixelX
hit.y = y / Screen.TwipsPerPixelY
ConvPointToIndex = SendMessage(ListView1.hwnd, LVM_HITTEST, 0, hit)
End Function
' 交换列表控件条目
Private Function SwapListviewItem(ByVal lSrc As Long, ByVal lDest As Long) As Boolean
Dim strTemp As String
Dim objSrc As ListItem
Dim objDest As ListItem
Dim i As Long
Dim lCount As Long
' 检测输入索引号是否正确
lCount = ListView1.ListItems.Count
If (lSrc < 0 Or lDest < 0 Or (lSrc + 1) > lCount Or (lDest + 1) > lCount) Then
SwapListviewItem = False
Exit Function
End If
' 交换指明索引项数据
lCount = ListView1.ColumnHeaders.Count
Set objSrc = ListView1.ListItems.Item(lSrc + 1)
Set objDest = ListView1.ListItems.Item(lDest + 1)
strTemp = objSrc.Text
objSrc.Text = objDest.Text
objDest.Text = strTemp
For i = 1 To lCount - 1
strTemp = objSrc.SubItems(i)
objSrc.SubItems(i) = objDest.SubItems(i)
objDest.SubItems(i) = strTemp
Next
SwapListviewItem = True
End Function