源代码如下: (本v1.2版修正了前期版本的两个BUG,不带数据库演示 )
感谢本类由 [71port]sean , [71port]80端口 原创编写
<%@LANGUAGE="VBSCRIPT" CODEPAGE="936"%>
<% Option explicit %>
<meta http-equiv="Content-Type" content="text/html; charset=gb2312">
<form name="dcf">
<%
Dim DC
Set DC =New DCombo
DC.GroupData="1,11|||2,22$$$3,33|||4,44$$$" '变量数据格式="大类值|||小类值$$$大类值|||小类值$$$"
DC.DCCS="0,1,dcf,第一选择,第二选择,CbName1,CbName2"
response.Write DC.ReturnDo
Set DC=nothing
Dim DC2
Set DC2 =New DCombo
DC2.GroupData="1,11|||2,22$$$3,33|||4,44$$$" '变量数据格式="大类值|||小类值$$$大类值|||小类值$$$"
DC2.DCCS="3,2,dcf,第一选择2,第二选择2,CbName3,CbName4"
response.Write DC2.ReturnDo
Set DC2=nothing
%>
</form>
<%
Class DCombo
'本类由 [71port]sean , [71port]80端口 原创编写,版权没有,任意抄写,注意完整
'公开发布于2005年12月15日,欢迎访问http://www.71port.com
'****************示例*********************
' Dim DC
' Set DC =New DCombo
' DC.GroupData="1,11|||2,22$$$3,33|||4,44$$$" '变量数据格式="大类值,大类名|||小类值,小类名$$$"
' DC.DCCS="0,1,dcf,第一选择,第二选择,CbName1,CbName2" '为了方便用户节省代码行数,一次性附值接口
' 'DCCS变量格式(输出类型,对象ID,FORM名称,标题一,标题二,Combo名一,Combo名二)
' DC.ActionType=0 '输出类型(默认为0)
' 0 为 大类名=大类值且小类名=小类值
' 1 为 大类名<>大类值且小类名=小类值
' 2 为 大类名=大类值且小类名<>小类值
' 3 为 大类名<>大类值且小类名<>小类值
' DC.DCID=1 '对象数字ID要唯一,必填
' DC.DCForm="dcf" '所属FORM的名称,必填
' DC.DC1Name="第一选择" '第一选择的名称唯一
' DC.DC2Name="第二选择" '第二选择的名称唯一
' DC.Combo1Name="ComboName1" '第一Combo的名称唯一
' DC.Combo2Name="ComboName2" '第二Combo的名称唯一
' response.Write DC.ReturnDo
' Set DC=nothing
'****************************************
'类名:双联动菜单类(12月15日修正)
'版本号: DCombo V1.2 版
'************************************
Private myActionType,myGroupData,myDCID,myForm
,myCombo1Name,myCombo2Name,myFirstType,mySecType
Private myDCCS
Private mylvzf,str,f1,f2,cs
Private myDC1Name,myDC2Name
Private ErrId,Do_Tmp,IsTest
Private Sub Class_Initialize()
Clear()
End Sub
Private Sub Class_Terminate()
Clear()
End Sub
Public Property Let DCCS(Value)
myDCCS=Split(Value,",")
If Ubound(myDCCS)<>6 Then
ErrId=ErrId&"2"
Else
myActionType=Cint(lvzf(myDCCS(0)))
myDCID="DCID"&Cint(lvzf(myDCCS(1)))
myForm=lvzf(myDCCS(2))
myDC1Name=myDCCS(3)
myDC2Name=myDCCS(4)
myCombo1Name=lvzf(myDCCS(5))
myCombo2Name=lvzf(myDCCS(6))
End If
End Property
Public Property Let GroupData(Value)
myGroupData=Value
myGroupData=lvzf(myGroupData)
End Property
Public Property Let ActionType(value)
myActionType=value
myActionType=Cint(lvzf(myActionType))
End Property
Public Property Let DCID(value)
myDCID=value
myDCID="DCID"&Cint(lvzf(myDCID))
End Property
Public Property Let DCForm(value)
myForm=value
myForm=lvzf(myForm)
End Property
Public Property Let Combo1Name(value)
myCombo1Name=value
End Property
Public Property Let Combo2Name(value)
myCombo2Name=value
End Property
Public Property Let DC1Name(value)
myDC1Name=value
End Property
Public Property Let DC2Name(value)
myDC2Name=value
End Property
Public Sub Clear()
IsTest=True'为True是调试状态
ErrId=""
myActionType=0
myGroupData=""
myForm=""
myDC1Name=""
myDC2Name=""
myCombo1Name=""
myCombo2Name=""
Do_Tmp=""
End Sub
Private Function FindErr(ErrId)'也许有更多不可预料的错误
Dim StrTmp
Select Case ErrId
Case "1"
StrTmp=StrTmp&"<font color=red>ErrId=1</font>: GroupData数据格式有误(注意大分割符$$$小分割符|||)<br>"
Case "2"
StrTmp=StrTmp&"<font color=red>ErrId=2</font>: DCCS变量格式有误(输出类型,对象ID,FORM名称,标题一,标题二,Combo名一,Combo名二)<br>"
End Select
If IsTest=True Then Response.Write StrTmp
End Function
Private Function lvzf(mylvzf)
mylvzf=replace(mylvzf," ","")
mylvzf=replace(mylvzf,"(","")
mylvzf=replace(mylvzf,")","")
mylvzf=replace(mylvzf,"'","")
mylvzf=replace(mylvzf,"“","")
mylvzf=replace(mylvzf,"”","")
lvzf=mylvzf
End Function
Private Function GetArray(str,f1,f2)
Dim i,x,y,tmp_a,tmp_b,a,b
tmp_a=split(str,f1)
x=ubound(tmp_a)-1
For i=0 To x
tmp_b=split(tmp_a(i),f2)
If ubound(tmp_b)>=y Then y=ubound(tmp_b)
Next
ReDim Result(x,y)
For a=0 To x
ReDim tmp_b(y)
tmp_b=split(tmp_a(a),f2)
If ubound(tmp_b)<>y Then ErrId=ErrId&"1" : Exit Function
For b=0 To y
Result(a,b)=tmp_b(b)
Next
Next
GetArray=Result
End Function
Private Function GetGroup(ArrayTmp)
Dim i,ii,iii,j,k,NoCF,FirstType_Temp
ReDim PubTmp(Ubound(ArrayTmp,1))
For i=0 To Ubound(ArrayTmp,1)
NoCF=True
If i=0 Then PubTmp(i)=ArrayTmp(0,0):FirstType_Temp=ArrayTmp(0,0)
For j=0 To i
If PubTmp(j)=ArrayTmp(i,0) Then NoCF=False
Next
If NoCF=True Then FirstType_Temp=FirstType_Temp&"|||"&ArrayTmp(i,0) : PubTmp(i)=ArrayTmp(i,0)
Next
myFirstType=Split(FirstType_Temp,"|||")
ReDim Result(Ubound(myFirstType),Ubound(ArrayTmp,1)+1)
For ii=0 To Ubound(myFirstType)
Result(ii,0)=myFirstType(ii)
k=0
j=0
NoCF=True
For iii=0 to Ubound(ArrayTmp,1)
If ArrayTmp(iii,0)=myFirstType(ii) Then
For j=0 to k
If Result(ii,j)=ArrayTmp(iii,1) Then NoCF=False
Next
If NoCF=True Then k=k+1 : Result(ii,k)=ArrayTmp(iii,1)
End If
Next
Next
GetGroup=Result
End Function
Private Function CheckErr(ErrId)
Dim i,ErrIdTmp
If Len(ErrId)>0 Then
For i=0 To Len(ErrId)
ErrIdTmp=Left(ErrId,i)
FindErr(ErrIdTmp)
Next
CheckErr=False
Else
CheckErr=True
End If
End Function
Public Function ReturnDo()
Dim i,k,m,n
Dim Array_Temp
Array_Temp=GetArray(myGroupData,"$$$","|||")
mySecType=GetGroup(Array_Temp)
Do_Tmp=Do_Tmp&myDC1Name&"<select name="""&myCombo1Name&""" size=""1"" onChange="""&myDCID&"redirect(this.options.selectedIndex)"">"&vbcrlf
For i=0 To Ubound(myFirstType)
Select Case myActionType
Case 0,2
Do_Tmp=Do_Tmp&"<option value="""&myFirstType(i)&""">"&myFirstType(i)&"</option>"&vbcrlf
Case 1,3
Dim case1a_tmp : case1a_tmp=Split(myFirstType(i),",")
Do_Tmp=Do_Tmp&"<option value="""&case1a_tmp(0)&""">"&case1a_tmp(1)&"</option>"&vbcrlf
Case Else
Do_Tmp=Do_Tmp&"<option value="""&myFirstType(i)&""">"&myFirstType(i)&"</option>"&vbcrlf
End Select
Next
Do_Tmp=Do_Tmp&"</select>"&vbcrlf
Do_Tmp=Do_Tmp&myDC2Name&"<select name="""&myCombo2Name&""" size=""1"">"&vbcrlf
For i=1 To Ubound(mySecType,2)
If mySecType(0,i)<>"" Then
Select Case myActionType
Case 0,1
Do_Tmp=Do_Tmp&"<option value="""&mySecType(0,i)&""">"&mySecType(0,i)&"</option>"&vbcrlf
Case 2,3
Dim case2a_tmp : case2a_tmp=Split(myFirstType(i),",")
Do_Tmp=Do_Tmp&"<option value="""&case2a_tmp(0)&""">"&case2a_tmp(1)&"</option>"&vbcrlf
Case Else
Do_Tmp=Do_Tmp&"<option value="""&mySecType(0,i)&""">"&mySecType(0,i)&"</option>"&vbcrlf
End Select
End If
Next
Do_Tmp=Do_Tmp&"</select>"&vbcrlf
Do_Tmp=Do_Tmp&"<script>"&vbcrlf
Do_Tmp=Do_Tmp&"var "&myDCID&"groups=document."&myForm&"
."&myCombo1Name&".options.length"&vbcrlf
Do_Tmp=Do_Tmp&" var "&myDCID&"group=new Array("&myDCID&"groups)"&vbcrlf
Do_Tmp=Do_Tmp&"for (i=0; i<"&myDCID&"groups; i++)"&vbcrlf
Do_Tmp=Do_Tmp&""&myDCID&"group[i]=new Array()"&vbcrlf
For m=0 To Ubound(myFirstType)
n=1
k=-1
Do While n<UBound(mySecType,2)
If mySecType(m,n)<>"" Then
k=k+1
Select Case myActionType
Case 0,1
Do_Tmp=Do_Tmp& ""&myDCID&"group["&m&"]["&k&"]=new Option("""&mySecType(m,n)&""","""&mySecType(m,n)&""")"&vbcrlf
Case 2,3
Dim case3a_tmp : case3a_tmp=Split(mySecType(m,n),",")
Do_Tmp=Do_Tmp& ""&myDCID&"group["&m&"]["&k&"]=new Option("""&case3a_tmp(1)&""","""&case3a_tmp(0)&""")"&vbcrlf
Case Else
Do_Tmp=Do_Tmp& ""&myDCID&"group["&m&"]["&k&"]=new Option("""&mySecType(m,n)&""","""&mySecType(m,n)&""")"&vbcrlf
End Select
End If
n=n+1
Loop
Next
Do_Tmp=Do_Tmp&"var "&myDCID&"temp=document."&myForm&"."&myCombo2Name&""&vbcrlf
Do_Tmp=Do_Tmp&"function "&myDCID&"redirect("&myDCID&"x){"&vbcrlf
Do_Tmp=Do_Tmp&"for ("&myDCID&"m="&myDCID&"temp.options.length-1;"&myDCID&"m>0;"&myDCID&"m--)"&vbcrlf
Do_Tmp=Do_Tmp&""&myDCID&"temp.options["&myDCID&"m]=null"&vbcrlf
Do_Tmp=Do_Tmp&"for (i=0;i<"&myDCID&"group["&myDCID&"x].length;i++){"&vbcrlf
Do_Tmp=Do_Tmp&""&myDCID&"temp.options[i]=new Option("&myDCID&"group["&myDCID&"x][i].text,"&myDCID&"group["&myDCID&"x][i].value)"&vbcrlf
Do_Tmp=Do_Tmp&" }"&vbcrlf
Do_Tmp=Do_Tmp&""&myDCID&"temp.options[0].selected=true"&vbcrlf
Do_Tmp=Do_Tmp&" }"&vbcrlf
Do_Tmp=Do_Tmp&" </script>"&vbcrlf
If CheckErr(ErrId)=True Then
ReturnDo=Do_Tmp
Else
ReturnDo="调用类对象发生错误"
End If
End Function
End Class
%>