自己動(dòng)手寫(xiě)程序，想添加什么功能就添加什么，真是很爽。
因?yàn)槲矣玫腶ccess數(shù)據(jù)庫(kù)保存資料，在自動(dòng)讀入treeview控件中時(shí)，為了解決讀入的先后順序，我給每個(gè)記錄添加了一個(gè)divid字段，比如根節(jié)點(diǎn)是0，一級(jí)是1，二級(jí)是2，依次類(lèi)推，所以拖拽是必須考慮修改該字段，實(shí)現(xiàn)起來(lái)復(fù)雜了一些，現(xiàn)在我按照拖拽實(shí)現(xiàn)的順序編程如下：

Private Sub TreeView1_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
mybutton = Button
If Button = vbLeftButton And Shift Then
Set sourcenode = TreeView1.SelectedItem '設(shè)置拖動(dòng)的源 對(duì)象，全局node對(duì)象
sourcedivid = txtdivid
Set TreeView1.DropHighlight = Nothing
'DropHighlight 返回或設(shè)置一個(gè)Node對(duì)象或ListItem對(duì)象的引用。該對(duì)象在鼠標(biāo)移到其上時(shí)使用系統(tǒng)加亮顏色加亮。
End If
End Sub
Private Sub TreeView1_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
StatusBar1.Panels(1).Text = "請(qǐng)及時(shí)保存。"
If Button = vbLeftButton And Shift Then
dragnow = True   
TreeView1.DragIcon = TreeView1.SelectedItem.CreateDragImage ‘定義拖拽顯示的圖標(biāo)，必須的。
TreeView1.Drag vbBeginDrag   ’開(kāi)始
End If
End Sub
Private Sub TreeView1_DragOver(Source As Control, x As Single, y As Single, State As Integer)
If dragnow = True Then
' Set DropHighlight to the mouse's coordinates.
Set TreeView1.DropHighlight = TreeView1.HitTest(x, y) ‘注意既使目標(biāo)高亮，又是設(shè)置目標(biāo)對(duì)象
End If
End Sub
Private Sub TreeView1_DragDrop(Source As Control, x As Single, y As Single)’拖放后的目標(biāo)操作
Dim parentkey As String
Dim parentdivid As Integer
Set mcctree = DataEnvironment1.rsCommand2

If TreeView1.DropHighlight Is Nothing Then '如果目標(biāo)為空，不操作
dragnow = False
Exit Sub
Else ' Set dragged node's parent property to the target node.
On Error GoTo checkerror ' To prevent circular errors.
If MsgBox("你確定要把[" & sourcenode.Text & "]移動(dòng)到[" & TreeView1.DropHighlight.Text & "]下嗎？ ", vbOKCancel) = vbCancel Then Exit Sub

If TreeView1.DropHighlight.Text = "我的文檔" Then '因?yàn)閿?shù)據(jù)庫(kù)里沒(méi)有該記錄，所以如果目標(biāo)是放到根節(jié)點(diǎn)下，則需要單獨(dú)處理
parentkey = "root"
parentdivid = 1
mcctree.find "title='" & sourcenode.Text & "'", , , adBookmarkFirst
mcctree.Fields("relative") = parentkey ’修改數(shù)據(jù)庫(kù)
mcctree.Fields("divid") = parentdivid
mcctree.Update
Set sourcenode.Parent = TreeView1.DropHighlight ‘這里是修改treeview的節(jié)點(diǎn)位置的關(guān)鍵代碼。 Else
mcctree.find "title='" & TreeView1.DropHighlight.Text & "'", , , adBookmarkFirst
If mcctree.Fields("key") = "" Then '如果目標(biāo)不是節(jié)點(diǎn)，則放棄
MsgBox "非節(jié)點(diǎn)不能放置", vbInformation
Set mcctree = Nothing
Exit Sub
End If
‘如果既不是根節(jié)點(diǎn)也不是資料則如下處理
Set sourcenode.Parent = TreeView1.DropHighlight
mcctree.find "title='" & sourcenode.Parent.Text & "'", , , adBookmarkFirst ’查父節(jié)點(diǎn)
parentkey = mcctree.Fields("key").Value
parentdivid = mcctree.Fields("divid").Value
    If CInt(txtdivid) + 1 = sourcedivid Then '如果是同級(jí)別，則只要改relative
    mcctree.find "title='" & sourcenode.Text & "'", , , adBookmarkFirst
    mcctree.Update "relative", parentkey
    Debug.Print "ok111", parentkey
    Else ‘否則要改relative 和divid兩個(gè)字段的值
    mcctree.find "title='" & sourcenode.Text & "'", , , adBookmarkFirst
    Debug.Print parentkey, parentdivid + 1
    mcctree.Fields("relative") = parentkey
    mcctree.Fields("divid") = parentdivid + 1
    mcctree.Update
    updatechildnod mcctree.Fields("key").Value, mcctree.Fields("divid").Value ’遞歸子函數(shù)
    End If
