📄 class_html_form.asp

📁 是一个很好用的通信录源码,可以用在同学朋友等的通信上使用!
💻 ASP
📖 第 1 页 / 共 2 页
字号:
上一页 12
	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(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,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


%>
上一页 12
⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -