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.
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.
"Ce n'est pas parce que les choses sont impossibles qu'il faut les accepter."
J'ai trouvé une solution de ce genre, mais qui m'affiche tout le chemin, alors que je ne voudrais que le dossier survolé.
et de plus, on est tributaire du nombre de dossiers dans le dirlist pour calculer la hauteur. Cela fonctionne donc assez mal
Code : Sélectionner tout - Visualiser dans une fenêtre à part
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
"Ce n'est pas parce que les choses sont impossibles qu'il faut les accepter."
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.
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 : Sélectionner tout - Visualiser dans une fenêtre à part Public TT As CtoolTipMouvement de ma souris sur le dirlistbox:
Code : Sélectionner tout - Visualiser dans une fenêtre à part
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
Module de classe nomé CtoolTip:
Code : Sélectionner tout - Visualiser dans une fenêtre à part
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
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.
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
Merci d'avance.
"Ce n'est pas parce que les choses sont impossibles qu'il faut les accepter."
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 : Sélectionner tout - Visualiser dans une fenêtre à part
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
Merci iClic, cela fonctionne sur Form_MouseMove mais par contre, j'ai "toto tutu" qui s'affichent, mais pas le nom du dossier survolé
"Ce n'est pas parce que les choses sont impossibles qu'il faut les accepter."
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
Bonjour,
Question pertinente.De Aniki
C'est justement là le problème !
Comment ne récupérer QUE le nom du dossier survolé par la souris ?
Là je n"ai pas la solution, peut-être quelqu'un autre ?
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:
Merci quand même
Code : Sélectionner tout - Visualiser dans une fenêtre à part Dir1.ToolTipText = MA_VARIABLE
"Ce n'est pas parce que les choses sont impossibles qu'il faut les accepter."
teste ça (Repertoire est une DirListBox):
Ne me demande pas d’où vient le 210, c'est expérimental !
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 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
A voir ! http://www.physafilm.fr/
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.
c'est la hauteur d'une ligne dans le DirListBox.Ne me demande pas d’où vient le 210, c'est expérimental !
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.
Soyez sympa, pensez -y
Balises[CODE]...[/CODE]
Balises[CODE=NomDuLangage]...[/CODE] quand vous mettez du code d'un autre langage que celui du forum ou vous postez.
Balises[C]...[/C] code intégré dans une phrase.
Balises[C=NomDuLangage]...[/C] code intégré dans une phrase quand vous mettez du code d'un autre langage que celui du forum ou vous postez.
Le bouton en fin de discussion, quand vous avez obtenu l'aide attendue.
......... et pourquoi pas, pour remercier, un pour celui/ceux qui vous ont dépannés.
👉 → → Ma page perso sur DVP ← ← 👈
La valeur 210 doit être ajustée (c'est le nombre de pas de la souris entre deux lignes)surtout quand on utilise l’ascenseur pour visualiser des répertoires en bas de la DirListBox.surtout quand le nombre de ligne dépasse le 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 .
A voir ! http://www.physafilm.fr/
Ton approche de résolution du problème n'est pas inintéressante, je pense qu'il faudrait y ajouter l'utilisation de .TopIndex.Envoyé par DAUDET78
Soyez sympa, pensez -y
Balises[CODE]...[/CODE]
Balises[CODE=NomDuLangage]...[/CODE] quand vous mettez du code d'un autre langage que celui du forum ou vous postez.
Balises[C]...[/C] code intégré dans une phrase.
Balises[C=NomDuLangage]...[/C] code intégré dans une phrase quand vous mettez du code d'un autre langage que celui du forum ou vous postez.
Le bouton en fin de discussion, quand vous avez obtenu l'aide attendue.
......... et pourquoi pas, pour remercier, un pour celui/ceux qui vous ont dépannés.
👉 → → Ma page perso sur DVP ← ← 👈
"Ce n'est pas parce que les choses sont impossibles qu'il faut les accepter."
A voir ! http://www.physafilm.fr/
Problème résolu avec le topindex
Et avec quelques modif pour n'avoir que le dernier répertoire de la dirlist
Code : Sélectionner tout - Visualiser dans une fenêtre à part
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
Merci à tous
Code : Sélectionner tout - Visualiser dans une fenêtre à part
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
"Ce n'est pas parce que les choses sont impossibles qu'il faut les accepter."
Vous avez un bloqueur de publicités installé.
Le Club Developpez.com n'affiche que des publicités IT, discrètes et non intrusives.
Afin que nous puissions continuer à vous fournir gratuitement du contenu de qualité, merci de nous soutenir en désactivant votre bloqueur de publicités sur Developpez.com.
Partager