Подсказка при наведении курсора - VB

Option Explicit
 
Private 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 Long
Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, _
ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal Y As Long, ByVal cx As _
Long, ByVal cy As Long, ByVal wFlags As Long) 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 GetClientRect Lib "user32" (ByVal hwnd As Long, _
lpRect As RECT) As Long
Private Declare Function DestroyWindow Lib "user32" (ByVal hwnd As Long) As Long
 
Private Type RECT
        Left As Long
        Top As Long
        Right As Long
        Bottom As Long
End Type
 
Private Type TOOLINFO
    cbSize As Long
    uFlags As Long
    hwnd As Long
    uid As Long
    RECT As RECT
    hinst As Long
    lpszText As String
    lParam As Long
End Type
 
Private Const CW_USEDEFAULT = &H80000000
 
Private Const SWP_NOMOVE = &H2
Private Const SWP_NOACTIVATE = &H10
Private Const SWP_NOSIZE = &H1
Private Const HWND_NOTOPMOST = -2
Private Const HWND_TOP = 0
Private Const HWND_TOPMOST = -1
Private Const HWND_BOTTOM = 1
Private Const WS_POPUP = &H80000000
Private Const WS_EX_TOPMOST = &H8&
 
Private Const WM_USER = &H400
 
Private Const CP_ACP = 0
Private Const CP_OEMCP = 1
 
Private Const WC_COMPOSITECHECK = &H200
Private Const WC_DEFAULTCHAR = &H40
Private Const WC_DEFAULTCHECK = &H100
Private Const WC_DIALOG = 8002&
Private Const WC_DISCARDNS = &H10
Private Const WC_SEPCHARS = &H20
 
Private Const TTDT_AUTOMATIC = 0
Private Const TTDT_AUTOPOP = 2
Private Const TTDT_INITIAL = 3
Private Const TTDT_RESHOW = 1
 
Private Const TTF_ABSOLUTE = &H80
Private Const TTF_CENTERTIP = &H2
Private Const TTF_DI_SETITEM = &H8000
Private Const TTF_IDISHWND = &H1
Private Const TTF_RTLREADING = &H4
Private Const TTF_SUBCLASS = &H10
Private Const TTF_TRACK = &H20
Private Const TTF_TRANSPARENT = &H100
 
Private Const TTM_ACTIVATE = (WM_USER + 1)
Private Const TTM_ADDTOOLA = (WM_USER + 4)
Private Const TTM_ADDTOOLW = (WM_USER + 50)
Private Const TTM_ADJUSTRECT = (WM_USER + 31)
Private Const TTM_DELTOOLA = (WM_USER + 5)
Private Const TTM_DELTOOLW = (WM_USER + 51)
Private Const TTM_ENUMTOOLSA = (WM_USER + 14)
Private Const TTM_ENUMTOOLSW = (WM_USER + 58)
Private Const TTM_GETBUBBLESIZE = (WM_USER + 30)
Private Const TTM_GETCURRENTTOOLA = (WM_USER + 15)
Private Const TTM_GETCURRENTTOOLW = (WM_USER + 59)
Private Const TTM_GETDELAYTIME = (WM_USER + 21)
Private Const TTM_GETMARGIN = (WM_USER + 27)
Private Const TTM_GETMAXTIPWIDTH = (WM_USER + 25)
Private Const TTM_GETTEXTA = (WM_USER + 11)
Private Const TTM_GETTEXTW = (WM_USER + 56)
Private Const TTM_GETTIPBKCOLOR = (WM_USER + 22)
Private Const TTM_GETTIPTEXTCOLOR = (WM_USER + 23)
Private Const TTM_GETTOOLCOUNT = (WM_USER + 13)
Private Const TTM_GETTOOLINFOA = (WM_USER + 8)
Private Const TTM_GETTOOLINFOW = (WM_USER + 53)
Private Const TTM_HITTESTA = (WM_USER + 10)
Private Const TTM_HITTESTW = (WM_USER + 55)
Private Const TTM_NEWTOOLRECTA = (WM_USER + 6)
Private Const TTM_NEWTOOLRECTW = (WM_USER + 52)
Private Const TTM_POP = (WM_USER + 28)
Private Const TTM_RELAYEVENT = (WM_USER + 7)
Private Const TTM_SETDELAYTIME = (WM_USER + 3)
Private Const TTM_SETMARGIN = (WM_USER + 26)
Private Const TTM_SETMAXTIPWIDTH = (WM_USER + 24)
Private Const TTM_SETTIPBKCOLOR = (WM_USER + 19)
Private Const TTM_SETTIPTEXTCOLOR = (WM_USER + 20)
Private Const TTM_SETTITLEA = (WM_USER + 32)
Private Const TTM_SETTITLEW = (WM_USER + 33)
Private Const TTM_SETTOOLINFOA = (WM_USER + 9)
Private Const TTM_SETTOOLINFOW = (WM_USER + 54)
Private Const TTM_TRACKACTIVATE = (WM_USER + 17)
Private Const TTM_TRACKPOSITION = (WM_USER + 18)
Private Const TTM_UPDATE = (WM_USER + 29)
Private Const TTM_UPDATETIPTEXTA = (WM_USER + 12)
Private Const TTM_UPDATETIPTEXTW = (WM_USER + 57)
Private Const TTM_WINDOWFROMPOINT = (WM_USER + 16)
 