End If
Cls '清除
Set TreeView1.DropHighlight = Nothing
dragnow = False
Set mcctree = Nothing
Exit Sub ' Exit if no errors occured.

End If

checkerror: ' Define constants to represent Visual Basic errors code.
Const CircularError = 35614
If Err.Number = CircularError Then
Dim msg As String
msg = "A node can't be made a child of its own children."
If MsgBox(msg, vbExclamation & vbOKCancel) = vbOK Then
dragnow = False
Set TreeView1.DropHighlight = Nothing
Set mcctree = Nothing
Exit Sub
End If
Else
Set mcctree = Nothing
Debug.Print Err.Description
End If
Exit Sub
End Sub

Private Sub updatechildnod(nodekey As String, nodedivid As Integer) ‘遞歸子函數(shù)
Dim upcctree As ADODB.Recordset
Dim nkey() As String   ’動(dòng)態(tài)數(shù)組
Dim ndivid() As Integer
Dim i As Integer
Dim x As Integer
i = 0
If DataEnvironment1.rsCommand4.State = 1 Then ’因?yàn)槊看味家P(guān)閉記錄對(duì)象所以遞歸要變通。
DataEnvironment1.rsCommand4.Close
End If

DataEnvironment1.rsCommand4.Open "select * from cctree where [relative]= '" & nodekey & "'"
   x = DataEnvironment1.rsCommand4.RecordCount ‘根據(jù)關(guān)鍵字查找子對(duì)象
   If x > 0 Then
   ReDim nkey(x)   ’定義一個(gè)臨時(shí)數(shù)組保存需要遞歸處理的字節(jié)點(diǎn)對(duì)象，
   ReDim ndivid(x) ‘因?yàn)樽庸?jié)點(diǎn)對(duì)象不會(huì)超過(guò)符合條件的記錄數(shù)，重定義數(shù)組
   Set upcctree = DataEnvironment1.rsCommand4
   upcctree.MoveFirst   ‘到第一條
   Do   ’循環(huán)
   Debug.Print upcctree.Fields("divid").Value, upcctree.Fields("title").Value
   upcctree.Update "divid", nodedivid + 1 ‘子節(jié)點(diǎn)只要更新divid
   If upcctree.Fields("key").Value <> "" Then
   nkey(i) = upcctree.Fields("key").Value ’如果是子節(jié)點(diǎn)，暫時(shí)不處理，保存到數(shù)組中
   ndivid(i) = upcctree.Fields("divid").Value
   i = i + 1
   End If
   'Debug.Print upcctree.Fields("divid").Value, upcctree.Fields("title").Value
   upcctree.MoveNext    ‘繼續(xù)處理下一條
   Loop While Not upcctree.EOF ’這樣本層節(jié)點(diǎn)下的所有對(duì)象都已修改，下面可以處理再下一級(jí)
    If i <> 0 Then    ‘判斷是否有這樣的節(jié)點(diǎn)
For x = 0 To i - 1
updatechildnod nkey(x), ndivid(x)   ’遞歸
Next
End If
   Set upcctree = Nothing
   End If
End Sub