listview 条目拖动

[qq259372339]

我要实现listview里鼠标上下可以拖动item 拖出listview 该item就删除 谁能给我一个思路 或者代码 涉及到listview的什么事件

[jhone99]

lz要什么样的效果呢？

[嗷嗷叫的老马]

估计是想通过拖动来添加/删除/排列ITEM

的确是个很方便的功能.

关注一下....- -!

[qq259372339]

[Quote=引用 2 楼 myjian 的回复:]
估计是想通过拖动来添加/删除/排列ITEM

的确是个很方便的功能.

关注一下....- -!
[/Quote]
恩 是的 可以灵活的拖动listitem！

[qq259372339]

比如 一个listview1.View =lvwReport
里面有很行
id name
---------------
1 a
---------------
2 b
---------------
3 c
---------------
4 e

我用鼠标选择了第一行。。 （1 a） 然后拖动到 第3行 listview就变成
id name
---------------
2 b
---------------
3 c
---------------
1 a
---------------
4 e

这样。。。

[Tiger_Zhao]

http://btmtz.mvps.org/listview/
第二项

[bdzwj]

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

[qq259372339]

Private Sub ListView2_OLEDragDrop(Data As MSComctlLib.DataObject, Effect As Long, Button As Integer, Shift As Integer, x As Single, y As Single)
Dim i As Integer
Dim itmtxt() As String
Dim j As Integer

j = ListView2.ColumnHeaders.Count
ReDim Preserve itmtxt(j)

Set itmx2 = ListView2.HitTest(x, y)
ListView2.DropHighlight = Nothing

For j = 0 To ListView2.ColumnHeaders.Count - 1
If j = 0 Then
itmtxt(j) = ListView2.SelectedItem.Text
Else
itmtxt(j) = ListView2.SelectedItem.SubItems(j)
End If
Next

For i = ListView2.SelectedItem.Index To itmx2.Index + 1 Step -1
For j = 0 To ListView2.ColumnHeaders.Count - 1
If j = 0 Then
ListView2.ListItems(i).Text = ListView2.ListItems(i - 1).Text
Else
ListView2.ListItems(i).SubItems(j) = ListView2.ListItems(i - 1).SubItems(j)
End If
Next
Next

If itmx2.Index = ListView2.ListItems.Count Then
For j = 0 To ListView2.ColumnHeaders.Count - 1
If j = 0 Then
ListView2.SelectedItem.Text = itmx2.Text
Else
ListView2.SelectedItem.SubItems(j) = itmx2.SubItems(j)
End If
Next
End If

For i = 0 To ListView2.ColumnHeaders.Count - 1
If i = 0 Then
itmx2.Text = itmtxt(i)
Else
itmx2.SubItems(i) = itmtxt(i)
End If
Next

itmx2.Selected = True
End Sub

Private Sub ListView2_OLEDragOver(Data As MSComctlLib.DataObject, Effect As Long, Button As Integer, Shift As Integer, x As Single, y As Single, State As Integer)
Set itmx2 = ListView2.HitTest(x, y)
ListView2.DropHighlight = itmx2
End Sub

Private Sub ListView2_OLEStartDrag(Data As MSComctlLib.DataObject, AllowedEffects As Long)
Set itmx = ListView2.SelectedItem
End Sub


这是另外一个代码 但是有点小问题。。。

[qq259372339]

Private Sub ListView2_OLEDragDrop(Data As MSComctlLib.DataObject, Effect As Long, Button As Integer, Shift As Integer, x As Single, y As Single)
   Dim i As Integer
   Dim itmtxt() As String
   Dim j As Integer
   
   j = ListView2.ColumnHeaders.Count
   ReDim Preserve itmtxt(j)
   
   Set itmx2 = ListView2.HitTest(x, y)
   ListView2.DropHighlight = Nothing
   
   For j = 0 To ListView2.ColumnHeaders.Count - 1
       If j = 0 Then
          itmtxt(j) = ListView2.SelectedItem.Text
       Else
          itmtxt(j) = ListView2.SelectedItem.SubItems(j)
       End If
   Next
   
   For i = ListView2.SelectedItem.Index To itmx2.Index + 1 Step -1
       For j = 0 To ListView2.ColumnHeaders.Count - 1
           If j = 0 Then
              ListView2.ListItems(i).Text = ListView2.ListItems(i - 1).Text
           Else
              ListView2.ListItems(i).SubItems(j) = ListView2.ListItems(i - 1).SubItems(j)
           End If
       Next
   Next
   
   If itmx2.Index = ListView2.ListItems.Count Then
       For j = 0 To ListView2.ColumnHeaders.Count - 1
           If j = 0 Then
              ListView2.SelectedItem.Text = itmx2.Text
           Else
              ListView2.SelectedItem.SubItems(j) = itmx2.SubItems(j)
           End If
       Next
   End If

   For i = 0 To ListView2.ColumnHeaders.Count - 1
       If i = 0 Then
          itmx2.Text = itmtxt(i)
       Else
          itmx2.SubItems(i) = itmtxt(i)
       End If
   Next
   
   itmx2.Selected = True
