Запретить окну отображаться на панели

Option Explicit
'
'ToolTip модифицированный класс - Позволяет создавать подсказки с различными стилями
'© FelixMacintosh (Антихакер32™)
'
'----------------------------------------------------------[ Enums ]
Public Enum ttStyleEnum
    TTStandard
    TTBalloon
End Enum
 
Public Enum ttDelayTimeConstants 'Константы времени задержки
    [Задержка по умолчанию] = 0
    [Повторный просмотр] = 1
    [Задержка показа] = 2
    [Начальная задержка] = 3
End Enum
 
'----------------------------------------------------------[ Types ]
Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type
 
Private Type TOOLINFO
    lSize As Long
    lFlags As Long
    lHwnd As Long
    lId As Long
    lpRect As RECT
    hInstance As Long
    lpStr As String
    lParam As Long
End Type
'----------------------------------------------------------[ Const ]
Private Const WM_USER = &H400
Private Const BACK_COLOUR As Long = "&H80000018"
Private Const CW_USEDEFAULT = &H80000000
Private Const FORE_COLOUR As Long = "&H80000017"
Private Const HWND_TOPMOST = -1
Private Const SWP_NOACTIVATE = &H10
Private Const SWP_NOMOVE = &H2
Private Const SWP_NOSIZE = &H1
Private Const TOOLTIPS_CLASSA = "tooltips_class32"
Private Const TTF_CENTERTIP = &H2
Private Const TTF_SUBCLASS = &H10
Private Const TTF_TRANSPARENT = &H100
Private Const TTM_ACTIVATE = WM_USER + 1
Private Const TTM_ADDTOOLA = (WM_USER + 4)
Private Const TTM_GETDELAYTIME = (WM_USER + 21)
Private Const TTM_SETDELAYTIME = (WM_USER + 3)
Private Const TTM_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 TTM_UPDATETIPTEXTA = (WM_USER + 12)
Private Const TTS_ALWAYSTIP = &H1
Private Const TTS_BALLOON = &H40
Private Const TTS_NOPREFIX = &H2
'----------------------------------------------------------[ WinApi ]
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 DestroyWindow Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function GetClientRect Lib "user32" (ByVal hWnd As Long, lpRect As RECT) 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 SendMessageT Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam 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 Sub InitCommonControls Lib "comctl32.dll" ()
'----------------------------------------------------------[ Varibales ]
Private mHwnd As Long
Private mblnCentered As Boolean
Private mblnMultiLine As Boolean
Private mlngBackColor As OLE_COLOR
Private mlngForeColor As OLE_COLOR
Private mlngHwndParentControl As Long
Private mlngStyle As ttStyleEnum
Private mstrText As String
Private mstrTitle As String
Private mtypToolInfo As TOOLINFO
 
Public Function Create(hWnd, Optional Title$, Optional Text$, Optional Style As ttStyleEnum, _
Optional DelayInitial& = 1, Optional DelayShow& = 10000, Optional DelayReshow& = 10000) As Boolean
    On Error GoTo CreateError
    Dim lpRect As RECT
    Dim lWinStyle As Long
 
    If mHwnd <> 0 Then
        DestroyWindow mHwnd
    End If
    lWinStyle = TTS_ALWAYSTIP Or TTS_NOPREFIX
 
    If Style = TTBalloon Then 'создать стиль шарика по желанию
        lWinStyle = lWinStyle Or TTS_BALLOON
    End If
 
    If hWnd <> 0 Then 'Родительский контрол должен быть задан первым
        mHwnd = CreateWindowEx(0&, TOOLTIPS_CLASSA, vbNullString, lWinStyle, CW_USEDEFAULT, CW_USEDEFAULT, _
        CW_USEDEFAULT, CW_USEDEFAULT, hWnd, 0&, App.hInstance, 0&)
        'сделать нашу подсказку "поверх всех окон"
        SetWindowPos mHwnd, HWND_TOPMOST, 0&, 0&, 0&, 0&, SWP_NOACTIVATE Or SWP_NOSIZE Or SWP_NOMOVE
        GetClientRect hWnd, lpRect 'получить квадрат родительского контрола
 
        With mtypToolInfo 'теперь наши подсказки в структуре
 
            If Me.Centered = True Then 'если мы хотим, чтобы он был по центру
                .lFlags = TTF_SUBCLASS Or TTF_CENTERTIP
            Else
                .lFlags = TTF_SUBCLASS
            End If
            'set the hwnd prop to our parent control's hwnd
            .lHwnd = hWnd
            .lId = 0
            .hInstance = App.hInstance
            .lpStr = Text 'ALREADY SET
            .lpRect = lpRect
        End With
        SendMessage mHwnd, TTM_ADDTOOLA, 0&, mtypToolInfo 'добавить структуру подсказки
 
        If Title <> vbNullString Then 'если мы хотим, чтобы был заголовок или значок
            SendMessage mHwnd, TTM_SETTITLE, 0, ByVal Title
        End If
 
        'Будет все черное, если вы установите его в стандартные цвета
        If ForeColor <> FORE_COLOUR Then
            SendMessage mHwnd, TTM_SETTIPTEXTCOLOR, ForeColor, 0& 'Задать цвет текста
        End If
 
        If BackColor <> BACK_COLOUR Then
            SendMessage mHwnd, TTM_SETTIPBKCOLOR, BackColor, 0& 'Задать цвет фона
        End If
 
        If MultiLine = True Then
            SendMessage mHwnd, TTM_SETMAXTIPWIDTH, 0&, 0 'Значение многострочности
        End If
    End If
    Create = True 'Бул готовности
    DelayTime([Начальная задержка]) = DelayInitial 'Интервал времени для возникновения (мс)
    DelayTime([Задержка показа]) = DelayShow 'Интервал времени отображения (мс)
    DelayTime([Повторный просмотр]) = DelayReshow
    Exit Function
