Option Explicit

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 Const LB_GETITEMHEIGHT = &H1A1

Private Sub Form_Load()
  Dim i As Long

  With List1
    .AddItem "Michael Schumacher - Ferrari"
    .AddItem "Ralf Schumacher - Williams BMW"
    .AddItem "David Coulthard - McLaren Mercedes"
    .AddItem "Kimi Räikkönen - McLaren Mercedes"
    .AddItem "Jarno Trulli - Renault"
    .AddItem "Fernando Alonso - Renault"
    .AddItem "Nick Heidfeld - SAUBER PETRONAS"
    .AddItem "H.-H. Frentzen - SAUBER PETRONAS"
    .AddItem "Giancarlo Fisichella - Jordan Ford"
    .AddItem "Zsolt Baumgartner - Jordan Ford"
    .ListIndex = 0
  End With
End Sub

Private Sub List1_MouseMove(Button As Integer, _
      Shift As Integer, X As Single, Y As Single)

  ListBoxToolTip List1, Y, "VB-Fun-Demo"
End Sub

Private Sub ListBoxToolTip(ByVal lst As ListBox, ByVal Y _
    As Single, Optional ByRef DefaultToolTip As String = "")

  Dim lstHeight As Long
  Dim lstItem As Long

  lstHeight = SendMessage(lst.hwnd, LB_GETITEMHEIGHT, 0&, 0&)
  lstItem = (Y \ Screen.TwipsPerPixelY) \ lstHeight

  lstItem = lstItem + lst.TopIndex
  If lstItem < lst.ListCount Then
    lst.ToolTipText = lst.List(lstItem)
  Else
    lst.ToolTipText = DefaultToolTip
  End If
End Sub