Option Explicit
Private m_DefualtListItem As ListItem              '默认的选择项、或者先前的选择项
Private m_MouseDownX As Single, m_MouseDownY As Single '鼠标按下时的坐标
' Index of currently depressed button (vbLeftButton or vbRightButton)
Private m_iButton As Integer

Private Sub Form_Load()
  Dim i As Integer
  For i = 1 To 20
    Call ListView1.ListItems.Add(Text:="item" & i)
End Sub

Private Sub ListView1_MouseDown(Button As Integer, _
            Shift As Integer, x As Single, y As Single)

  ' If the left- or right-mouse button is being depressed, and is not over
  ' a ListItem, set the module level variable to the button's value.
    If Button And (ListView1.HitTest(x, y) Is Nothing) Then m_iButton = Button
    Set m_DefualtListItem = ListView1.SelectedItem
    m_MouseDownX = x / Screen.TwipsPerPixelX
    m_MouseDownY = y / Screen.TwipsPerPixelY  
End Sub

Private Sub ListView1_MouseMove(Button As Integer, _
            Shift As Integer, x As Single, y As Single)
  ' If no mouse button is currently pressed, and the module level
  ' variable still contains a button value set in MouseDown, then
  ' a mouse button is being released, call the MouseUp and Click
  ' events, and zero the variable. (to our favor, the ListView raises
  ' a MouseMove when any mouse button is released).
    If (Button = 0) And m_iButton Then
        Call ListView1_MouseUp(m_iButton, Shift, x, y)
        m_iButton = 0
    End If
End Sub

Private Sub ListView1_MouseUp(Button As Integer, _
            Shift As Integer, x As Single, y As Single)

  ' Clear the module level variable here also in case one mouse button
  ' is depressed while the other is already down, and either is released,
  ' prevents the MouseMove code from calling unwanted events
    If Not m_DefualtListItem Is Nothing And m_iButton = 1 Then
        Dim DefaultItemRect As RECT, SelectRect As RECT, Intersect As RECT
        With DefaultItemRect
        .Left = m_DefualtListItem.Left
        .Top = m_DefualtListItem.Top
        .Right = m_DefualtListItem.Left + m_DefualtListItem.Width
        .Bottom = m_DefualtListItem.Top + m_DefualtListItem.Height
        End With
        x = x / Screen.TwipsPerPixelX
        y = y / Screen.TwipsPerPixelY
        With SelectRect
        .Left = IIf(x > m_MouseDownX, m_MouseDownX, x)
        .Right = IIf(x > m_MouseDownX, x, m_MouseDownX)
        .Top = IIf(y > m_MouseDownY, m_MouseDownY, y)
        .Bottom = IIf(y > m_MouseDownY, y, m_MouseDownY)
        End With
        Call IntersectRect(Intersect, DefaultItemRect, SelectRect)
        If Intersect.Right - Intersect.Left = 0 Or Intersect.Bottom - Intersect.Top = 0 Then
            m_DefualtListItem.Selected = False
        End If
    End If
    m_iButton = 0
End Sub

Microsoft Windows Common Controls 6.0---用的是这个库
其中称:This bug has been fixed in Visual Basic 6.0.但是好像没解决


  • 广告
  • 抄袭
  • 版权
  • 政治
  • 色情
  • 无意义
  • 其他