CreateError:
    Create = False 'Бул ошибки !
End Function
 
Public Property Get DelayTime(dwType As ttDelayTimeConstants) As Long
 
    If (mHwnd = 0) Then
        Exit Property
    End If
    DelayTime = SendMessageT(mHwnd, TTM_GETDELAYTIME, (dwType And [Начальная задержка]), 0&)
End Property
 
Public Property Let DelayTime(dwType As ttDelayTimeConstants, dwMilliSecs As Long)
 
    If (mHwnd = 0) Then
        Exit Property
    End If
    Call SendMessageT(mHwnd, TTM_SETDELAYTIME, (dwType And [Начальная задержка]), ByVal dwMilliSecs)
End Property
 
Private Sub Class_Initialize()
    'Set some defaults
    Me.MultiLine = True
    Me.Style = TTStandard
    Me.Centered = False
    Me.HwndParentControl = 0
    Me.BackColor = vbInfoBackground 'BACK_COLOUR 'Default Back colour
    Me.ForeColor = FORE_COLOUR 'Default Fore colour
End Sub
 
Private Sub Class_Terminate()
 
    If mHwnd <> 0 Then
        DestroyWindow mHwnd
    End If
End Sub
 
Public Property Let HwndParentControl(ByVal lHwnd As Long)
    'Set the control you want the tool tip to apply to
    mlngHwndParentControl = lHwnd
End Property
 
Public Property Get HwndParentControl() As Long
    HwndParentControl = mlngHwndParentControl
End Property
 
Public Property Let Style(ByVal lngToolTipStyle As ttStyleEnum)
    'Style of the ToolTip
    mlngStyle = lngToolTipStyle
End Property
 
Public Property Get Style() As ttStyleEnum
    Style = mlngStyle
End Property
 
Public Property Let Centered(ByVal blnCentered As Boolean)
    'Want the tool tip Centered? (works well with Baloon type tips!)
    mblnCentered = blnCentered
End Property
 
Public Property Get Centered() As Boolean
    Centered = mblnCentered
End Property
 
Public Property Let ForeColor(ByVal lngForeColor As OLE_COLOR)
    'ToolTip ForeColour
    mlngForeColor = lngForeColor
End Property
 
Public Property Get ForeColor() As OLE_COLOR
    ForeColor = mlngForeColor
End Property
 
Public Property Let BackColor(ByVal lngBackColor As OLE_COLOR)
    'Tool Tip Background Colour
    mlngBackColor = lngBackColor
End Property
 
Public Property Get BackColor() As OLE_COLOR
    BackColor = mlngBackColor
End Property
 
Public Property Let Title(ByVal vData As String)
    'Tool Tip Title
    mstrTitle = vData
End Property
 
Public Property Get Title() As String
    Title = mstrTitle
End Property
 
Public Property Let Text(ByVal strText As String)
    'The Actual Tool Tip Text
    mstrText = strText
End Property
 
Public Property Get Text() As String
    Text = mstrText
End Property
 
Public Property Get MultiLine() As Boolean
    'Want the Tool tip to be able to show multi line text
    MultiLine = mblnMultiLine
End Property
 
Public Property Let MultiLine(blnMultiLine As Boolean)
    mblnMultiLine = blnMultiLine
End Property
 
Public Property Get SystemToolTipForeColor() As OLE_COLOR
    SystemToolTipForeColor = FORE_COLOUR
End Property
 
Public Property Get SystemToolTipBackColor() As OLE_COLOR
    SystemToolTipBackColor = BACK_COLOUR
End Property

Option Explicit
Dim MyToolTip As CTooltip
 
Private Sub Command1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Dim s$
 
    If Button = 2 Then
        Set MyToolTip = New CTooltip
 
        With MyToolTip
            s = "Пример подсказки" & vbCrLf & "Для особо одаренных"
            .Create Command1.hWnd, "Привет пиплы !", s, TTBalloon
        End With
    End If
End Sub