(1)例子: Option Explicit Dim mnIndex As Integer Dim mbIndrag As Boolean Dim moDragNode As Object Private Sub GetFirstParent() On Error GoTo myerr Dim i As Integer Dim nTmp As Integer
For i = 1 To TreeView1.Nodes.Count nTmp = TreeView1.Nodes(i).Parent.Index Next Exit Sub
myerr: mnIndex = i Exit Sub End SubPrivate Function GetNextKey() As String Dim sNewKey As String Dim iHold As Integer Dim i As Integer On Error GoTo myerr 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 Exit Function myerr: GetNextKey = "1_" Exit Function End FunctionPrivate Sub cmdChild_Click() Dim oNodex As Node Dim skey As String Dim iIndex As Integer
On Error GoTo myerr iIndex = TreeView1.SelectedItem.Index skey = GetNextKey() Set oNodex = TreeView1.Nodes.Add(iIndex, tvwChild, skey, "Child " & skey, 1, 2) 'ʹ×Ó½Úµã¿É¼û¡£ oNodex.EnsureVisible Exit Sub myerr: 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 SubPrivate Sub cmdClear_Click() Cls TreeView1.Nodes.Clear End SubPrivate Sub cmdClose_Click() Unload Me End SubPrivate Sub cmdFirst_Click() Dim skey As String Dim iIndex As Integer
On Error GoTo myerr iIndex = TreeView1.SelectedItem.Index skey = GetNextKey() TreeView1.Nodes.Add iIndex, tvwFirst, skey, "First " & skey, 1, 2 Exit Sub myerr: MsgBox ("You must select a Node to do an Add First" & vbCrLf _ & "If the TreeView is empty us Add Last to create the first node") Exit Sub
End SubPrivate Sub cmdLast_Click() Dim skey As String skey = GetNextKey() On Error GoTo myerr TreeView1.Nodes.Add TreeView1.SelectedItem.Index, tvwLast, skey, "Last " & skey, 1, 2 Exit Sub myerr: TreeView1.Nodes.Add , tvwLast, skey, "Last " & skey, 1, 2 Exit Sub End Sub Private Sub cmdNext_Click() Dim skey As String Dim iIndex As Integer
On Error GoTo myerr iIndex = TreeView1.SelectedItem.Index skey = GetNextKey() TreeView1.Nodes.Add iIndex, tvwNext, skey, "Next " & skey, 1, 2 Exit Sub myerr: MsgBox ("You must select a Node to do an Add Next" & vbCrLf _ & "If the TreeView is empty us Add Last to create the first node") Exit Sub End SubPrivate Sub cmdPrevious_Click() Dim skey As String Dim iIndex As Integer On Error GoTo myerr iIndex = TreeView1.SelectedItem.Index skey = GetNextKey() TreeView1.Nodes.Add iIndex, tvwPrevious, skey, "Previous " & skey, 1, 2 Exit Sub myerr: MsgBox ("You must select a Node to do an Add Previous" & vbCrLf _ & "If the TreeView is empty us Add Last to create the first node") Exit Sub End SubPrivate Sub cmdRemove_Click() Dim iIndex As Integer
On Error GoTo myerr iIndex = TreeView1.SelectedItem.Index TreeView1.Nodes.Remove iIndex Exit Sub myerr: MsgBox ("You must select a Node to do a Remove" & vbCrLf _ & "If the TreeView is empty us Add Last to create the first node") Exit Sub End Sub Private Sub Form_Load() Set moDragNode = Nothing cmdLast_Click cmdLast_Click TreeView1.Nodes(1).Selected = True cmdChild_Click End SubPrivate Sub TreeView1_DragDrop(Source As Control, x As Single, y As Single)If TreeView1.DropHighlight Is Nothing Then mbIndrag = False Exit Sub Else On Error GoTo checkerror Set moDragNode.Parent = TreeView1.DropHighlight Cls Print TreeView1.DropHighlight.Text & _ " is parent of " & moDragNode.Text Set TreeView1.DropHighlight = Nothing mbIndrag = False Set moDragNode = Nothing Exit Sub End If
checkerror:
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 mbIndrag = False Set TreeView1.DropHighlight = Nothing Exit Sub End If End If End SubPrivate Sub TreeView1_DragOver(Source As Control, x As Single, y As Single, State As Integer) If mbIndrag = True Then Set TreeView1.DropHighlight = TreeView1.HitTest(x, y) End If End SubPrivate Sub TreeView1_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single) Set TreeView1.DropHighlight = TreeView1.HitTest(x, y) If Not TreeView1.DropHighlight Is Nothing Then TreeView1.SelectedItem = TreeView1.HitTest(x, y) Set moDragNode = TreeView1.SelectedItem End If Set TreeView1.DropHighlight = Nothing End SubPrivate Sub TreeView1_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single) If Button = vbLeftButton Then mbIndrag = True TreeView1.DragIcon = TreeView1.SelectedItem.CreateDragImage TreeView1.Drag vbBeginDrag ' Drag operation. End IfEnd Sub(2)与TREE绑定的imageList可以指定大小的,比如 With ils1 .ImageHeight = 16 .ImageWidth = 16
'ADD .ListImages.Add 1, "ADD", LoadResPicture("ADD", vbResIcon) 'EDIT .ListImages.Add 2, "EDIT", LoadResPicture("EDIT", vbResIcon) 'DELETE .ListImages.Add 3, "DELETE", LoadResPicture("DELETE", vbResIcon) End With
(1)例子:
Option Explicit
Dim mnIndex As Integer
Dim mbIndrag As Boolean
Dim moDragNode As Object
Private Sub GetFirstParent()
On Error GoTo myerr
Dim i As Integer
Dim nTmp As Integer
For i = 1 To TreeView1.Nodes.Count
nTmp = TreeView1.Nodes(i).Parent.Index
Next
Exit Sub
myerr:
mnIndex = i
Exit Sub
End SubPrivate Function GetNextKey() As String
Dim sNewKey As String
Dim iHold As Integer
Dim i As Integer
On Error GoTo myerr
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
Exit Function
myerr:
GetNextKey = "1_"
Exit Function
End FunctionPrivate Sub cmdChild_Click()
Dim oNodex As Node
Dim skey As String
Dim iIndex As Integer
On Error GoTo myerr
iIndex = TreeView1.SelectedItem.Index
skey = GetNextKey()
Set oNodex = TreeView1.Nodes.Add(iIndex, tvwChild, skey, "Child " & skey, 1, 2)
'ʹ×Ó½Úµã¿É¼û¡£
oNodex.EnsureVisible
Exit Sub
myerr:
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 SubPrivate Sub cmdClear_Click()
Cls
TreeView1.Nodes.Clear
End SubPrivate Sub cmdClose_Click()
Unload Me
End SubPrivate Sub cmdFirst_Click()
Dim skey As String
Dim iIndex As Integer
On Error GoTo myerr
iIndex = TreeView1.SelectedItem.Index
skey = GetNextKey()
TreeView1.Nodes.Add iIndex, tvwFirst, skey, "First " & skey, 1, 2
Exit Sub
myerr:
MsgBox ("You must select a Node to do an Add First" & vbCrLf _
& "If the TreeView is empty us Add Last to create the first node")
Exit Sub
End SubPrivate Sub cmdLast_Click()
Dim skey As String
skey = GetNextKey()
On Error GoTo myerr
TreeView1.Nodes.Add TreeView1.SelectedItem.Index, tvwLast, skey, "Last " & skey, 1, 2
Exit Sub
myerr:
TreeView1.Nodes.Add , tvwLast, skey, "Last " & skey, 1, 2
Exit Sub
End Sub
Private Sub cmdNext_Click()
Dim skey As String
Dim iIndex As Integer
On Error GoTo myerr
iIndex = TreeView1.SelectedItem.Index
skey = GetNextKey()
TreeView1.Nodes.Add iIndex, tvwNext, skey, "Next " & skey, 1, 2
Exit Sub
myerr:
MsgBox ("You must select a Node to do an Add Next" & vbCrLf _
& "If the TreeView is empty us Add Last to create the first node")
Exit Sub
End SubPrivate Sub cmdPrevious_Click()
Dim skey As String
Dim iIndex As Integer
On Error GoTo myerr
iIndex = TreeView1.SelectedItem.Index
skey = GetNextKey()
TreeView1.Nodes.Add iIndex, tvwPrevious, skey, "Previous " & skey, 1, 2
Exit Sub
myerr:
MsgBox ("You must select a Node to do an Add Previous" & vbCrLf _
& "If the TreeView is empty us Add Last to create the first node")
Exit Sub
End SubPrivate Sub cmdRemove_Click()
Dim iIndex As Integer
On Error GoTo myerr
iIndex = TreeView1.SelectedItem.Index
TreeView1.Nodes.Remove iIndex
Exit Sub
myerr:
MsgBox ("You must select a Node to do a Remove" & vbCrLf _
& "If the TreeView is empty us Add Last to create the first node")
Exit Sub
End Sub
Private Sub Form_Load()
Set moDragNode = Nothing
cmdLast_Click
cmdLast_Click
TreeView1.Nodes(1).Selected = True
cmdChild_Click
End SubPrivate Sub TreeView1_DragDrop(Source As Control, x As Single, y As Single)If TreeView1.DropHighlight Is Nothing Then
mbIndrag = False
Exit Sub
Else
On Error GoTo checkerror
Set moDragNode.Parent = TreeView1.DropHighlight
Cls
Print TreeView1.DropHighlight.Text & _
" is parent of " & moDragNode.Text
Set TreeView1.DropHighlight = Nothing
mbIndrag = False
Set moDragNode = Nothing
Exit Sub
End If
checkerror:
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
mbIndrag = False
Set TreeView1.DropHighlight = Nothing
Exit Sub
End If
End If
End SubPrivate Sub TreeView1_DragOver(Source As Control, x As Single, y As Single, State As Integer)
If mbIndrag = True Then
Set TreeView1.DropHighlight = TreeView1.HitTest(x, y)
End If
End SubPrivate Sub TreeView1_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
Set TreeView1.DropHighlight = TreeView1.HitTest(x, y)
If Not TreeView1.DropHighlight Is Nothing Then
TreeView1.SelectedItem = TreeView1.HitTest(x, y)
Set moDragNode = TreeView1.SelectedItem
End If
Set TreeView1.DropHighlight = Nothing
End SubPrivate Sub TreeView1_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
If Button = vbLeftButton Then
mbIndrag = True
TreeView1.DragIcon = TreeView1.SelectedItem.CreateDragImage
TreeView1.Drag vbBeginDrag ' Drag operation.
End IfEnd Sub(2)与TREE绑定的imageList可以指定大小的,比如
With ils1
.ImageHeight = 16
.ImageWidth = 16
'ADD
.ListImages.Add 1, "ADD", LoadResPicture("ADD", vbResIcon)
'EDIT
.ListImages.Add 2, "EDIT", LoadResPicture("EDIT", vbResIcon)
'DELETE
.ListImages.Add 3, "DELETE", LoadResPicture("DELETE", vbResIcon)
End With