0/5 (4 avis)
Vue 25 990 fois - Téléchargée 3 235 fois
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
8 sept. 2006 à 12:59
Ce code est très bien (codes + commentaires) mais il a un prérequis génant au niveau de la base access : il faut que toutes les lignes soient ordonnées au niveau de la base au moment de la fonction Load(). Cela implique que l'arbre est déjà construit sur le papier avant, si l'on mélange les lignes dans la base le prog plante.
ELEMENT NOT FOUND sur Set oNodex = TreeView1.Nodes.Add(Trim(mRS.Fields("parent")), tvwChild, Trim(mRS.Fields("key")), Trim(mRS.Fields("text")), nImage, nSelectedImage) ce qui est normal.
L'algo n'a pas la puissance de créer dynamiquement l'arbre (faisable sur 10-20 lignes mais sur 300 lignes avec 50 branches ouf ca fait du boulot au niveau de la gestion d'index). Le programme serait beaucoup plus puissant avec l'ajout d'un test dynamique : le noeud n'existe t-il pas déjà dans l'arbre ? Si oui création d'un fils supplémentaire, sinon création d'un nouveau père. J'espère que mes explications sont claires. A+ Bon courage.
Remarque : je dois moi-même faire ce taf, je pensais trouver la soluce toute faite ouarf!
15 oct. 2004 à 12:27
12 mars 2004 à 17:36
Merci infoniment et que Dieu t'inspire d'autre code, pour nous les amateurs.
24 nov. 2003 à 21:34
Le remplissage du treeview est tout simple et l'ajout de noeuds fonctionne parfaitement.
En plus, tu l'as posté un jour avant mon anniversaire :-D
Du bon boulot, pratique, bien commenté et surtout tout de suite fonctionnel.
Juste une question, pourquoi avoir géré les index avec des underscores (_) ?!?
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.