Problème avec info bulle [Résolu]

[petit rabot]

Bonjour,
je recherche comment afficher le nom des dossiers d'un dirlistbox que la souris survole dans une info bulle. J'ai fait plusieurs recherche sur internet, mais rien de bien concluant.
Merci d'avance.

[petit rabot]

J'ai trouvé une solution de ce genre, mais qui m'affiche tout le chemin, alors que je ne voudrais que le dossier survolé.

Code :

1
2
3
4
5
6
7
Private Sub Dir1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Dim Ligne As Byte
 
    Ligne = Y / Dir1.Height * 1
    Dir1.ToolTipText = Dir1.List(Ligne + Dir1.TopIndex)
 
End Sub

et de plus, on est tributaire du nombre de dossiers dans le dirlist pour calculer la hauteur. Cela fonctionne donc assez mal

[iclic]

Bonjour,

Essaie ceci, tu verras si cela te convient

bulle.zip

N.B:touvé sur DVP,mais je ne sais plus quel en est l'auteur.

[petit rabot]

Bonjour, et merci iClic pour ton aide. J'avais bien trouvé cette source, mais elle me paraissait un peu compliquer pour ce que je veux réaliser. Néanmoins, j'ai essayé ce weekend de la mettre en oeuvre, mais rien ne se passe. Lorsque je survole mon dirlistbox, rien ne s'affiche.

Voici mon code:

Déclaration de la variable

Code :

Public TT As CtoolTip

Code :

1
2
3
4
5
6
7
Private Sub Form_Load()
 
    Set TT = New CtoolTip
    TT.DelayTime = 100 '  1/10 sec pour afficher
    TT.VisibleTime = 5000 ' reste affiché 5 sec
 
End Sub

Mouvement de ma souris sur le dirlistbox:

Code :

1
2
3
4
5
Private Sub Dir1_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
 
    Call TT.Display(Dir1.hwnd, "toto", "tutu", TTIconInfo)
 
End Sub

Module de classe nomé CtoolTip:

Code :

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

De plus, ce code permet d'afficher des info bulles avec un style "Balloon", mais si quelqu'un à une idée avec le style classique, cela me va parfaitement.
Merci d'avance.

[iclic]

Bonjour petit rabot,

Tiens! Chez moi cela fonctionne parfaitement.

Tu n'aurais pas une autre variable ou procédure appelée TT ou commençant par TT qui prêterait à confusion ?

Essaie aussi avec ceci

Code :

1
2
3
4
5
6
 
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
 
    Call TT.Display(Dir1.hwnd, "toto", "tutu", TTIconInfo)
 
End Sub

[petit rabot]

Merci iClic, cela fonctionne sur Form_MouseMove mais par contre, j'ai "toto tutu" qui s'affichent, mais pas le nom du dossier survolé

[iclic]

Bonjour,

"Toto" c'est le nom donné ou du libellé donné à la bulle,
remplacer "tutu" par la variable du dossier survolé de la 'dir à afficher

Excuse c'est l'inverse,
"Tutu" c'est le nom donné ou du libellé donné à la bulle,
remplacer "totà" par la variable du dossier survolé de la 'dir à afficher

[Aniki]

Envoyé par iclic

remplacer "totà" par la variable du dossier survolé de la 'dir à afficher

C'est justement là le problème !
Comment ne récupérer QUE le nom du dossier survolé par la souris ?

[iclic]

Bonjour,

De Aniki

C'est justement là le problème !
Comment ne récupérer QUE le nom du dossier survolé par la souris ?

Question pertinente.

Là je n"ai pas la solution, peut-être quelqu'un autre ?

[petit rabot]

Si j'avais trouvé la VARIABLE qui me donne le dossier survolé, je ne me serais pas embêté, et j'aurais mis un bout de code de ce type:

Code :

Dir1.ToolTipText = MA_VARIABLE

Merci quand même

[DAUDET78]

teste ça (Repertoire est une DirListBox):

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
 
Dim Nmin% ' Indice minimum de DirListBox
 
Private Sub repertoire_Change()
FichierVu.FileName = Repertoire.Path
RepertoireChoisi.Caption = Repertoire.Path
' détermination de l'indice minimum négatif
Nmin% = 0
Do While Repertoire.List(Nmin%) <> ""
    Nmin% = Nmin% - 1
Loop
End Sub
 
Private Sub Repertoire_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Repertoire.ToolTipText= Repertoire.List(Y \ 210 + Nmin% + 1) 
End Sub

Ne me demande pas d’où vient le 210, c'est expérimental !

[ProgElecT]

Salut

Noms donnés aux 2 autres composants:
un Label RepertoireChoisi, un FileListBox FichierVu.
Chez moi cela ne fonctionne pas toujours, surtout quand le nombre de ligne dépasse le DirListBox.

Ne me demande pas d’où vient le 210, c'est expérimental !

c'est la hauteur d'une ligne dans le DirListBox.
Souvent pour trouver cette valeur je mes un Label Autosize=True, Apperence = 0 (Flat) et BorderStyle = 1 (FixedSingle) , tous les paramètres Police identique au DirListBox, la hauteur du Label ainsi paramétré tombe souvent à la mesure recherchée.

[DAUDET78]

Envoyé par ProgElecT

Chez moi cela ne fonctionne pas toujours,

La valeur 210 doit être ajustée (c'est le nombre de pas de la souris entre deux lignes)

surtout quand le nombre de ligne dépasse le DirListBox.

surtout quand on utilise l’ascenseur pour visualiser des répertoires en bas de la DirListBox.
Ce n'était qu'une idée de départ pour récupérer le nom du répertoire. On peut certainement améliorer .

[ProgElecT]

Envoyé par DAUDET78

Ce n'était qu'une idée de départ pour récupérer le nom du répertoire. On peut certainement améliorer .

Ton approche de résolution du problème n'est pas inintéressante, je pense qu'il faudrait y ajouter l'utilisation de .TopIndex.

[petit rabot]

Merci Daudet78 de ta réponse, cela fonctionne jusqu'à ce que je fasse défiler la dirlist. Mais c'est déjà un début...
Pour cette valeur:

Envoyé par DAUDET78

Ne me demande pas d’où vient le 210, c'est expérimental !

J'avais déjà calculé la hauteur approximative d'une ligne qui est de 240 chez moi.
Affaire à suivre.

[DAUDET78]

Envoyé par petit rabot

cela fonctionne jusqu'à ce que je fasse défiler la dirlist.

Regarde la piste donnée en #14 par ProgElecT

J'avais déjà calculé la hauteur approximative d'une ligne qui est de 240 chez moi.

Cela doit dépendre de la fonte utilisée

[petit rabot]

Problème résolu avec le topindex

Code :

1
2
3
4
5
6
7
8
Public Nmin%
 
Private Sub Dir1_Change()
Nmin% = 0
    Do While Dir1.List(Nmin%) <> ""
        Nmin% = Nmin% - 1
    Loop
End Sub

Et avec quelques modif pour n'avoir que le dernier répertoire de la dirlist

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Private Sub Dir1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
 
Dim CutBulle As Variant
Dim NbCut As Integer
    CutBulle = Split(Dir1.List(Y \ 240 + Nmin% + 1 + Dir1.TopIndex), "\")
    NbCut = UBound(CutBulle)
    If NbCut = -1 Then
        GoTo Line1
    Else
        Dir1.ToolTipText = CutBulle(NbCut)
    End If
Line1:
 
End Sub

Merci à tous