Private Const TTS_ALWAYSTIP = &H1
Private Const TTS_BALLOON = &H40
Private Const TTS_NOANIMATE = &H10
Private Const TTS_NOFADE = &H20
Private Const TTS_NOPREFIX = &H2
 
Private Const TOOLTIPS_CLASS = "tooltips_class"
Private Const TOOLTIPS_CLASSA = "tooltips_class32"
 
Dim hwndTT As Long
 
Private Sub Form_Load()
 
    Dim ti As TOOLINFO
 
    Dim uid As Long
    uid = 0
 
    Dim strTT As String * 50
    strTT = "Title"
 
    Dim strPntr As String
    strPntr = "Это первая стока подсказки." & vbCrLf & "Это вторая строка." & vbCrLf & "Это третья строка! """
 
    Dim LPTSTR As String
    LPTSTR = strPntr
 
    Dim RECT As RECT
 
    Dim RetVal As Long
 
    hwndTT = CreateWindowEx(WS_EX_TOPMOST, TOOLTIPS_CLASSA, vbNullString, WS_POPUP Or TTS_NOPREFIX Or TTS_BALLOON, CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT, Me.hwnd, 0, App.hInstance, 0)
 
    SetWindowPos hwndTT, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE Or SWP_NOACTIVATE
 
    GetClientRect Command1.hwnd, RECT
    
    ti.cbSize = Len(ti)
    ti.uFlags = TTF_CENTERTIP Or TTF_SUBCLASS
    ti.hwnd = Command1.hwnd
    ti.hinst = App.hInstance
    ti.uid = uid
    ti.lpszText = LPTSTR
    ti.RECT.Left = RECT.Left
    ti.RECT.Top = RECT.Top
    ti.RECT.Right = RECT.Right
    ti.RECT.Bottom = RECT.Bottom
 
    SendMessage hwndTT, TTM_ADDTOOLA, 0, ti
    SendMessage hwndTT, TTM_SETMAXTIPWIDTH, 0, 80
    ti.lpszText = strPntr
    SendMessage hwndTT, TTM_UPDATETIPTEXTA, 0, ti
    SendMessage hwndTT, TTM_SETTIPBKCOLOR, RGB(255, 255, 255), 0
    SendMessage hwndTT, TTM_SETTIPTEXTCOLOR, RGB(0, 0, 150), 0
    SendMessage hwndTT, TTM_UPDATETIPTEXTA, 0, ti
 
End Sub
 
Private Sub Form_Unload(Cancel As Integer)
    DestroyWindow hwndTT
 
End Sub