Всплывающая подсказка (ToolTipText)

[X-BOND]

Как это осуществить прогроаммно (допустим, на несколько секунд). В частности возле значка в трее, как у WinXP.
Спасибо

[mvandrew]

Я для того, чтобы показывать подсказку у тех объектов, для которых не предусмотрен Hint, открываю OnTop окно стилизованное под Хинт подсказки, потом оно само закрывается через несколько секунд. Можешь описать специальный класс под это дело.

[X-BOND]

Извиняюсь, но не совсем понял. Что такое Hint?
Можно примерчик.

[mvandrew]

Hint - это и есть всплывающая подсказка. Примера на ВБ подходящего сейчас не могу прислать. Просто посмотри как работать с классами. Тебе нужен наследник класса формы, который будет отображать подсказку. Подобный пример был, кажется, на http://www.sources.ru/. Посмотри внимательно. Только вот я точно не помню на каком языке на ВБ, или С++. В любом случае, переписать по аналогии не сложно - они все очнь похожи. Удачи.

[Александр Андреев]

Классная статейка есть на http://msdn.microsoft.com/msdnmag/issues/02/11/CQA/ но она под .Net заточена.

[X-BOND]

Спасибо.
Немного покапался и с различных примеров склепал свой класс.

Вот он:

Код: Выделить всё

Option Explicit

Private Declare Function Shell_NotifyIcon Lib "shell32.dll" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, lpData As NOTIFYICONDATA) As Long
Private Declare Function SetForegroundWindow Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function GetFileVersionInfoSize Lib "version.dll" Alias "GetFileVersionInfoSizeA" (ByVal lptstrFilename As String, lpdwHandle As Long) As Long
Private Declare Function GetFileVersionInfo Lib "version.dll" Alias "GetFileVersionInfoA" (ByVal lptstrFilename As String, ByVal dwHandle As Long, ByVal dwLen As Long, lpData As Any) As Long
Private Declare Function VerQueryValue Lib "version.dll" Alias "VerQueryValueA" (pBlock As Any, ByVal lpSubBlock As String, lpBuffer As Any, nVerSize As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)

Enum ICON_FLAG
ICON_NONE = &H0
ICON_INFO = &H1
ICON_WARNING = &H2
ICON_ERROR = &H3
ICON_GUID = &H5
ICON_ICON_MASK = &HF
ICON_NOSOUND = &H10
End Enum
   
Enum BALLOON
WM_USER = &H400
NIN_BALLOONSHOW = (WM_USER + 2)
NIN_BALLOONHIDE = (WM_USER + 3)
NIN_BALLOONTIMEOUT = (WM_USER + 4)
NIN_BALLOONUSERCLICK = (WM_USER + 5)
End Enum

Enum UF
NIF_MESSAGE = &H1
NIF_ICON = &H2
NIF_TIP = &H4
End Enum
   
Enum NIM_MODE
NIM_STATE = &H8
NiM_INFO = &H10
NIM_ADD = &H0
NIM_MODIFY = &H1
NIM_DELETE = &H2
End Enum
   
Enum CallMess
WM_MOUSEMOVE = &H200
WM_LBUTTONDOWN = &H201
WM_LBUTTONUP = &H202
WM_LBUTTONDBLCLK = &H203
WM_RBUTTONDOWN = &H204
WM_RBUTTONUP = &H205
WM_RBUTTONDBLCLK = &H206
WM_MBUTTONDOWN = &H207
WM_MBUTTONUP = &H208
WM_MBUTTONDBLCLK = &H209
WM_SETFOCUS = &H7
WM_KEYDOWN = &H100
WM_KEYFIRST = &H100
WM_KEYLAST = &H108
WM_KEYUP = &H101
End Enum

Private Type GUID
   Data1 As Long
   Data2 As Integer
   Data3 As Integer
   Data4(7) As Byte
End Type
   
Private Type NOTIFYICONDATA
cbSize As Long
hWnd As Long
uID As Long
uFlags As UF
uCallbackMessage As CallMess
hIcon As Long
szTip As String * 128
dwState As Long
dwStateMask As Long
szInfo As String * 256
uTimeoutAndVersion As Long
szInfoTitle As String * 64
dwInfoFlags As Long
guidItem As GUID
End Type

Private NID As NOTIFYICONDATA
Private NOTIFYICONDATA_SIZE As Long
Private Const NOTIFYICONDATA_V1_SIZE As Long = 88  'pre-5.0 structure size
Private Const NOTIFYICONDATA_V2_SIZE As Long = 488 'pre-6.0 structure size
Private Const NOTIFYICONDATA_V3_SIZE As Long = 504 '6.0+ structure size
Private Const APP_SYSTRAY_ID = 888 'unique identifier
Private Const NIS_HIDDEN = &H1
Private Const NIS_SHAREDICON = &H2
Private Const NIM_VERSION = &H5
Private Const NIM_SETVERSION = &H4
Private Const NOTIFYICON_VERSION = &H3
Private Const WM_NULL = &H0

Private m_hWnd As Long
Private m_Icon As Long
Private m_ToolTipText As String
   
