VB中怎么给TreeView子节点添加打开窗口事件,就是一点节点,就弹出d盘窗口,象资源管理器一样。
1个回答
展开全部
Option Explicit
Private Enum ObjectType
otNone = 0
otFactory = 1
otGroup = 2
otPerson = 3
otFactory2 = 4
otGroup2 = 5
otPerson2 = 6
End Enum
Private SourceNode As Object
Private SourceType As ObjectType
Private TargetNode As Object
' A list of EmployeeProjects each person has worked on.
Private Projects As New Collection
' Save information about these projects for this
' employee.
Private Sub AddProjects(emp_name As String, ParamArray proj_names() As Variant)
Dim emp_proj As New EmployeeProjects
Dim i As Integer
' Add the project names to the EmplyeeProjects
' object for this employee.
For i = LBound(proj_names) To UBound(proj_names)
emp_proj.ProjectNames.Add proj_names(i)
Next i
' Add emp_proj to the collection of EmployeeProjects.
Projects.Add emp_proj, emp_name
End Sub
' ***********************************************
' Return the node's object type.
' ***********************************************
Private Function NodeType(test_node As Node) As ObjectType
Select Case Left$(test_node.Key, 1)
Case "f"
NodeType = otFactory
Case "g"
NodeType = otGroup
Case "p"
NodeType = otPerson
End Select
End Function
' ***********************************************
' Prepare the ImageList and TreeView controls.
' ***********************************************
Private Sub Form_Load()
Dim i As Integer
Dim factory As Node
Dim group As Node
Dim person As Node
' Load pictures into the ImageList.
For i = 1 To 6
TreeImages.ListImages.Add , , TreeImage(i).Picture
Next i
' Attach the TreeView to the ImageList.
OrgTree.ImageList = TreeImages
' Create some nodes.
Set factory = OrgTree.Nodes.Add(, , "f R & D", "R & D", otFactory, otFactory2)
Set group = OrgTree.Nodes.Add(factory, tvwChild, "g Engineering", "Engineering", otGroup, otGroup2)
Set person = OrgTree.Nodes.Add(group, tvwChild, "p Cameron, Charlie", "Cameron, Charlie", otPerson, otPerson2)
AddProjects "p Cameron, Charlie", "Alpha", "Beta"
Set person = OrgTree.Nodes.Add(group, tvwChild, "p Davos, Debbie", "Davos, Debbie", otPerson, otPerson2)
AddProjects "p Davos, Debbie", "Beta", "Delta", "Epsilon"
person.EnsureVisible
Set group = OrgTree.Nodes.Add(factory, tvwChild, "g Test", "Test", otGroup, otGroup2)
Set person = OrgTree.Nodes.Add(group, tvwChild, "p Able, Andy", "Andy, Able", otPerson, otPerson2)
AddProjects "p Able, Andy", "Phi"
Set person = OrgTree.Nodes.Add(group, tvwChild, "p Baker, Betty", "Baker, Betty", otPerson, otPerson2)
AddProjects "p Baker, Betty", "Alpha", "Zeta"
person.EnsureVisible
Set factory = OrgTree.Nodes.Add(, , "f Sales & Support", "Sales & Support", otFactory, otFactory2)
Set group = OrgTree.Nodes.Add(factory, tvwChild, "g Showroom Sales", "Showroom Sales", otGroup, otGroup2)
Set person = OrgTree.Nodes.Add(group, tvwChild, "p Gaines, Gina", "Gaines, Gina", otPerson, otPerson2)
AddProjects "p Gaines, Gina", "Pi", "Rho"
person.EnsureVisible
Set group = OrgTree.Nodes.Add(factory, tvwChild, "g Field Service", "Field Service", otGroup, otGroup2)
Set person = OrgTree.Nodes.Add(group, tvwChild, "p Helms, Harry", "Helms, Harry", otPerson, otPerson2)
AddProjects "p Helms, Harry"
Set person = OrgTree.Nodes.Add(group, tvwChild, "p Ives, Irma", "Ives, Irma", otPerson, otPerson2)
AddProjects "p Ives, Irma", "Alpha", "Beta", "Gamma", "Delta", "Epsilon", "Omega"
Set person = OrgTree.Nodes.Add(group, tvwChild, "p Jackson, Josh", "Jackson, Josh", otPerson, otPerson2)
AddProjects "p Jackson, Josh", "Pi"
person.EnsureVisible
Set group = OrgTree.Nodes.Add(factory, tvwChild, "g Customer Support", "Customer Support", otGroup, otGroup2)
Set person = OrgTree.Nodes.Add(group, tvwChild, "p Klug, Karl", "Klug, Karl", otPerson, otPerson2)
AddProjects "p Klug, Karl", "Fee", "Fie", "Foe", "Fum"
Set person = OrgTree.Nodes.Add(group, tvwChild, "p Landau, Linda", "Landau, Linda", otPerson, otPerson2)
AddProjects "p Landau, Linda", "Zeta", "Eta", "Nu"
person.EnsureVisible
' Associate the ImageLists with the
' ListView's Icons and SmallIcons properties.
lvProjects.Icons = imgLarge
lvProjects.SmallIcons = imgSmall
' Start with small icon view.
mnuSetView_Click lvwSmallIcon
End Sub
' ***********************************************
' Make the TreeView as large as possible.
' ***********************************************
Private Sub Form_Resize()
OrgTree.Move 0, 0, ScaleWidth / 2, ScaleHeight
lvProjects.Move ScaleWidth / 2, 0, ScaleWidth, ScaleHeight
End Sub
Private Sub mnuSetView_Click(Index As Integer)
Dim i As Integer
' Display the selected view style.
lvProjects.View = Index
' Check this menu item.
For i = 0 To 3
If i = Index Then
mnuSetView(i).Checked = True
Else
mnuSetView(i).Checked = False
End If
Next i
End Sub
' Display the data for this node in the ListView.
Private Sub OrgTree_Click()
Dim emp_proj As EmployeeProjects
Dim column_header As ColumnHeader
Dim list_item As ListItem
Dim obj As Object
Dim i As Integer
' Clear the ListView.
lvProjects.ListItems.Clear
lvProjects.ColumnHeaders.Clear
' Get the employee's EmployeeProjects object.
If SourceNode Is Nothing Then Exit Sub
On Error GoTo NoProjects
Set emp_proj = Projects(SourceNode.Key)
On Error GoTo 0
' Fill in the ListView.
' Create the column header.
Set column_header = lvProjects. _
ColumnHeaders.Add(, , "Project", _
2 * TextWidth("Project"))
With emp_proj.ProjectNames
For i = 1 To .Count
Set list_item = lvProjects.ListItems.Add(, , .Item(i))
list_item.Icon = 1
list_item.SmallIcon = 1
Next i
End With
NoProjects:
Exit Sub
End Sub
' ***********************************************
' Save the node pressed so we can drag it later.
' ***********************************************
Private Sub OrgTree_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
Set SourceNode = OrgTree.HitTest(x, y)
End Sub
' ***********************************************
' Start a drag if one is not in progress.
' ***********************************************
Private Sub OrgTree_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
If Button = vbLeftButton Then
' Start a new drag. Note that we do not get
' other MouseMove events while the drag is
' in progress.
' See what node we are dragging.
SourceType = NodeType(SourceNode)
' Select this node. When no node is highlighted,
' this node will be displayed as selected. That
' shows where it will land if dropped.
Set OrgTree.SelectedItem = SourceNode
' Set the drag icon for this source.
OrgTree.DragIcon = IconImage(SourceType)
OrgTree.Drag vbBeginDrag
End If
End Sub
' ***********************************************
' The user is dropping. See if the drop is valid.
' ***********************************************
Private Sub OrgTree_DragDrop(Source As Control, x As Single, y As Single)
If Not (OrgTree.DropHighlight Is Nothing) Then
' It's a valid drop. Set source node's
' parent to be the target node.
Set SourceNode.Parent = OrgTree.DropHighlight
Set OrgTree.DropHighlight = Nothing
End If
Set SourceNode = Nothing
SourceType = otNone
End Sub
' ***********************************************
' The mouse is being dragged over the control.
' Highlight the appropriate node.
' ***********************************************
Private Sub OrgTree_DragOver(Source As Control, x As Single, y As Single, State As Integer)
Dim target As Node
Dim highlight As Boolean
' See what node we're above.
Set target = OrgTree.HitTest(x, y)
' If it's the same as last time, do nothing.
If target Is TargetNode Then Exit Sub
Set TargetNode = target
highlight = False
If Not (TargetNode Is Nothing) Then
' See what kind of node were above.
If NodeType(TargetNode) + 1 = SourceType Then _
highlight = True
End If
If highlight Then
Set OrgTree.DropHighlight = TargetNode
Else
Set OrgTree.DropHighlight = Nothing
End If
End Sub
Private Enum ObjectType
otNone = 0
otFactory = 1
otGroup = 2
otPerson = 3
otFactory2 = 4
otGroup2 = 5
otPerson2 = 6
End Enum
Private SourceNode As Object
Private SourceType As ObjectType
Private TargetNode As Object
' A list of EmployeeProjects each person has worked on.
Private Projects As New Collection
' Save information about these projects for this
' employee.
Private Sub AddProjects(emp_name As String, ParamArray proj_names() As Variant)
Dim emp_proj As New EmployeeProjects
Dim i As Integer
' Add the project names to the EmplyeeProjects
' object for this employee.
For i = LBound(proj_names) To UBound(proj_names)
emp_proj.ProjectNames.Add proj_names(i)
Next i
' Add emp_proj to the collection of EmployeeProjects.
Projects.Add emp_proj, emp_name
End Sub
' ***********************************************
' Return the node's object type.
' ***********************************************
Private Function NodeType(test_node As Node) As ObjectType
Select Case Left$(test_node.Key, 1)
Case "f"
NodeType = otFactory
Case "g"
NodeType = otGroup
Case "p"
NodeType = otPerson
End Select
End Function
' ***********************************************
' Prepare the ImageList and TreeView controls.
' ***********************************************
Private Sub Form_Load()
Dim i As Integer
Dim factory As Node
Dim group As Node
Dim person As Node
' Load pictures into the ImageList.
For i = 1 To 6
TreeImages.ListImages.Add , , TreeImage(i).Picture
Next i
' Attach the TreeView to the ImageList.
OrgTree.ImageList = TreeImages
' Create some nodes.
Set factory = OrgTree.Nodes.Add(, , "f R & D", "R & D", otFactory, otFactory2)
Set group = OrgTree.Nodes.Add(factory, tvwChild, "g Engineering", "Engineering", otGroup, otGroup2)
Set person = OrgTree.Nodes.Add(group, tvwChild, "p Cameron, Charlie", "Cameron, Charlie", otPerson, otPerson2)
AddProjects "p Cameron, Charlie", "Alpha", "Beta"
Set person = OrgTree.Nodes.Add(group, tvwChild, "p Davos, Debbie", "Davos, Debbie", otPerson, otPerson2)
AddProjects "p Davos, Debbie", "Beta", "Delta", "Epsilon"
person.EnsureVisible
Set group = OrgTree.Nodes.Add(factory, tvwChild, "g Test", "Test", otGroup, otGroup2)
Set person = OrgTree.Nodes.Add(group, tvwChild, "p Able, Andy", "Andy, Able", otPerson, otPerson2)
AddProjects "p Able, Andy", "Phi"
Set person = OrgTree.Nodes.Add(group, tvwChild, "p Baker, Betty", "Baker, Betty", otPerson, otPerson2)
AddProjects "p Baker, Betty", "Alpha", "Zeta"
person.EnsureVisible
Set factory = OrgTree.Nodes.Add(, , "f Sales & Support", "Sales & Support", otFactory, otFactory2)
Set group = OrgTree.Nodes.Add(factory, tvwChild, "g Showroom Sales", "Showroom Sales", otGroup, otGroup2)
Set person = OrgTree.Nodes.Add(group, tvwChild, "p Gaines, Gina", "Gaines, Gina", otPerson, otPerson2)
AddProjects "p Gaines, Gina", "Pi", "Rho"
person.EnsureVisible
Set group = OrgTree.Nodes.Add(factory, tvwChild, "g Field Service", "Field Service", otGroup, otGroup2)
Set person = OrgTree.Nodes.Add(group, tvwChild, "p Helms, Harry", "Helms, Harry", otPerson, otPerson2)
AddProjects "p Helms, Harry"
Set person = OrgTree.Nodes.Add(group, tvwChild, "p Ives, Irma", "Ives, Irma", otPerson, otPerson2)
AddProjects "p Ives, Irma", "Alpha", "Beta", "Gamma", "Delta", "Epsilon", "Omega"
Set person = OrgTree.Nodes.Add(group, tvwChild, "p Jackson, Josh", "Jackson, Josh", otPerson, otPerson2)
AddProjects "p Jackson, Josh", "Pi"
person.EnsureVisible
Set group = OrgTree.Nodes.Add(factory, tvwChild, "g Customer Support", "Customer Support", otGroup, otGroup2)
Set person = OrgTree.Nodes.Add(group, tvwChild, "p Klug, Karl", "Klug, Karl", otPerson, otPerson2)
AddProjects "p Klug, Karl", "Fee", "Fie", "Foe", "Fum"
Set person = OrgTree.Nodes.Add(group, tvwChild, "p Landau, Linda", "Landau, Linda", otPerson, otPerson2)
AddProjects "p Landau, Linda", "Zeta", "Eta", "Nu"
person.EnsureVisible
' Associate the ImageLists with the
' ListView's Icons and SmallIcons properties.
lvProjects.Icons = imgLarge
lvProjects.SmallIcons = imgSmall
' Start with small icon view.
mnuSetView_Click lvwSmallIcon
End Sub
' ***********************************************
' Make the TreeView as large as possible.
' ***********************************************
Private Sub Form_Resize()
OrgTree.Move 0, 0, ScaleWidth / 2, ScaleHeight
lvProjects.Move ScaleWidth / 2, 0, ScaleWidth, ScaleHeight
End Sub
Private Sub mnuSetView_Click(Index As Integer)
Dim i As Integer
' Display the selected view style.
lvProjects.View = Index
' Check this menu item.
For i = 0 To 3
If i = Index Then
mnuSetView(i).Checked = True
Else
mnuSetView(i).Checked = False
End If
Next i
End Sub
' Display the data for this node in the ListView.
Private Sub OrgTree_Click()
Dim emp_proj As EmployeeProjects
Dim column_header As ColumnHeader
Dim list_item As ListItem
Dim obj As Object
Dim i As Integer
' Clear the ListView.
lvProjects.ListItems.Clear
lvProjects.ColumnHeaders.Clear
' Get the employee's EmployeeProjects object.
If SourceNode Is Nothing Then Exit Sub
On Error GoTo NoProjects
Set emp_proj = Projects(SourceNode.Key)
On Error GoTo 0
' Fill in the ListView.
' Create the column header.
Set column_header = lvProjects. _
ColumnHeaders.Add(, , "Project", _
2 * TextWidth("Project"))
With emp_proj.ProjectNames
For i = 1 To .Count
Set list_item = lvProjects.ListItems.Add(, , .Item(i))
list_item.Icon = 1
list_item.SmallIcon = 1
Next i
End With
NoProjects:
Exit Sub
End Sub
' ***********************************************
' Save the node pressed so we can drag it later.
' ***********************************************
Private Sub OrgTree_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
Set SourceNode = OrgTree.HitTest(x, y)
End Sub
' ***********************************************
' Start a drag if one is not in progress.
' ***********************************************
Private Sub OrgTree_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
If Button = vbLeftButton Then
' Start a new drag. Note that we do not get
' other MouseMove events while the drag is
' in progress.
' See what node we are dragging.
SourceType = NodeType(SourceNode)
' Select this node. When no node is highlighted,
' this node will be displayed as selected. That
' shows where it will land if dropped.
Set OrgTree.SelectedItem = SourceNode
' Set the drag icon for this source.
OrgTree.DragIcon = IconImage(SourceType)
OrgTree.Drag vbBeginDrag
End If
End Sub
' ***********************************************
' The user is dropping. See if the drop is valid.
' ***********************************************
Private Sub OrgTree_DragDrop(Source As Control, x As Single, y As Single)
If Not (OrgTree.DropHighlight Is Nothing) Then
' It's a valid drop. Set source node's
' parent to be the target node.
Set SourceNode.Parent = OrgTree.DropHighlight
Set OrgTree.DropHighlight = Nothing
End If
Set SourceNode = Nothing
SourceType = otNone
End Sub
' ***********************************************
' The mouse is being dragged over the control.
' Highlight the appropriate node.
' ***********************************************
Private Sub OrgTree_DragOver(Source As Control, x As Single, y As Single, State As Integer)
Dim target As Node
Dim highlight As Boolean
' See what node we're above.
Set target = OrgTree.HitTest(x, y)
' If it's the same as last time, do nothing.
If target Is TargetNode Then Exit Sub
Set TargetNode = target
highlight = False
If Not (TargetNode Is Nothing) Then
' See what kind of node were above.
If NodeType(TargetNode) + 1 = SourceType Then _
highlight = True
End If
If highlight Then
Set OrgTree.DropHighlight = TargetNode
Else
Set OrgTree.DropHighlight = Nothing
End If
End Sub
推荐律师服务:
若未解决您的问题,请您详细描述您的问题,通过百度律临进行免费专业咨询