0/5 (1 avis)
Vue 9 051 fois - Téléchargée 667 fois
' API pour le scroll horizontal Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long Private Const LB_SETHORIZONTALEXTENT = &H194 ' Dimensionne deux tableaux. Modifier la valeur du "To" suivant le nombre de questions Dim Q(0 To 7) Dim R(0 To 7) Dim i As Integer Private Sub Form_Load() Me.ScaleMode = vbPixels ' Questions textes dans le List1 (Tableau 1) Q(0) = "Q1 - En combien de temps peut-on faire le test ?" Q(1) = "Q2 - Pourquoi les tests sont parfois difficiles ?" Q(2) = "Q3 - Si le test est terminé avant le temps imparti, a t-on des points en plus ?" Q(3) = "Q4 - ..." Q(4) = "Q5 - ..." Q(5) = "Q6 - ..." Q(6) = "Q7 - ..." Q(7) = "Q8 - ..." ' Réponses textes dans le Label1 (Tableau 2) R(0) = "R1 - Tout dépend de la rapidité de la personne testée." R(1) = "R2 - Certains tests peuvent sembler difficile, mais quand on a la réponse " & _ "on se dit «Bon sang mais c'est bien-sûr !» " R(2) = "R3 - Non car il ne s'agit que de tests personnels et non de groupe" R(3) = "R4 - ..." R(4) = "R5 - ..." R(5) = "R6 - ..." R(6) = "R7 - ..." R(7) = "R8 -" For i = 0 To 7 'Ajoute le contenu du ListBox List1.AddItem Q(i) Next i List1.ListIndex = 0 ' Affiche le premier élément du ListBox (0=Q1 1=Q2 2=Q3....) 'Calculer la largeur des items et créer une barre de défilement horizontale si nécessaire Call BarreDeDéfilement(Me.List1) End Sub Private Sub List1_Click() ' Affichage de la réponse texte (tableau 2) dans le Label Label1.Caption = R(List1.ListIndex) End Sub Private Sub BarreDeDéfilement(lstBox As ListBox) Dim i As Integer Dim Largeur As Integer Largeur = 1 'Parcourt la liste et mesure la largeur des éléments et conserve la taille la plus large For i = 0 To lstBox.ListCount - 1 If TextWidth(lstBox.List(i)) > Largeur Then Largeur = TextWidth(lstBox.List(i)) Next i 'Affiche une barre de défilement horizontale SendMessage lstBox.hwnd, LB_SETHORIZONTALEXTENT, Largeur + 5, 0 End Sub Private Sub CmdQuitter_Click() End End Sub
28 févr. 2007 à 11:50
je, connais des méthodes beaucoup plus simles que celle la.
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.