作者:[转载]  文章来源:http://www.alixixi.com/  更新时间:2005-12-20

源代码如下: (本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
%>

网友评论
相关搜索
阿里西西Baidu.com搜索