Voici un module permettant de mettre un dock sur un formulaire. Le code est très commenté, il est donc accessible aux débutants.
Le problème principale de ce module est qu'il effectue beaucoup de calculs et de tests et est donc très lent lorsqu'il y a beaucoup de contrôles sur le formulaire.
Vous trouverez le code source ci-dessous et également en fichier joint.
N'hésitez pas à me faire part de vos commentaires et suggestions.
Code :
'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
26/06/2007, 12h54
Dock comme Mac OSX sur un formulaire
Dock comme Mac OSX sur un formulaire
