Listbox/listview personnalisable a volonte

Télécharger le projet
Commenter

Description

Il s'agit d'une classe (accompagnée d'un module) qui gère des lignes de contrôles.
- Il n'y a pas de Contrôle ActiveX
- Il n'y a pas de Contrôle utilisateur
Une ligne est composée du nombre de contrôles que vous avez posé dans la picturebox (leur index doit être égal à 1)
Les propriétés stockées sont celles des contrôles posées dans le listbox: la classe peut donc gérer une liste dont chaque ligne peut avoir des polices, couleurs, valeurs etc. différentes!

Il suffit pour cela de faire à la ligne 429 (par exemple):
ListC.Property("text1","text")="Valeur du texte dans ma ligne"
ListC.Property("shape1","fillcolor")=&hFFFF00
La classe garde en mémoire ces informations pour cette ligne, et lorsqu'elle doit afficher la ligne 429, elle réaffecte toutes les propriétés aux contrôles présents dans le picturebox.
- Cette classe n'utilise que 15 contrôles de chaque type si 15 lignes sont visibles.
- Les valeurs que l'utilisateur modifie peuvent être affectées à la main par .Property("text1","text"), mais peuvent être stockées automatiquement par .AutoUpdate(index), où index est l'index de l'événement du contrôle (voir le code)

Le fait de stocker des propriétés et non une liste figée de valeurs permet pas mal de finesses, voir l'exemple du code pour donner une idée.

NB: Ah, bien entendu pour permettre tout cela j'utilise intensément CallByName().

Source / Exemple : 


'
'***    EXEMPLE DE LA CLASSE QUI GERE UNE LISTE
'                                       par g0g0 
'
' Résumé:
'   - Stocke toutes les propriétés définies pour chaque ligne de la liste
'   - N'affiche que le nombre de contrôles nécessaire, avec ces propriétés
'
' Fonctionnement:
'   - Créez un picturebox et un scrollbar vertical, où vous voulez
'   - Crééz dans le picturebox autant de contrôles que vous le souhaitez,
'     mais chaque contrôle doit avoir l'index "1"
'     (La taille d'une ligne est définie par le contrôle le plus bas trouvé)
'   - Appelez .Init Picture1, VScroll1
'   - Le contrôle fonctionne!
'
'       -> .AddItem / .Refresh pour ajouter une ligne (propriétés par défaut)
'
'       -> Ecriture manuelle possible:
'                   .Property("text1", "backcolor")=&hFFFFFF
'                   .Property("check1","value")=1
'                   etc.
'
'       -> Ecriture automatique possible sur modification d'une ligne:
'                   .AutoUpdate index
'                   en passant l'index du contrôle modifié, par exemple:
'
'                   Private Sub Check1_Click(Index As Integer)
'                       ListC.AutoUpdate index
'                   End Sub
'
'  ATTENTION: Si vous désirez que la classe puisse ressortir une
'             propriété il faut auparavant la définir au moins une fois
'             pour qu'elle la stocke !
'             Voir dans ce code: .Property("text1", "borderstyle") = 1
'             Essayez d'enlever la ligne puis de modifier des textes
'             dans la liste: le border n'est pas restauré!
'
'   NOTE: La ligne rouge n'est pas gérée par la classe, donc dès
'         que la classe fait un refresh() elle disparait ! Il faut donc
'         gérer vous même son retraçage.
'
'   NOTE: SetAlternativeCol() ne peut pas être remplacé par des affectations
'         d'une couleur sur les lignes paires et d'une autre sur les lignes
'         impaires, car il est possible de supprimer une ligne de la liste
'
'   NOTE: Le changement de propriété Text.Font marche aussi
'
Dim WithEvents ListC As cListContainer

Private Sub Form_Load()
    
    Set ListC = New cListContainer
    With ListC
        '*****************************
        '*   DEFINITION OBLIGATOIRE  *
        '*****************************
        .Init Picture1, VScroll1
        .Refresh False
        .AutoPicRefresh = False
    
        '*****************************
        '*  PROPRIETES OPTIONNELLES  *
        '*****************************
        .BottomMargin = 0
        .TopMargin = 0
        .AutoPicRefresh = False
    
        .SetAlternativeCol "shape1", "backcolor", &HFFFFFF, &HFFF5F5
        .SetAlternativeCol "check1", "backcolor", &HFFFFFF, &HFFF5F5
        .Property("text1", "borderstyle") = 1
        .Property("text1", "forecolor") = &H0
    End With

End Sub

Private Sub ListC_ListChange(ByVal FirstVisible As Long, ByVal LastVisible As Long)
    '
    '*** EVENEMENT DE CHANGEMENT SUR LA LISTE
    '
    '
    SelectionnerLigneMilieu
    AfficherInfos
    

End Sub

