Försöker att skapa en "ul och li"-lista, men mina hjärnceller står still.
Skulle det inte gå att utgå ifråd detta må någe vis?
Sub LinkTree(intParent,intIndent) : Dim X,Z
For X = 0 To Ubound(arrLinks,2)
If arrLinks(1,X) = intParent then
IF intIndent < 0 then
Response.Write "<li>"& arrLinks(2,X) &"</ul>"& VbCrlf
ELSE
For Z = 1 To intIndent
Response.Write Z &" * "& intIndent
next
Response.Write("<li><a href=""javascript:void(0);"">"& arrLinks(2,X)& "</a></li></ul>"& VbCrlf)
END IF
Call LinkTree(arrLinks(0,X),intIndent + 1)
End If
Next
End Sub
Jag satt med detta i fyra timmar i går och har pillat in ul och li-taggar men det funkar inte. Jag förstår att det är något som fattas funktionen. Har googlat: recursive ASP function li ul osv. utan något bra resultat.
För FSO så har jag en sådan funktion. Eventuellt så går den att överföra på ngt smidigt sätt till getrows?!
function GetSubFolders(pfolder)
Dim sFolders, fldr, fil
sFolders = "<LI>" & pfolder.Name
If pfolder.SubFolders.Count > 0 Or pfolder.Files.Count > 0 Then _
sFolders = sFolders & "<UL>"
For Each fldr In pfolder.SubFolders
sFolders = sFolders & GetSubFolders(fldr)
Next
For Each fil In pfolder.Files
sFolders = sFolders & "<LI>" & fil.Name & "</LI>"
Next
If pfolder.SubFolders.Count > 0 Or pfolder.Files.Count > 0 Then _
sFolders = sFolders & "</UL>"
sFolders = sFolders & "</LI>"
Set fil = Nothing
Set fldr = Nothing
GetSubFolders = sFolders
End function
Hur är listan du vill skriva ut sparad? För att göra en rekursiv funktion som skriver ut en trädsstruktur bör man... hmmm... jag förklarar med ett exempel istället :)
Nu ligger det en snygg liten trädstruktur där och för att skriva ut rasket rekursivt kan man antaglien göra så här
Sub PrintTree(intParent)
Dim objNode, objChild
strSQL = "SELECT intNode, strNamn FROM tblTree WHERE intParent = " & intParent
Set objNode = Server.CreateObject("ADODB.Recordset")
Set objChild = Server.CreateObject("ADODB.Recordset")
objNode.Open strSQL, objConn
While Not objNode.EOF
strSQL = "SELECT 1 FROM tblTree WHERE intParent = " & objNode(0)
objChild.Open strSQL, objConn
If objChild.EOF Then
Response.Write "<li>" & objNode(1) & "</li>"
Else
Response.Write "<ul>"
PrintTree objNode(0)
Response.Write "</ul>"
End If
objChild.Close
objNode.MoveNext
Wend
Set objChild = Nothing
objNode.Close : Set objNode = Nothing
objConn.Close : Set objConn = Nothing
End Sub
Response.Write "<ul>" & PrintTree(0) & "</ul>"
Jag säger antagligen, eftersom jag inte har testat detta mer än i huvudet... ;) Och detta kanske inte passar ditt behov heller :)
Ahh... det är ju förmodligen därför att <li>-elementen stör till det antar jag. Om du byter ut list-elementen mot ett tecken eller en liten bild så får du nog se vad jag hade tänkt att det skulle se ut som.
red.
Det Space(x) gör är returnerar en sträng med x mellanslag.
Åhhh, det var inte lätt detta. Jag är tebax på ruta ett. Om det inte blir li och ul taggar enligt strukturen på denna sida: http://member.webforum.nu/Jesper T/liul.htm
så kommer inte javascriptet att funka.
"Jag" gjorde en variant med getrows, och den ritar ju ut strukturen rätt iaf. :)
Sub LinkTree(intParent,intIndent) : Dim X,Z
For X = 0 To Ubound(arrLinks,2)
If arrLinks(1,X) = intParent then
For Z = 1 To intIndent
Response.Write "-----"
next
IF len(arrLinks(3,X)) > 3 then
Response.Write("<span><a href="""& arrLinks(3,X) &""">"& arrLinks(2,X)& "</a></span><br>"& VbCrlf)
ELSE
Response.Write "<span>"& arrLinks(2,X) &"</span><br>"& VbCrlf
END IF
Call LinkTree(arrLinks(0,X),intIndent + 1)
End If
Next
End Sub
Det varkar ju som om Engine^s kod inte funkar riktigt, så jag kan väl bidra med den jag skrev nu i brist på annat?
Har bytt ut namnet på tabellen till tblNodes och kolumnerna till nodeId, nodeParent och nodeText, annars är det ingen skillnad i databasdesignen.
<%
Set objConn = Server.CreateObject("ADODB.Connection")
objConn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & Server.MapPath("db.mdb")
Sub PrintTree(intParent)
strSQL = "SELECT nodeId, nodeParent, nodeText FROM tblNodes WHERE nodeParent = " & intParent
Set objRubrik = objConn.Execute(strSQL)
Response.Write("<ul>" & vbCrLf)
Do Until objRubrik.EOF
Response.Write("<li>" & objRubrik(2) & "</li>" & vbCrLf)
strSQL = "SELECT nodeParent FROM tblNodes WHERE nodeParent = " & objRubrik(0)
Set objNode = objConn.Execute(strSQL)
If NOT objNode.EOF Then
PrintTree objNode(0)
End If
objNode.Close : Set objNode = Nothing
objRubrik.MoveNext
Loop
objRubrik.Close : Set objRubrik = Nothing
Response.Write("</ul>")
End Sub
PrintTree 0
objConn.Close : Set objConn = Nothing
%>
Jag brukar aldrig använda mig av list-element, men skriver du ut rasket såhär kanske det blir bättre. Om inte så är det ju bara att testa flytta runt lite bland <li>- och <ul>-taggarna :)
Med min bristande kunskap om dessa listelement skulle jag kunna gissa på att det är helt onödigt att använda Space()-funktionen.
Sub PrintTree(intParent, intDepth)
Dim objNode, objChild
strSQL = "SELECT intNode, strNamn FROM tblTree WHERE intParent = " & intParent
Set objNode = Server.CreateObject("ADODB.Recordset")
Set objChild = Server.CreateObject("ADODB.Recordset")
objNode.Open strSQL, objConn
While Not objNode.EOF
strSQL = "SELECT 1 FROM tblTree WHERE intParent = " & objNode(0)
objChild.Open strSQL, objConn
If objChild.EOF Then
Response.Write Space(intDepth * 4) & "<li>" & objNode(1) & "</li>"
Else
Response.Write "<li>" & Space(intDepth * 4) & "<ul>" & objNode(1)
PrintTree objNode(0), intDepth + 1
Response.Write "</ul></li>"
End If
objChild.Close
objNode.MoveNext
Wend
Set objChild = Nothing
objNode.Close : Set objNode = Nothing
objConn.Close : Set objConn = Nothing
End Sub
Reponse.Write "<ul>"
PrintTree 0, 0
Response.Write "</ul>"
