Bonjour, je traine depuis quelques temps une classe qui permet d'afficher facilement des "Tool-Tip-Text" ("info bulles" en francais).
la base du code n'est pas de moi, celà vient de là : http://www.codeproject.com/KB/vb/balloon-tooltip.aspx
par contre je l'ai modifié pour la rendre vraiment plus facile.

A noter que celà fonctionne sous toutes plateforme windows (95 à vista) ce qui n'est pas mal. les info bulles ont un look type windows XP (pas trop moche donc) et est même multilinge (vbcrlf).

avant de mettre le code de la classe (fichier CToolTip) je vous met ici la manière dont on l'utilise :
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
    Dim TT as CtoolTip
    Set TT = New CTooltip
    TT.DelayTime = 100 '  1/10 sec pour afficher
    TT.VisibleTime = 5000 ' reste affiché 5 sec
'...
'quand on veux afficher... (dans un MouseMove par exemple)
Call TT.Display(obj.hwnd, "titre", "texte", TTIconInfo)
 
'quand on veux masquer (en sortie d'un controle par ex)
Call TT.Destroy
obj est le controle (un bouton par exemple) sur lequel est affiché le TT
d'une maniere generale, j'utilise un seul objet TT par form, vu qu'il n'est pas interessant d'en afficher 2 en même temps, comme j'en ai qu'un, j'ai pas ce probleme.
Note : on peut appeller un destroy sans risque même si la bulle n'a pas encore été appellé.

voilà, c'est simple à utiliser (a comparer de la version originale)
voici maintenant le code de la classe :
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
Option Explicit
 
Private Declare Sub InitCommonControls Lib "comctl32.dll" ()
 
''Windows API Functions
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 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 SendMessageLong Lib "USER32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function DestroyWindow Lib "USER32" (ByVal hwnd As Long) As Long
 
''Windows API Constants
Private Const WM_USER = &H400
Private Const CW_USEDEFAULT = &H80000000
 
''Windows API Types
Private Type RECT
        Left As Long
        TOp As Long
        Right As Long
        Bottom As Long
End Type
 
''Tooltip Window Constants
Private Const TTS_NOPREFIX = &H2
Private Const TTF_TRANSPARENT = &H100
Private Const TTF_CENTERTIP = &H2
Private Const TTM_ADDTOOLA = (WM_USER + 4)
Private Const TTM_ACTIVATE = WM_USER + 1
Private Const TTM_UPDATETIPTEXTA = (WM_USER + 12)
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 TTS_BALLOON = &H40
Private Const TTS_ALWAYSTIP = &H1
Private Const TTF_SUBCLASS = &H10
Private Const TTF_IDISHWND = &H1
Private Const TTM_SETDELAYTIME = (WM_USER + 3)
Private Const TTDT_AUTOPOP = 2
Private Const TTDT_INITIAL = 3
 
Private Const TOOLTIPS_CLASSA = "tooltips_class32"
 
''Tooltip Window Types
Private 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 Long
End Type
 
 
Public Enum ttIconType '<=== Ici les differentes icones possibles
    TTNoIcon = 0
    TTIconInfo = 1
    TTIconWarning = 2
    TTIconError = 3
End Enum
 
Public Enum ttStyleEnum
    TTStandard
    TTBalloon
End Enum
 
'local variable(s) to hold property value(s)
Private mvarBackColor As Long
Private mvarTitle As String
Private mvarForeColor As Long
Private mvarIcon As ttIconType
Private mvarCentered As Boolean
Private mvarStyle As ttStyleEnum
Private mvarTipText As String
Private mvarVisibleTime As Long
Private mvarDelayTime As Long
 
Private m_Show As Boolean
 
'Public mAffiche As Boolean ' affiché ou pas ?
'private data
Private m_lTTHwnd As Long ' hwnd of the tooltip
Private m_lParentHwnd As Long ' hwnd of the window the tooltip attached to
Private ti As TOOLINFO
 
Public Property Let Style(ByVal vData As ttStyleEnum)
   mvarStyle = vData
End Property
 
Public Property Get Style() As ttStyleEnum
   Style = mvarStyle
End Property
 
Public Property Let Centered(ByVal vData As Boolean)
   mvarCentered = vData
End Property
 
Public Property Get Centered() As Boolean
   Centered = mvarCentered
End Property
 
 
' la methode d'affichage nouvelle generation.
Public Sub Display(ByVal ParentHwnd As Long, ByRef titre As String, ByRef txt As String, i As ttIconType)
 If Not m_Show Then
      m_Show = True
      Title = titre
      Icon = i
      If Len(txt) > 115 Then ' nouv v3
        Dim p As Long
        p = InStr(110, txt, " ")
        If p >= 110 Then txt = Left(txt, p - 1) & vbCrLf & Mid(txt, p + 1)
      End If
      TipText = txt
      Create ParentHwnd
 End If
End Sub
 
Public Function Create(ByVal ParentHwnd As Long) As Boolean
   Dim lWinStyle As Long
 
'   If mAffiche Then Exit Function
'   mAffiche = True
 
   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 set our 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, mvarDelayTime
End 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 If
End Property
 
Public Property Get Icon() As ttIconType
   Icon = mvarIcon
End Property
 
Public Property Let ForeColor(ByVal vData As Long)
   mvarForeColor = vData
   If m_lTTHwnd <> 0 Then
      SendMessage m_lTTHwnd, TTM_SETTIPTEXTCOLOR, mvarForeColor, 0&
   End If
End Property
 
Public Property Get ForeColor() As Long
   ForeColor = mvarForeColor
End 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 If
End Property
 
Public Property Get Title() As String
   Title = ti.lpStr
End Property
 
Public Property Let BackColor(ByVal vData As Long)
   mvarBackColor = vData
   If m_lTTHwnd <> 0 Then
      SendMessage m_lTTHwnd, TTM_SETTIPBKCOLOR, mvarBackColor, 0&
   End If
End Property
 
Public Property Get BackColor() As Long
   BackColor = mvarBackColor
End 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 If
End Property
 
Public Property Get TipText() As String
   TipText = mvarTipText
End Property
 
Private Sub Class_Initialize()
   InitCommonControls
   mvarDelayTime = 200
   mvarVisibleTime = 5000
   Style = TTBalloon ' val par defaut
   Icon = TTIconInfo ' val par defaut
   m_Show = False 'pas affiché par defaut'
End Sub
 
Private Sub Class_Terminate()
   Destroy
End Sub
 
Public Sub Destroy()
m_Show = False
   If m_lTTHwnd <> 0 Then
      DestroyWindow m_lTTHwnd
      m_lTTHwnd = 0
   End If
End Sub
 
Public Property Get VisibleTime() As Long
   VisibleTime = mvarVisibleTime
End Property
 
Public Property Let VisibleTime(ByVal lData As Long)
   mvarVisibleTime = lData
End Property
 
Public Property Get DelayTime() As Long
   DelayTime = mvarDelayTime
End Property
 
Public Property Let DelayTime(ByVal lData As Long)
   mvarDelayTime = lData
End Property
 
Public Property Get Show() As Boolean
Show = m_Show
End Property
Et surtout un merci à Nayan S. Patel, l'auteur original.
edit:ajout de remarques