作者：未知 来源：月光软件站 加入时间：2005-2-28　月光软件站

'=======================================================
'===efei Super TreeView
'===Code By efei(草不含羞)
'===Mailto:[email protected]
'===2004.7
'=======================================================

Dim tvwRoot
Dim tvwChild
Dim tvwPrevious
Dim tvwNext

tvwRoot = 0
tvwChild = 1
tvwPrevious = 2
tvwNext = 3

'===树的类
Class TreeView
?Public Name???'对象名
?Public TreeView_Name
?
?Private ArrNodes??'节点集合，从0开始
?
?Private ArrImage??'图标数组
?
?
?
?
?Private AddFromExpand??'节点的添加是否来自于父节点的展开
?
?'===一些设置
?
?Public FirstDisplayLevel?'初次显示几层
?Public UseConnectLine??'使用节点之间的连接线
?'Public ImagePath???'图象目录
?Public Target????'链接目标
?Public Font_Size???'文字大小
?Public Font_Family???'字体
?Public Font_Color???'颜色
?Public SelectedBgcolor??'选中的节点背景色
?
?'===图象目录=============================
?Private lImagePath???
?Public Property Get ImagePath()
??ImagePath = lImagePath
?End Property
?Public Property Let ImagePath(ByVal vNewValue)
??'更新之前先去掉原来的节点的边框
??lImagePath = vNewValue
??If Right(lImagePath,1) <> "/" Then lImagePath = lImagePath & "/"
?End Property
?'========================================
?
?Private lSelectedNode??'被选择的节点
?Public Property Get SelectedNode()
??Set SelectedNode = lSelectedNode
?End Property
?Public Property Let SelectedNode(ByVal vNewValue)
??'更新之前先去掉原来的节点的边框
??If Not lSelectedNode Is Nothing Then
???With Document.getElementById("txt" & lSelectedNode.Key).style
????.background = ""
???End With
??End If
??Set lSelectedNode = vNewValue
??With Document.getElementById("txt" & lSelectedNode.Key).style
???.background = SelectedBgcolor
??End With
?End Property
?
?Private lMenuNode
?Private lPopupMenu
?
?'===类的析构函数，用于初始化对象==============
?Private Sub Class_Initialize()
??'===初始化树对象
??Document.Write ""
??'===
??Redim ArrNodes(0)
??Set ArrNodes(0) = Nothing
??name=""
??TreeView_Name = "Efei Super TreeView"
??
??Set lSelectedNode = Nothing
??Set lMenuNode = Nothing
??lPopupMenu = ""
??
??Redim ArrImage(1,2)
??ArrImage(0,0) = "FolderClose"
??ArrImage(1,0) = "FolderClose.gif"
??ArrImage(0,1) = "FolderOpen"
??ArrImage(1,1) = "FolderOpen.gif"
??ArrImage(0,2) = "Rplus"
??ArrImage(1,2) = "Rplus.gif"
??AddImage "root","root.gif"
??AddImage "file","file.gif"
??
??lImagePath = "Image/"
??FirstDisplayLevel = 0
??UseConnectLine = True
??AddFromExpand = False
??Target = "_Blank"
??
??Font_Size = "12px"
??Font_Family = "宋体"
??Font_Color = "#000000"
??SelectedBgcolor = "#D4D0C8"
??
?End Sub
?'===============================================
?
?'===功能：?添加一个节点
?'===参数：?Text???节点显示的文本
?'???Key????节点关键字，该关键字必须唯一
?'???HyperLink??节点要链接到的地址
?'???Node???父节点或者兄弟节点
?'???AddType???添加类型，0-子节点，1-子节点，2-前置节点，3-后置节点
?'???Image???节点的图片，如空，则使用关闭的文件夹
?Public Function add(ByVal Text,ByVal Key,ByVal HyperLink,ByRef Node,ByVal AddType,ByVal Image)
??Dim i
??'先检查关键字是否已存在，参数是否合法
??Key = Trim(Key)
??If Key = "" Then
???Msgbox "关键字不能为空",vbInformation,TreeView_Name
???Exit Function
??End If
??If NOT Me.Nodes(Key) Is Nothing Then
???Msgbox "关键字【" & Key & "】已存在",vbInformation,TreeView_Name
???Exit Function
??End If
??Text = Trim(Text)
??If Text = "" Then
???Msgbox "节点文本不能为空",vbInformation,TreeView_Name
???Exit Function
??End If
??If IsNumeric(AddType) = True Then
???If AddType < 0 And AddType > 3 Then
????AddType = 1
???End If
??Else
???AddType = 1
??End If
??If Node Is Nothing Then
???If Me.NodesCount <> 0 Then
????Msgbox "根节点只能有一个",vbInformation,TreeView_Name
????Exit Function
???End If
???AddType = 0
??End IF
???
??Redim Preserve ArrNodes(Me.NodesCount)
??Set ArrNodes(Ubound(ArrNodes)) = New Node
??
??
??
??With ArrNodes(Ubound(ArrNodes))
???.Key = Key
???.Text=Text
???.HyperLink=HyperLink
???
???.AddType = AddType
???.Image = Image
???Set .parentObject = Me
???
???
???Select Case AddType
????Case 0??'根节点
?????Set .ParentNode=Nothing
?????Set .NextNode = Nothing
????Case 1??'子节点
?????Set .ParentNode = Node??????'父节点
?????If Node.ChildrenCount > 0 Then
??????Set .PreviousNode = Node.Children(Node.ChildrenCount)
??????Set Node.Children(Node.ChildrenCount).NextNode = ArrNodes(Ubound(ArrNodes))
?????End If
?????Set .NextNode = Nothing
????Case 2??'插在前面
?????Set .ParentNode = Node.ParentNode
?????Set .PreviousNode = Node.PreviousNode
?????Set Node.PreviousNode.NextNode = ArrNodes(Ubound(ArrNodes))
?????Set Node.PreviousNode = ArrNodes(Ubound(ArrNodes))
?????Set .NextNode = Node
?????
????Case 3??'插在后面
?????Set .ParentNode = Node.ParentNode
?????Set .PreviousNode = Node
?????Set .NextNode = Node.NextNode
?????Set Node.NextNode = ArrNodes(Ubound(ArrNodes))
???End Select
???If Not .ParentNode Is Nothing Then
????'更新父节点的内容
????.Level = .ParentNode.Level + 1
????
????.ParentNode.AddChild ArrNodes(Ubound(ArrNodes))??'添加子节点
???End If
???'If Image <> "" Then
???'?.Image = Me.Images(Image)
???'End If
???
???.Display
???
???
???If .Level > Me.FirstDisplayLevel Then
????.DisplayStatus = 0
???Else
????If NOT .ParentNode Is Nothing AND AddFromExpand = False Then
?????If .ParentNode.ExpandStatus = 0 Then
??????.ParentNode.ExpandStatus = 1??'自己都显示了，那说明父节点肯定是展开的
?????End If
????End If
????.DisplayStatus = 1
????
???End If
???
???
???
???
???If NOT .ParentNode Is Nothing Then??
????RefreshImage .ParentNode????
???End If
???'=================
??End With
??Set add = ArrNodes(UBound(ArrNodes))
?End Function
?'==============================================================================================
?
?
?'===功能：?移除一个节点，包括该节点下的所有子节点=============================================
?'===参数：?Key???节点的Key，或者是顺序号
?Public Function RemoveNode(ByVal Key)
??Dim i
??Dim Node
??Set Node = Nothing
??Key = Trim(Key)
??If Key = "" Then
???Exit Function
??End IF
??If IsNumeric(Key) = True Then
???If Key > 0 And Key <= Me.NodesCount Then
????Set Node = Nodes(Key)
???End If
??Else
???Set Node = Nodes(Key)
??End If
??If Node Is Nothing Then
???Exit Function
??End If
??Do Until Node.ChildrenCount = 0
???RemoveNode Node.Children(1).Key
??Loop
??
??If Not Node.PreviousNode Is Nothing Then
???'如果有前置节点，则要重新设置前置节点的后置节点
???Set Node.PreviousNode.NextNode = Node.NextNode
??End If
??If Not Node.NextNode Is Nothing Then
???'如果有后置节点，则要重新设置后置节点的前置节点
???Set Node.NextNode.previousNode = Node.PreviousNode
??End If
??
??'===设置它的父节点的子节点内容================================
??With Node.ParentNode
???
???For i = 0 To .ChildrenCount - 1
????If .ChildrenNodes(i).Key = Key Then
?????Exit For
????End If
???Next
???For i = i To .ChildrenCount - 2
????Set .ChildrenNodes(i) = .ChildrenNodes(i+1)
???Next
???.ChildrenCount = .ChildrenCount - 1
???Redim Preserve ChildrenNodes(.ChildrenCount - 1)
??End With
??'=============================================================
??
??'===设置树对象的节点集合======================================
??For i = 0 To Ubound(ArrNodes)
???If ArrNodes(i).Key = Key Then Exit For
??Next
??For i = i To Ubound(ArrNodes) - 1
???Set ArrNodes(i) = ArrNodes(i+1)
??Next
??Redim Preserve ArrNodes(Ubound(ArrNodes)-1)
??'==============================================================??
??
??Set Node = Document.getElementByID(Key).parentElement.parentElement
??Node.ParentElement.parentElement.deleteRow Node.rowIndex
??
??
??
??Set Node = Nothing
?End Function
?'==============================================================================================
?
?
?
?'===Nodes集合，返回一个节点，如果没有，返回Nothing========
?Public Function Nodes(index)
??dim i
??Set Nodes = Nothing
??If IsNumeric(index) = True Then
???If Ubound(ArrNodes)+1 >= index And index > 0 Then
????Set Nodes = ArrNodes(index - 1)
???End If
??Else
???If Ubound(ArrNodes) = 0 And ArrNodes(0) Is Nothing Then
????
???Else
????For i=0 to Ubound(ArrNodes)
?????If ArrNodes(i).Key = index Then
??????Set Nodes = ArrNodes(i)
?????End If
????Next
???End If
??End If
?End Function
?'==========================================================
?
?Public Property Get NodesCount()
??If Ubound(ArrNodes) = 0 And ArrNodes(0) Is Nothing Then
???NodesCount = 0
??Else
???NodesCount = Ubound(ArrNodes) + 1
??End If
?End Property
?Public Property Let NodesCount(ByVal vNewValue)
??Msgbox "NodesCount属性只读！"
?End Property
?
?'===功能：?清空图标集合=====================================
?Public Function ClearAllImage()
??Redim ArrImage(1,0)
?End Function
?'===End======================================================
?
?'===功能：?添加图标集合=====================================
?'???如果关键字imgKey存在，则更新，如不存在，则添加
?'===参数：?imgKey??图标关键字
?'???imgSrc??图标的名称
?Public Function AddImage(ByVal imgKey,ByVal imgFileName)
??dim i
??For i=1 To Ubound(ArrImage,2)
???If ArrImage(0,i) = imgKey Then
????ArrImage(1,i) = imgFileName??'更新
????Exit Function
???End If
??Next
??'添加
??If IsNumeric(imgFileName) = True Then
???Msgbox "图标关键字不能为纯数字！请使用字母或字母和数字的组合。"
???Exit Function
??End If
??i = Ubound(ArrImage,2)+1
??Redim Preserve ArrImage(1,i)
??ArrImage(0,i) = imgKey
??ArrImage(1,i) = imgFileName
?End Function
?'===End======================================================
?
?'===功能：?根据关键字来得到图标的路径=======================
?'===参数：?imgKey??图标的关键字，或是索引。索引从1开始
?Function Images(ByVal imgKey)
??Dim i
??Images = ""
??If imgKey = "" Then Exit Function
??If IsNumeric(imgKey) = True Then
???If Cint(imgKey) <= Ubound(ArrImage,2) AND Cint(imgKey) > 0 Then
????Images = Me.ImagePath & ArrImage(1,imgKey)
???End If
??Else
???For i = 1 To Ubound(ArrImage,2)
????If Ucase(ArrImage(0,i)) = Ucase(imgKey) Then
?????Images = Me.ImagePath & ArrImage(1,i)
?????Exit For
????End If
???Next
??End If
?End Function
?'===End=======================================================
?
?'===动态更新各个节点前的连接线符号=============================
?Function RefreshImage(ByRef objNode)
??Dim i,j
??objNode.ExpandStatus = objNode.ExpandStatus
??Dim objTemp
??
??If NOT UseConnectLine Then Exit Function
??
??For i = 1 To objNode.ChildrenCount??'对子节点进行遍历
???Set objTemp = objNode.Children(i)
???For j = objNode.Level To 1 Step -1
????If NOT objTemp.ParentNode Is Nothing Then
?????Set objTemp = objTemp.ParentNode
?????If NOT objTemp.NextNode Is Nothing Then
??????Document.getElementById(objNode.Children(i).Key).rows(0).cells(j).firstChild.src = Me.ImagePath & "I.gif"?
?????End If
????End If
???Next
???RefreshImage objNode.Children(i)
??Next
?End Function
?'===End=========================================================
?
?'===展开或收起节点
?Public Function Expand(objNode)
??On Error Resume Next
??Dim ChildrenCount
??Dim Name
??Dim i
??
??
??
??ChildrenCount = objNode.ChildrenCount
??Name = Me.Name
??AddFromExpand = True??'在这里，如果外部在事件中给其他的节点添加了子节点，还是会出错，因此不能依赖于外部代码，还要改进
??TreeView_Expand Name,objNode
??AddFromExpand = False
??On Error Goto 0
??
??'===取得要显示/隐藏的最后一个接点的关键字
??Dim ArrIndex??'定义一个存放要操作的行索引的数组
??Dim FirstIndex,LastIndex
??FirstIndex = Document.getElementById(objNode.Key).parentElement.parentElement.rowIndex + 1
??
??Dim obj
??
??Redim ArrIndex(0)
??
??Dim tm
??tm = timer()
??
??If objNode.ExpandStatus = 0 Then
???objNode.ExpandStatus = 1
???If objNode.NextNode Is Nothing Then
????Set obj = ObjNode
????Do Until NOT obj.NextNode Is Nothing
?????Set obj = obj.parentNode
?????If obj Is Nothing Then Exit Do
????Loop
????If obj Is Nothing Then
?????LastIndex = Document.getElementById("TabTreeView").rows.length - 1
????Else
?????LastIndex = Document.getElementById(obj.NextNode.Key).parentElement.parentElement.rowIndex -1
????End If
???Else
????'===有下一个节点
????LastIndex = Document.getElementById(objNode.NextNode.Key).parentElement.parentElement.rowIndex -1
???End If
???
???Dim strAllKey?'存放所有要显示的节点的Key，用“,”隔开
???strAllKey = objNode.Key & ","
???For i = FirstIndex To LastIndex
????NodeKey = Document.getElementById("TabTreeView").rows(i).cells(0).firstChild.id
????If Instr(strAllKey,Me.Nodes(NodeKey).parentNode.key & ",") > 0 And CBool(Me.Nodes(NodeKey).parentNode.ExpandStatus) Then
?????Redim Preserve ArrIndex(Ubound(ArrIndex)+1)
?????ArrIndex(Ubound(ArrIndex)) = i
?????strAllKey = strAllKey & NodeKey & ","
????End If
???Next
??ElseIf objNode.ExpandStatus = 1 Then
???'收起
???objNode.ExpandStatus = 0
???If objNode.NextNode Is Nothing Then
????Set obj = ObjNode
????Do Until NOT obj.NextNode Is Nothing
?????Set obj = obj.parentNode
?????If obj Is Nothing Then Exit Do
????Loop
????If obj Is Nothing Then
?????LastIndex = Document.getElementById("TabTreeView").rows.length - 1
????Else
?????LastIndex = Document.getElementById(obj.NextNode.Key).parentElement.parentElement.rowIndex -1
????End If
???Else
????'===有下一个节点
????LastIndex = Document.getElementById(objNode.NextNode.Key).parentElement.parentElement.rowIndex -1
???End If
???For i = FirstIndex To LastIndex
????Redim Preserve ArrIndex(Ubound(ArrIndex)+1)
????ArrIndex(Ubound(ArrIndex)) = i
???Next
??End If
??
??Dim NodeKey
??
??For i = 1 To Ubound(ArrIndex)
???NodeKey = Document.getElementById("TabTreeView").rows(ArrIndex(i)).cells(0).firstChild.id
???Me.Nodes(NodeKey).DisplayStatus = objNode.ExpandStatus
??Next
??
??'msgbox timer()-tm & Me.NodesCount
?End Function
?
?
?
?
?
?
?Public Property Get usePopupMenu()
??usePopupMenu = lPopupMenu
?End Property
?Public Property Let usePopupMenu(ByVal vNewValue)
??If lPopupMenu = "" Then
???Document.Write "

