DOCK (COMME SOUS MAC OSX)

'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

Télécharger le zip

26 juin 2007 07:42:29 :

Ceci est une légère mise à jour qui concerne le curseur de la souris. Ce dernier changera d'aspect lors du passagde sur les icônes du dock

26 juin 2007 12:24:02 :

Mise à jour des noms de variables pour être plus clair suite à la suggestion d'un commentaire et suppression d'une variable en fait inutile

02 juillet 2007 14:00:23 :

Cette mise à jour permet de créer une collection contenant les éléments du dock et permettant ainsi de réduire considérablement le nombre de tests lorsqu'il y a beaucoup de contrôles sur le formulaire. On gagne donc en rapidité d'exécution.

03 juillet 2007 10:34:38 :

Petite correction d'un bug, En effet lors de la fermeture du formulaire contenant le dock, la collection contenant les icônes du dock n'était pas purger, ce qui créer problème lors de l'ouverture d'un autre (ou du même) formulaire. De plus amples explications sont en commentaire dans le code.

• GESTION DE STOCK
• EXCEL <> AUTOCAD LT
• SHIFUMI EN FORMULAIRE ACCÈSS / CODE VBA
• TRANSFERT DONNÉES ACCESS
• CALCUL ENTHALPIQUE DE L'AIR HUMIDE

• TRANSPARENCE GÉNÉRALISÉE DES PICTUREBOX
• TRANSPARENCE DES PICTUREBOX
• USERFORM PLEIN ÉCRAN SOUS EXCEL VBA
• BARRE À GAUCHE DÉFILANTE
• MENU PERSONNALISÉ