Hit-Parade .VB Research Center . Compteur
Accueil ~  Code ~  Programmes ~  Api ~  Forum ~  Cours ~  Livres ~  Quiz ~  Annuaire
~ Edito ~
12/03/2006 @ 13:39
Depuis la dernière mise à jour (qui remonte à... oulala plusieurs mois), un petit ménage de printemps s'impose. Ca tombe bien, c'est presque la période.
Au menu, et progressivement sur les jours à venir, rafraîchissement de plusieurs fonctions et procédures, nouvelles APIs et nouveaux programmes.

~ Rechercher ~

  

~ Annuaire VB ~
 Rechercher un site :
  

~ Partenaires ~

Divers : frmChoiceBox
Création d'une boîte de dialogue permettant des choix étendus avec gestion de time-out et autres fonctionnalités.
(Consulté 21986 fois.)

La "ChoiceBox" affiche une fenêtre à partir de laquelle l'utilisateur pourra faire un choix. C'est une sorte de "MsgBox" améliorée qui possède plusieurs propriétés utiles :

- Possibilité de définir plus de deux boutons,
- Définition de la position d'affichage de la fenêtre,
- Alignement du texte affiché,
- Fermeture automatique sur un délai choisi,
- Association d'image à chaque bouton.

Pour utiliser correctement cette fenêtre, il faut l'inclure dans un projet. Une seule ligne de code suffit pour appeler la fenêtre. Attention toutefois, puisque la fonction est déclarée dans une fenêtre, il faut préciser le nom de celle-ci lors de l'appel.

Function ChoiceBox(stTexte As String, _
                   varBouton, _
                   Optional stTitre As String = vbNullString, _
                   Optional XPos As Single = -1, _
                   Optional YPos As Single = -1, _
                   Optional lgAlign As AlignmentConstants = vbLeftJustify, _
                   Optional lgDefault As Long = 1, _
                   Optional lgTimeOut As Long = 0, _
                   Optional imlTmp As ImageList, _
                   Optional tabImlKey) As Long

stTexte, texte à afficher dans la fenêtre (en théorie, pas de limitation de longueur... mais en pratique, un texte trop grand ne s'affichera pas entièrement).
varBouton, tableau de boutons. Le tableau ne doit pas être vide. Il contient le texte associé à chaque bouton, ils sont affichés dans l'ordre du tableau (de gauche à droite). Les caractères "&" sont autorisés pour faire des accès rapides.
stTitre, titre de la fenêtre.
XPos, position horizontale de la fenêtre. Si la valeur est -1, la fenêtre est centrée horizontalement.
YPos, position verticale de la fenêtre. Si la valeur est -1, la fenêtre est centrée verticalement.
lgAlign, alignement du texte (stTexte). Valeurs possibles : centré, droite ou gauche.
lgDefault, bouton associé par défaut à l'action de la touche [Entrée].
lgTimeOut, temps d'attente en milli-secondes avant fermeture automatique de la fenêtre. Lorsque la fenêtre se ferme automatiquement, cela correspond à sélectionner le bouton par défaut (lgDefault).
imlTmp, indique la liste d'image (contrôle ImageList) à utiliser pour placer des images dans les boutons.
tabImlKey, tableau de clés. Chaque clé correspond à une image dans la liste précédente. Il doit y avoir autant de clé que de boutons (le tableau doit avoir la même taille que varBouton).

La fonction retourne un entier qui indique le bouton sélectionné. 1 si c'est le premier bouton, 2 pour le second, ...

En mode création, voici l'aspect de la fenêtre :

Voici un exemple de ce que l'on peut obtenir à l'éxecution :

Et le code pour afficher cette fenêtre :

lgRep = frmChoiceBox.ChoiceBox( _
           "Sous quel forme désirez-vous consulter le résultat?", _
           Array("Texte simple", "Tableau", "Export Excel"), _
           "Résultat traitement", , , _
           vbCenter, , , _
           imlTemp, _
           Array("kTexte", "kTableau", "kExcel"))

La fenêtre s'adapte automatiquement en fonction du nombre de bouton à afficher. Ces derniers sont affichés de manière régulière sur la fenêtre.
De même, si on choisit d'afficher des images dans les boutons, ils sont agrandis pour pouvoir tout faire rentrer, et la fenêtre est également agrandie.
Certains tests n'ont pas été prévu, et il est possible que pour certaines utilisations, des erreurs apparaissent. Vous devrez donc les mettre en place en fonction de vos besoins.

Option Explicit
' Variable contenant le résultat de la ChoiceBox
Private lgResChoix As Long

Private Sub
cmdChoice_Click(Index As Integer)
' Enregistre l'index du bouton choisit
lgResChoix = Index + 1
Unload Me
End Sub

Private Sub
tmrOut_Timer()
' Déclenchement du time out
If (tmrOut.Tag > 0) And (tmrOut.Tag <= cmdChoice.Count) Then
   
lgResChoix = -tmrOut.Tag
Else
   
lgResChoix = 0
End If
Unload Me
End Sub

Public Function
ChoiceBox(stTexte As String, varBouton, _
                         
Optional stTitre As String = vbNullString, _
                         
Optional XPos As Single = -1, _
                         
Optional YPos As Single = -1, _
                         
Optional lgAlign As AlignmentConstants = vbLeftJustify, _
                         
Optional lgDefault As Long = 1, _
                         
Optional lgTimeOut As Long = 0, _
                         
Optional imlTmp As ImageList, _
                         
Optional tabImlKey) As Long
Dim
lgFor As Long
Dim
lgW As Long, lgD As Long
' Mise en place du texte
lblChoice.Caption = stTexte
lblChoice.Alignment = lgAlign
' Titre de la fenêtre (ou nom de l'application)
If (stTitre <> vbNullString) Then Me.Caption = stTitre Else Me.Caption = App.Title
' Positionnement de la fenêtre
If (XPos < 0) Then XPos = (Screen.Width - Me.Width) / 2
If (YPos < 0) Then YPos = (Screen.Height - Me.Height) / 2
Me.Top = YPos
Me.Left = XPos
' Mise en place des boutons (création dynamique en fonction de la taille du tableau)
For lgFor = 1 To UBound(varBouton) + 1
   
