Sunday, July 26, 2009

Balloon Tooltips

To make balloon tooltips, make a new module then insert code following:

Option Explicit

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


Private Type TOOLINFO
cbSize As Long
dwFlags As Long
hWNd As Long
dwID As Long
rtRect As RECT
hInst As Long
lpszText As Long
lParam As Long
End Type


Private Type ICCEX
dwSize As Long
dwICC As Long
End Type

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 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 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 InitCommonControlsEx Lib "Comctl32.dll" (ByRef iccInit As ICCEX) As Long
Private Declare Function DestroyWindow Lib "user32" (ByVal hWNd As Long) As Long


Private Const HWND_TOPMOST As Long = -1
Private Const SWP_NOMOVE As Long = &H2
Private Const SWP_NOSIZE As Long = &H1


Private Const ICC_WIN95_CLASSES As Long = &HFF

Private Const TTS_ALWAYSTIP As Long = &H1
Private Const TTS_NOPREFIX As Long = &H2
Private Const TTS_BALLOON As Long = &H40
Private Const WS_EX_TOPMOST As Long = &H8&
Private Const TOOLTIPS_CLASSA As String = "tooltips_class32"
Private Const WS_POPUP As Long = &H80000000
Private Const CW_USEDEFAULT As Long = &H80000000
Private Const TTF_SUBCLASS As Long = &H10
Private Const TTF_TRANSPARENT As Long = &H100
Private Const WM_USER As Long = &H400
Private Const TTM_ADDTOOL As Long = (WM_USER + 4)


Global ghWndTip As Long, ghWndParent As Long

Public Sub StartBalloon(hWndParent As Long)
Dim hWndTip As Long, dwFlags As Long, ICEx As ICCEX


dwFlags = TTS_NOPREFIX Or TTS_ALWAYSTIP Or TTS_BALLOON

With ICEx
.dwSize = Len(ICEx)
.dwICC = ICC_WIN95_CLASSES
End With


InitCommonControlsEx ICEx
hWndTip = CreateWindowEx(WS_EX_TOPMOST, TOOLTIPS_CLASSA, "", WS_POPUP Or dwFlags, CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT, hWndParent, 0, App.hInstance, ByVal 0&)
If hWndTip = 0 Then Exit Sub
SetWindowPos hWndTip, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE


ghWndTip = hWndTip
ghWndParent = hWndParent
End Sub


Public Sub BalloonTips(hWndOwner As Long, szText As String)
Dim tiInfo As TOOLINFO


With tiInfo
.dwFlags = TTF_SUBCLASS Or TTF_TRANSPARENT
.hWNd = hWndOwner
.lpszText = StrPtr(StrConv(szText, vbFromUnicode))
.hInst = App.hInstance
GetClientRect hWndOwner, .rtRect
.cbSize = Len(tiInfo)
End With


SendMessage ghWndTip, TTM_ADDTOOL, 0&, tiInfo
End Sub


For example of its use is:

Private Sub Form_Load()
StartBalloon Form1.hWNd
BalloonTips Frame1.hWNd, Label1.Caption
End Sub


Description:
  • Code situation of tooltips balloon obliged at part of Form_Load.
  • Form1.hWNd is Form to present of balloon tooltips.
  • Frame1.hWNd is object to present of balloon tooltips.
  • Label1.Caption is text to be presented at balloon tooltips.
Every balloon tooltips will is always presented by if mouse move at such object.


No comments:

Post a Comment