treeview 拖拽 节点 实现目录的更改

[莫凡]

目录如下：

A_奥迪
|____A4L
B_宝马
|____BMW232
|____BMW525


现在如果想通过拖拽treeview节点实现以下结果，希望不吝赐教。

A_奥迪
|____A4L
|____BMW525
B_宝马
|____BMW232

[莫凡]

有人帮忙吗。

[SYSSZ]

从哪向哪拖?

[帝企鹅已被占用]

DragDrop事件。
Set DragNode.Parent = .DropHighlight

[莫凡]

有没有具体一点的。

[fudonghaiaaaa]

Option Explicit

Dim mnIndex As Integer ' Holds the index of a Node
Dim mbIndrag As Boolean ' Flag that signals a Drag Drop operation.
Dim moDragNode As Object ' Item that is being dragged.


Private Sub cmdLast_Click()
'Add a node using tvwLast
Dim skey As String
skey = GetNextKey()
On Error GoTo myerr 'if the treeview does not have a node selected
' the next line of code will return an error number 91
TreeView1.Nodes.Add TreeView1.SelectedItem.Index, tvwLast, skey, "Last " & skey, 1, 2
Exit Sub
myerr:
'add a root node in the last postion because no other node is selected.
TreeView1.Nodes.Add , tvwLast, skey, "Last " & skey, 1, 2
Exit Sub
End Sub
Private Sub cmdChild_Click()
'Add a node using tvwChild
Dim oNodex As Node
Dim skey As String
Dim iindex As Integer

On Error GoTo myerr 'if the treeview does not have a node selected
' the next line of code will return an error number 91
iindex = TreeView1.SelectedItem.Index 'Check to see if a Node is selected
skey = GetNextKey() ' Get a key for the new Node
Set oNodex = TreeView1.Nodes.Add(iindex, tvwChild, skey, "Child " & skey, 1, 2)
oNodex.EnsureVisible 'make sure the child node is visible
Exit Sub
myerr:
'Display a messge telling the user to select a node
MsgBox ("You must select a Node to do an Add Child" & vbCrLf _
& "If the TreeView is empty us Add Last to create the first node")
Exit Sub
End Sub
Private Sub Form_Load()
'Add some Nodes so the TreeView is not empty

Dim I As Integer
'在 ImageList 控件中添加一个图象。
Dim oNodex As Object
Dim imgX As ListImage
Dim iindex As Integer
' TreeView1.ImageList = ImageList1 '初始化ImageList。

Set imgX = ImageList1.ListImages.Add(, , LoadPicture("C:\Program Files\Microsoft Visual Studio\Common\Tools\APE\Source\Aeservic\SERVICE.ico"))

TreeView1.ImageList = ImageList1 '初始化ImageList。


TreeView1.LineStyle = tvwRootLines

TreeView1.Style = tvwTreelinesPlusMinusPictureText

Dim DriverCount As Integer

Dim GivePath As String

Set moDragNode = Nothing
cmdLast_Click
cmdLast_Click
TreeView1.Nodes(1).Selected = True
cmdChild_Click
End Sub
Private Function GetNextKey() As String
'Returns a new key value for each Node being added to the TreeView
'This algorithm is very simple and will limit you to adding a total of 999 nodes
'Each node needs a unique key. If you allow users to remove Nodes you can't use
'the Nodes count +1 as the key for a new node.

Dim sNewKey As String
Dim iHold As Integer
Dim I As Integer
On Error GoTo myerr
'The next line will return error #35600 if there are no Nodes in the TreeView
iHold = Val(TreeView1.Nodes(1).Key)
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 'Return a unique key
Exit Function
myerr:
'Because the TreeView is empty return a 1 for the key of the first Node
GetNextKey = "1_"
Exit Function
End Function



