TREEVIEW AVEC BASE DE DONNÉES ACCESS

---

Commentaire sur cette source (4)
Ajouter un commentaire et/ou une note

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)  

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

  

Si vous avez des problèmes et des remarques n'hésitez pas...

Bonne programmation

A++  

Pour les "Membres Club", vous pouvez télécharger directement un fichier contenu dans le zip sans télécharger le zip en entier !

Télécharger le zip

• SAUVEGARDE DES PROPRIÉTÉS D'UNE FENÊTRE
• DÉFINITION DU MONITEUR

• CONTRÔLE TREEXML
• NOUVEAU CONTRÔLE DYNAMICDATAGRIDVIEW
• XPLISTVIEW
• IMPRIMER UNE DATAGRIDVIEW ET AUTRES CONTRÔLES
• RATING-NOTE