www.gusucode.com > CC校友录贴吧 CCBar源码程序asp编程 > class/class_html_form_make.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" -->
<%
CONST MUST_FILLED_CHAR = "*"
Class classForm


Private strAction,strMethod,strId,strName,strOnSubmit
Private cssBtn,cssText,cssTextrea,cssSeleck,cssChkBox,cssRadio,cssSelect

Private bolSubmit

Private strTdValueChk  '== 临时存储td value来校验是否有*

Private strHtmlCode

Public  arrDataChk		'== 数据校验数组


'== form表格样式
Private cssFormTable		'== form所在table样式
Private cssFormTableSpacing	'== form所在table cellspacing样式
Private cssFormTablePadding	'== form所在table cellpadding样式
Private cssFormTableAlign	'== form所在table居中方式
Private cssColumnScale		'== form所在左右列比例样式
Private cssFormTitle		'== form标题样式
Private cssFormTr			'== form tr样式
Private cssFormLeftTd		'== form左侧td样式
Private cssFormRightTd		'== form右侧td样式

'===================================================================
'= 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

	'== 定义form表格样式
	cssFormTable		= GBL_cssFormTable
	cssFormTableSpacing = GBL_cssFormTableSpacing
	cssFormTablePadding = GBL_cssFormTablePadding
	cssFormTableAlign	= GBL_cssFormTableAlign
	cssColumnScale		= GBL_cssColumnScale
	cssFormTitle		= GBL_cssFormTitle
	cssFormTr			= GBL_cssFormTr
	cssFormLeftTd		= GBL_cssFormTdLeft
	cssFormRightTd		= GBL_cssFormTdRight

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

	cssFormTable = ""
	cssFormTableSpacing = ""
	cssFormTablePadding = ""
	cssColumnScale = ""
	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,i
	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

Public Property Let FormTablePadding(value) 
	cssFormTablePadding = Trim(value)
End Property

Public Property Let FormTableSpacing(value) 
	cssFormTableSpacing = 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 MakeTableSet(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 & chr(9) & "<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 & ">" & chr(13) & chr(10) & "[tr]"
	strTmp = strTmp & chr(9) & "</form>" & chr(13) & chr(10)
	strTmp = strTmp & "</tbody></table>" & chr(13) & chr(10)
	strHtmlCode = Replace(strHtmlCode,"[table]",strTmp)

End Sub


Public Sub MakeFormTable()

	Dim strTmp

	Call MakeForm()

	strTmp = "<table cellspacing='" & cssFormTableSpacing & "' cellpadding='" & GBL_cssFormTablePadding & "' align=""" & GBL_cssFormTableAlign & """ " 
	strTmp = strTmp & " class=" & cssFormTable
	strTmp = strTmp & " >" & chr(13) & chr(10) & "<tbody>" & chr(13) & chr(10) 
	strTmp = strTmp & chr(9) & "<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 & ">" & chr(13) & chr(10) & "[tr]" & chr(13) & chr(10)
	strTmp = strTmp & chr(9) & "</form>" & chr(13) & chr(10)
	strTmp = strTmp & "</tbody>" & chr(13) & chr(10) & "</table>" & chr(13) & chr(10)
	strHtmlCode = Replace(strHtmlCode,"[table]",strTmp)

End Sub

Public Sub AddTr()
	Call AddTrByStyle(cssFormTr)
End Sub

Public Sub AddTrByStyle(strTrClass)

	Dim strTmp
	strHtmlCode = Replace(strHtmlCode,"[input]","")
	strHtmlCode = Replace(strHtmlCode,"[value]","")
	strHtmlCode = Replace(strHtmlCode,"value= ","")
	strHtmlCode = Replace(strHtmlCode,"value=''","")
	strHtmlCode = Replace(strHtmlCode,"value=>"," >")
	strTmp = chr(9) & "<tr class=" & strTrClass & " >" & chr(13) & chr(10)
	strTmp = strTmp & "[td]" & chr(13) & chr(10) & chr(9) & "</tr>" & chr(13) & chr(10) & "[tr]"
	strHtmlCode = Replace(strHtmlCode,"[tr]",strTmp)

End Sub


Public Sub AddTd(strTdValue)
	Call AddTdByStyle(strTdValue,cssFormLeftTd,cssFormRightTd)
End Sub

Public Sub AddTdByStyle(strTdValue,strTdClass1,strTdClass2)

	Dim strTmp
	
	strTdValueChk = strTdValue
	strTdValue = Replace(strTdValue,MUST_FILLED_CHAR,"")
	
	strTmp = chr(9) & chr(9) & "<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 & chr(9) & chr(9) & "<td"
	If strTdClass2 <> "" Then
		strTmp = strTmp & " class=" & strTdClass2 
	End If
	strTmp = strTmp & " valign=top>"
	strTmp = strTmp & "[input]" & "</td>" & chr(13) & chr(10)
	strHtmlCode = Replace(strHtmlCode,"[td]",strTmp)

End Sub

Public Sub AddTdClew(strTdValue,strTdClass1,strTdClass2,strClew)
	 Call AddTdClewByStyle(strTdValue,cssFormLeftTd,cssFormRightTd,strClew)
End Sub

Public Sub AddTdClewByStyle(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)

	Call AddTitleByStyle(strTitle,cssFormTitle)

End Sub

Public Sub AddTitleByStyle(strTitle,strTitleClass)

	Dim strTmp
	strTmp = chr(9) & chr(9) & "<td"
	If strTitleClass <> "" Then
		strTmp = strTmp & " class=" & strTitleClass
	End If
	strTmp = strTmp & " colspan=2>"
	strTmp = strTmp & "&nbsp;" & Trim(strTitle)  & "&nbsp;" & "</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 & "&nbsp;<font color=red>*</font>"
	End If
	
	strHtmlCode = Replace(strHtmlCode,"[input]",strTmp)

End Sub

Public Sub AddHidden(strName)

	Dim strTmp
	strTmp = "<tr style=""display:none""><td></td><td><input type='hidden' name='" & strName & "'" 
	strTmp = strTmp & " value='[value]'></td></tr>" & chr(13) & chr(10) & "[tr]"
	strHtmlCode = Replace(strHtmlCode,"[tr]",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 & "&nbsp;<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 & "&nbsp;<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 & "&nbsp;<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 & "&nbsp;<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 & "&nbsp;<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()
	Call AddSubTdByStyle(GBL_cssFormTd)
End Sub

Public Sub AddSubTdByStyle(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 & "&nbsp;[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 & "&nbsp;[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 & "&nbsp;[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 & "&nbsp;[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,strJs1,strSubmit,objClientChk
	
	'== 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


%>