Voici un petit treeview sans prétention...
Celui ci est lié à une base de données Access...
Au chargement de la form, l'arborescence est ainsi déployée à partir de la table de test. Cette même arborescence est sauvegardée à la fermeture de la fenêtre...
Par contre, l'interface est à arranger à votre convenance et certains petits détails sont certainement à revoir mais les essais majeurs ont été effectués...
Vous pouvez par exemple effectuer une vérification des zones de texte (Code + Description) lors de la création d'un noeud (parent ou enfant) afin que dans l'arborescence il n'y aie aucune description vide...enfin à vous de voir ;o)
Source / Exemple :
Option Explicit
Dim mDB As Database
Dim mRS As Recordset
Dim mnIndex As Integer
Dim mbIndrag As Boolean
Dim moDragNode As Object
Dim FileName As String
Private Sub cmdChild_Click()
Dim oNodex As Node
Dim skey As String
Dim iIndex As Integer
On Error GoTo myerr
iIndex = TreeView1.SelectedItem.Index ' si un noeud a été sélectionné
skey = GetNextKey() ' génération d'une nouvelle clé
Set oNodex = TreeView1.Nodes.Add(iIndex, tvwChild, skey, txtCode.Text & ":" & txtName.Text, 1, 2)
oNodex.EnsureVisible ' le noeud crée doit être visible
txtCode.Text = ""
txtName.Text = ""
Exit Sub
myerr:
MsgBox "Vous devez sélectionner un noeud pour la création d'un noeud enfants...", vbInformation, "Message"
Exit Sub
End Sub
Private Sub cmdLast_Click()
Dim skey As String
skey = GetNextKey() ' génération d'une nouvelle clé
On Error GoTo myerr
' Cas où le treeview contient déjà une arborescence de noeuds...
TreeView1.Nodes.Add TreeView1.SelectedItem.Index, tvwLast, skey, txtCode.Text & ":" & txtName.Text, 1, 2
txtCode.Text = ""
txtName.Text = ""
Exit Sub
myerr:
' Si le treeview est vide...
TreeView1.Nodes.Add , tvwLast, skey, txtCode.Text & ":" & txtName.Text, 1, 2
txtCode.Text = ""
txtName.Text = ""
Exit Sub
End Sub
Private Sub cmdLoad_Click()
LoadFromTable
End Sub
Private Sub GetFirstParent()
On Error GoTo myerr
Dim i As Integer
Dim nTmp As Integer
For i = 1 To TreeView1.Nodes.Count
nTmp = TreeView1.Nodes(i).Parent.Index
Next
Exit Sub
myerr:
mnIndex = i
Exit Sub
End Sub
Private Function GetNextKey() As String
Dim sNewKey As String
Dim iHold As Integer
Dim i As Integer
On Error GoTo myerr
iHold = Val(TreeView1.Nodes(1).Key)
' On parcourt tous les noeuds
For i = 1 To TreeView1.Nodes.Count
If Val(TreeView1.Nodes(i).Key) > iHold Then
iHold = Val(TreeView1.Nodes(i).Key)
End If
Next
iHold = iHold + 1
sNewKey = CStr(iHold) & "_"
GetNextKey = sNewKey
Exit Function
myerr:
GetNextKey = "1_"
Exit Function
End Function
Private Sub LoadFromTable()
Dim oNodex As Node
Dim nImage As Integer
Dim nSelectedImage As Integer
Dim i As Integer
Dim sTableNames As String
Dim sNodeTable As String
' Chemin de la base de données
FileName = App.Path & "\test.mdb"
' Nom de la table traitée
sNodeTable = "table1"
' Connection à la base de données
Set mDB = DBEngine.Workspaces(0).OpenDatabase(FileName)
' On vide le treeview
TreeView1.Nodes.Clear
' On crée un jeu d'enregistrement
Set mRS = mDB.OpenRecordset(sNodeTable)
If mRS.RecordCount > 0 Then
mRS.MoveFirst
Do While mRS.EOF = False
nImage = mRS.Fields("image")
nSelectedImage = mRS.Fields("selectedimage")
' Il s'agit d'un noeud parent
If Trim(mRS.Fields("parent")) = "0_" Then
Set oNodex = TreeView1.Nodes.Add(, 1, Trim(mRS.Fields("key")), _
Trim(mRS.Fields("text")), nImage, nSelectedImage)
Else
' Il s'agit d'un noeud enfant
Set oNodex = TreeView1.Nodes.Add(Trim(mRS.Fields("parent")), tvwChild, _
Trim(mRS.Fields("key")), Trim(mRS.Fields("text")), nImage, nSelectedImage)
' Le noeud enfant est visible
oNodex.EnsureVisible
End If
mRS.MoveNext
Loop
End If
mRS.Close ' fermeture du recordset
mDB.Close ' fermeture de la base de données
End Sub
Sub SaveToTable()
Dim sResponse As String
Dim sMDBName As String
Dim sTableName As String
Dim i As Integer
' Chemin de la base de données
FileName = App.Path & "\test.mdb"
' Nom de la table
sTableName = "table1"
' Connection à la base de données
Set mDB = DBEngine.Workspaces(0).OpenDatabase(FileName)
' Ouverture d'un jeu d'enregistrements
Set mRS = mDB.OpenRecordset(sTableName)
' Mise à jour des données
Call WriteToTable
mRS.Close
mDB.Close
End Sub
Private Sub cmdRemove_Click()
Dim iIndex As Integer
On Error GoTo myerr
iIndex = TreeView1.SelectedItem.Index ' suppression du noeud sélectionné
TreeView1.Nodes.Remove iIndex
Exit Sub
myerr:
' Si aucun noeud n'est sélectionné...
MsgBox "Vous devez sélectionner un noeud...", vbInformation, "Message"
Exit Sub
End Sub
Private Sub cmdSave_Click()
SaveToTable
End Sub
Sub WriteToTable()
Dim i As Integer
Dim iTmp As Integer
Dim iIndex As Integer
' Suppression des tuples de la table
If mRS.RecordCount > 0 Then
mRS.MoveFirst
Do While mRS.EOF = False
mRS.Delete
mRS.MoveNext
Loop
End If
' Si aucun noeud alors on sort de la procédure
If TreeView1.Nodes.Count = 0 Then
Exit Sub
End If
Call GetFirstParent
iIndex = TreeView1.Nodes(mnIndex).FirstSibling.Index
iTmp = iIndex
' Insertion du noeud parent
mRS.AddNew
mRS("parent") = "0_"
mRS("key") = TreeView1.Nodes(iIndex).Key
mRS("text") = TreeView1.Nodes(iIndex).Text
mRS("image") = TreeView1.Nodes(iIndex).Image
mRS("selectedimage") = TreeView1.Nodes(iIndex).SelectedImage
mRS.Update
' On traite les noeuds enfant du premier noeud parent
If TreeView1.Nodes(iIndex).Children > 0 Then
Call WriteChild(iIndex)
End If
' On traite les noeuds parents restants
While iIndex <> TreeView1.Nodes(iTmp).LastSibling.Index
' NB : TreeView1.Nodes(iIndex).Next.Key
' Next permet de passer au noeud parent suivant !!!
' Insertion du noeud parent
mRS.AddNew
mRS("parent") = "0_"
mRS("key") = TreeView1.Nodes(iIndex).Next.Key
mRS("text") = TreeView1.Nodes(iIndex).Next.Text
mRS("image") = TreeView1.Nodes(iIndex).Next.Image
mRS("selectedimage") = TreeView1.Nodes(iIndex).Next.SelectedImage
mRS.Update
' Traitement des noeuds enfants via appel récursif
If TreeView1.Nodes(iIndex).Next.Children > 0 Then
WriteChild TreeView1.Nodes(iIndex).Next.Index
End If
' On passe au noeud suivant
iIndex = TreeView1.Nodes(iIndex).Next.Index
Wend
End Sub
Private Sub Form_Load()
Set moDragNode = Nothing
' Chargement du treeview avec les données de la table
Call LoadFromTable
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
Call SaveToTable ' sauvegarde de l'arborescence
End Sub
Private Sub Toolbar1_ButtonClick(ByVal Button As ComctlLib.Button)
Select Case Button.Key
Case "exit"
Unload Me
Case "parent"
Call cmdLast_Click
Case "child"
Call cmdChild_Click
Case "delete"
Call cmdRemove_Click
End Select
End Sub
Private Sub TreeView1_DragDrop(Source As Control, x As Single, y As Single)
If TreeView1.DropHighlight Is Nothing Then
mbIndrag = False
Exit Sub
Else
' Set dragged node's parent property to the target node.
On Error GoTo checkerror ' To prevent circular errors.
' Le parent du noeud déplacé est celui qui a été survolé ;o)
Set moDragNode.Parent = TreeView1.DropHighlight
Set TreeView1.DropHighlight = Nothing
mbIndrag = False
Set moDragNode = Nothing
Exit Sub
End If
checkerror:
' Constants Visual Basic errors code.
Const CircularError = 35614
If Err.Number = CircularError Then
mbIndrag = False
Set TreeView1.DropHighlight = Nothing
Exit Sub
End If
End Sub
Private Sub TreeView1_DragOver(Source As Control, x As Single, y As Single, State As Integer)
If mbIndrag = True Then
' Positionner DropHighlight d'aprés les coordonnées de la souris
Set TreeView1.DropHighlight = TreeView1.HitTest(x, y)
End If
End Sub
Private Sub TreeView1_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
Set TreeView1.DropHighlight = TreeView1.HitTest(x, y)
' Savoir si l'on a cliqué sur un noeud
If Not TreeView1.DropHighlight Is Nothing Then
' On a cliqué sur un noeud
TreeView1.SelectedItem = TreeView1.HitTest(x, y)
Set moDragNode = TreeView1.SelectedItem ' représente le noeud qui sera drag and drop
End If
Set TreeView1.DropHighlight = Nothing
End Sub
Private Sub TreeView1_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
If Button = vbLeftButton Then ' on est donc en mode drag and drop
mbIndrag = True ' on positionne le flag à TRUE
TreeView1.DragIcon = Image1.Picture
TreeView1.Drag vbBeginDrag ' on commence le drag and drop
End If
End Sub
Private Sub WriteChild(ByVal iNodeIndex As Integer)
Dim i As Integer
Dim iTempIndex As Integer
iTempIndex = TreeView1.Nodes(iNodeIndex).Child.FirstSibling.Index
For i = 1 To TreeView1.Nodes(iNodeIndex).Children
mRS.AddNew
mRS("parent") = TreeView1.Nodes(iTempIndex).Parent.Key
mRS("key") = TreeView1.Nodes(iTempIndex).Key
mRS("text") = TreeView1.Nodes(iTempIndex).Text
mRS("image") = TreeView1.Nodes(iTempIndex).Image
mRS("selectedimage") = TreeView1.Nodes(iTempIndex).SelectedImage
mRS.Update
' Appel récursif de la procédure
If TreeView1.Nodes(iTempIndex).Children > 0 Then
Call WriteChild(iTempIndex)
End If
' On passe au noeud suivant
If i <> TreeView1.Nodes(iNodeIndex).Children Then
iTempIndex = TreeView1.Nodes(iTempIndex).Next.Index
End If
Next i
End Sub
Conclusion :
Si vous avez des problèmes et des remarques n'hésitez pas...
Bonne programmation
A++
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.