www.gusucode.com > CC校友录贴吧 CCBar源码程序asp编程 > class/class_html_form.asp
<% '=================================================================== '= Description : Class's parameters define '= Time : Created At OCT,19,2003 '= Change Log : '= 2005-8-6 10:23 by cc '= * 增加数据校验自动生成 arrChk '= 2005-8-6 14:55 by cc '= * 把必填符号的位置放在输入项后面 '= 必填符号在inc_config.asp定义 '= Const MUST_FILLED_CHAR = "*" '= 2005-8-25 21:57 by cc '= * 增加函数AddSelectByArray(strName,strValue,arrShow,arrValue,strSelFlag) '= 从字符串中读取记录,作为下来选项,字符串中的可选项用逗号分隔 '= 2005-8-26 1:16 by cc '= * 带有提示的输入项 '= Public Sub AddTdClew(strTdValue,strTdClass1,strTdClass2,strClew) '=================================================================== %> <!-- #include file = "./class_client_check.asp" --> <% Class classForm Private strAction,strMethod,strId,strName,strOnSubmit,cssColumnScale Private cssBtn,cssText,cssTextrea,cssSeleck,cssChkBox,cssRadio Private bolSubmit Private strTdValueChk '== 临时存储td value来校验是否有* Private strHtmlCode Public arrDataChk '== 数据校验数组 '=================================================================== '= Description : Class's initialization '= Time : Created At OCT,19,2003 '= Modify : '= Time Description '=================================================================== Private Sub Class_Initialize() strAction = "./" strMethod = "post" strId = "" strName = "" strOnSubmit = "" strTdValueChk = "" bolSubmit = True cssBtn = GBL_cssIptBtn cssText = GBL_cssIptText cssTextrea = GBL_cssTextrea cssSelect = GBL_cssSelect cssChkBox = GBL_cssChkBox cssRadio = GBL_cssRadio cssColumnScale = GBL_cssColumnScale End Sub '=================================================================== '= Description : Class's terminate '= Time : Created At OCT,19,2003 '= Modify : '= Time Description '=================================================================== Private Sub Class_Terminate() strAction = "./" strMethod = "post" strId = "" strName = "" strOnSubmit = "" strTdValueChk = "" bolSubmit = True Set strHtmlCode = Nothing End Sub '=================================================================== '= Description : Set members parameters '= Time : Created At OCT,19,2003 '= Modify : '= Time Description '=================================================================== Public Property Let Action(value) strAction = Trim(value) End Property Public Property Let Method(value) strMethod = Trim(value) End Property Public Property Let Id(value) strId = Trim(value) End Property Public Property Let DataChkArr(value) ReDim arrDataChk(UBound(value)) Dim Flag Flag = True For i = LBound(value) To UBound(value) arrDataChk(i) = value(i) Flag = False Next If Flag = True Then Set arrDataChk = Nothing End If End Property Public Property Let Name(value) strName = Trim(value) End Property Public Property Let OnSubmit(value) strOnSubmit = Trim(value) End Property Public Property Let ColumnScale(value) cssColumnScale = Trim(value) End Property Public Property Let IptBtn(value) cssBtn = Trim(value) End Property Public Property Let IptText(value) cssText = Trim(value) End Property Public Property Let Submit(value) bolSubmit = Trim(value) End Property '=================================================================== '= Description : Set public functions and sub of class '= Time : Created At OCT,19,2003 '= Modify : '= Time Description '=================================================================== Public Sub MakeForm() 'strHtmlCode = "<form action='" & strAction & "'" 'strHtmlCode = strHtmlCode & " method='" & strMethod & "'" 'strHtmlCode = strHtmlCode & " id=" & strId 'strHtmlCode = strHtmlCode & " name=" & strName 'If strOnSubmit <> "" Then ' strHtmlCode = strHtmlCode & " onsubmit='" & strOnSubmit & "'" 'End If 'strHtmlCode = strHtmlCode & ">[table]" strHtmlCode = strHtmlCode & "[table]" strHtmlCode = strHtmlCode & "<script language=JavaScript>var strNowForm = '" & strName & "'</Script>" 'strHtmlCode = strHtmlCode & "</form>" End Sub Public Sub MakeTable(strBorder,strPadding,strSpacing,strAlign,strWidth,strClass) Dim strTmp strTmp = "<table border=" & strBorder strTmp = strTmp & " cellpadding=" & strPadding strTmp = strTmp & " cellspacing=" & strSpacing strTmp = strTmp & " align=" & strAlign strTmp = strTmp & " width=" & strWidth strTmp = strTmp & " class=" & strClass strTmp = strTmp & " ><tbody>" & chr(13) & chr(10) strTmp = strTmp & "<form action='" & strAction & "'" strTmp = strTmp & " method='" & strMethod & "'" strTmp = strTmp & " id=" & strId strTmp = strTmp & " name=" & strName If strOnSubmit <> "" Then strTmp = strTmp & " onsubmit='" & strOnSubmit & "'" End If strTmp = strTmp & ">[tr]" strTmp = strTmp & "</form>" & chr(13) & chr(10) strTmp = strTmp & "</tbody></table>" & chr(13) & chr(10) strHtmlCode = Replace(strHtmlCode,"[table]",strTmp) End Sub Public Sub MakeTableEasy() Call MakeTable(strBorder,strPadding,strSpacing,strAlign,strWidth,strClass) End Sub Public Sub AddTr(strTrClass) Dim strTmp strHtmlCode = Replace(strHtmlCode,"[input]","") strHtmlCode = Replace(strHtmlCode,"[value]","") strHtmlCode = Replace(strHtmlCode,"value= ","") strHtmlCode = Replace(strHtmlCode,"value=''","") strHtmlCode = Replace(strHtmlCode,"value=>"," >") strTmp = "<tr class=" & strTrClass & " >" & chr(13) & chr(10) strTmp = strTmp & "[td]" & chr(13) & chr(10) & "</tr>[tr]" strHtmlCode = Replace(strHtmlCode,"[tr]",strTmp) End Sub Public Sub AddTd(strTdValue,strTdClass1,strTdClass2) Dim strTmp strTdValueChk = strTdValue strTdValue = Replace(strTdValue,MUST_FILLED_CHAR,"") strTmp = "<td" If strTdClass1 <> "" Then strTmp = strTmp & " class=" & strTdClass1 End If strTmp = strTmp & " width=" & cssColumnScale & " valign=top>" If Trim(strTdValue) <> "" And Trim(strTdValue) <> "<br>" Then strTmp = strTmp & strTdValue & ":" End If strTmp = strTmp & "</td>" & chr(13) & chr(10) strTmp = strTmp & "<td" If strTdClass2 <> "" Then strTmp = strTmp & " class=" & strTdClass2 End If strTmp = strTmp & " valign=top>" & chr(13) & chr(10) strTmp = strTmp & "[input]</td>" & chr(13) & chr(10) strHtmlCode = Replace(strHtmlCode,"[td]",strTmp) End Sub Public Sub AddTdClew(strTdValue,strTdClass1,strTdClass2,strClew) Dim strTmp strTdValueChk = strTdValue strTdValue = Replace(strTdValue,MUST_FILLED_CHAR,"") strTmp = "<td" If strTdClass1 <> "" Then strTmp = strTmp & " class=" & strTdClass1 End If strTmp = strTmp & " width=" & cssColumnScale & " valign=top>" If Trim(strTdValue) <> "" And Trim(strTdValue) <> "<br>" Then strTmp = strTmp & strTdValue & ":" End If strTmp = strTmp & "</td>" strTmp = strTmp & "<td" If strTdClass2 <> "" Then strTmp = strTmp & " class=" & strTdClass2 End If strTmp = strTmp & " valign=top>" strTmp = strTmp & "[input]" & strClew & "</td>" strHtmlCode = Replace(strHtmlCode,"[td]",strTmp) End Sub Public Sub AddTitle(strTitle,strTitleClass) Dim strTmp strTmp = "<td" If strTitleClass <> "" Then strTmp = strTmp & " class=" & strTitleClass End If strTmp = strTmp & " colspan=2>" & chr(13) & chr(10) strTmp = strTmp & CONST_TITLE_CHAR & " " & Trim(strTitle) & " " & CONST_TITLE_CHAR & "</td>" & chr(13) & chr(10) strHtmlCode = Replace(strHtmlCode,"[td]",strTmp) End Sub Public Sub AddText(strName,strMaxLen,strSize) Dim strTmp strTmp = "<input type='text' maxlength=" & strMaxLen strTmp = strTmp & " size=" & strSize strTmp = strTmp & " name=" & strName strTmp = strTmp & " class=" & cssText & " value='[value]'>" If InStr(strTdValueChk,MUST_FILLED_CHAR) Then strTmp = strTmp & " <font color=red>*</font>" End If strHtmlCode = Replace(strHtmlCode,"[input]",strTmp) End Sub Public Sub AddHidden(strName) Dim strTmp strTmp = "<input type='hidden' name='" & strName & "'" strTmp = strTmp & " value='[value]'>" & chr(13) & chr(10) strHtmlCode = Replace(strHtmlCode,"[input]",strTmp) End Sub Public Sub AddPwd(strName,strMaxLen,strSize) Dim strTmp strTmp = "<input type='password' maxlength=" & strMaxLen strTmp = strTmp & " size=" & strSize strTmp = strTmp & " name=" & strName strTmp = strTmp & " class=" & cssText & " value='[value]'>" & chr(13) & chr(10) If InStr(strTdValueChk,MUST_FILLED_CHAR) Then strTmp = strTmp & " <font color=red>*</font>" End If strHtmlCode = Replace(strHtmlCode,"[input]",strTmp) End Sub Public Sub AddSelect(strName,strValue) Dim strTmp strHtmlCode = Replace(strHtmlCode,"[option]","") strTmp = "<select " strTmp = strTmp & " name=" & strName strTmp = strTmp & " class=" & cssSelect & ">" & chr(13) & chr(10) strTmp = strTmp & "[option]</select> " & strValue & "[input]" If InStr(strTdValueChk,MUST_FILLED_CHAR) Then strTmp = strTmp & " <font color=red>*</font>" End If strHtmlCode = Replace(strHtmlCode,"[input]",strTmp) End Sub Public Sub AddSelectByArray(strName,strValue,arrShow,arrValue,strSelFlag) Dim strTmp strHtmlCode = Replace(strHtmlCode,"[option]","") strTmp = "<select " strTmp = strTmp & " name=" & strName strTmp = strTmp & " class=" & cssSelect & ">" strTmp = strTmp & "[option]</select> " & strValue & "[input]" If InStr(strTdValueChk,MUST_FILLED_CHAR) Then strTmp = strTmp & " <font color=red>*</font>" End If strHtmlCode = Replace(strHtmlCode,"[input]",strTmp) arrShow = Split(arrShow,CONST_SELECT_ARR_DIVIDER) arrValue = Split(arrValue,CONST_SELECT_ARR_DIVIDER) For i = Lbound(arrShow) To Ubound(arrShow) Call AddOption(arrValue(i),arrShow(i),strSelFlag) Next End Sub Public Sub AddOption(strValue,strShowStr,strSelFlag) Dim strTmp strTmp = "<option value='" & strValue & "' " If Lcase(Trim(strSelFlag)) = Lcase(Trim(strValue)) Then strTmp = strTmp & " selected " End If strTmp = strTmp & " >" & chr(13) & chr(10) strTmp = strTmp & strShowStr & "</option>[option]" & chr(13) & chr(10) strHtmlCode = Replace(strHtmlCode,"[option]",strTmp) End Sub Public Sub AddChkBox(strName,strValue,strShowStr,strChkFlag) Dim strTmp Dim strTmp2 strTmp = "<input type='checkbox' " strTmp = strTmp & " name=" & strName strTmp = strTmp & " class=" & cssChkBox strTmp = strTmp & " value='" & strValue & "' " If IsArray(strChkFlag) Then '== Check this check box wether or not be checked For Each strTmp2 In strChkFlag If Trim(strTmp2) = strValue Then strTmp = strTmp & " checked " Exit For End If Next ElseIf strChkFlag = strValue Then strTmp = strTmp & " checked " End If strTmp = strTmp & " > " & strShowStr & " [input] " & chr(13) & chr(10) strHtmlCode = Replace(strHtmlCode,"[input]",strTmp) End Sub Public Sub AddRadio(strName,strValue,strShowStr,strRdoFlag) Dim strTmp strTmp = "<input type='radio' " strTmp = strTmp & " name=" & strName strTmp = strTmp & " class=" & cssRadio strTmp = strTmp & " value='" & strValue & "' " If Lcase(Trim(strValue)) = Lcase(Trim(strRdoFlag)) Then strTmp = strTmp & " checked " End If If InStr(strTdValueChk,MUST_FILLED_CHAR) Then strTmp = strTmp & " <font color=red>*</font>" End If strTmp = strTmp & " > " & strShowStr & " [input] " strHtmlCode = Replace(strHtmlCode,"[input]",strTmp) End Sub Public Sub AddTextrea(strName,strCols,strRows) Dim strTmp strTmp = "<textarea " strTmp = strTmp & " name=" & strName strTmp = strTmp & " cols=" & strCols strTmp = strTmp & " rows=" & strRows strTmp = strTmp & " class=" & cssTextrea & ">" & chr(13) & chr(10) strTmp = strTmp & "[value]</textarea>" & chr(13) & chr(10) If InStr(strTdValueChk,MUST_FILLED_CHAR) Then strTmp = strTmp & " <font color=red>*</font>" End If strHtmlCode = Replace(strHtmlCode,"[input]",strTmp) End Sub Public Sub AddLine(strValue) strHtmlCode = Replace(strHtmlCode,"[input]",strValue) End Sub Public Sub AddSubTd(strClass) Dim strTmp strTmp = "<td" If strClass <> "" Then strTmp = strTmp & " class=" & strClass End If strTmp = strTmp & " colspan=2 >" & chr(13) & chr(10) strTmp = strTmp & "<br>[sub]</td>" & chr(13) & chr(10) strHtmlCode = Replace(strHtmlCode,"[td]",strTmp) End Sub Public Sub AddSub(strName,strValue,strType) Dim strTmp strTmp = " <input type=" & strType strTmp = strTmp & " name=" & strName strTmp = strTmp & " class=" & cssBtn strTmp = strTmp & " value='" & strValue & "'>" strTmp = strTmp & " [sub]" strHtmlCode = Replace(strHtmlCode,"[sub]",strTmp) End Sub Public Sub AddSubBtn(strName,strValue,strLink) Dim strTmp strTmp = " <input type='button' " strTmp = strTmp & " name=" & strName strTmp = strTmp & " class=" & cssBtn strTmp = strTmp & " onclick=parent.location.href='" & strLink & "'" strTmp = strTmp & " value='" & strValue & "'>" strTmp = strTmp & " [sub]" strHtmlCode = Replace(strHtmlCode,"[sub]",strTmp) End Sub Public Sub AddSubImg(strName,strImg,strLink) Dim strTmp strTmp = " <input type='button' border=0 src='" &GBL_strHomeURL & "images/new/" & strImg & "' " strTmp = strTmp & " name=" & strName strTmp = strTmp & " class=CSS_IPT_BUTTON " strTmp = strTmp & " onclick=parent.location.href='" & strLink & "'" strTmp = strTmp & " [sub]" strHtmlCode = Replace(strHtmlCode,"[sub]",strTmp) End Sub Public Sub AddSubBtnClick(strName,strValue,strClick) Dim strTmp strTmp = " <input type='button' " strTmp = strTmp & " name=" & strName strTmp = strTmp & " class=" & cssBtn strTmp = strTmp & " onclick=" & strClick strTmp = strTmp & " value='" & strValue & "'>" strTmp = strTmp & " [sub]" strHtmlCode = Replace(strHtmlCode,"[sub]",strTmp) End Sub Public Sub AddValue(strValue) strHtmlCode = Replace(strHtmlCode,"[value]","" & Trim(strValue) & "") End Sub '== 自动生成客户端校验脚本 Public Function AddClientChkJs() Dim strJs,strSubmit '== submit execute strSubmit = Replace(strOnSubmit,"return","") strSubmit = Replace(strSubmit,"(this)","") strSubmit = Replace(strSubmit,"()","") strSubmit = Replace(strSubmit,";","") Set objClientChk = New classClientChk If Not IsArray(arrDataChk) Then AddClientChkJs = "" Exit Function End If strJs = objClientChk.ClientDataCheck(strName,arrDataChk) Set objClientChk = Nothing strJs1 = "<script language=javascript>" & chr(13) & chr(10) strJs1 = strJs1 & "function " & strSubmit & "()" & chr(13) & chr(10) strJs1 = strJs1 & "{" & chr(13) & chr(10) strJs1 = strJs1 & strJs & chr(13) & chr(10) strJs1 = strJs1 & "return true;" & chr(13) & chr(10) strJs1 = strJs1 & "}" & chr(13) & chr(10) strJs1 = strJs1 & "</script>" AddClientChkJs = strJs1 End Function Public Sub OutPutForm() Dim strSubmit strHtmlCode = Replace(strHtmlCode,"[tr]","") strHtmlCode = Replace(strHtmlCode,"[td]","") strHtmlCode = Replace(strHtmlCode,"[sub]","") strHtmlCode = Replace(strHtmlCode,"[input]","") strHtmlCode = Replace(strHtmlCode,"[table]","") strHtmlCode = Replace(strHtmlCode,"[value]","") strHtmlCode = Replace(strHtmlCode,"[option]","") strHtmlCode = Replace(strHtmlCode,"value= ","") strHtmlCode = Replace(strHtmlCode,"value=''","") strHtmlCode = Replace(strHtmlCode,"value=>"," >") strHtmlCode = Replace(strHtmlCode,"class= "," ") strHtmlCode = Replace(strHtmlCode,"class=>"," >") Response.Write strHtmlCode & AddClientChkJs() '== submit execute strSubmit = Replace(strOnSubmit,"return","") strSubmit = Replace(strSubmit,"(this)","") strSubmit = Replace(strSubmit,"()","") strSubmit = Replace(strSubmit,";","") strSubmit = Trim(strSubmit) If bolSubmit = True Then %> <script> function CtlKey<% =strName %>(theform) { if (event.ctrlKey && window.event.keyCode==13) { if (<% =strSubmit %>(document.<% =strName %>)) { document.<% =strName %>.submit(); } } if (event.altKey && (window.event.keyCode==83 || window.event.keyCode==115)) { if (<% =strSubmit %>(document.<% =strName %>)) { document.<% =strName %>.submit(); } } } var ie = (document.all)? true:false if (ie) { window.document.onkeydown = CtlKey<% =strName %>; } </script> <% End If End Sub Public Sub Clear() strAction = "./" strMethod = "post" strId = "" strName = "" strOnSubmit = "" strTdValueChk = "" bolSubmit = True End Sub End Class %>