Créer un treview aussi facilement que les menu !

Télécharger le projet
Commenter

Description

Ce code permet, après une adaptation de votre cru, de contrôler la création des treeview plus facilement.

Source / Exemple : 


Private Sub asxPowerButton1_Click()
List1.List(List1.ListIndex) = "." + List1.List(List1.ListIndex)
End Sub

Private Sub asxPowerButton2_Click() ' Bouton "<"
If Left(List1.List(List1.ListIndex), 1) = "." Then ' enlever un point si il existe en préfuxe
List1.List(List1.ListIndex) = Right(List1.List(List1.ListIndex), Len(List1.List(List1.ListIndex)) - 1)
End If
End Sub

Private Sub asxPowerButton3_Click() ' Bouton "<MAJ"
Dim root As Node ' Le noeud principal qui est temporaire
Dim tmp As Node ' le noeud sur lequel on travail
Dim ix, iy As Integer
tv1.Nodes.Clear ' effacer le treeview
Set root = tv1.Nodes.Add ' Ajouter un noeud
Set tmp = root ' Le noeud tmp serra le noeud root
Set tmp = tv1.Nodes.Add(tmp, , , List1.List(0)) ' le noeud tmp devient un fils de root
For ix = 0 To List1.ListCount - 2 ' a cause du ix+1 il faut arrêter 1 index avant la fin
If comptechar(ix + 1) > comptechar(ix) Then ' si la ligne précédente commence avec plus de points ...
Set tmp = tv1.Nodes.Add(tmp, tvwChild, , Strings.Right(List1.List(ix + 1), Len(List1.List(ix + 1)) - comptechar(ix + 1))) '... tmp devient un noeud fils
End If
If comptechar(ix + 1) < comptechar(ix) Then ' si c'est l'inverse (moins de points) ...
For iy = 0 To comptechar(ix) - comptechar(ix + 1) - 1 ' ... on va boucler le nombre de fois nécessire
If tmp Is root Then Exit For ' Si l'on tombe sur le noeud parrent (root) on arrête de boucler
Set tmp = tmp.Parent ' On remonte d'un noeud
Next ' Boucle suivante
Set tmp = tv1.Nodes.Add(tmp, , , Strings.Right(List1.List(ix + 1), Len(List1.List(ix + 1)) - comptechar(ix + 1))) ' On crée un cousin (ou frêre) au noeud
End If
If comptechar(ix + 1) = comptechar(ix) Then ' Même nombre de point ...
Set tmp = tv1.Nodes.Add(tmp, , , Strings.Right(List1.List(ix + 1), Len(List1.List(ix + 1)) - comptechar(ix + 1))) ' On crée un cousin.
End If
Next
tv1.Nodes.Remove root.index ' On enlève le noeud root qui ne sert plus
End Sub

Private Sub asxPowerButton4_Click()
cd1.ShowOpen
tvfile (cd1.FileName)
End Sub

Private Sub asxPowerButton5_Click()
For ix = 0 To comptechar(List1.ListIndex) ' comptechar est une fonction que j'ai définie (voir plus bas)
If comptechar(List1.ListIndex) = 0 Then Exit For
Text2 = "." + Text2
Next
List1.List(List1.ListIndex) = Text2
asxPowerButton3_Click
End Sub

Private Sub asxPowerButton6_Click()
List1.AddItem Text1
End Sub

Function comptechar(ByVal index As Integer)
Dim d As MatchCollection ' On travaille avec des regex
Dim c As Match ' resultat d'une régex
Dim b As New RegExp ' La Régex
Rem : J'ai une source sur les régex regardez mon profil !!!
comptechar = 0 ' Pour que la fonction retourne 0 si il n'y a pas de résultats
b.Pattern = "^\.+" ' Voir mon autre tuto : '^' pour début de ligne, '\.' pour '.' et + pour prendre un max de caractères
b.Global = True ' Globale ;-)
Set d = b.Execute(List1.List(index))
'MsgBox d.Count ' Lignes commentées que j'ai utilisées lors du déboguage : faites de même !!!
'MsgBox d.Item(0).Value '
For Each c In d ' Pour chaque resultats (c) Dans l'enssemble des résultats (d)...
comptechar = Len(c.Value) ' donner la valeure de la logueure de la valeure du resultat de la régex
Next
End Function

Sub tvfile(fichier) ' Simple transformation pour utiliser les fichiers
Dim root As Node
Dim tmp As Node
Dim pre As String
Dim ix, iy As Integer
tv1.Nodes.Clear
Set root = tv1.Nodes.Add
Open fichier For Input As #1
Input #1, a
pre = a
Set tmp = root
Set tmp = tv1.Nodes.Add(tmp, , , a)
Do
pre = a
Input #1, a
If comptecharb(a) > comptecharb(pre) Then
Set tmp = tv1.Nodes.Add(tmp, tvwChild, , Strings.Right(a, Len(a) - comptecharb(a)))
End If
If comptecharb(a) < comptecharb(pre) Then
For iy = 0 To comptecharb(pre) - comptecharb(a) - 1
If tmp Is root Then Exit For
Set tmp = tmp.Parent
Next
Set tmp = tv1.Nodes.Add(tmp, , , Strings.Right(a, Len(a) - comptecharb(a)))
End If
If comptecharb(a) = comptecharb(pre) Then
Set tmp = tv1.Nodes.Add(tmp, , , Strings.Right(a, Len(a) - comptecharb(a)))
End If
Loop Until EOF(1)
Close #1
tv1.Nodes.Remove root.index
End Sub

Function comptecharb(ByVal chain As String) ' Modification de comptechar
Dim d As MatchCollection
Dim c As Match
Dim b As New RegExp
comptecharb = 0
b.Pattern = "^\.+"
b.Global = True
Set d = b.Execute(chain)
'MsgBox d.Count
'MsgBox d.Item(0).Value
For Each c In d
comptecharb = Len(c.Value)
Next
End Function

Private Sub asxPowerButton7_Click() ' enregistrement du travail :-)
cd1.ShowSave
Open cd1.FileName For Output As #1
For ix = 0 To List1.ListCount - 1
Print #1, List1.List(ix)
Next
Close #1
End Sub

Private Sub asxPowerButton8_Click()
List1.RemoveItem List1.ListIndex
End Sub

Private Sub tv1_Click()
Text4 = tv1.SelectedItem.index
End Sub

Conclusion :


N'oubliez pas d'enregistrer le contrôle que j'ai mis avec.
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 (krissssss)