📄 bldtree.frm
字号:
VERSION 5.00
Object = "{6B7E6392-850A-101B-AFC0-4210102A8DA7}#1.3#0"; "COMCTL32.OCX"
Begin VB.Form Form1
Caption = "Form1"
ClientHeight = 5400
ClientLeft = 2475
ClientTop = 1710
ClientWidth = 7455
LinkTopic = "Form1"
PaletteMode = 1 'UseZOrder
ScaleHeight = 5400
ScaleWidth = 7455
Begin VB.Frame Frame2
Height = 735
Left = 4800
TabIndex = 8
Top = 3480
Width = 2535
Begin VB.CommandButton cmdClear
Caption = "Clear Treeview"
Height = 375
Left = 240
TabIndex = 9
Top = 240
Width = 2055
End
End
Begin VB.CommandButton cmdClose
Caption = "Close"
Height = 375
Left = 5040
TabIndex = 2
Top = 4320
Width = 2055
End
Begin VB.Frame Frame1
Height = 3375
Left = 4800
TabIndex = 1
Top = 120
Width = 2535
Begin VB.CommandButton cmdRemove
Caption = "Remove Node"
Height = 375
Left = 240
TabIndex = 10
Top = 2760
Width = 2055
End
Begin VB.CommandButton cmdChild
Caption = "Add Child"
Height = 375
Left = 240
TabIndex = 7
Top = 2280
Width = 2055
End
Begin VB.CommandButton cmdPrevious
Caption = "Add Previous Sibling"
Height = 375
Left = 240
TabIndex = 6
Top = 1800
Width = 2055
End
Begin VB.CommandButton cmdNext
Caption = "Add Next Sibling"
Height = 375
Left = 240
TabIndex = 5
Top = 1320
Width = 2055
End
Begin VB.CommandButton cmdLast
Caption = "Add Last Sibling"
Height = 375
Left = 240
TabIndex = 4
Top = 840
Width = 2055
End
Begin VB.CommandButton cmdFirst
Caption = "Add First Sibling"
Height = 375
Left = 240
TabIndex = 3
Top = 360
Width = 2055
End
End
Begin ComctlLib.TreeView TreeView1
Height = 4335
Left = 240
TabIndex = 0
Top = 360
Width = 3855
_ExtentX = 6800
_ExtentY = 7646
_Version = 327682
Style = 7
ImageList = "ImageList1"
BorderStyle = 1
Appearance = 1
End
Begin ComctlLib.ImageList ImageList1
Left = 4200
Top = 120
_ExtentX = 1005
_ExtentY = 1005
BackColor = -2147483643
ImageWidth = 16
ImageHeight = 16
MaskColor = 12632256
_Version = 327682
BeginProperty Images {0713E8C2-850A-101B-AFC0-4210102A8DA7}
NumListImages = 2
BeginProperty ListImage1 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "bldtree.frx":0000
Key = ""
EndProperty
BeginProperty ListImage2 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "bldtree.frx":031A
Key = ""
EndProperty
EndProperty
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'这个例子演示了如何向一个TreeView控件增加、减少结点
'增加结点的方式包括了增加“兄弟姐妹”结点：这种情况也四种增加方式，分别
'是最初、最后、下一个和上一个。也包含了增加子结点的方式
'这样就使用了TreeView控件中的这5种关系。
'另外，该例子也演示例如何通过拖放操作来对结点进行位置上的改变
'拖放操作是比较广泛的一种Windows操作，在本例子之后将对其进行介绍
Option Explicit
Dim mnIndex As Integer ' 存放一个结点的索引
Dim mbIndrag As Boolean ' 拖放操作的信号标志
Dim moDragNode As Object ' 被拖动的条目
Private Sub cmdChild_Click()
'用tvwChild方式来增加一个结点
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:
'如果出现错误，则通知用户，先从TreeView中选择一个结点
MsgBox ("必须先选择一个结点才能添加！" & vbCrLf _
& "如果TreeView是空的，那么就用Add Last Sibling按钮添加一个结点！")
Exit Sub
End Sub
Private Sub cmdClear_Click()
Cls
TreeView1.Nodes.Clear
End Sub
Private Sub cmdClose_Click()
Unload Me
End Sub
Private Sub cmdFirst_Click()
'用关系tvwFirst添加结点
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:
'如果出现错误，则通知用户，先从TreeView中选择一个结点
MsgBox ("必须先选择一个结点才能添加！" & vbCrLf _
& "如果TreeView是空的，那么就用Add Last Sibling按钮添加一个结点！")
Exit Sub
End Sub
Private Sub cmdLast_Click()
'用关系tvwLast添加一个结点
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:
'如果没有其他被选中的结点，则添加一个Root结点
TreeView1.Nodes.Add , tvwLast, skey, "Last " & skey, 1, 2
Exit Sub
End Sub
'*****************************************************************
'功能： 返回一个不会重复的关键词
'输入： 空
'输出：
' GetNextKey String
'实现算法很简单，只是在每次添加新结点的时候，对所有结点的数量加1
'由于每个Key是唯一的，因此如果用户可以删除结点，则这个算法不适用
'本例子允许删除结点，不过，还是演示了这种方法
'******************************************************************
Private Function GetNextKey() As String
Dim sNewKey As String
Dim iHold As Integer
Dim i As Integer
On Error GoTo myerr
'如果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
Exit Function
myerr:
'如果TreeView为空，则新增的结点为第一个结点，索引为1
GetNextKey = "1_"
Exit Function
End Function
Private Sub cmdNext_Click()
'用tvwNext添加结点
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:
'如果出现错误，则通知用户，先从TreeView中选择一个结点
MsgBox ("必须先选择一个结点才能添加！" & vbCrLf _
& "如果TreeView是空的，那么就用Add Last Sibling按钮添加一个结点！")
Exit Sub
End Sub
Private Sub cmdPrevious_Click()
'用tvwPrevious添加结点
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:
'如果出现错误，则通知用户，先从TreeView中选择一个结点
MsgBox ("必须先选择一个结点才能添加！" & vbCrLf _
& "如果TreeView是空的，那么就用Add Last Sibling按钮添加一个结点！")
Exit Sub
End Sub
Private Sub cmdRemove_Click()
'删除被选结点
Dim iIndex As Integer
'如果没有当前选中的结点，则出错。
'因为必须在增加结点之前指定好位置
On Error GoTo myerr
iIndex = TreeView1.SelectedItem.Index
TreeView1.Nodes.Remove iIndex '删除一个结点以及它的所有子结点
Exit Sub
myerr:
'如果出现错误，则通知用户，先从TreeView中选择一个结点
MsgBox ("必须先选择一个结点才能添加！" & vbCrLf _
& "如果TreeView是空的，那么就用Add Last Sibling按钮添加一个结点！")
Exit Sub
End Sub
Private Sub Form_Load()
'预先设置好TreeView，不让其为空
Set moDragNode = Nothing
cmdLast_Click
cmdLast_Click
TreeView1.Nodes(1).Selected = True
cmdChild_Click
End Sub
Private Sub TreeView1_DragDrop(Source As Control, x As Single, y As Single)
'如果用户没有移动鼠标，或目标位置不正确，则不执行拖放
'并将拖放操作标志设为False
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
'拖放结束，将操作标志符设置为False
mbIndrag = False
'清除被拖放的结点在源位置的结点
Set moDragNode = Nothing
Exit Sub
End If
checkerror:
Const CircularError = 35614
If Err.Number = CircularError Then
Dim msg As String
msg = "不能将一个父结点拖放变成自身子节点的子结点！"
If MsgBox(msg, vbExclamation & vbOKCancel) = vbOK Then
mbIndrag = False
Set TreeView1.DropHighlight = Nothing
Exit Sub
End If
End If
End Sub
Private 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 Sub
Private 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
'将moDragNode结点设置为将要被选择的结点
'如果不这样做，那就要直到单击完结点后才选择结点
TreeView1.SelectedItem = TreeView1.HitTest(x, y)
Set moDragNode = TreeView1.SelectedItem '设置该结点为要拖动的对象
End If
Set TreeView1.DropHighlight = Nothing
End Sub
Private Sub TreeView1_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
'确定鼠标左键按下状态
If Button = vbLeftButton Then '标志一个拖动操作
mbIndrag = True '设置拖放标志为True
' 设置拖放时的图标显示情况
TreeView1.DragIcon = TreeView1.SelectedItem.CreateDragImage
TreeView1.Drag vbBeginDrag ' 开始拖动操作
End If
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -