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