1、建一Access数据库test.mdb，表名myTreeView，字段为：
myNodeKey 文本
myNodeName 文本
myParent 文本
myParentPath 文本
添加记录：
K001 节点1 Root Root.
K002 节点2 Root Root.
K003 节点3 Root Root.
K004 节点4 Root Root.
K005 节点5 Root Root.
2、新建VB工程，在“引用”中加入ADO2.6，在“部件”中加入Microsoft Windows CommonControls 5.0。
3、在窗体上添加TreeView控件，命名为TreeView1；添加TextBox控件，命名为txtNodeName；添加Image控件，命名为IconImage，并在其Picture属性中加载一个Icon图标文件。
4、在窗体代码中添加：
Private Conn As ADODB.Connection
Private Const TreeRootTag As String = "Root" '根节点标记
Private SourceNode As Object '定义节点拖曳的源节点
Private TargetNode As Object '定义节点拖曳的目标节点
Private Sub Form_Load()
Dim strCnt As String
Dim rs As New ADODB.Recordset
Dim strJudgeKey As String
Dim NodeX As Node
TreeView1.LineStyle = tvwRootLines
Set NodeX = TreeView1.Nodes.Add(, tvwFirst,TreeRootTag, "根节点")
NodeX.Expanded = True
'加载TreeView控件数据
strCnt = "Provider=Microsoft.Jet.OLEDB.4.0;DataSource=test.mdb;Persist Security Info=False"
Set Conn = New ADODB.Connection
Conn.CursorLocation = adUseClient
Conn.Open strCnt
rs.Open "Select * from myTreeView", Conn,adOpenKeyset, adLockReadOnly
strJudgeKey = TreeRootTag
Do Until rs.EOF
strJudgeKey =rs("myParent") & ""
Set NodeX =TreeView1.Nodes.Add(strJudgeKey, tvwChild, rs("myNodeKey")& "", rs("myNodeName") & "")
NodeX.Expanded =True
rs.MoveNext
Loop
rs.Close
Set rs = Nothing
End Sub
'当鼠标点击某节点时，在窗体上显示该节点的值
Private Sub TreeView1_NodeClick(ByVal myNode As Node)
Dim rs As ADODB.Recordset
If myNode.Index = 1 Then
txtNodeName =myNode.Key
Else
Set rs = NewADODB.Recordset
rs.Open "Select * frommyTreeView where myNodeKey='" & myNode.Key& "'", Conn, adOpenKeyset, adLockReadOnly
If Not rs.EOF Then
txtNodeName = rs("myNodeName") & ""
End If
rs.Close
Set rs = Nothing
End If
End Sub
'当按下鼠标按钮时，取得源节点
Private Sub TreeView1_MouseDown(Button As Integer, Shift AsInteger, x As Single, y As Single)
'将鼠标指针下的对象赋值给源节点
Set SourceNode = TreeView1.HitTest(x, y)
'在窗体上显示该节点的值
If Not (SourceNode Is Nothing) Then
CallTreeView1_NodeClick(SourceNode)
End If
End Sub
'当移动鼠标时
Private Sub TreeView1_MouseMove(Button As Integer, Shift AsInteger, x As Single, y As Single)
If Button = vbLeftButton Then '如果按下鼠标左键
If Not (SourceNode IsNothing) Then
Set TreeView1.SelectedItem = SourceNode '将源节点设为选定节点（蓝底显示）
TreeView1.DragIcon = IconImage '设置拖曳时的鼠标指针图标
TreeView1.Drag vbBeginDrag '开始拖动操作
End If
End If
End Sub
'当鼠标拖动时
Private Sub TreeView1_DragOver(Source As Control, x As Single, y AsSingle, state As Integer)
Dim target As Node
Dim highlight As Boolean '该变量控制拖曳的目标节点是否有效
Set target = TreeView1.HitTest(x, y)
If target Is TargetNode Then Exit Sub
Set TargetNode = target
highlight = False
If Not (TargetNode Is Nothing Or SourceNode IsNothing) Then
'符合以下两种情况才可拖曳：
'1、源节点不等于目标节点
'2、源节点不是目标节点的前辈节点
If TargetNode<> SourceNode And NotisEldershipNode(SourceNode, TargetNode) Then
highlight = True
End If
End If
If highlight Then
'拖曳有效，目标节点突出显示（蓝底显示）
SetTreeView1.DropHighlight = TargetNode
Else
SetTreeView1.DropHighlight = Nothing
End If
End Sub
'当鼠标拖放完成时（释放了鼠标按钮）
Private Sub TreeView1_DragDrop(Source As Control, x As Single, y AsSingle)
If Not (TreeView1.DropHighlight Is Nothing)Then '有突出显示的节点，即目标节点拖曳有效
If MsgBox("确认要拖曳到此处？",vbYesNo, g_Msgtitle) = vbYes Then
Set SourceNode.Parent = TreeView1.DropHighlight '将源节点的父节点设为目标节点
DragSave TreeView1.DropHighlight.Key, SourceNode.Key '更新拖曳后数据库中的变动
End If
SetTreeView1.DropHighlight = Nothing '取消突出显示
End If
Set SourceNode = Nothing
End Sub
'更新拖曳后的数据
Private Sub DragSave(ParentNodeKey As String, ChildNodeKey AsString)
Dim rs As New ADODB.Recordset
'更新源节点的父节点路径、父节点
rs.Open "Select * from myTreeView WheremyNodeKey='" & ChildNodeKey & "'",Conn, adOpenKeyset, adLockOptimistic
If rs.RecordCount = 0 Then
Exit Sub
End If
rs("myParent") = ParentNodeKey
rs("myParentPath") =GetFatherNodePath(ParentNodeKey, TreeView1) &"."
rs.Update
rs.Close
'更新源节点的子节点数据
rs.Open "Select * from myTreeView WheremyParent='" & ChildNodeKey & "'",Conn, adOpenKeyset, adLockOptimistic
Do While Not rs.EOF
DragSave ChildNodeKey,rs("myNodeKey") '递归调用
rs.MoveNext
Loop
rs.Close
Set rs = Nothing
End Sub
'获得父节点路径
Private Function GetFatherNodePath(strFatherNodeKey As String,tree1 As TreeView, Optional strSpliteTag = ".") As String
Dim Nodx As Node
Set Nodx = tree1.Nodes(strFatherNodeKey)
GetFatherNodePath = strFatherNodeKey
Do
Set Nodx =Nodx.Parent
If Nodx Is Nothing ThenExit Do
GetFatherNodePath =Nodx.Key & strSpliteTag &GetFatherNodePath
Loop
End Function
'判断节点A是否为节点B的前辈节点
Private Function isEldershipNode(NodeA As Node, NodeB As Node) AsBoolean
If NodeB.Parent Is Nothing Then
isEldershipNode =False '如果节点B为根节点，那么节点A不是节点B的前辈节点
ElseIf NodeB.Parent.Key = NodeA.Key Then
isEldershipNode =True
Else
isEldershipNode =isEldershipNode(NodeA, NodeB.Parent) '递归调用
End If
End Function
