Treeview facile

Soyez le premier à donner votre avis sur cette source.

Vue 11 592 fois - Téléchargée 2 375 fois

Description

Avec ce treeview, vous pouvez ajouter, modifier, supprimer, déplacer,imprimer et enregistrer vos données d'une façon simple avec visualisation préalable.
Une gestion des icônes à partir d'un contrôle imagelist vous permet aussi de les modifier.

Source / Exemple :


Dim numfich As Integer
Dim savefic()
Dim tvdrag As Boolean
Dim nodX As Node

Sub nouveaufichier()
chemin = ""
Tv.Nodes.Clear
fnom = "nouveau"
    Tv.Nodes.Add , , , fnom, 1, 1   'affichage par defaut
Toolbarmenu.Buttons(2).ToolTipText = "Enregistrer "
End Sub

Sub fermeture()
Dim ret
'demande d 'enregistrement en cas de modifications à la fermeture ou au changement de liste
If okaychange = True Then
    okaychange = False
    ret = MsgBox("Enregistrez les modifications ? ", vbYesNo + vbQuestion, "Enregistrement")
    If ret = 7 Then Exit Sub
    Call listeàenregistrer
    Call enregistrement(chemin)
End If
End Sub

Sub deplacetree(orignode As Node, destnode As Node)
On Error Resume Next
Dim cs As Long, nn, mm
Dim i As Integer
i = i + 1
Tv.Nodes.Add destnode.Key, tvwChild, destnode.Key & "\" & orignode.Text, orignode.Text, orignode.Image, orignode.Image
cs = orignode.Children
If cs > 0 Then
    nn = orignode.Child.Key
    mm = Tv.Nodes(destnode.Key & "\" & orignode.Text).Key
    j = 1
    Do
        deplacetree Tv.Nodes(nn), Tv.Nodes(mm)
        If j < cs Then
            nn = orignode.Child.Key
            j = j + 1
        Else
            Exit Do
        End If
    Loop
End If
Tv.Nodes.Remove orignode.Key
End Sub

Sub chargeimages()
Dim folder, f1, s, fc
'
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set folder = fso.GetFolder(App.Path & "\liste_image")
    Set fc = folder.Files
    For Each f1 In fc
     Image1.ListImages.Add , f1.Name, LoadPicture(folder & "\" & f1.Name)
    Next
End Sub
Sub boiteouverture()
On Error GoTo ErrHandler 'si click sur annuler
CommonDialog1.InitDir = App.Path 'chemin par défaut ou se lance le logiciel
CommonDialog1.CancelError = True ' initialise la valeur d'erreur
CommonDialog1.DialogTitle = "Ouvrir un tree view"
CommonDialog1.Filter = "Tous les fichiers (*.*)|*.*| Fichiers texte""(*.txt)|*.txt"
CommonDialog1.FilterIndex = 2   'filtre sur texte
CommonDialog1.ShowOpen  'boite ouvrir
chemin = CommonDialog1.FileName
Exit Sub
ErrHandler:
erreurouverture = True
If Err.Number = 32755 And chemin = "" Then 'si annuler activé et chemin vide
MsgBox Err.Description & vbLf & "un nouveau projet va être affiché", vbInformation
mnulignesenregistrer.Enabled = False
Call nouveaufichier
End If
If Err.Number = 35601 Then  'si fichier non conforme
    MsgBox Err.Description
    Frame2.Visible = False
    mnulignesenregistrer.Enabled = False 'on inhibe la liste complète
    mnuliste.Enabled = False    'on inhibe la liste de sauvegarde
    mnuenregistrer.Enabled = False 'inhibition menu enregistrer
    mnusous.Enabled = False 'inhibition menu enregistrer sous
    mnutitre.Enabled = False   ' inhibition menu ajouter un titre
    mnusupsel.Enabled = False   'inhibition menu supprimer
    Exit Sub
End If
End Sub

Sub chargetv1()
Dim i As Long
'charge la nouvelle liste
tv1.Nodes.Clear
For i = 1 To Image1.ListImages.Count
tv1.Nodes.Add , , , Image1.ListImages(i).Key, Image1.ListImages(i).Key
Next
End Sub

Public Sub listeàenregistrer()
Dim lig As Integer
ReDim savefic(500)
For lig = 1 To Tv.Nodes.Count
    
    If Tv.Nodes(lig).Parent Is Nothing Then
        savefic(lig) = Tv.Nodes(lig).FullPath & "," & Tv.Nodes(lig).Text & "," & Tv.Nodes(lig).Image & "," & Tv.Nodes(lig).SelectedImage
    Else
        savefic(lig) = Tv.Nodes(lig).Parent.FullPath & "," & Tv.Nodes(lig).Text & "," & Tv.Nodes(lig).Image & "," & Tv.Nodes(lig).SelectedImage
    End If
Next lig
DoEvents
End Sub

Sub affichagelistesauvegarde()
For lig = 1 To Form1.Tv.Nodes.Count
    If Form1.Tv.Nodes(lig).Parent Is Nothing Then
    'affichage raçine
        Liste.List1.AddItem Form1.Tv.Nodes(lig).FullPath & "," & Form1.Tv.Nodes(lig).Text & "," & Form1.Tv.Nodes(lig).Image & "," & Form1.Tv.Nodes(lig).SelectedImage
    Else
        Liste.List1.AddItem Form1.Tv.Nodes(lig).Parent.FullPath & "," & Form1.Tv.Nodes(lig).Text & "," & Form1.Tv.Nodes(lig).Image & "," & Form1.Tv.Nodes(lig).SelectedImage
    End If
Next lig
Liste.Caption = "Liste d'enregistrement"
        Liste.Show
End Sub
Public Sub sauve_sous()
On Error GoTo ErrHandler 'si click sur annuler
Dim lig As Integer
numfich = FreeFile
'
CommonDialog1.InitDir = App.Path    'chemin du dossier d'ouverture
CommonDialog1.CancelError = True ' initialise la valeur d'erreur
CommonDialog1.DialogTitle = "sauve un tree view"
CommonDialog1.Filter = "Tous les fichiers (*.*)|*.*| Fichiers texte""(*.txt)|*.txt"
CommonDialog1.FilterIndex = 2   'filtre sur txt par défaut
CommonDialog1.Flags = &H2   'si le fichier à remplacer existe
CommonDialog1.FileName = chemin 'nom du fichier à  sauvegarder avec chemin
CommonDialog1.ShowSave  'affichage boite de sauvegarde
'
Call listeàenregistrer
Call enregistrement(CommonDialog1.FileName)
Toolbarmenu.Buttons(2).ToolTipText = "Enregistrer " & chemin
Exit Sub
ErrHandler:
Exit Sub
End Sub

Private Sub cmdmemento_Click()
If Lbl1.Visible = True Then
    Lbl1.Visible = False
    Lbl2.Visible = True
    cmdmemento.Caption = "<"
    Exit Sub
Else
    Lbl2.Visible = False
    Lbl1.Visible = True
    cmdmemento.Caption = ">"
End If
End Sub

Private Sub Form_Load()
Form1.Width = 600 * Screen.TwipsPerPixelX  'largeur feuille
Form1.Height = 550 * Screen.TwipsPerPixelY  'hauteur feuille
Form1.Show  'affiche la feuille
erreurouverture = False
Tv.ImageList = Image1   'affecte l'objet image au treeview
tv1.ImageList = Image1 'affecte l'objet image au treeview de gestion des images
Call chargeimages   'charge imagelist avec les images du dossier liste_image
Call boiteouverture 'ouvre la boite de sélection de fichier
Call ouverture  'charge le treeview
okaychange = False
DoEvents
End Sub

Private Sub Form_Resize()
'redimensionne le treeview
Tv.Move 5, Toolbarmenu.Height, (Form1.Width), (Form1.Height - sb1.Height)
End Sub

Public Sub ouverture()
On Error GoTo errouverture
If chemin = "" Then Exit Sub
Frame2.Visible = True 'affiche le texte de chargement
LockWindowUpdate Tv.hwnd
Tv.Nodes.Clear  'vide le treeview
numfich = FreeFile
Open chemin For Input As #numfich
    While Not EOF(numfich)
        Input #numfich, fchemin     'clé du noeud parent
        Input #numfich, fnom        'texte du noeud
        Input #numfich, fimage      'image
        Input #numfich, fimagesel   'imagesélectionnée
        'racine
        If fchemin = fnom Then
            Tv.Nodes.Add , , fnom, fnom, fimage, fimagesel 'noeud raçine
        Else
            Tv.Nodes.Add fchemin, tvwChild, fchemin & "\" & fnom, fnom, fimage, fimagesel 'noeud dépendant
        End If
    DoEvents
    Wend
Close
Tv.Nodes(1).Expanded = True 'affiche les dossiers
Frame2.Visible = False  'chargement en cours...
sb1.Panels(1).Text = Tv.Nodes.Count & " noeuds" 'nombre de lignes
Form1.Caption = CommonDialog1.FileName  'nom du fichier à la feuille
' enabled des menus
mnuliste.Enabled = True
mnulignesenregistrer.Enabled = True
mnuenregistrer.Enabled = True
mnusous.Enabled = True
mnutitre.Enabled = True
mnusupsel.Enabled = True
Call listefullpath
Tv.Nodes(1).Selected = True
DoEvents
LockWindowUpdate 0& 'affiche la fenetre
Toolbarmenu.Buttons(2).ToolTipText = "Enregistrer " & chemin
Exit Sub
' gestion des erreurs si l'image n'existe pas
errouverture:
If Err.Number = 35601 Then
    fimage = "img1"
    fimagesel = "img1"
    Resume
End If
End Sub

Private Sub Form_Unload(Cancel As Integer)
Call fermeture
End Sub

Private Sub mnuaide_Click()
frmaide.Show 1
End Sub

Private Sub mnuapropos_Click()
frmAbout.Show 1
End Sub

Private Sub mnuchercher_Click()
frecherche.Show 1   'ouvre la feuille de recherche
End Sub

Private Sub mnuedition_Click()
mnusoustitre.Caption = "Ajouter un sous-titre à " & Tv.SelectedItem.Text
End Sub

Private Sub mnuenregistrer_Click()
Call sauve
End Sub

Private Sub mnufermearbre_Click()
'ferme tous les noeuds ouverts
For i = 1 To Tv.Nodes.Count
Tv.Nodes.Item(i).Expanded = False
Next
End Sub

Private Sub mnufermer_Click()
Unload Me
End Sub

Private Sub mnuimage_Click()
'gestion des images
Toolbarmenu.Buttons(5).Value = tbrPressed
Frame1.Visible = True
Frameaide.Visible = False
End Sub

Private Sub mnulignesenregistrer_Click()
'affichage des lignes complètes
Dim i As Integer
i = 1
While fic(i) <> ""
Liste.List1.AddItem fic(i)
i = i + 1
Wend
Liste.Caption = "Lignes entières de l'arborescence"
Liste.Show 1
End Sub

Private Sub mnuliste_Click()
'affiche la liste de sauvegarde
Call affichagelistesauvegarde
End Sub

Private Sub mnunouveau_Click()
Call fermeture
Call nouveaufichier
End Sub

Private Sub mnuouvrearbre_Click()
'ouvre tous les noeuds du treeview
For i = 1 To Tv.Nodes.Count
Tv.Nodes.Item(i).Selected = True
Next
End Sub

Private Sub mnuouvrir_Click()
' ouverture d'un nouveau fichier
Call fermeture
Call boiteouverture
DoEvents
Call ouverture
End Sub

Private Sub mnusous_Click()
'enregistrement sous un nouveau nom
Call sauve_sous
End Sub

Private Sub mnusoustitre_Click()
'insère un sous titre dans l'arborescence
Set nodX = Tv.Nodes.Add(Tv.SelectedItem, tvwChild, , "Sous-titre", 1, 1)
nodX.EnsureVisible
okaychange = True
End Sub

Private Sub mnusupsel_Click()
Dim ret As Integer
'efface le noeud sélectionné
ret = MsgBox("Supprimer réellement " & Tv.Nodes(Tv.SelectedItem.Index), vbYesNo + vbQuestion, "Supprimer un enregistrement")
If ret = 7 Then Exit Sub
    Tv.Nodes.Remove (Tv.SelectedItem.Index)
okaychange = True
End Sub

Private Sub mnutitre_Click()
'insère un titre dans l'arborescence
Set nodX = Tv.Nodes.Add(, , , "Titre", 1, 1)
nodX.EnsureVisible
okaychange = True
End Sub

Private Sub Toolbarmenu_ButtonClick(ByVal Button As MSComctlLib.Button)
Dim lig As Integer
Select Case Button.Index
    Case 1 'ouvrir
        Call fermeture
        Call boiteouverture
        DoEvents
        Call ouverture
    Case 2 'sauve
        Call sauve
    Case 3 'fermer
        Unload Me
    Case 5  'gestion image
        If Button.Value = tbrPressed Then
           ' Frame1.Move Frameaide.Left, Frameaide.Top, Frameaide.Width, Frameaide.Height
            Formimage.Left = Form1.Left + (Form1.Width / 2)
            Formimage.Top = Form1.Top
            form1active = True
            Formimage.Show
           ' Frame1.Visible = True
           ' Frameaide.Visible = False
        Else
        Unload Formimage
           ' Frame1.Visible = False
           ' Frameaide.Visible = True
            imdrag = False
        End If
    Case 6  'rechercher
        frecherche.Show 1
    Case 8  'arborescence
        If Button.Value = tbrPressed Then
        'ouvre tous les noeuds du treeview
            For i = 1 To Tv.Nodes.Count
                Tv.Nodes.Item(i).Selected = True
            Next
        Else
            'ferme tous les noeuds ouverts
            For i = 1 To Tv.Nodes.Count
                Tv.Nodes.Item(i).Expanded = False
            Next
        End If
    Case 9  'liste
        Call affichagelistesauvegarde
    End Select
End Sub
   
Private Sub Tv_AfterLabelEdit(Cancel As Integer, NewString As String)
okaychange = True   'variable d'enregistrement sur vrai si modification étiquette
End Sub

Private Sub Tv_DragDrop(Source As Control, x As Single, y As Single)
If imdrag = True Then Exit Sub
 If Tv.DropHighlight Is Nothing Then GoTo suite
 If nodX Is Nothing Then GoTo suite 'si noeud vide
If nodX = Tv.DropHighlight Then GoTo suite 'si noeud est le meme
    Call deplacetree(nodX, Tv.DropHighlight)
    Set Tv.DropHighlight = Nothing
    tvdrag = False
    okaychange = True
    Exit Sub
suite:
Set Tv.DropHighlight = Nothing
tvdrag = False
End Sub

Private Sub Tv_DragOver(Source As Control, x As Single, y As Single, State As Integer)
On Error Resume Next
If tvdrag = True Then
    Set Tv.DropHighlight = Tv.HitTest(x, y)
    Tv.DragIcon = Tv.SelectedItem.CreateDragImage
End If
End Sub

Private Sub Tv_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
If Button = 1 Then
    Set nodX = Tv.HitTest(x, y)
End If
'affiche le menu contextuel
If Button = 2 Then
mnusupsel.Caption = "Supprimer " & Tv.SelectedItem
PopupMenu mnuedition
End If
End Sub

Private Sub Tv_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
If Button = 1 Then
    tvdrag = True
    Tv.Drag vbBeginDrag    'initialise le dragdrop
End If
End Sub

Private Sub Tv_NodeClick(ByVal Node As MSComctlLib.Node)
'ouvre ou ferme le noeud cliqué
Node.Expanded = Not Node.Expanded
sb1.Panels(2).Text = Node.FullPath
If form1active = True Then
    Formimage.tvimg.Nodes.Clear
    DoEvents
    Formimage.Textimg.Text = Node.FullPath
    Formimage.tvimg.Nodes.Add , , , Tv.SelectedItem.Image, Tv.SelectedItem.Image
    Formimage.tvimg.Nodes.Add , , , Tv.SelectedItem.SelectedImage, Tv.SelectedItem.SelectedImage
End If
End Sub

Public Sub enregistrement(nomfichier)
Dim lig As Integer
numfich = FreeFile
lig = 1
Open nomfichier For Output As #numfich
While savefic(lig) <> ""
    'sauvegarde du noeud clé parent et du texte du noeud
    Print #numfich, savefic(lig)
    DoEvents
lig = lig + 1
Wend
Close
chemin = nomfichier
Form1.Caption = chemin
okaychange = False
End Sub

Public Sub listefullpath()
'liste les lignes d'enregistrement
ReDim fic(500)
Dim i, n As Integer
n = 1
For i = 1 To Tv.Nodes.Count 'lecture de chaque noeud du treeview
    If Tv.Nodes(i).Children Then    'si enfant existe on continue
    Else
        fic(n) = Tv.Nodes(i).FullPath   'sinon on ecrit la ligne complète
        n = n + 1
    End If
Next
sb1.Panels(3).Text = n - 1 & " Enregistrement(s)"
End Sub

Private Sub tv1_DragDrop(Source As Control, x As Single, y As Single)
tv1.DropHighlight = Nothing
tv1.Drag vbEndDrag    'initialise le dragdrop
  imdrag = False
End Sub

Private Sub tv1_DragOver(Source As Control, x As Single, y As Single, State As Integer)
If State = 0 Then Source.DragIcon = LoadPicture(App.Path & "\liste_image\rat.ico")
If imdrag = True Then
    tv1.DragIcon = tv1.SelectedItem.CreateDragImage 'icone de l'image sélectionnée
End If
End Sub

Private Sub tv1_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
If tv1.Nodes.Count = 0 Then Exit Sub
Set imgx = tv1.HitTest(x, y) 'variable de l'image sélectionnée
End Sub

Private Sub tv1_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
If tv1.Nodes.Count = 0 Then Exit Sub 'si des images existent dans le treeview
If Button = vbLeftButton Then
   tv1.Drag vbBeginDrag    'initialise le dragdrop
  imdrag = True
End If
End Sub

Private Sub tvimg_DragDrop(Source As Control, x As Single, y As Single)
If tvimg.DropHighlight Is Nothing Then
    Set tvimg.DropHighlight = Nothing
    imdrag = False
    Exit Sub
Else
    If tvimg.DropHighlight.Index = 1 Then
        Tv.SelectedItem.Image = tv1.SelectedItem.Image
        tvimg.DropHighlight.Image = tv1.SelectedItem.Image
        okaychange = True
    End If
    If tvimg.DropHighlight.Index = 2 Then
        Tv.SelectedItem.SelectedImage = tv1.SelectedItem.Image
        tvimg.DropHighlight.Image = tv1.SelectedItem.Image
        okaychange = True
    End If
    Set tvimg.DropHighlight = Nothing
End If
End Sub

Private Sub tvimg_DragOver(Source As Control, x As Single, y As Single, State As Integer)
If imdrag = True Then
    Set tvimg.DropHighlight = tvimg.HitTest(x, y)
End If
End Sub

Private Sub tvimg_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
imdrag = False
End Sub

Public Sub sauve()
If chemin = "" Then 'si le chemin est vide on dirige vers enregistrer_sous
    Call sauve_sous
    Exit Sub
End If
' sauve vers tableau
Call listeàenregistrer
Call enregistrement(chemin)
End Sub

Codes Sources

A voir également

Ajouter un commentaire

Commentaires

Messages postés
5
Date d'inscription
vendredi 8 décembre 2006
Statut
Membre
Dernière intervention
19 mai 2009

tres bonne. 10
Messages postés
8
Date d'inscription
samedi 10 juillet 2004
Statut
Membre
Dernière intervention
13 octobre 2008

Je suis pluto etonnée je pensée qui y avais plus personne qui programme sur VB6
sinon ta source à l'aire pas mal je note 9

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.