Private Sub Text1_KeyPress(Index As Integer, KeyAscii As Integer)
    '
    '*** ENREGISTRE LES PROPRIETES DE LA LIGNE ACTUELLE
    '
    If KeyAscii = 13 Then
        ListC.AutoUpdate Index
        Me.positionmodif.Caption = "Dernière ligne dont le texte a été modifié: " & ListC.ItemFromIndex(Index)
        AfficherInfos
    End If
End Sub

Private Sub Check1_Click(Index As Integer)
    '
    '*** ENREGISTRE LES PROPRIETES DE LA LIGNE ACTUELLE
    '
    ListC.AutoUpdate Index

    AfficherInfos

End Sub

Private Sub Command1_Click()
    
    '**************************************
    '*  Ajouter un élement dans la liste  *
    '**************************************
    With ListC
    
        '*** Ajout d'une ligne vierge dans la liste
        .AddItem
        
        '*** Définition d'autant de propriétés que désiré
        '*   sur les contrôles présents dans la ligne
        '*
        .Property("text1", "text") = "Toto " & Str(ListC.Count)
        .Property("text1", "backcolor") = RGB(Rnd * 55 + 200, Rnd * 55 + 200, Rnd * 55 + 200)
        
        '*** Mise à jour de la liste
        .Refresh
        
    End With
    
    '*** Afficher les informations de debug sur la liste
    AfficherInfos
    
End Sub

Private Sub Command3_Click()
    '*****************************************
    '*  Ajouter 1000 élements dans la liste  *
    '*****************************************
    Dim i&
    For i = 1 To 1000
        '
        '*** Définition d'une ligne
        '    voir Command1_click() pour les explications
        '
        With ListC
            .AddItem
            .Property("text1", "text") = "Ligne " & Str(ListC.Count) & " Timer:" & Timer
            .Property("text1", "backcolor") = RGB(Rnd * 55 + 200, Rnd * 55 + 200, Rnd * 55 + 200)
        End With
    Next
    '*** Rafraichir toute la liste d'un coup
    ListC.Refresh False
    AfficherInfos
End Sub

Private Sub AfficherInfos()
    '
    '*** AFFICHE LES INFORMATIONS SUR LA LISTE
    '
    Dim txt$, tmp$, item&
    
    txt = "La liste affichée va de " & ListC.ListStart & " à " & ListC.ListEnd & vbCrLf
    txt = txt & "Nombre de lignes de la liste: " & ListC.Count & vbCrLf
    txt = txt & "Centre de la liste: " & ListC.ListCenter & " correspond au contrôle: " & ListC.IndexFromItem(ListC.ListCenter) & vbCrLf
    
    
    item = ListC.ListCenter
    If item > 0 Then
        ListC.item = item
        txt = txt & "Ligne en rouge: " & ListC.Property("text1", "text") & " (Couleur: " & Hex$(ListC.Property("text1", "backcolor")) & ")" & vbCr
    End If
    Me.informations = txt
End Sub

Private Sub SelectionnerLigneMilieu()
    '
    '*** SELECTIONNER EN ROUGE LA LIGNE DU MILIEU
    '
    ' Lors de l'affichage de la liste toutes ces propriétés
    ' seront réaffectées car je ne les sauve pas
    '
    Dim Index&
    Index = ListC.IndexFromItem(ListC.ListCenter)
    If Index > 0 Then
        Me.Shape1(Index).BackColor = &HFF
        Me.Check1(Index).BackColor = &HFF
        Me.Text1(Index).BackColor = &HFF
        Me.Text1(Index).ForeColor = &HFFFFFF
        Me.Text1(Index).BorderStyle = 0
    End If
    '*** Rafraichir le picturebox pour afficher les modifications
    Me.Picture1.Refresh
End Sub

Private Sub Command2_Click()
    Dim item&
    item = ListC.ListCenter
    If item > 0 Then
        ListC.RemoveItem item
    End If
End Sub

Private Sub Text1_GotFocus(Index As Integer)
'
'*** FORCER L'APPARENCE DU CONTROLE DE SAISIE
'
    Text1(Index).BorderStyle = 0
    Text1(Index).BackColor = &HFFFFFF
    Text1(Index).ForeColor = &H0
End Sub

Private Sub Text1_LostFocus(Index As Integer)
'
'*** RECHARGER LES PROPRIETES ENREGISTREES DU CONTROLE DE SAISIE
'
    Dim item&
    item = ListC.ItemFromIndex(Index)
    If item > 0 Then
        ListC.item = item
        ListC.Refresh True
    End If
End Sub

Conclusion :


Je mets en niveau "initié" à cause du CallByName(), mais c'est redoutable de simplicité.
N'hésitez pas à me soumettre vos idées ou remarques.
Télécharger le projet

Codes Sources

A voir également

S'inscrire maintenant

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.

Du même auteur (cs_gogomanu)