listview 条目拖动

Question

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

Answer 1

估计是想通过拖动来添加/删除/排列ITEM的确是个很方便的功能.关注一下....- -!

Answer 2

 
恩 是的  可以灵活的拖动listitem！     

Answer 3

比如 一个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   这样    

Answer 4

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

Answer 5

Option ExplicitPrivate Const LVM_FIRST     As Long = &H1000
Private Const LVM_HITTEST   As Long = LVM_FIRST + 18Private Type LVHITTESTINFO
    x As Long
    y As Long
    flags As Long
    iItem As Long
    iSubItem As Long
End TypePrivate 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 LongPrivate m_bMouseDowned As Boolean
Private m_nSelIndex     As LongPrivate 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 SubPrivate 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 SubPrivate 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

Answer 6

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 SubPrivate 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 SubPrivate Sub ListView2_OLEStartDrag(Data As MSComctlLib.DataObject, AllowedEffects As Long)
   Set itmx = ListView2.SelectedItem
End Sub
这是另外一个代码 但是有点小问题

Answer 7

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 SubPrivate 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 SubPrivate Sub ListView2_OLEStartDrag(Data As MSComctlLib.DataObject, AllowedEffects As Long)
   Set itmx = ListView2.SelectedItem
End Sub

Answer 8

用 TextBox 模拟，简单
Option ExplicitPrivate 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 TypePrivate 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 LongPrivate m_DragIndex As LongSub 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 SubSub 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 SubPrivate 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 SubPrivate 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 SubPrivate 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