本程序有两文件test.asp 和tree.asp 还有一些图标文件
1。test.asp 调用类生成树 代码如下
<%@ Language=VBScript %>
<html>
<head>
<link rel="stylesheet" href="tree.css">
<title>tree</title>
</head>
<!-- #include file="tree.asp" -->
<%
''========================================
'' BUILDING A TREE PROGRAMATICALLY
''========================================
'' This approach would be best suited for building
'' dynamic trees using For..Next loops and such.
Set MyTree2 = New Tree
MyTree2.Top = 10
MyTree2.Left = 10
MyTree2.ExpandImage = "plus.gif"
MyTree2.CollapseImage = "minus.gif"
MyTree2.LeafImage = "webpage.gif"
'' Notice the indentation used to reprensent the hierarchy
Set Node1 = MyTree2.CreateChild("script")
Set SubNode1 = Node1.CreateChild("server")
Set secSubNode1 = SubNode1.CreateChild("html")
secSubNode1.CreateChild "<A HREF=""http://127.0.0.1/"">asp</A>"
secSubNode1.CreateChild "<A HREF=""http://127.0.0.1/"">php</A>"
secSubNode1.CreateChild "<A HREF=""http://127.0.0.1/"">jsp</A>"
Set SubNode2 = Node1.CreateChild("os")
SubNode2.CreateChild "<A HREF=""#"">winnt</A>"
SubNode2.CreateChild "<A HREF=""#"">win2000</A>"
Set Node2 = MyTree2.CreateChild("Desktop")
Node2.CreateChild "<A HREF=""#"">Area Code Lookup</A>"
Node2.CreateChild "<A HREF=""#"">Arin Based Whois Search</A>"
Node2.CreateChild "<A HREF=""#"">World Time Zone Map</A>"
MyTree2.Draw()
Set MyTree2 = Nothing
%>
</BODY>
</HTML>
2。tree.asp 类的定义 代码如下
<%
''******************************************************
'' Author: Jacob Gilley
'' Email: avis7@airmail.net
'' My Terms: You can use this control in anyway you see fit
'' cause I have no means to enforce any guidelines
'' or BS that most developers think they can get
'' you to agree to by spouting out words like
'' "intellectual property" and "The Code Gods".
'' - Viva la Microsoft!
''******************************************************
Dim gblTreeNodeCount:gblTreeNodeCount = 1
Class TreeNode
Public Value
Public ExpandImage
Public CollapseImage
Public LeafImage
Public Expanded
Private mszName
Private mcolChildren
Private mbChildrenInitialized
Public Property Get ChildCount()
ChildCount = mcolChildren.Count
End Property
Private Sub Class_Initialize()
mszName = "node" & CStr(gblTreeNodeCount)
gblTreeNodeCount = gblTreeNodeCount + 1
mbChildrenInitialized = False
Expanded = False
End Sub
Private Sub Class_Terminate()
If mbChildrenInitialized And IsObject(mcolChildren) Then
mcolChildren.RemoveAll()
Set mcolChildren = Nothing
End If
End Sub
Private Sub InitChildList()
Set mcolChildren = Server.CreateObject("Scripting.Dictionary")
mbChildrenInitialized = True
End Sub
Private Sub LoadState()
If Request(mszName) = "1" Or Request("togglenode") = mszName Then
Expanded = True
End If
End Sub
Public Function CreateChild(szValue)
If Not mbChildrenInitialized Then InitChildList()
Set CreateChild = New TreeNode
CreateChild.Value = szValue
CreateChild.ExpandImage = ExpandImage
CreateChild.CollapseImage = CollapseImage
CreateChild.LeafImage = LeafImage
mcolChildren.Add mcolChildren.Count + 1, CreateChild
End Function
Public Sub Draw()
LoadState()
Response.Write "<table border=""0"">" & vbCrLf
Response.Write "<tr><td>" & vbCrLf
If Expanded Then
Response.Write "<a href=""javascript:collapseNode(''" & mszName & "'')""><img src=""" & CollapseImage & """ border=""0""></a>" & vbCrLf
ElseIf Not mbChildrenInitialized Then
Response.Write "<img src=""" & LeafImage & """ border=0>" & vbCrLf
Else
Response.Write "<a href=""javascript:expandNode(''" & mszName & "'')""><img src=""" & ExpandImage & """ border=""0""></a>" & vbCrLf
End If
Response.Write "</td>" & vbCrLf
Response.Write "<td>" & Value & "</td></tr>" & vbCrLf
If Expanded Then
Response.Write "<input type=""hidden"" name=""" & mszName & """ value=""1"">" & vbCrLf
If mbChildrenInitialized Then
Response.Write "<tr><td> </td>" & vbCrLf
Response.Write "<td>" & vbCrLf
For Each ChildNode In mcolChildren.Items
ChildNode.Draw()
Next
Response.Write "</td>" & vbCrLf
Response.Write "</tr>" & vbCrLf
End If
End If
Response.Write "</table>" & vbCrLf
End Sub
End Class
Class Tree
Public Top
Public Left
Public ExpandImage
Public CollapseImage
Public LeafImage
Private mszPosition
Private mcolChildren
Public Property Let Absolute(bData)
If bData Then mszPosition = "absolute" Else mszPosition = "relative"
End Property
Public Property Get Absolute()
Absolute = CBool(mszPosition = "absolute")
End Property
Private Sub Class_Initialize()
Set mcolChildren = Server.CreateObject("Scripting.Dictionary")
mnTop = 0
mnLeft = 0
mszPosition = "absolute"
End Sub
Private Sub Class_Terminate()
mcolChildren.RemoveAll()
Set mcolChildren = Nothing
End Sub
Public Function CreateChild(szValue)
Set CreateChild = New TreeNode
CreateChild.Value = szValue
CreateChild.ExpandImage = ExpandImage
CreateChild.CollapseImage = CollapseImage
CreateChild.LeafImage = LeafImage
mcolChildren.Add mcolChildren.Count + 1, CreateChild
End Function
Public Sub LoadTemplate(szFileName)
Dim objWorkingNode
Dim colNodeStack
Dim fsObj, tsObj
Dim szLine
Dim nCurrDepth, nNextDepth
Set colNodeStack = Server.CreateObject("Scripting.Dictionary")
Set fsObj = CreateObject("Scripting.FileSystemObject")
Set tsObj = fsObj.OpenTextFile(szFileName, 1)
nCurrDepth = 0
While Not tsObj.AtEndOfLine
nNextDepth = 1
szLine = tsObj.ReadLine()
If nCurrDepth = 0 Then
Set objWorkingNode = CreateChild(Trim(szLine))
nCurrDepth = 1
Else
While Mid(szLine,nNextDepth,1) = vbTab Or Mid(szLine,nNextDepth,1) = " "
nNextDepth = nNextDepth + 1
WEnd
If nNextDepth > 1 Then szLine = Trim(Mid(szLine,nNextDepth))
If szLine <> "" Then
If nNextDepth > nCurrDepth Then
If colNodeStack.Exists(nCurrDepth) Then
Set colNodeStack.Item(nCurrDepth) = objWorkingNode
Else
colNodeStack.Add nCurrDepth, objWorkingNode
End If
Set objWorkingNode = objWorkingNode.CreateChild(szLine)
nCurrDepth = nCurrDepth + 1
ElseIf nNextDepth <= nCurrDepth Then
If nNextDepth > 1 Then
nNextDepth = nNextDepth - 1
While Not colNodeStack.Exists(nNextDepth) And nNextDepth > 1
nNextDepth = nNextDepth - 1
WEnd
Set objWorkingNode = colNodeStack.Item(nNextDepth)
Set objWorkingNode = objWorkingNode.CreateChild(szLine)
nNextDepth = nNextDepth + 1
Else
Set objWorkingNode = CreateChild(szLine)
End If
nCurrDepth = nNextDepth
End If
End If
End If
WEnd
tsObj.Close()
Set tsObj = Nothing
Set fsObj = Nothing
colNodeStack.RemoveAll()
Set colNodeStack = Nothing
End Sub
Public Sub Draw()
AddClientScript()
Response.Write "<div id=""treectrl"" style=""left: " & Left & "px; top: " & Top & "px; position: " & mszPosition & ";"">" & vbCrLf
Response.Write "<form name=""treectrlfrm"" action=""" & Request.ServerVariables("SCRIPT_NAME") & """ method=""get"">" & vbCrLf
Response.Write "<table border=""0"">" & vbCrLf
Response.Write "<tr><td>" & vbCrLf
For Each ChildNode In mcolChildren.Items
ChildNode.Draw()
Next
Response.Write "</td></tr>" & vbCrLf
Response.Write "</table>" & vbCrLf
Response.Write "<input type=""hidden"" name=""togglenode"" value="""">" & vbCrLf
Response.Write "</form>" & vbCrLf
Response.Write "</div>" & vbCrLf
End Sub
Private Sub AddClientScript()
%>
<script language="JavaScript">
function expandNode(szNodeName)
{
if(document.layers != null) {
document.treectrl.document.treectrlfrm.togglenode.value = szNodeName;
document.treectrl.document.treectrlfrm.submit();
}
else {
document.all["treectrlfrm"].togglenode.value = szNodeName;
document.all["treectrlfrm"].submit();
}
}
function collapseNode(szNodeName)
{
if(document.layers != null) {
document.treectrl.document.treectrlfrm.elements[szNodeName].value = -1;
document.treectrl.document.treectrlfrm.submit();
}
else {
document.treectrlfrm.elements[szNodeName].value = -1;
document.treectrlfrm.submit();
}
}
</script>
<%
End Sub
End Class
%>