TREEVIEW AVEC BASE DE DONNÉES ACCESS

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