Hi,
I have found in the forum examples or 2 dropdown lists and 3 dropdown list. Does anyone have any idea how to do 4 or more dropdown list? I tried to modify it from an example script found here but failed.
This is what I have done after modification:
I have found in the forum examples or 2 dropdown lists and 3 dropdown list. Does anyone have any idea how to do 4 or more dropdown list? I tried to modify it from an example script found here but failed.
This is what I have done after modification:
Code:
<%
Function QuadLinkedList(oCon, sQuery, nSize, sDBField1, sDBField2, sDBField3, sDBField4, sDBFieldResult)
' this is a general-purpose routine that implements quad-linked
' listboxes. here is the drill
Dim sTemp ' general-purpose temp variable
Dim sScript ' bucket for holding the script structure
Dim sSelect ' bucket for the <SELECT> statement
Dim sArray1 ' bucket to store the DBField2 array
Dim nField1 ' counter for the 1st array
Dim sArray2 ' bucket to store the DBField3 array
Dim nField2 ' counter for the 2nd array
Dim sArray3 ' bucket to store the DBField4 array
Dim nField3 ' counter for the 3rd array
Dim rs ' recordset
Dim sLastVal1 ' comparison string to test for record changes
Dim sLastVal2 ' comparison string to test for record changes
Dim sLastVal3 ' comparison string to test for record changes
On Error Resume Next
If Not IsObject(oCon) Then
sScript = "error processing triplelist -- need a connection object."
ElseIf oCon.State <> 1 Then
If Err.number <> 0 Then
sScript = "error processing triplelist -- invalid connection object."
Else
sScript = "error processing triplelist -- connection is not open."
End If
Else
Set rs = oCon.Execute(sQuery)
If Err.number <> 0 Then
sScript = "error processing query. Error " & Hex(Err.number) & ": " & Err.Description
ElseIf rs.EOF Then
sScript = "no records found -- seems wrong"
Else
On Error Goto 0
sScript = "<SCR" & "IPT LANGUAGE=""JavaScript"">" & vbCrlf
sScript = sScript & "var array1 = new Array();" & vbCrlf
sScript = sScript & "var array2 = new Array();" & vbCrlf
sScript = sScript & "var array3 = new Array();" & vbCrlf
sSelect = "<table>" & VbCrLf
sSelect = sSelect & "<tr><td width=180><font color=red>*</font>Facility ID: </td><td bgcolor=red><input type=text name=txtselFacility_id size=50/></td><td>" & VbCrLf
sSelect = sSelect & "<SELECT style=""width: 200px"" NAME=""selFacility_id"" SIZE=""" & nSize & _
""" ONCHANGE=""setoption(this.form,this.name);return(clickcombo(1 ,document.forms[0].selFacility_id,document.forms[0].selTester_name,document.forms[0].selTester_family,document.forms[0].selNo_of_testers));""><OPTION>Select an existing record</OPTION>" & vbCrlf
sLastVal1 = "empty" ' set up a default test value...
Do Until rs.EOF
If rs(sDBField1) <> sLastVal1 Then
If Right(sArray1, 4) = "," & vbCrlf Then
' pull off any trailing commas
sArray1 = Left(sArray1, Len(sArray1) - 4)
End If
If Len(sArray1) > 0 Then
sArray1 = sArray1 & ");" & vbCrlf
End If
' pick up new information for this row...
nField1 = nField1 + 1
sLastVal1 = rs(sDBField1)
' write the new contents of field 1 to the select statement
sSelect = sSelect & "<OPTION VALUE=" & nField1 & ">" & sLastVal1 & "</OPTION>"
' write a new entry in array1 for the field 2 values...
sArray1 = sArray1 & "array1[" & nField1 & "] = new Array(" & vbCrlf
' and reset the test values for field 2
nField2 = 0
sLastVal2 = "empty"
End If
If sLastVal2 <> rs(sDBField2) Then
If Right(sArray2, 4) = "," & vbCrlf Then
' pull off any trailing commas
sArray2 = Left(sArray2, Len(sArray2) - 4)
End If
If Len(sArray2) > 0 Then
sArray2 = sArray2 & ");" & vbCrlf
End If
' pick up new information for this row...
sLastVal2 = rs(sDBField2)
nField2 = nField2 + 1
' write a new entry in array1 containing this set of field 2 values...
sArray1 = sArray1 & " " & 1000 * nField1 + nField2 & ",""" & sLastVal2 & """," & vbCrlf
' write a new entry in array2 for this set of field 3 values...
sArray2 = sArray2 & "// values for " & sLastVal2 & vbCrlf
sArray2 = sArray2 & "array2[" & 1000 * nField1 + nField2 & "] = new Array(" & vbCrlf
' and reset the test values for field 3
nField3 = 0
sLastVal3 = "empty"
End If
If sLastVal3 <> rs(sDBField3) Then
If Right(sArray3, 4) = "," & vbCrlf Then
' pull off any trailing commas
sArray3 = Left(sArray3, Len(sArray3) - 4)
End If
If Len(sArray3) > 0 Then
sArray3 = sArray3 & ");" & vbCrlf
End If
' pick up new information for this row...
sLastVal3 = rs(sDBField3)
nField3 = nField3 + 1
' write a new entry in array2 containing this set of field 3 values...
sArray2 = sArray2 & " " & 2000 * nField2 + nField3 & ",""" & sLastVal3 & """," & vbCrlf
' write a new entry in array3 for this set of field 4 values...
sArray3 = sArray3 & "// values for " & sLastVal3 & vbCrlf
sArray3 = sArray3 & "array3[" & 2000 * nField2 + nField3 & "] = new Array(" & vbCrlf
End If
' write the field4 values to the field3 array...
sArray3 = sArray3 & " " & rs(sDBFieldResult) & ",""" & rs(sDBField4) & """," & vbCrlf
rs.MoveNext ' move on to the next record...
Loop
' if these arrays weren't previously closed out, then close them now
If Right(sArray3, 4) = "," & vbCrlf Then
' pull off any trailing commas
sArray3 = Left(sArray3, Len(sArray3) - 4)
End If
If Len(sArray3) > 0 Then
sArray3 = sArray3 & ");" & vbCrlf
End If
' if these arrays weren't previously closed out, then close them now
If Right(sArray2, 4) = "," & vbCrlf Then
' pull off any trailing commas
sArray2 = Left(sArray2, Len(sArray2) - 4)
End If
If Len(sArray2) > 0 Then
sArray2 = sArray2 & ");" & vbCrlf
End If
' if these arrays weren't previously closed out, then close them now
If Right(sArray1, 4) = "," & vbCrlf Then
' pull off any trailing commas
sArray1 = Left(sArray1, Len(sArray1) - 4)
End If
If Len(sArray1) > 0 Then
sArray1 = sArray1 & ");" & vbCrlf
End If
' close out the listbox/combobox and add the second, third and fourth listbox/combobox entries...
sSelect = sSelect & "</SELECT>" & vbCrlf
sSelect = sSelect & "<tr><td><font color=red>*</font>Tester Name: </td><td bgcolor=red><input type=text name=txtselTester_name size=50></td><td>" & VbCrLf
sSelect = sSelect & "<SELECT style=""width: 200px"" NAME=""selTester_name"" SIZE=""" & nSize & _
""" ONCHANGE=""setoption(this.form,this.name);return(clickcombo(2 ,document.forms[0].selFacility_id,document.forms[0].selTester_name,document.forms[0].selTester_family,document.forms[0].selNo_of_testers));""><OPTION>Select an existing record</OPTION></SELECT>" & vbCrlf
sSelect = sSelect & "</SELECT>" & vbCrlf
sSelect = sSelect & "<tr><td>Tester Family: </td><td><input type=text name=txtselTester_family size=50></td><td>" & VbCrLf
sSelect = sSelect & "<SELECT style=""width: 200px"" NAME=""selTester_family"" SIZE=""" & nSize & _
""" ONCHANGE=""setoption(this.form,this.name);return(clickcombo(3 ,document.forms[0].selFacility_id,document.forms[0].selTester_name,document.forms[0].selTester_family,document.forms[0].selNo_of_testers));""><OPTION>Select an existing record</OPTION></SELECT>" & vbCrlf
sSelect = sSelect & "<tr><td>Number of Testers: </td><td><input type=text name=txtselNo_of_testers size=50></td><td>" & VbCrLf
sSelect = sSelect & "<SELECT style=""width: 200px"" NAME=""selNo_of_testers"" SIZE=""" & nSize & _
""" ONCHANGE=""setoption(this.form,this.name)""><OPTION>Select an existing record</OPTION></SELECT>" & vbCrlf
sSelect = sSelect & "</table><br>" & VbCrLf
' finally clean up the script and write the whole thing out as a block
sScript = sSelect & vbCrlf & _
sScript & vbCrlf & _
sArray1 & vbCrlf & _
sArray2 & vbCrlf & _
sArray3 & vbCrlf & _
"</SCR" & "IPT>" & vbCrlf
' -----------------------------------------------------------------
End If
' close and free the recordset
rs.Close
Set rs = Nothing
End If
' and get the fleep outta here
QuadLinkedList = sScript
End Function
%>![[thumbsup2]](/data/assets/smilies/thumbsup2.gif "[thumbsup2] [thumbsup2]")
DreX