Private Sub TreeView1_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
If Button = vbLeftButton Then ' Signal a Drag operation.
mbIndrag = True ' Set the flag to true.
' Set the drag icon with the CreateDragImage method.
TreeView1.DragIcon = TreeView1.SelectedItem.CreateDragImage
TreeView1.Drag vbBeginDrag ' Drag operation.
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)
'Make sure we are over a Node
If Not TreeView1.DropHighlight Is Nothing Then
'Set the Node we are on to be the selected Node
'if we don't do this it will not be the selected node
'until we finish clicking on the Node
TreeView1.SelectedItem = TreeView1.HitTest(x, y)
Set moDragNode = TreeView1.SelectedItem ' Set the item being dragged.
End If
Set TreeView1.DropHighlight = Nothing
End Sub
Private Sub TreeView1_DragOver(Source As Control, x As Single, y As Single, State As Integer)
If mbIndrag = True Then
' Set DropHighlight to the mouse's coordinates.
Set TreeView1.DropHighlight = TreeView1.HitTest(x, y)
End If
End Sub
Private Sub TreeView1_DragDrop(Source As Control, x As Single, y As Single)
' If user didn't move mouse or released it over an invalid area.

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.
Set moDragNode.Parent = TreeView1.DropHighlight
Cls
Print TreeView1.DropHighlight.Text & _
" is parent of " & moDragNode.Text
' Release the DropHighlight reference.
Set TreeView1.DropHighlight = Nothing
mbIndrag = False
Set moDragNode = 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."

' Display the message box with an exclamation mark icon
' and with OK and Cancel buttons.
If MsgBox(msg, vbExclamation & vbOKCancel) = vbOK Then
' Release the DropHighlight reference.
mbIndrag = False
Set TreeView1.DropHighlight = Nothing
Exit Sub
End If
End If


End Sub

[孤独剑_LPZ]

怎么样了，lz的问题解决了吗

[Tiger_Zhao]

http://www.vb-helper.com/howto_treeview_add_node.html

[倒大霉的上帝]

新建窗体，放置一个Treeview（默认名Treeview1）拷贝下面代码：

Option Explicit
Private mvarSelectKey As String
Private Sub Form_Load()
    
    TreeView1.Indentation = 300                '设置缩进
    TreeView1.LineStyle = tvwRootLines         '设置显示方式
    TreeView1.LabelEdit = tvwManual            '不可编辑
    
    TreeView1.Nodes.Add , , "A_aoDi", "A_奥迪"                    '根节点
    TreeView1.Nodes.Add "A_aoDi", tvwChild, "A4L", "A4L"          '子节点
    
    TreeView1.Nodes.Add , , "B_baoMa", "B_宝马"                   '另一个根节点
    TreeView1.Nodes.Add "B_baoMa", tvwChild, "B232", "BMW232"     ''''
    TreeView1.Nodes.Add "B_baoMa", tvwChild, "B525", "BMW525"     '''''
    
    Dim msNode As MSComctlLib.Node                                ''''
    
    For Each msNode In TreeView1.Nodes                            '展开
        msNode.Expanded = True
    Next
End Sub

'拖动结束事件
Private Sub TreeView1_DragDrop(Source As Control, x As Single, y As Single)
    Dim strHitKey As String
    Dim strName As String
    
    strHitKey = TreeView1.HitTest(x, y).Key
    strName = TreeView1.Nodes(mvarSelectKey).Text
    
    TreeView1.Nodes.Remove (mvarSelectKey)
    TreeView1.Nodes.Add strHitKey, tvwChild, mvarSelectKey, strName
    
End Sub

'拖动过程事件
Private Sub TreeView1_DragOver(Source As Control, x As Single, y As Single, State As Integer)
    
    Set TreeView1.DropHighlight = TreeView1.HitTest(x, y)
End Sub

'鼠标按下事件
Private Sub TreeView1_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
    Dim strKey As String
        If Button = vbLeftButton Then
        If Not TreeView1.SelectedItem Is Nothing Then
            
            strKey = TreeView1.SelectedItem.Key
            
            If TreeView1.Nodes(strKey).Children = 0 Then
                mvarSelectKey = strKey
                TreeView1.DragIcon = TreeView1.SelectedItem.CreateDragImage
                TreeView1.Drag vbBeginDrag
            End If
        End If
    End If
End Sub

'鼠标移动事件
Private Sub TreeView1_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
    Dim strKey As String
    
    If Not TreeView1.HitTest(x, y) Is Nothing Then
        TreeView1.SelectedItem = TreeView1.HitTest(x, y)
    End If

End Sub

[AddDark]

帮顶，还真没遇到过这种问题

[guyehanxinlei]

收藏一下，顺便帮顶

[莫凡]

多谢大家，正在解决中。。。