End Sub

Private Sub ListView2_OLEDragOver(Data As MSComctlLib.DataObject, Effect As Long, Button As Integer, Shift As Integer, x As Single, y As Single, State As Integer)
   Set itmx2 = ListView2.HitTest(x, y)
   ListView2.DropHighlight = itmx2
End Sub

Private Sub ListView2_OLEStartDrag(Data As MSComctlLib.DataObject, AllowedEffects As Long)
   Set itmx = ListView2.SelectedItem
End Sub

[Tiger_Zhao]

用 TextBox 模拟，简单

Option Explicit

Private Const LVM_FIRST As Long = &H1000
Private Const LVM_GETITEMRECT As Long = (LVM_FIRST + 14)

Private Type RECT
    Left    As Long
    Top     As Long
    Right   As Long
    Bottom  As Long
End Type

Private Declare Function MapWindowPoints Lib "user32.dll" ( _
     ByVal hwndFrom As Long, _
     ByVal hwndTo As Long, _
     ByRef lppt As Any, _
     ByVal cPoints As Long) As Long
Private Declare Function MoveWindow Lib "user32.dll" ( _
     ByVal hwnd As Long, _
     ByVal X As Long, _
     ByVal Y As Long, _
     ByVal nWidth As Long, _
     ByVal nHeight As Long, _
     ByVal bRepaint As Long) As Long
Private Declare Function SendMessage Lib "user32.dll" Alias "SendMessageW" ( _
     ByVal hwnd As Long, _
     ByVal wMsg As Long, _
     ByVal wParam As Long, _
     ByRef lParam As Any) As Long

Private m_DragIndex As Long

Sub LVMoveItem(ByVal i1 As Long, ByVal i2 As Long)
    Dim lvi1 As ListItem
    Dim lvi2 As ListItem
    Dim aSubItems() As String
    Dim i As Long
    
    If i1 = i2 Then Exit Sub
    
    Set lvi1 = ListView1.ListItems(i1)
    ReDim aSubItems(ListView1.ColumnHeaders.Count - 1)
    For i = 1 To UBound(aSubItems)
        aSubItems(i) = lvi1.SubItems(i)
    Next
    
    ListView1.ListItems.Remove i1

    Set lvi2 = ListView1.ListItems.Add(i2, lvi1.Key, lvi1.Text, lvi1.Icon, lvi1.SmallIcon)
    For i = 1 To UBound(aSubItems)
        lvi2.SubItems(i) = aSubItems(i)
    Next
    
    Set ListView1.SelectedItem = lvi2
End Sub

Sub LVBeginDrag(ByVal Index As Long, ByVal DragControl As Control)
    Dim rc As RECT
    
    SendMessage ListView1.hwnd, LVM_GETITEMRECT, Index - 1, rc
    MapWindowPoints ListView1.hwnd, Me.hwnd, rc, 2
    MoveWindow DragControl.hwnd, rc.Left, rc.Top, rc.Right - rc.Left, rc.Bottom - rc.Top, 0
    DragControl.Drag vbBeginDrag
End Sub

Private Sub Form_Load()
    Dim i As Long
    For i = 1 To 50
        With ListView1.ListItems.Add(, , i)
            .SubItems(1) = Chr(64 + i)
        End With
    Next
    
    ListView1.FullRowSelect = True '否则在 SubItems 上 HitTest 无效
    Text1.Visible = False '只要有拖动效果，不需要显示
End Sub

Private Sub ListView1_DragDrop(Source As Control, X As Single, Y As Single)
    Dim oDropItem As ListItem
    
    If Not Source Is Text1 Then Exit Sub
    
    Set oDropItem = ListView1.HitTest(X, Y)
    If oDropItem Is Nothing Then Exit Sub
    
    LVMoveItem m_DragIndex, oDropItem.Index
End Sub

Private Sub ListView1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Dim oDragItem As ListItem
    
    If Button = vbLeftButton Then
        Set oDragItem = ListView1.HitTest(X, Y)
        If oDragItem Is Nothing Then Exit Sub
        Set ListView1.SelectedItem = oDragItem
        m_DragIndex = oDragItem.Index
        
        LVBeginDrag m_DragIndex, Text1
    End If
End Sub

[Tiger_Zhao]

记得将 5 个帖子一块结掉！

[嗷嗷叫的老马]

顶顶!收藏!!

如果再加个拖动效果就更完美了,呵呵~~~~~我是不是太懒了

[嗷嗷叫的老马]

哇哈哈.

这下不少分!

就怕楼主不结帖.........