asp:树型select菜单

调用处

<%
Dim rss,u
Set rss = Server.CreateObject("Adodb.RecordSet")
rss.Open "select ID,ParentID,SortName from [Sorts] order by ParentID",Conn,1,1
Response.Write "<select onChange=""MM_jumpMenu('this',this,0)"">"&GetListTree&"<select>"
rss.Close
%>

产生菜单的函数。

Function GetListTree
    Dim Result,i
    Redim u(rss.RecordCount,3)
    for i = 1 to rss.RecordCount
        u(i - 1,0) = rss("ID")
        u(i - 1,1) = rss("ParentID")
        u(i - 1,2) = rss("SortName")
        rss.MoveNext
    next
    'rss.moveFirst
    for i = 0 to uBound(u) - 1
        If Int(u(i,1)) = 0 Then
            Result = Result &"<option value='?SortID="& u(i,0) &"&ParentID="& ParentID &"'>◢"& u (i ,2) &"</option>"& vbcrlf & SunSorts(u(i ,0), 0)
        End If
    next
    GetListTree = Result
End Function

Function SunSorts(who,SunLevel)
        Dim selected
        Dim Result,i,sp,EndID
        for i = 0 to SunLevel
            sp = sp &"--"
        next
        for i = 0 to uBound(u) - 1
            If Int(u(i,1)) = Int(who) Then
                EndID = u(i ,0)
            End If
        next
        for i = 0 to uBound(u) - 1
            If Int(u(i,1)) = Int(who) Then
                If u(i ,0) - EndID = 0 Then
                    Result = Result &"<option "&selected&" value='?SortID="& u(i,0) &"&ParentID="&ParentID&"'>"& sp &"┕"& u(i ,2) & "</option>"& vbcrlf & SunSorts(u(i ,0),SunLevel + 1)
                Else
                    Result = Result &"<option "&selected&" value='?SortID="& u(i,0) &"&ParentID="&ParentID&"'>"& sp &"┝"& u(i ,2) & "</option>"& vbcrlf & SunSorts(u(i ,0),SunLevel + 1)
                End If
            End If
        next
        SunSorts = Result
End Function

 

效果