1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
| Dim DragNode As Node
Private Sub Form_Open(Cancel As Integer)
'Autorise le mode drag & drop
TreeView1.OLEDragMode = 1
TreeView1.OLEDropMode = 1
'Affichage du treeview avec des lignes en pointillés et des +
TreeView1.LineStyle = 1
'Empêche la modification du texte des noeuds
TreeView1.LabelEdit = 1
'Création du Treeview1
TreeView1.Nodes.Add , , "coucou1", "coucou1"
TreeView1.Nodes.Add , , "coucou2", "coucou2"
TreeView1.Nodes.Add , , "coucou3", "coucou3"
TreeView1.Nodes.Add "coucou1", tvwChild, "hello1", "hello1"
TreeView1.Nodes.Add "coucou1", tvwChild, "hello2", "hello2"
TreeView1.Nodes.Add "coucou2", tvwChild, "hello4", "hello4"
TreeView1.Nodes.Add "coucou2", tvwChild, "hello5", "hello5"
End Sub
Private Sub TreeView1_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Long, ByVal y As Long)
'Si bouton gauche de la souris enfoncé
If Button = 1 Then
'Sur appuie de la souris, sélectionne le noeud cliqué comme noeud sélectionné
Set TreeView1.SelectedItem = TreeView1.HitTest(x, y)
Set DragNode = TreeView1.SelectedItem
Texte5 = TreeView1.SelectedItem
End If
End Sub
'Evenement glisser un noeud
Private Sub TreeView1_OLEDragOver(Data As Object, Effect As Long, Button As Integer, Shift As Integer, x As Single, y As Single, State As Integer)
With TreeView1
'Glissement uniquement possible pour les noeuds enfants
If Not DragNode Is Nothing Then
'Met en surbrillance les noeuds survolés
Set .DropHighlight = .HitTest(x, y)
On Error Resume Next
'Si essaie de déplacer un noeud dans un noeud enfant --> 'curseur d'interdiction
If Not .HitTest(x, y).Parent Is Nothing Then
Effect = vbDropEffectNone 'curseur d'interdiction
End If
Else
'Si essai de déplacer un noeud parent --> curseur d'interdiction
Effect = vbDropEffectNone 'curseur d'interdiction
End If
End With
End Sub
Private Sub TreeView1_OLEDragDrop(Data As Object, Effect As Long, Button As Integer, Shift As Integer, x As Single, y As Single)
'Glissement uniquement possible pour les noeuds enfants
If Not DragNode Is Nothing Then
'Déposer = possible si il s'agit d'un noeud parent uniquement
If TreeView1.HitTest(x, y).Parent Is Nothing Then
On Error Resume Next
Texte7 = TreeView1.DropHighlight.Text
'Sélectionne le noeud de destination
Set TreeView1.SelectedItem = TreeView1.DropHighlight
'Effectue le déplacement (=changement de parent)
Set DragNode.Parent = TreeView1.SelectedItem
'Réinitialise la surbrillance de déplacement
Set TreeView1.DropHighlight = Nothing
'Tri par ordre alphabétique
DragNode.Parent.Sorted = True
Else 'si noeud enfant --> impossible de déposer
'Réinitialise la surbrillance de déplacement
Set TreeView1.DropHighlight = Nothing
End If
End If
End Sub
Private Sub TreeView1_OLEStartDrag(Data As Object, AllowedEffects As Long)
'Glissement uniquement possible pour les noeuds enfants
If DragNode.Parent Is Nothing Then
Set DragNode = Nothing
End If
End Sub |