" _
?????& "" _
?????& "" _
?????& "" _
?????& "" _
?????& "

?
'=============================================================

'===结点的类===================================================
Class Node
?Public parentObject??'该节点归属的TreeView对象
?Public Key????'层的关键字
?Private lText???'显示的文本
?Public Property Get Text()
??Text = lText
?End Property
?Public Property Let Text(ByVal vNewValue)
??lText = vNewValue
??'===设置文字
??Dim objNode
??Set objNode = document.getElementById(me.Key)
??If Not objNode Is Nothing Then
???objNode.rows(0).cells(Me.Level+2).firstChild.innerHTML = vNewValue
??End If
?End Property
?
?Private lHyperLink
?Public Property Get HyperLink()
??HyperLink = lHyperLink
?End Property
?Public Property Let HyperLink(ByVal vNewValue)
??lHyperLink = vNewValue
??Dim objNode
??Set objNode = document.getElementById(me.Key)
??If Not objNode Is Nothing Then
???objNode.rows(0).cells(Me.Level+2).firstChild.href = vNewValue
??End If
?End Property
?
??
?Public Index???'索引
?Public Level???'层次，根节点层次为0
?'Public HyperLink??'联接的地址
?Public ParentNode??'父节点
?Public PreviousNode??'前一个兄弟节点
?Public NextNode???'下一个兄弟节点
?Public ChildrenCount?'子节点个数
?Public NodeIndex??'索引，每一级用两位（26个大写字母）表示，共有26*26=676个节点
?Public ChildrenNodes?'子节点集合，从零开始
?Public AddType???'节点添加类型
?Public Flag????'附加标记，主要用于给用户在事件中扩展使用
?
?Private lImage????'图标
?Private lDisplayStatus??'显示状态??0-未显示，1-显示
?Private lExpandStatus??'展开状态??0-未展开，1-展开
?Private lFirstDisplay??'是否是第一次显示
?
?Private Sub Class_Initialize()
??Set parentObject = Nothing
??Key = ""
??lText = ""
??Index = 0
??Level = 0
??HyperLink = ""
??Set ParentNode = Nothing
??Set PreviousNode = Nothing
??Set NextNode = Nothing
??Redim ChildrenNodes(0)
??Set ChildrenNodes(0) = Nothing
??ChildrenCount = 0
??NodeIndex = ""
??Image = ""
??lExpandStatus = 0
??lDisplayStatus = 0
??lFirstDisplay = True
??
??AddType = "1"??'默认为添加子节点
??Flag = ""
?End Sub
?
?Public Function Display()
??dim tabTreeView,udtTreeView
??Set tabTreeView = Document.getElementById("tabTreeView")
??Set udtTreeView = Me.parentObject
??Dim objNode
??dim objTab,objTR,objTD
??dim i
??Set objNode = Document.getElementById(Me.Key)
??If objNode Is Nothing Then
??
???'===检测节点的添加类型
???If Me.AddType = 1 Then
????If Me.ParentNode.NextNode Is Nothing Then
?????If Me.PreviousNode Is Nothing Then
??????i = Document.getElementById(Me.ParentNode.Key).parentElement.parentElement.rowIndex + 1
?????Else
??????Set objNode = Me.PreviousNode
??????Do Until objNode.ChildrenCount = 0
???????Set objNode = objNode.Children(objNode.ChildrenCount)
??????Loop
??????i = Document.getElementById(objNode.Key).parentElement.parentElement.rowIndex + 1
?????End If
????Else
?????i = Document.getElementById(Me.ParentNode.NextNode.Key).parentElement.parentElement.rowIndex
????End If
???ElseIf Me.AddType = 2 then
????i = Document.getElementById(Me.NextNode.Key).parentElement.parentElement.rowIndex
???ElseIf Me.AddType = 3 Then
????If Me.NextNode Is Nothing Then
?????Set objNode = Me.PreviousNode
?????Do Until objNode.ChildrenCount = 0
??????Set objNode = objNode.Children(objNode.ChildrenCount)
?????loop
?????i = Document.getElementById(objNode.Key).parentElement.parentElement.rowIndex + 1
????Else
?????i = Document.getElementById(Me.NextNode.Key).parentElement.parentElement.rowIndex
????End If
???Else
????i = tabTreeView.rows.length
???End If
???Set objTR=tabTreeView.insertRow(i)
???Set objTD=objTR.insertCell()
???objTD.innerHTML = "

End Class

?

相关软件：