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
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
|
'Développer par Cyril DAVID, étudiant à l'ISIMA, en collaboration avec David CHAPUT
'ISIMA : Institut Supérieur d'Informatique, de Modélisation et de leurs Applications
'Pour toute question sur ce code, il est possible de me contacter aux adresses suivantes :
'Cyril.David@tele2.fr
'rams085@hotmail.com
'rams085@hotmail.fr
'cyril.david@poste.isima.fr
'Certaines adresses sont amenées à disparaître donc n'hésitez pas à me contacter sur
'toute les adresses si je ne répond pas
'**************************************************************************************************
'ATTENTION :
' - Il est nécessaire que tous les éléments du dock aient le même préfixe pour pouvoir les distingués
' des autres contrôles. Ce préfixe doit être sauvegardé dans la constante "Cst_prefixe".
' - Il est important que les éléments soit numérotées dans l'ordre que l'on souhaite qu'elles
' apparaissent. La première devant obligatoirement commencer par "0".
'Si vous désirez modifier le nombre d'images, il vous suffit de :
' - modifier la constante "Cst_nb_icones"
' - réordonner les images
'Si le nombre d'image dépasse 10, il faut numéroter toutes les images sur 2 caractères et
'partout ou la fonction "right" est appelée, mettre "2" à la place de "1" (ex : Right(im.Name,2))
'**************************************************************************************************
Option Compare Database
'Constante représentant l'écart entre les icônes
Const Cst_ecart As Integer = 15
'Constante représentant la taille maximum lors du zoom
Const Cst_taille_max As Integer = 1500
'Constante représentant la taille intermédiaire
Const Cst_taille_intermediaire As Integer = 1000
'Constante représentant le déplacement vertical lors du zoom
Const Cst_dplct_vertical As Integer = 80
'Constante représentant le facteur de zoom
Const Cst_facteur_zoom As Double = 1.05
'Constante représentant le nombre d'icônes
Const Cst_nb_icones As Integer = 8
'Constante représentant le préfixe attribué à tout les élément du dock
'Il est déconseillé d'utiliser le préfixe "Image" puisque chaque objet
'image rajouté aura ce préfixe par défaut
Const Cst_prefixe As String = "Image_"
'Constante représentant la taille du préfixe en nombre de caractère
Const Cst_taille_prefixe As Integer = 6
'Variables de sauvegarde des dimensions des images
Dim Hauteur As Long
Dim Largeur As Long
'Variable de sauvegarde du nom de l'image de référence
Dim Nom_reference As String
'Variable de sauvegarde de la position de l'image de référence
Dim Position_verticale As Long
Dim Position_horizontale As Long
'Dans tous le module, la variable "formulaire" correspond au formulaire sur lequel on veut
'appliquer la fonction. Quand on fait appel aux fonctions dans un formulaire, il suffit
'de mettre "Me" en paramètre
'*****************************************************************************
'* Procédure permettant le positionnement horizontal des images *
'* Le positionnement se fait par rapport à la première image. *
'* Il suffit donc de placer correctement la première image sur le formulaire *
'* pour que les autres se placent correctement. *
'*****************************************************************************
Private Sub Position_X(formulaire As Form)
Dim im As Control
Dim cpt As Integer
Dim i As Integer
Dim position(Cst_nb_icones) As Long
'Sauvegarde dans un tableau interne à la fonction des tailles des images.
'Ceci permet de pouvoir positionner dynamiquement les images.
'En effet, à chaque fois que l'on appel cette fonction, la tailles des images peut
'avoir changer, suivant si elles sont zoomées ou non.
For Each im In formulaire.Controls
'Vérification pour savoir s'il s'agit bien d'un élément du dock
If Left(im.Name, Cst_taille_prefixe) = Cst_prefixe Then
position(Right(im.Name, 1)) = im.Width
End If
Next
'Calcul de leur position et positionnement
'Formule de calcul :
' position = nombre d'image précédente * écart entre les images
' + position de la première image
' + somme des largeurs des images précédentes
For Each im In formulaire.Controls
'Vérification pour savoir s'il s'agit bien d'un élément du dock
If Left(im.Name, Cst_taille_prefixe) = Cst_prefixe Then
If im.Name <> Nom_reference Then
cpt = Right(im.Name, 1)
im.Left = cpt * Cst_ecart + Position_horizontale
For i = 0 To cpt - 1
im.Left = im.Left + position(i)
Next i
End If
im.SizeMode = acOLESizeZoom
End If
Next
End Sub
'************************************************
'* Positionnement verticale des images, *
'* se base sur la position de la première image *
'************************************************
Private Sub Position_Y(formulaire As Form)
Dim im As Control
For Each im In formulaire.Controls
'Vérification pour savoir s'il s'agit bien d'un élément du dock
If Left(im.Name, Cst_taille_prefixe) = Cst_prefixe Then
im.Top = Position_verticale
End If
Next
End Sub
'****************************************
'* Dézoom des images *
'****************************************
Private Sub Dezoom(im As Control)
With im
.Width = .Width / Cst_facteur_zoom
.Height = .Height / Cst_facteur_zoom
.Top = .Top + Cst_dplct_vertical
End With
End Sub
'*************************************
'* Zoom des images *
'*************************************
Private Sub Zoom(im As Control)
With im
.Width = .Width * Cst_facteur_zoom
.Height = .Height * Cst_facteur_zoom
.Top = .Top - Cst_dplct_vertical
End With
End Sub
'**************************************************************
'* Réinitialisation des images sauf les deux qui sont zoomées *
'* (1 grand zoom + 1 zoom intermédiaire) *
'* Sert uniquement pour les images des extrémités *
'**************************************************************
Private Sub Init_Sauf_2(im1 As String, im2 As String, formulaire As Form)
Dim im As Control
For Each im In formulaire.Controls
'Vérification pour savoir s'il s'agit bien d'un élément du dock
If Left(im.Name, Cst_taille_prefixe) = Cst_prefixe Then
If im.Name <> im1 And im.Name <> im2 Then
If im.Width > Largeur Then
Call Dezoom(im)
End If
End If
End If
Next
End Sub
'***************************************************************
'* Réinitialisation des images sauf les trois qui sont zoomées *
'* (1 grand zoom + 2 zoom intermédiaire) *
'* Sert uniquement pour les images du milieu *
'***************************************************************
Private Sub Init_Sauf_3(im1 As String, im2 As String, im3 As String, formulaire As Form)
Dim im As Control
For Each im In formulaire.Controls
'Vérification pour savoir s'il s'agit bien d'un élément du dock
If Left(im.Name, Cst_taille_prefixe) = Cst_prefixe Then
If im.Name <> im1 And im.Name <> im2 And im.Name <> im3 Then
If im.Width > Largeur Then
Call Dezoom(im)
End If
End If
End If
Next
End Sub
'*****************************************************************************
'* Procédure à appeler au chargement du formulaire *
'* Sert au sauvegarde des paramètre initiaux et au positionnement des images *
'*****************************************************************************
'Explication des variables de paramètre :
' - DL : Dimension Largeur de l'image de référence (.Width)
' - DH : Dimension Hauteur de l'image de référence (.Height)
' - PV : Position Verticale de l'image de référence (.Top)
' - PH : Position Horizontale de l'image de référence (.Left)
' - Nom_reference : nom de l'image de référence (.Name)
Public Sub Form_(DL As Integer, DH As Integer, PV As Long, PH As Long, n As String, formulaire As Form)
Dim im As Control
Dim cpt As Integer
'Sauvegarde des informations de l'image de référence
Largeur = DL
Hauteur = DH
Position_verticale = PV
Position_horizontale = PH
Nom_reference = n
'Positionnement des images (par rapport à la première image)
Call Position_Y(formulaire)
Call Position_X(formulaire)
End Sub
'*********************************************************************************
'* Procédure à appeler sur "souris déplacer" dans la partie détail du formulaire *
'* Elle sert à réinitialiser les images (zoom et position) *
'*********************************************************************************
Public Sub Detail(formulaire As Form)
Dim im As Control
'On dézoom chaque image jusqu'à atteindre sa taille initiale
For Each im In formulaire.Controls
'Vérification pour savoir s'il s'agit bien d'un élément du dock
If Left(im.Name, Cst_taille_prefixe) = Cst_prefixe Then
If im.Width > Largeur Then
Call Dezoom(im)
End If
End If
Next
'On repositionne les images
Call Position_X(formulaire)
End Sub
'********************************************
'* Initialisation des images *
'* A mettre sur "perte focus" du formulaire *
'********************************************
Public Sub Focus(formulaire As Form)
Dim im As Control
'On réinitialise les images à leur taille et positions de départ
For Each im In formulaire.Controls
'Vérification pour savoir s'il s'agit bien d'un élément du dock
If Left(im.Name, Cst_taille_prefixe) = Cst_prefixe Then
im.Width = Largeur
im.Height = Hauteur
End If
Next
Call Position_Y(formulaire)
Call Position_X(formulaire)
End Sub
'***********************************************************************
'* Procédure effetuant les zooms sur les images. *
'* A appeler sur "souris déplacée" pour les images de chaque extrémité *
'***********************************************************************
'Définition des variables de paramètre :
' - im1 : image sur laquelle pointe la souris (sur laquelle on appel la procédure)
' - im2 : image voisine de la précédente (2ème image si on est sur la 1ère,
' avant dernière image s'il on est sur la dernière
Public Sub Image_df(im1 As Control, im2 As Control, formulaire As Form)
If im1.Width <= Cst_taille_max Then
'Zoom de l'image sur laquelle la souris pointe
Call Zoom(im1)
'Si l'image voisine est plus petite que la taille intermédiaire on la zoom
If im2.Width < Cst_taille_intermediaire Then
Call Zoom(im2)
'Sinon on la dézoom
Else
Call Dezoom(im2)
End If
'On initialise les autres images
Call Init_Sauf_2(im1.Name, im2.Name, formulaire)
'Repositionnement horizontal des images
Call Position_X(formulaire)
End If
DoEvents
End Sub
'*************************************************************
'* Procédure effetuant les zooms sur les images. *
'* A appeler sur "souris déplacée" pour les images du milieu *
'*************************************************************
'Explication des variables de paramètre :
' - im1 : image sur laquelle la souris pointe (sur laquelle on appel la procédure)
' - im2 : image précédent im1
' - im3 : image suivant im1
'Rq : Inverser im2 et im3 et sans importance, je conseil cependant de garder toujours le
' même ordre pour éviter de se mélanger
Public Sub Image_(im1 As Control, im2 As Control, im3 As Control, formulaire As Form)
If im1.Width <= Cst_taille_max Then
'Zoom de l'image sur laquelle la souris pointe
Call Zoom(im1)
'Si l'image précédente est plus petite que la taille intermédiaire on la zoom
If im2.Width < Cst_taille_intermediaire Then
Call Zoom(im2)
'Sinon on la dézoom
Else
Call Dezoom(im2)
End If
'Si l'image suivante est plus petite que la taille intermédiaire on la zoom
If im3.Width < Cst_taille_intermediaire Then
Call Zoom(im3)
'Sinon on la dézoom
Else
Call Dezoom(im3)
End If
'Réinitialisation des autres images
Call Init_Sauf_3(im2.Name, im1.Name, im3.Name, formulaire)
'Repositionnement horizontal des images
Call Position_X(formulaire)
End If
DoEvents
End Sub |
Dock comme Mac OSX sur un formulaire
Répondre avec citation
Partager