[Last Call] Learn how to a build a cloud-first strategyRegister Now

  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 357
  • Last Modified:

ToolTipText Update of ListView Control...MouseMove Event

In a vb 6 form, I am trying to addopt following code to update ToolTipText content in MouseMove event.  My list view control (lvWs) has 4 columns but wide-enough to show only two.  The remaining two columns aren't very important nevertheless, I want user to see it when the mouse is moved on certain list item.

Following code is used to do, in a way, similar thing with a list box.  Depending what item is right-clicked on, it opens a popup menu specific to that item.  

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

    Dim typPoint As POINTAPI, lngSel As Long, intTemp As Integer
    If Button = vbRightButton Then
    'typPoint.X = X \ Screen.TwipsPerPixelX
    typPoint.y = y \ Screen.TwipsPerPixelY
    Call ClientToScreen(lstAllPagesWith.hWnd, typPoint)
    lngSel = LBItemFromPt(lstAllPagesWith.hWnd, typPoint.x, typPoint.y, False)
    If lngSel > -1 Then
    lstAllPagesWith.Selected(lngSel) = True
    strFlag = Left(lstAllPagesWith.List(lngSel), 3)
    Select Case strFlag
        Case "Pag"
            Call ShowPopup("Pag", y) ', True, True, True, False)
        Case "Col"
            Call ShowPopup("Col", y) ', True, True, True, True)
        Case "Row"
            Call ShowPopup("Row", y) ', True, True, False, False)
    End Select

    End If
    End If
    ApplyUndo False

End Sub

Now, I want to use this sample to code it for mouse move event such that it will detect what list item it is on.  Then I suppose, it will easy to build a string of the first subItem plus last two to update ToolTipText property.

Any other solution that works also is fine with me.

Mike Eghtebas
Mike Eghtebas
  • 2
1 Solution

Paste this in Mouse event of lvWs
Private Sub lvWs_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
    On Error Resume Next                                       'Don't stop on error
    Dim Item As ListItem                                         'create temporary item object
    Set Item = lvWs.HitTest(100, y)                         'get reference to item under mouse coordinates

    If Err = 0 Then                                                 'if mouse is over ListItem
        lvWs.ToolTipText = Item.Text & " "                'get text of the main item
        For x = 1 To 4
            lvWs.ToolTipText = lvWs.ToolTipText & Item.SubItems(x) & " "            'get each subitems text
        Next x
        Err = 0                        'if mouse was not over listititem object, then error was raised, clear it.
    End If
End Sub

I think it should work immediately, but in case it doesn't, here's the rest of the code which I used when testing:
Private Sub Form_Load()
    Dim Item As ListItem
    lvWs.ColumnHeaders.Add , , "Col 1"
    lvWs.ColumnHeaders.Add , , "Col 2"
    lvWs.ColumnHeaders.Add , , "Col 3"
    lvWs.ColumnHeaders.Add , , "Col 4"
    lvWs.View = lvwReport
    For x = 1 To 100
        lvWs.ListItems.Add , , x
    Next x

    For Each Item In lvWs.ListItems
        Item.ListSubItems.Add , , "Sub: " & Item.Text & " (1)"
        Item.ListSubItems.Add , , "Sub: " & Item.Text & " (2)"
        Item.ListSubItems.Add , , "Sub: " & Item.Text & " (3)"
        Item.ListSubItems.Add , , "Sub: " & Item.Text & " (4)"
    Next Item
End Sub
I forgot to mention: You have to set lvWs's FullRowSelect property to True.

When it's set to false, then HitTest works only on main items (that's why I used 100 in Set Item = lvWs.HitTest(100, y)).
But when first column was not visible, it didn't work.

Setting FullRowSelect property to True, eliminates this problem, so now you can use      Set Item = lvWs.HitTest(x, y)        if you want.
Mike EghtebasDatabase and Application DeveloperAuthor Commented:
Re:> I think it should work immediately...

You were right.  Thank you for this fantastic solusion.


Featured Post

Independent Software Vendors: We Want Your Opinion

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

  • 2
Tackle projects and never again get stuck behind a technical roadblock.
Join Now