在设计时可以通过TreeView控件的属性页来指定控件的部分属性。在TreeView控件的属性中，比较重要的有如下属性：
样式（Style）属性
该属性返回或设置Node对象的图形类型（图像、文本、+/-号、直线）以及出现在TreeView控件中每一Node对象上的文本类型。
行样式（LineStyle）属性
这个属性返回或设置在Node对象之间显示的线的样式。
注意：若Style属性设置为包含直线的值，则LineStyle属性就确定了直线的外观。如果Style属性设置为不含直线的值，则LineStyle属性将被忽略。
Sort属性
该属性返回或设置一布尔值，此值确定Node对象的子节点和TreeView控件的根层节点是否按字母顺序排序。
Sorted属性有两种用法：第一，在TreeView控件的根（顶）层排列Node对象；第二，对任何单个Node对象的立即子节点（即第一层子接点）排序。例如，下面的代码是对TreeView控件的根节点排序：
TreeView1.Sorted=True。而代码Node1.Sorted=True则是对当前选中的Node对象的立即子节点排序。
注意：当设置Sorted属性为True时，仅对当前Nodes集合排序；在TreeView控件中添加新的Node对象时，必须再次设置Sorted属性为True，以便对添加的Node对象排序。
FullPath属性
这个属性返回在TreeView控件中引用的Node对象的完整限定路径。通常完整限定路径是引用的Node对象的Text属性中的文本与它的所有前辈的Text属性值的连接。
Root、Parent、Child、FirstSibling、LastSibling、Previous和Next属性
这些属性分别返回对Node对象的根节点，父节点，子节点，同层的第一个节点和最后一个节点，同层的前一个相邻节点和后一个相邻节点的引用。
同前面所讲的控件一样，TreeView控件也使用由ImageList属性指定的ImageList控件，来存储显示于Node对象的位图和图标。任何时刻，TreeView控件只能使用一个ImageList。这意味着，当TreeView控件的Style属性被设置成显示图像的样式时，TreeView控件中每一项的旁边都有一个同样大小的图像。为了使被选中的Node对象显示不同的图像，需要使用SelectedImage属性。
SelectedImage属性
该属性返回或设置当Node对象被选中时显示的图像。如果它为Null，则使用由ImageList属性指定的图像的屏蔽图像。
TreeView控件与前几个控件一样，用Add方法，Clear方法和Remove方法来添加Node对象，但它不能在设计时利用属性页来进行添加和删除。
TreeView控件的Clear方法和Remove方法与前面所讲的控件基本一致，这里主要讲Add方法。
Add方法
该方法在TreeView控件的Nodes集合中添加一个Node对象，语法如下：
TreeView1.Add(relative,relationship,key,text,
image,selectedimage)
在这些参数中，只有text参数是必需的，其它的参数都是可选的。relative参数是已存在的Node对象的索引号或键值。Relationship指定了Node对象的相对位置，如后表所述。Key是唯一的字符串，可用于检索Node对象。Text是在Node中出现的字符串。Image是在关联的ImageList控件中的图像的索引。Selectedimage是在关联的ImageList控件中的图像的索引，在Node被选中时显示。
CreateDragImage方法
这个方法使用Node对象的关联图像的抖动形式来创建拖动图像。这种图像一般用于拖放操作。该方法一般用于在拖放操作开始时给DragIcon属性赋值一个图像（图6）。
EnsureVisible方法
这个方法确保指定的ListItem或Node对象是可视的。如果需要，这个方法可展开Node对象并滚动TreeView控件下列代码创建一棵树，并可以演示拖动操作（由于篇幅所限，这段代码并未真正实现拖动）。
Dim indrag As Boolean
'指示拖放操作的标志。
Dim nodX As Object
'被拖动的项。
Private Sub Form_Load()
'在Imagelist控件中加载一个位图。
Dim imgX As ListImage
Dim BitmapPath As String
BitmapPath="graphics/icons/mail/mail01a.ico"
Set imgX=ImageList1.ListImages.Add_
(,,LoadPicture(BitmapPath))
'初始化TreeView控件并创建几个节点。
TreeView1.ImageList=ImageList1
Dim nodX As Node'创建一棵树。
Set nodX=TreeView1.Nodes.Add(,,,"Parent1",1)
Set nodX=TreeView1.Nodes.Add(,,,"Parent2",1)
Set nodX=TreeView1.Nodes.Add(1,tvwChild,,
"Child1",1)
Set nodX=TreeView1.Nodes.Add(1,tvwChild,,"Child2",1)
Set nodX=TreeView1.Nodes.Add(2,tvwChild,,"Child3",1)
Set nodX=TreeView1.Nodes.Add(2,tvwChild,,"Child4",1)
Set nodX=TreeView1.Nodes.Add(3,tvwChild,,"Child5",1)
nodX.EnsureVisible'展开树显示全部节点。
End Sub
Private Sub TreeView1_MouseDown_
(Button As Integer,Shift As Integer,x As Single,y As Single)
Set nodX=TreeView1.SelectedItem
'设置要拖动的项。
End Sub
Private Sub TreeView1_MouseMove(Button As Integer,
Shift As Integer,x As Single,y As Single)
If Button=vbLeftButton Then
'指示拖动操作。
indrag=True
'设置标志为true。
'用CreateDragImage方法设置拖动图标。
TreeView1.DragIcon=TreeView1.SelectedItem.CreateDragImage
TreeView1.DragvbBeginDrag'拖动操作。
End If
End Sub
添加根结点：
TreeView1.Nodes.Add , , "node1", "总公司"
添加node1的子节点：
TreeView1.Nodes.Add "node1", tvwChild, "node2", "行政部"
点击处理treeview1的click事件即可，可以用下面的方法得到当前的选择项
Private Sub TreeView1_Click()
Dim nod As Node
Set nod = TreeView1.SelectedItem
MsgBox nod.Text
End Sub
Option Explicit
Private Sub Form_Load()
Dim nodEach As Node
With Me.TreeView1
.Nodes.Add , , "a", "a"
.Nodes.Add "a", tvwChild, "b", "b"
.Nodes.Add "a", tvwChild, "c", "c"
.Nodes.Add , , "d", "d"
.Nodes.Add "d", tvwChild, "e", "e"
.Nodes.Add "d", tvwChild, "f", "f"
For Each nodEach In .Nodes
nodEach.Expanded = True
Next
End With
End Sub
Private Sub TreeView1_NodeClick(ByVal Node As MSComctlLib.Node)
'treeview控件的node得到焦点是NodeClick事件
MsgBox Node.Text
End Sub
TreeView 和 ListView 综合实例'1.从 Listview 拖拽 Item 加到 Treeview 的 Node
'2.添加 Treeview 节点时,可自动滚动
'3.编辑节点的 Text
'4.Treeview Node Menu
'5.Listview Item Double Click、Menu
'Objects:
'FORM1、Treeview1、Listview1、Timer1、Command1
Option Explicit
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Const WM_VSCROLL = &H115
Private Const WM_HSCROLL = &H114
Dim mfX As Single
Dim mfY As Single
Private Enum ScrollDirection
NoScroll = 0
VScrollBarUp = 1
HScrollBarRight = 2
VScrollBarDown = 3
HScrollBarLeft = 4
End Enum
Dim sdX As ScrollDirection
Private Sub Command1_Click()
If Not ListView1.SelectedItem Is Nothing Then
Dim NodeX As MSComctlLib.Node
If TreeView1.SelectedItem Is Nothing Then
Set NodeX = TreeView1.Nodes.Add(, , GetNextKey() & ListView1.SelectedItem.Text, ListView1.SelectedItem.Text)
Else
Set NodeX = TreeView1.Nodes.Add(TreeView1.SelectedItem, tvwChild, GetNextKey() & ListView1.SelectedItem.Text, ListView1.SelectedItem.Text)
End If
NodeX.Selected = True
'TreeView1.SelectedItem.Expanded = True
TreeView1.StartLabelEdit
End If
End Sub
Private Sub Command2_Click() '删除
Dim i As Long
For i = ListView1.ListItems.Count To 1 Step -1
If ListView1.ListItems.Item(i).Selected Then
ListView1.ListItems.Remove i
End If
Next i
End Sub
Private Sub FORM_DragOver(Source As Control, x As Single, y As Single, State As Integer)
If Source Is TreeView1 Then
Timer1.Enabled = False
End If
End Sub
Private Sub FORM_Load()
Timer1.Enabled = False
Timer1.Interval = 100
TreeView1.Style = tvwTreelinesPlusMinusPictureText
Dim i As Long
Dim j As Long
Dim NodeX As MSComctlLib.Node
TreeView1.Style = tvwTreelinesPlusMinusPictureText
Dim Temp As String
For i = 1 To 10
Temp = GetNextKey
Set NodeX = TreeView1.Nodes.Add(, , Temp, "Node " & TreeView1.Nodes.Count + 1)
For j = 0 To 5
TreeView1.Nodes.Add Temp, tvwChild, GetNextKey, "Node " & TreeView1.Nodes.Count + 1
Next
NodeX.Expanded = True
Next i
TreeView1.HideSelection = False
TreeView1.LabelEdit = tvwManual
ListView1.ListItems.Add , , "cc"
ListView1.ListItems.Add , , "dd"
ListView1.ListItems.Add , , "ee"
ListView1.ListItems.Add , , "ff"
ListView1.OLEDragMode = ccOLEDragAutomatic
ListView1.LabelEdit = lvwManual
ListView1.HideSelection = False
ListView1.MultiSelect = True
Command1.Caption = "<<"
Command2.Caption = "删除"
End Sub
Private Sub ListView1_DblClick()
If Not ListView1.SelectedItem Is Nothing Then
VBA.MsgBox ListView1.SelectedItem.Text
End If
End Sub
Private Sub ListView1_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
If Not ListView1.HitTest(x, y) Is ListView1.SelectedItem Then
Set ListView1.SelectedItem = Nothing
End If
End Sub
Private Sub ListView1_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
If Button = vbLeftButton And Not ListView1.SelectedItem Is Nothing Then
ListView1.DragIcon = ListView1.SelectedItem.CreateDragImage
ListView1.Drag vbBeginDrag
End If
End Sub
Private Sub MenuNodeClose_Click()
If TreeView1.SelectedItem.Children > 0 Then
TreeView1.SelectedItem.Expanded = False
End If
End Sub
Private Sub MenuNodeExpand_Click()
If TreeView1.SelectedItem.Children > 0 Then
TreeView1.SelectedItem.Expanded = True
End If
End Sub
Private Sub MenuNodesRename_Click()
If Not TreeView1.SelectedItem Is Nothing Then
TreeView1.StartLabelEdit
End If
End Sub
Private Sub TreeView1_AfterLabelEdit(Cancel As Integer, NewString As String)
If VBA.Len(NewString) <= 0 Then
MsgBox "error"
TreeView1.StartLabelEdit
Cancel = 1
End If
End Sub
Private Sub TreeView1_DblClick()
If Not TreeView1.SelectedItem Is Nothing Then
'只响应叶节点(没有孩子)
If TreeView1.SelectedItem.Children = 0 Then
VBA.MsgBox TreeView1.SelectedItem.Text
End If
End If
End Sub
Private Sub TreeView1_DragDrop(Source As Control, x As Single, y As Single)
If Not TreeView1.DropHighlight Is Nothing Then
Dim NodeX As MSComctlLib.Node
Set NodeX = TreeView1.Nodes.Add(TreeView1.DropHighlight.Key, tvwChild, GetNextKey() & ListView1.SelectedItem.Text, ListView1.SelectedItem.Text)
TreeView1.DropHighlight.Expanded = True
NodeX.Selected = True
TreeView1.StartLabelEdit
End If
Timer1.Enabled = False
End Sub
Private Sub TreeView1_DragOver(Source As Control, x As Single, y As Single, State As Integer)
If Not TreeView1.HitTest(x, y) Is Nothing Then
Set TreeView1.DropHighlight = TreeView1.HitTest(x, y)
mfX = x
mfY = y
If y > 0 And y < 100 Then
sdX = VScrollBarUp
ElseIf y > (TreeView1.Height - 400) And y < TreeView1.Height Then
sdX = VScrollBarDown
ElseIf x > 0 And x < 100 Then
sdX = HScrollBarLeft
ElseIf x > (TreeView1.Width - 400) And x < TreeView1.Width Then
sdX = HScrollBarRight
Else
sdX = NoScroll
End If
Timer1.Enabled = True
End If
End Sub
Private Sub Timer1_Timer()
Set TreeView1.DropHighlight = TreeView1.HitTest(mfX, mfY)
Select Case sdX
Case VScrollBarUp
SendMessage TreeView1.hwnd, WM_VSCROLL, 0, vbNull
Case VScrollBarDown
SendMessage TreeView1.hwnd, WM_VSCROLL, 1, vbNull
Case HScrollBarLeft
SendMessage TreeView1.hwnd, WM_HSCROLL, 0, vbNull
Case HScrollBarRight
SendMessage TreeView1.hwnd, WM_HSCROLL, 1, vbNull
Case NoScroll
If Not TreeView1.DropHighlight Is Nothing Then
If TreeView1.DropHighlight.Children > 0 Then
TreeView1.DropHighlight.Expanded = True
End If
End If
End Select
End Sub
Private Sub TreeView1_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
Timer1.Enabled = False
If Button = vbRightButton Then
If TreeView1.HitTest(x, y) Is TreeView1.SelectedItem Then
If Not TreeView1.SelectedItem Is Nothing Then
If TreeView1.SelectedItem.Children > 0 Then
MenuNodeExpand.Visible = True
MenuNodeExpand.Caption = "Expand Node: " & TreeView1.SelectedItem.Text
MenuNodeClose.Visible = True
MenuNodeClose.Caption = "Close Node: " & TreeView1.SelectedItem.Text
Else
MenuNodeExpand.Visible = False
MenuNodeClose.Visible = False
End If
Me.PopupMenu MenuNodes
End If
End If
End If
End Sub
Private Sub TreeView1_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
TreeView1.DropHighlight = TreeView1.HitTest(x, y)
If Not TreeView1.DropHighlight Is Nothing Then
TreeView1.SelectedItem = TreeView1.HitTest(x, y)
End If
Set TreeView1.DropHighlight = Nothing
End Sub
Private 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 = VBA.CStr(iHold) & "_"
GetNextKey = sNewKey
Exit Function
myerr:
GetNextKey = "1_"
End Function
换成位图就不大清楚，换色是可以的。例：
下面代码放入一公用模块：
Option Explicit
Public Const GWL_STYLE As Long = (-16)
Public Const COLOR_WINDOW As Long = 5
Public Const COLOR_WINDOWTEXT As Long = 8
Public Const TVI_ROOT As Long = &HFFFF0000
Public Const TVI_FIRST As Long = &HFFFF0001
Public Const TVI_LAST As Long = &HFFFF0002
Public Const TVI_SORT As Long = &HFFFF0003
Public Const TVIF_STATE As Long = &H8
'treeview styles
Public Const TVS_HASLINES As Long = 2
Public Const TVS_FULLROWSELECT As Long = &H1000
'treeview style item states
Public Const TVIS_BOLD As Long = &H10
Public Const TV_FIRST As Long = &H1100
Public Const TVM_GETNEXTITEM As Long = (TV_FIRST + 10)
Public Const TVM_GETITEM As Long = (TV_FIRST + 12)
Public Const TVM_SETITEM As Long = (TV_FIRST + 13)
Public Const TVM_SETBKCOLOR As Long = (TV_FIRST + 29)
Public Const TVM_SETTEXTCOLOR As Long = (TV_FIRST + 30)
Public Const TVM_GETBKCOLOR As Long = (TV_FIRST + 31)
Public Const TVM_GETTEXTCOLOR As Long = (TV_FIRST + 32)
Public Const TVGN_ROOT As Long = &H0
Public Const TVGN_NEXT As Long = &H1
Public Const TVGN_PREVIOUS As Long = &H2
Public Const TVGN_PARENT As Long = &H3
Public Const TVGN_CHILD As Long = &H4
Public Const TVGN_FIRSTVISIBLE As Long = &H5
Public Const TVGN_NEXTVISIBLE As Long = &H6
Public Const TVGN_PREVIOUSVISIBLE As Long = &H7
Public Const TVGN_DROPHILITE As Long = &H8
Public Const TVGN_CARET As Long = &H9
Public Type TV_ITEM
mask As Long
hItem As Long
state As Long
stateMask As Long
pszText As String
cchTextMax As Long
iImage As Long
iSelectedImage As Long
cChildren As Long
lParam As Long
End Type
Public Declare Function SendMessage Lib "user32" _
Alias "SendMessageA" _
(ByVal hwnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
lParam As Any) As Long
Public Declare Function GetWindowLong Lib "user32" _
Alias "GetWindowLongA" _
(ByVal hwnd As Long, _
ByVal nIndex As Long) As Long
Public Declare Function SetWindowLong Lib "user32" _
Alias "SetWindowLongA" _
(ByVal hwnd As Long, _
ByVal nIndex As Long, _
ByVal dwNewLong As Long) As Long
Public Declare Function GetSysColor Lib "user32" _
(ByVal nIndex As Long) As Long
下面代码放入窗体，加上一TreeView与五个按钮与一个CommonDialog：
Private Sub Form_Load()
Dim nodX As Node
'add some test items
Set nodX = TreeView1.Nodes.Add(, , "R", "Root")
Set nodX = TreeView1.Nodes.Add("R", tvwChild, "C1", "Child 1")
Set nodX = TreeView1.Nodes.Add("R", tvwChild, "C2", "Child 2")
Set nodX = TreeView1.Nodes.Add("R", tvwChild, "C3", "Child 3")
Set nodX = TreeView1.Nodes.Add("R", tvwChild, "C4", "Child 4")
nodX.EnsureVisible
Set nodX = TreeView1.Nodes.Add("C3", tvwChild, "C31", "Child 3 SubC 1")
Set nodX = TreeView1.Nodes.Add("C3", tvwChild, "C32", "Child 3 SubC 2")
nodX.EnsureVisible
Set nodX = TreeView1.Nodes.Add("C31", tvwChild, "C321", "Child 3 SubC 1 SubC 1")
Set nodX = TreeView1.Nodes.Add("C4", tvwChild, "C41", "Child 4 Subchild 1")
nodX.EnsureVisible
End Sub
Private Sub cmdEnd_Click()
Unload Me
End Sub
Private Function GetTVBackColour() As Long
Dim clrref As Long
Dim hwndTV As Long
hwndTV = TreeView1.hwnd
'try for the treeview backcolor
clrref = SendMessage(hwndTV, TVM_GETBKCOLOR, 0, ByVal 0)
'if clrref = -1, then the color is a system color.
'In theory, system colors need to be Or'd with &HFFFFFF
'to retrieve the actual RGB value, but not Or'ing
'seems to work for me. The default system colour for
'a treeview background is COLOR_WINDOW.
If clrref = -1 Then
clrref = GetSysColor(COLOR_WINDOW) ' Or &HFFFFFF
End If
'one way or another, pass it back
GetTVBackColour = clrref
End Function
Private Function GetTVForeColour() As Long
Dim clrref As Long
Dim hwndTV As Long
hwndTV = TreeView1.hwnd
'try for the treeview text colour
clrref = SendMessage(hwndTV, TVM_GETTEXTCOLOR, 0, ByVal 0)
'if clrref = -1, then the color is a system color.
'In theory, system colors need to be Or'd with &HFFFFFF
'to retrieve the actual RGB value, but not Or'ing
'seems to work for me. The default system colour for
'treeview text is COLOR_WINDOWTEXT.
If clrref = -1 Then
clrref = GetSysColor(COLOR_WINDOWTEXT) ' Or &HFFFFFF
End If
'one way or another, pass it back
GetTVForeColour = clrref
End Function
Private Sub SetTVBackColour(clrref As Long)
Dim hwndTV As Long
Dim style As Long
hwndTV = TreeView1.hwnd
'Change the background
Call SendMessage(hwndTV, TVM_SETBKCOLOR, 0, ByVal clrref)
'reset the treeview style so the
'tree lines appear properly
style = GetWindowLong(TreeView1.hwnd, GWL_STYLE)
'if the treeview has lines, temporarily
'remove them so the back repaints to the
'selected colour, then restore
If style And TVS_HASLINES Then
Call SetWindowLong(hwndTV, GWL_STYLE, style Xor TVS_HASLINES)
Call SetWindowLong(hwndTV, GWL_STYLE, style)
End If
End Sub
Private Sub SetTVForeColour(clrref As Long)
Dim hwndTV As Long
Dim style As Long
hwndTV = TreeView1.hwnd
'Change the background
Call SendMessage(hwndTV, TVM_SETTEXTCOLOR, 0, ByVal clrref)
'reset the treeview style so the
'tree lines appear properly
style = GetWindowLong(TreeView1.hwnd, GWL_STYLE)
'if the treeview has lines, temporarily
'remove them so the back repaints to the
'selected colour, then restore
If style And TVS_HASLINES Then
Call SetWindowLong(hwndTV, GWL_STYLE, style Xor TVS_HASLINES)
Call SetWindowLong(hwndTV, GWL_STYLE, style)
End If
End Sub
Private Sub cmdSetBackground_Click()
Dim newclr As Long
With cDlg
.Flags = cdlCCRGBInit 'using RGB colours
.Color = GetTVBackColour() 'pre-select the current colour
.ShowColor 'get the user's choice
newclr = .Color 'and assign to a var
End With
SetTVBackColour newclr 'set the backcolour
End Sub
Private Sub cmdBold_Click()
Dim TVI As TV_ITEM
Dim hitemTV As Long
Dim hwndTV As Long
'get the handle to the treeview item.
'If the item is selected, use TVGN_CARET.
'To highlight the first item in the root, use TVGN_ROOT
'To hilight the first visible, use TVGN_FIRSTVISIBLE
'To hilight the selected item, use TVGN_CARET
hwndTV = TreeView1.hwnd
hitemTV = SendMessage(hwndTV, TVM_GETNEXTITEM, TVGN_CARET, ByVal 0&)
'if a valid handle get and set the
'item's state attributes
If hitemTV > 0 Then
With TVI
.hItem = hitemTV
.mask = TVIF_STATE
.stateMask = TVIS_BOLD
Call SendMessage(hwndTV, TVM_GETITEM, 0&, TVI)
'flip the bold mask state
.state = TVIS_BOLD
End With
Call SendMessage(hwndTV, TVM_SETITEM, 0&, TVI)
End If
End Sub
Private Sub cmdFullRow_Click()
Dim hwndTV As Long
Dim style As Long
'get the window style
style = GetWindowLong(TreeView1.hwnd, GWL_STYLE)
'toggle the fullrow select
If style And TVS_FULLROWSELECT Then
style = style Xor TVS_FULLROWSELECT
Else: style = style Or TVS_FULLROWSELECT
End If
'and set it
Call SetWindowLong(TreeView1.hwnd, GWL_STYLE, style)
End Sub
Private Sub cmdSetText_Click()
Dim newclr As Long
With cDlg
.Flags = cdlCCRGBInit 'using RGB colours
.Color = GetTVForeColour() 'pre-select the current colour
.ShowColor 'get the user's choice
newclr = .Color 'and assign to a var
End With
SetTVForeColour newclr 'set the text colour
End Sub
被折叠的 条评论
为什么被折叠?
到【灌水乐园】发言
