Dock (comme sous mac osx)

Soyez le premier à donner votre avis sur cette source.

Vue 9 259 fois - Téléchargée 744 fois

Description

Ceci est un code pour faire un menu dock sous Microsoft Access, il est développé en VBA. Un dock est une sorte de menu dynamique, à base d'images qui grossissent lorsque la souris passe dessus. Il réalise donc une sorte de vague si on passe d'un icône à l'autre.

Source / Exemple :


'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

Conclusion :


Le code est entièrement commenté et j'ai également expliqué comment faire pour rajouter des icônes.
Chaque ligne étant commentée, il est très facile de comprendre le fonctionnement, même pour un débutant.

Toutes les suggestions pour améliorer mon code seront les bienvenues alors n'hésitez surtout pas !!! ;)

Codes Sources

A voir également

Ajouter un commentaire

Commentaires

mictif
Messages postés
105
Date d'inscription
lundi 13 décembre 2004
Statut
Membre
Dernière intervention
14 février 2013
1 -
bonjour,
xa ne fonctionne pas super ! ca rame..............
cs_rams085
Messages postés
1
Date d'inscription
vendredi 24 mars 2006
Statut
Membre
Dernière intervention
4 juillet 2007
-
J'ai un petit problème avec mon code : au bout d'un certain temps d'inactivité, lorsque je reviens sur le dock, les images disparaissent. Quelqu'un pourrait-il m'aider ??
cs_Patrice99
Messages postés
1222
Date d'inscription
jeudi 23 août 2001
Statut
Membre
Dernière intervention
9 septembre 2018
-
Excellent ! presqu'aussi jolie que le contrôle équivalent de certains sites vidéos en flash, et le code est bien présenté, bravo.
yrt007
Messages postés
13
Date d'inscription
samedi 31 juillet 2004
Statut
Membre
Dernière intervention
17 août 2010
-
Bonjour
Tes noms de variables sont ... abscons ! ;o)
Je normaliserais et mettrais des noms significatifs (la constante "a" deviendrait "Cst_Ecart_Inter_Icone" par exemple) ! d'expèrience, ca aide qd tu lis un source qui n'est pas de toi !
Sinon beau boulot !

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.