A class module, named: CTooltip, code is as follows: Option Explicit Private Declare Sub InitCommonControls Lib "comctl32.dll" () '' Windows API FunctionsPrivate Declare Function CreateWindowEx Lib "user32" Alias "CreateWindowExA" (ByVal dwExStyle As Long, ByVal lpClassName As String, ByVal lpWindowName As String, ByVal dwStyle As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hWndParent As Long, ByVal hMenu As Long, ByVal hInstance As Long, lpParam As Any) As LongPrivate Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As LongPrivate Declare Function SendMessageLong Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As LongPrivate Declare Function DestroyWindow Lib "user32" (ByVal hwnd As Long) As Long '' Windows API ConstantsPrivate Const WM_USER = & H400Private Const CW_USEDEFAULT = & H80000000 ' 'Windows API Type sPrivate Type RECT Left As Long Top As Long Right As Long Bottom As LongEnd Type '' Tooltip Window ConstantsPrivate Const TTS_NOPREFIX = & H2Private Const TTF_TRANSPARENT = & H100Private Const TTF_CENTERTIP = & H2Private Const TTM_ADDTOOLA = (WM_USER 4) Private Const TTM_ACTIVATE = WM_USER 1Private Const TTM_UPDATETIPTEXTA = (WM_USER 12) Private const twm_setmaxtipwidth = (WM_USER 24) Private const TTM_SETTIPBKCOLOR = (WM_USER 19) Private const TTM_SETTIPTEXTCOLOR = (WM_USER
20) Private Const TTM_SETTITLE = (WM_USER 32) Private Const TTS_BALLOON = & H40Private Const TTS_ALWAYSTIP = & H1Private Const TTF_SUBCLASS = & H10Private Const TTF_IDISHWND = & H1Private Const TTM_SETDELAYTIME = (WM_USER 3) Private Const TTDT_AUTOPOP = 2Private Const TTDT_INITIAL = 3 Private Const TOOLTIPS_CLASSA = " tooltips_class32 " '' Tooltip Window TypesPrivate Type TOOLINFO lSize As Long lFlags As Long hwnd As Long lId As Long lpRect As RECT hInstance As Long lpStr As String lParam As LongEnd Type Public Enum ttIconType TTNoIcon 0 TTIconInfo = 1 TTIconWarning = 2 TTIconError = 3End Enum = public Enum ttStyleEnum TTStandard TTBalloonEnd Enum 'local variable (s) to hold property value (s) Private mvarBackColor As LongPrivate mvarTitle As StringPrivate mvarForeColor As LongPrivate mvarIcon As ttIconTypePrivate mvarCentered As BooleanPrivate mvarStyle As ttStyleEnumPrivate mvarTipText As StringPrivate mvarVisibleTime As LongPrivate mvarDelayTime As L ong 'private dataPrivate m_lTTHwnd As Long' hwnd of the tooltipPrivate m_lParentHwnd As Long 'hwnd of the window the tooltip attached toPrivate ti As TOOLINFO Public Property Let Style (ByVal vData As ttStyleEnum)' used when assigning a value to the property, on the left side of an assignment. 'Syntax: X.Style = 5 mvarStyle = vDataEnd Property Public Property Get Style () As ttStyleEnum' used when retrieving value of a property, on the right side of an assignment 'Syntax:. Debug.Print X. Style style = mvarstylend property public property let center (byval vdata as boolean)
used when assigning a value to the property, on the left side of an assignment. 'Syntax: X.Centered = 5 mvarCentered = vDataEnd Property Public Property Get Centered () As Boolean' used when retrieving value of a property, on the right side of an assignment 'Syntax:. Debug.Print X.Centered Centered = mvarCenteredEnd Property Public Function Create (ByVal ParentHwnd As Long) As Boolean Dim lWinStyle As Long If m_lTTHwnd <> 0 Then DestroyWindow m_lTTHwnd End If m_lParentHwnd = ParentHwnd lWinStyle = TTS_ALWAYSTIP Or TTS_NOPREFIX '' create baloon style if desired If mvarStyle = TTBalloon Then lWinStyle = lWinStyle Or TTS_BALLOON m_lTTHwnd = CreateWindowEx (0 &, _ TOOLTIPS_CLASSA, _ vbNullString, _ lWinStyle, _ CW_USEDEFAULT, _ CW_USEDEFAULT, _ CW_USEDEFAULT, _ CW_USEDEFAULT, _ 0 &, _ 0 &, _ App.hinstance, _ 0 &) '' Now setur Tooltip Info Structure with Ti '' IF WE WANT IT centered, then set that flag If mvarCentered Then .lFlags = TTF_SUBCLASS Or TTF_CENTERTIP Or TTF_IDISHWND Else .lFlags = TTF_SUBCLASS Or TTF_IDISHWND End If '' set the hwnd prop to our parent control's hwnd .hwnd = m_lParentHwnd .lId = m_lParentHwnd '0 .hInstance = App.hInstance '.lpstr = ALREADY SET' .lpRect = lpRect .lSize = Len (ti) End With '' add the tooltip structure SendMessage m_lTTHwnd, TTM_ADDTOOLA, 0 &, ti '' if we want a title or we want an icon If Mvartitle <>
vbNullString Or mvarIcon <> TTNoIcon Then SendMessage m_lTTHwnd, TTM_SETTITLE, CLng (mvarIcon), ByVal mvarTitle End If If mvarForeColor <> Empty Then SendMessage m_lTTHwnd, TTM_SETTIPTEXTCOLOR, mvarForeColor, 0 & End If If mvarBackColor <> Empty Then SendMessage m_lTTHwnd, TTM_SETTIPBKCOLOR, mvarBackColor, 0 & End If SendMessageLong m_lTTHwnd, TTM_SETDELAYTIME, TTDT_AUTOPOP, mvarVisibleTime SendMessageLong m_lTTHwnd, TTM_SETDELAYTIME, TTDT_INITIAL, mvarDelayTimeEnd Function Public Property Let Icon (ByVal vData As ttIconType) mvarIcon = vData If m_lTTHwnd <> 0 And mvarTitle <> Empty And mvarIcon <> TTNoIcon Then SendMessage m_lTTHwnd, TTM_SETTITLE, CLng (mvarIcon), ByVal mvarTitle End IfEnd Property Public Property Get Icon () As ttIconType Icon = mvarIconEnd Property Public Property Let ForeColor (ByVal vData As Long) mvarForeColor = vData If m_lTTHwnd <> 0 Then SendMessage m_lTTHwnd, TTM_SETTIPTEXTCOLOR, MvarForeColor, 0 & End IFEND P roperty Public Property Get ForeColor () As Long ForeColor = mvarForeColorEnd Property Public Property Let Title (ByVal vData As String) mvarTitle = vData If m_lTTHwnd <> 0 And mvarTitle <> Empty And mvarIcon <> TTNoIcon Then SendMessage m_lTTHwnd, TTM_SETTITLE, CLng (mvarIcon ), ByVal mvarTitle End IfEnd Property Public Property Get Title () As String Title = ti.lpStrEnd Property Public Property Let BackColor (ByVal vData As Long) mvarBackColor = vData If m_lTTHwnd <> 0 Then SendMessage m_lTTHwnd, TTM_SETTIPBKCOLOR, mvarBackColor, 0 & End IfEnd Property Public Property Get BackColor () as long backcolor =
mvarBackColorEnd Property Public Property Let TipText (ByVal vData As String) mvarTipText = vData ti.lpStr = vData If m_lTTHwnd <> 0 Then SendMessage m_lTTHwnd, TTM_UPDATETIPTEXTA, 0 &, ti End IfEnd Property Public Property Get TipText () As String TipText = mvarTipTextEnd Property Private Sub Class_Initialize () InitCommonControls mvarDelayTime = 500 mvarVisibleTime = 5000End Sub Private Sub Class_Terminate () DestroyEnd Sub Public Sub Destroy () If m_lTTHwnd <> 0 Then DestroyWindow m_lTTHwnd End IfEnd Sub Public Property Get VisibleTime () As Long VisibleTime = mvarVisibleTimeEnd Property Public Property Let VisibleTime (ByVal lData as Long) mvarVisibleTime = lDataEnd Property Public Property Get DelayTime () as Long DelayTime = mvarDelayTimeEnd Property Public Property Let DelayTime (ByVal lData as Long) mvarDelayTime = lDataEnd Property a form, a listview control on the form, as follows : 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 Const LVM_FIRST = & H1000 & Const LVM_HITTEST = LVM_FIRST 18 Private Type POINTAPI X As Long Y As LongEnd Type Private Type LVHITTESTINFO pt As POINTAPI flags As Long iItem As Long iSubItem As LongEnd Type Dim TT As CTooltipDim m_lCurItemIndex As Long Private Sub Form_Load () With ListView1.ListItems .Add Text: = "Test item # 1" .Add Text: = "Test item # 2" .Add Text: = "Long long long test item # 3" end with set tt = new ctooltip tt.style = TTBALLOON TT.ICON =