If (lgFor > 1) Then
       
' Chargement d'un nouveau bouton
       
Load cmdChoice(lgFor - 1)
       
' Rend le bouton visible
       
cmdChoice(lgFor - 1).Visible = True
       
' Positionnement à la même hauteur
       
cmdChoice(lgFor - 1).Top = cmdChoice(0).Top
   
End If
   
cmdChoice(lgFor - 1).Caption = varBouton(lgFor - 1)
   
' Gestion des images sur les boutons
   
If Not imlTmp Is Nothing Then
        If UBound(
tabImlKey) = UBound(varBouton) Then
            Set
cmdChoice(lgFor - 1).Picture = imlTmp.ListImages(tabImlKey(lgFor - 1)).Picture
            cmdChoice(lgFor - 1).Height = cmdChoice(lgFor - 1).Picture.Height
       
End If
    End If
Next
lgFor
' Définition des tailles et positions des différents boutons
' Réajustement de la fenêtre, si nécessaire
If (cmdChoice(0).Width * cmdChoice.Count) + 400 > Me.Width Then
   
Me.Width = (cmdChoice(0).Width * cmdChoice.Count) + 400
    lblChoice.Width = Me.Width - 300
End If
If Not
imlTmp Is Nothing Then
    If (UBound(
tabImlKey) = UBound(varBouton)) Then Me.Height = 2500
End If
lgW = ((Me.Width - 100) / cmdChoice.Count)
lgD = ((lgW) - cmdChoice(0).Width) / 2
For lgFor = 0 To cmdChoice.Count - 1
    cmdChoice(lgFor).Left = (lgW * lgFor) + lgD
Next lgFor
If (lgDefault > 0) And (lgDefault <= cmdChoice.Count) Then
   
cmdChoice(lgDefault - 1).Default = True
End If
' Configuration du Time Out
If (lgTimeOut > 0) Then
   
tmrOut.Interval = lgTimeOut
    tmrOut.Enabled =
True
   
tmrOut.Tag = lgDefault
End If
' Affichage de la fenêtre en modal
Me.Show vbModal
' Dès la fermeture, on récupère le résultat et on le retourne
ChoiceBox = lgResChoix
End Function

Visual Basic Research Center - (c) 2000/2002 -  Webmaster : docvb (chez) free (point) fr