INDEXER LE TEXTE D'UN LISTBOX (POUR UNE FAQ PAR EXEMPLE)

' 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

Télécharger le zip

03 juillet 2006 07:27:12 :

Ce projet est très simple et si vous avez des trucs et astuces pour l'améliorer, je serais très heureux que vous m'en teniez informer, ce serait très sympa de me faire partager votre savoir.

05 juillet 2006 15:17:51 :

Je n'ai pas trouvé de Bug proprement dit, sauf peut-être pour le scroll horizontal où le texte ne s'affiche pas en totalité ! Ca coupe un peu avant, mais bon, c'est pas mon projet non plus !