Public Enum TrayIcon_Mouse
TRAYICON_MOUSE_NONE = 0
TRAYICON_MOUSE_LEFTDOWN = 1
TRAYICON_MOUSE_LEFTUP = 2
TRAYICON_MOUSE_LEFTDBLCLICK = 3
TRAYICON_MOUSE_RIGHTDOWN = 4
TRAYICON_MOUSE_RIGHTUP = 5
TRAYICON_MOUSE_RIGHTDBLCLICK = 6
End Enum

Public Event OnIcon(MouseButton As Integer)
   
Public Property Get hWnd() As Long
hWnd = m_hWnd
End Property

Public Property Let hWnd(ByVal NewValue As Long)
m_hWnd = NewValue
End Property

Public Property Get Icon() As Long
Icon = m_Icon
End Property

Public Property Let Icon(ByVal NewValue As Long)
m_Icon = NewValue
End Property

Public Property Get ToolTipText() As String
ToolTipText = m_ToolTipText
End Property

Public Property Let ToolTipText(ByVal NewValue As String)
m_ToolTipText = NewValue
End Property

Public Sub Add()
   
If NOTIFYICONDATA_SIZE = 0 Then SetShellVersion
     
With NID

.cbSize = NOTIFYICONDATA_SIZE
.hWnd = m_hWnd
.uID = APP_SYSTRAY_ID
.uFlags = NIF_MESSAGE Or NIF_ICON Or NIF_TIP
.dwState = NIS_SHAREDICON
.hIcon = m_Icon
.uCallbackMessage = WM_MOUSEMOVE
.szTip = m_ToolTipText & vbNullChar
.uTimeoutAndVersion = NOTIFYICON_VERSION
     
End With
   
Call Shell_NotifyIcon(NIM_ADD, NID)
Call Shell_NotifyIcon(NIM_SETVERSION, NID)
     
End Sub

Public Sub Modify()
   
With NID
.hIcon = m_Icon
.szTip = Left$(m_ToolTipText, 63) & Chr$(0)
.uFlags = NIF_TIP + NIF_ICON
.cbSize = Len(NID)
End With

Call Shell_NotifyIcon(NIM_MODIFY, NID)
     
End Sub

Public Sub Remove()

If NOTIFYICONDATA_SIZE = 0 Then SetShellVersion
     
With NID
.cbSize = NOTIFYICONDATA_SIZE
.hWnd = m_hWnd
.uID = APP_SYSTRAY_ID
End With
   
Call Shell_NotifyIcon(NIM_DELETE, NID)
     
End Sub

Public Sub CallEvent(X As Single, Y As Single)
If Y Then Exit Sub
     

Dim MouseButton As Integer
MouseButton = (X And &HFF) / Screen.TwipsPerPixelX
   
RaiseEvent OnIcon(MouseButton)
     
End Sub

Public Sub CallPopupMenu(Window As Form, PopMenu As Menu, Optional Flags, Optional X, Optional Y, Optional DefMenu)
     
SetForegroundWindow m_hWnd
Window.PopupMenu PopMenu, Flags, X, Y, DefMenu
PostMessage m_hWnd, WM_NULL, 0, 0

End Sub

Public Sub ModifyToolTip(ByVal Title As String, ByVal Text As String, ByVal IconIndex As ICON_FLAG)
Dim NID As NOTIFYICONDATA

If NOTIFYICONDATA_SIZE = 0 Then SetShellVersion
   
With NID
.cbSize = NOTIFYICONDATA_SIZE
.hWnd = m_hWnd
.uID = APP_SYSTRAY_ID
.uFlags = NiM_INFO
.dwInfoFlags = IconIndex
.uTimeoutAndVersion = 1
.szInfoTitle = Title & vbNullChar
.szInfo = Text & vbNullChar
End With

Call Shell_NotifyIcon(NIM_MODIFY, NID)

End Sub

Private Sub SetShellVersion()
Select Case True
Case IsShellVersion(6)
NOTIFYICONDATA_SIZE = NOTIFYICONDATA_V3_SIZE '6.0+ structure size
Case IsShellVersion(5)
NOTIFYICONDATA_SIZE = NOTIFYICONDATA_V2_SIZE 'pre-6.0 structure size
Case Else
NOTIFYICONDATA_SIZE = NOTIFYICONDATA_V1_SIZE 'pre-5.0 structure size
End Select
End Sub
Private Function IsShellVersion(ByVal version As Long) As Boolean

Dim nBufferSize As Long
Dim nUnused As Long
Dim lpBuffer As Long
Dim nVerMajor As Integer
Dim bBuffer() As Byte
   
Const sDLLFile As String = "shell32.dll"
   
nBufferSize = GetFileVersionInfoSize(sDLLFile, nUnused)
If nBufferSize > 0 Then
ReDim bBuffer(nBufferSize - 1) As Byte
Call GetFileVersionInfo(sDLLFile, 0&, nBufferSize, bBuffer(0))
If VerQueryValue(bBuffer(0), "\", lpBuffer, nUnused) = 1 Then
CopyMemory nVerMajor, ByVal lpBuffer + 10, 2
IsShellVersion = nVerMajor >= version
End If: End If
 
End Function


Здесь также грамотно реализовано высплывающее меню (PopUp). Оно не остается, если кликнуть в другом месте.
Но этот класс заточен под NT. Всплывающая подсказка не будет работать в Win9.x системах
Я думаю найдутся люди, которые этот код модифицируют и исправят ошибки