ListBox and Tooltips in VB4

[Claudi]

Hello,
I'm trying to put tooltips in a listbox when you put the mouse over a string bigger than the control is...(There is no ToolTipText in vb4/32).I already made a ToolTip function (with a picture box) but I want to put this tooltip just over the string (with the MouseMove event)and not under the ListBox or under the mouse cursor...
Has anybody some idea to:
1-detect when the string is longer than the control ?
2-put the tooltip at the right place ?

Thank you.

[MartinLiss]

1)

If TextWidth(List1.Text) > List1.Width - 60 Then
    MsgBox "too big"
End If

The 60 accounts for the "borders" of the Listbox.

------------------
Marty
What did the fish say when it hit the concrete wall?
> > > > > "Dam!"

[Aaron Young]

Here's a Sample I put together:

'In a Module..
Private Type POINTAPI
    x As Long
    y As Long
End Type

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

Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Declare Function ScreenToClient Lib "user32" (ByVal hwnd As Long, lpPoint As POINTAPI) As Long
Private Declare Function ClientToScreen Lib "user32" (ByVal hwnd As Long, lpPoint As POINTAPI) As Long
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 WindowFromPoint Lib "user32" (ByVal xPoint As Long, ByVal yPoint As Long) As Long
Private Declare Function SetTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
Private Declare Function KillTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long) As Long

Private Const LB_GETITEMRECT = &H198
Private Const LB_ITEMFROMPOINT = &H1A9

Private lTimerHwnd As Long
Private oTip As PictureBox
Private sText As String
Private TipLeft As Single
Private TipTop As Single

Public Function ItemFromPoint(ByRef oList As ListBox, ByVal x As Single, ByVal y As Single) As Long
    Dim tPOINT As POINTAPI
    Dim iIndex As Long
    'Get the Mouse Cursor Position
    Call GetCursorPos(tPOINT)
    'Convert the Coords to be Relative to the Listbox
    Call ScreenToClient(oList.hwnd, tPOINT)
    'Find which Item the Mouse is Over
    iIndex = SendMessage(oList.hwnd, LB_ITEMFROMPOINT, 0&, ByVal ((tPOINT.x And &HFF) Or (&H10000 * (tPOINT.y And &HFF))))
    'Extract the List Index
    ItemFromPoint = iIndex And &HFF
End Function

Public Sub PosToItemTopLeft(ByRef oList As ListBox, ByVal Index As Long, ByRef x As Single, ByRef y As Single)
    'Converts the X/Y Coords to the Listbox Items X/Y Coords
    Dim tRECT As RECT
    Dim tTL As POINTAPI
    
    Call SendMessage(oList.hwnd, LB_GETITEMRECT, Index, tRECT)
    tTL.x = tRECT.Left - 1
    tTL.y = tRECT.Top - 1
    Call ClientToScreen(oList.hwnd, tTL)
    Call ScreenToClient(oList.Parent.hwnd, tTL)
    x = oList.Parent.ScaleX(tTL.x, vbPixels, oList.Parent.ScaleMode)
    y = oList.Parent.ScaleY(tTL.y, vbPixels, oList.Parent.ScaleMode)
End Sub

Sub DrawTip(ByVal hwnd As Long, ByRef TipBox As PictureBox, ByVal ToolTip As String, ByVal x As Single, ByVal y As Single)
    'Set the ToolTip Hover Timer, Approx 1 Secs before showing Tip..
    Set oTip = TipBox
    TipLeft = x
    TipTop = y
    sText = ToolTip
    Call KillTimer(hwnd, 2)
    Call SetTimer(hwnd, 2, 1000, AddressOf HoverProc)
End Sub

Private Sub TimerProc(ByVal hwnd As Long, uMsg As Long, idEvent As Long, ByVal dwTime As Long)
    'Checks to see if the Tip needs to be hidden..
    Dim tPOINT As POINTAPI
    'Hide the Tip when it leaves the Listbox
    Call GetCursorPos(tPOINT)
    If WindowFromPoint(tPOINT.x, tPOINT.y) <> Val(lTimerHwnd) Then
        Call KillTimer(lTimerHwnd, 1)
        oTip.Visible = False
    End If
End Sub

Private Sub HoverProc(ByVal hwnd As Long, uMsg As Long, idEvent As Long, ByVal dwTime As Long)
    'Kill this Timer
    Call KillTimer(hwnd, 2)
    'Draw and Positon the Tip..
    With oTip
        .AutoRedraw = True
        .ScaleMode = vbPixels
        .Appearance = 0
        .BackColor = RGB(255, 255, 230)
        .Cls
        .CurrentX = 1
        .CurrentY = 1
        .Move TipLeft, TipTop, .ScaleX(.TextWidth(sText) + 5, vbPixels, vbTwips), .ScaleY(.TextHeight(sText) + 4, vbPixels, vbTwips)
        oTip.Print sText
        .Visible = True
    End With
    lTimerHwnd = oTip.hwnd
    'Set the Timer to Monitor the Tip..
    Call KillTimer(lTimerHwnd, 1)
    Call SetTimer(lTimerHwnd, 1, 100, AddressOf TimerProc)
End Sub

'Add a Picturebox to use as the Tip to the Form..
Private Sub Form_Load()
    Dim iIndex As Integer
    Picture1.Visible = False
    'Fill the List with Dummy Values
    For iIndex = 1 To 100
        List1.AddItem "Really Long List Item " & iIndex
    Next
End Sub

Private Sub List1_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
    Dim iIndex As Long
    Static iLastIndex As Long
    
    iIndex = ItemFromPoint(List1, x, y)
    If iIndex >= 0 And iIndex <> iLastIndex Then
        'Convert the X/Y Coords to Position the Tip over the Item..
        PosToItemTopLeft List1, iIndex, x, y
        'Set the ToolTip
        DrawTip List1.hwnd, Picture1, List1.List(iIndex), x, y
    End If
    iLastIndex = iIndex
End Sub

------------------
Aaron Young
Analyst Programmer
[email protected]
[email protected]
Certified AllExperts Expert