pop_datepicker.asp

代码名称： Snitz Forums 2000 代码语言： 英文 代码类型： 国外代码 运行环境： ASP 授权方式： 免费代码 代码大小： 530kb 代码等级： 3 整

end function
Rem -End Function Declaration
dim dDate : Rem -Date we're displaying calendar for
dim iDIM : Rem -Days In Month
dim iDOW : Rem -Day Of Week that month starts on
dim iCurrent : Rem -Variable we use to hold current day of month as we write table
dim iPosition : Rem -Variable we use to hold current position in table
dim strDOBDate : Rem -Holds the date of Birth if there is one - YYYYMMDD
dim strReturnFuncEmpty
Rem -Get selected date.  There are two ways to do this.
Rem -First check if we were passed a full date in RQS("date").
Rem -If so use it, if not look for seperate variables, putting them togeter into a date.
Rem -Lastly check if the date is valid...if not use today
if IsDate(Request.QueryString("date")) then
	Rem -This is date when navigating the calendar
	Rem -This should be a date as per locale Format
	dDate = cDate(Request.QueryString("date"))
elseif IsValidDate(Request.QueryString("date")) then
	Rem -This is when user edits Date of Birth 
	Rem -This should be in YYYYMMDD Format
	strDOBDate = Request.QueryString("date")
	dDate = cDate(Mid(strDOBDate,7,2) & "-" & MonthName(Mid(strDOBDate, 5,2)) & "-" & Mid(strDOBDate, 1,4))
else   '****************** Put as one ***********
	Rem -Assign a Default date to dDate variable
	dDate = DateAdd("yyyy", -13, strForumTimeAdjust)
	dDate = DateValue(dDate)
	if Request("day") <> "" and Request("month") <> "" and Request("year") <> "" then
		Rem -This will be the date when User clicks on Go Button
		if IsDate(Request("day") & "-" & MonthName(Request("month")) & "-" & Request("year")) Then
			dDate = cDate(Request("day") & "-" & MonthName(Request("month")) & "-" & Request("year"))
		end if
	end if
end if	

Response.Write	"<form action=""" & Request.ServerVariables("PATH_INFO") & "?FormName=" & Request("FormName") & "&FieldName=" & Request("FieldName") & "&History=" & Request("History") & """ method=""post"" id=""form1"" name=""form1"">" & vbNewLine & _
		"<input type=""hidden"" name=""day"" value=""" & Day(dDate) & """>" & vbNewLine & _
		"<table width=""275"" border=""0"" cellspacing=""1"" cellpadding=""2"" align=""center"">" & vbNewLine & _
		"  <tr>" & vbNewLine & _
		"    <td align=""center"">" & vbNewLine
Rem -Month Select Box
dim intLastMonth
Rem -Restrict the available Dates to Today
if Year(dDate) = Year(strForumTimeAdjust) then
	intLastMonth = Month(strForumTimeAdjust)
else
	intLastMonth = 12
end if
if Month(dDate) >= intLastMonth and Year(dDate) >= Year(strForumTimeAdjust) then
	if Day(dDate) > Day(strForumTimeAdjust) then
		dDate = DateSerial(Year(dDate),intLastMonth, 1) 
	else
		dDate = DateSerial(Year(dDate),intLastMonth, Day(dDate))
	end if
end if
Rem -Days in Month
iDIM = GetDaysInMonth(Month(dDate), Year(dDate))
Rem -Day of Week on First of Month
iDOW = GetWeekdayMonthStartsOn(dDate)
dim iMonth 'Counter to fill the Month Select Box
Response.Write	"    <select name=""month"">" & vbNewLine
for iMonth = 1 to intLastMonth
	Response.Write	"    	<option value=""" & iMonth & """" & SetMonthSelection(iMonth) & ">" & MonthName(iMonth) & "</option>" & vbNewLine
next
Response.Write	"    </select>" & vbNewLine
Rem -Year Select Box
dim int_YearCntr
Response.Write	"    <select name=""year"">" & vbNewLine
for int_YearCntr = 1901 to Year(strForumTimeAdjust) step 1
	Response.Write	"    	<option value=""" & int_YearCntr & """"
	if int_YearCntr = Year(dDate) then
		Response.Write(" selected")
	end if
	Response.Write	">" & int_YearCntr & "</option>" & vbNewLine
next
Response.Write	"    </select>" & vbNewLine & _
		"    <input type=""submit"" VALUE=""Go"" id=""submit1"" NAME=""submit1"">" & vbNewLine & _
		"    </td>" & vbNewLine & _
		"  </tr>" & vbNewLine & _
		"</table>" & vbNewLine
Rem -Calendar Navigation
Response.Write	"<table width=""275"" border=""0"" cellspacing=""0"" cellpadding=""0"" align=""center"">" & vbNewLine & _
		"  <tr>" & vbNewLine & _
		"    <td bgcolor=""" & strHeadCellColor & """ align=""center"">" & vbNewLine & _
		"      <table width=""100%"" border=""0"" cellspacing=""0"" cellpadding=""0"">" & vbNewLine & _
		"        <tr>" & vbNewLine & _
		"          <td width=""15%"" align=""right""><a href=""pop_datepicker.asp?date=" & PreviousMonth(dDate) & "&FormName=" & Request("FormName") & "&FieldName=" & Request("FieldName") & "&History=" & Request("History") & """><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """ color=""" & strHeadFontColor & """>&lt;&lt;</font></a></td>" & vbNewLine & _
		"          <td align=""center""><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """ color=""" & strHeadFontColor & """><b>" & MonthName(Month(dDate)) & "  " & Year(dDate) & "</b></font></td>" & vbNewLine & _
		"          <td width=""15%"" align=""left"">"
if NextMonth(dDate) <> strForumTimeAdjust then Response.Write("<a href=""pop_datepicker.asp?date=" & NextMonth(dDate) & "&FormName=" & Request("FormName") & "&FieldName=" & Request("FieldName") & "&History=" & Request("History") & """><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """ color=""" & strHeadFontColor & """>&gt;&gt;</font></a>") else Response.Write("&nbsp;")
Response.Write	"</td>" & vbNewLine & _
		"        </tr>" & vbNewLine & _
		"      </table>" & vbNewLine & _
		"    </td>" & vbNewLine & _
		"  </tr>" & vbNewLine
Rem -Weekday Names
Response.Write	"  <tr>" & vbNewLine & _
		"    <td bgcolor=""" & strTableBorderColor & """>" & vbNewline & _
		"      <table width=""100%"" border=""0"" cellspacing=""1"" cellpadding=""2"" align=""center"">" & vbNewline & _
		"        <tr>" & vbNewLine
dim iWeekDayName
for iWeekDayName = 1 to 7
	Response.Write	"          <td width=""14%"" align=""center"" bgcolor=""" & strCategoryCellColor & """><font face=""" & strDefaultFontFace & """ size=""" & strFooterFontSize & """ color=""" & strCategoryFontColor & """>" & WeekDayName(iWeekDayName, True) & "</font></td>" & vbNewLine
next
Response.Write	"        </tr>" & vbNewLine
strReturnFuncEmpty = "returnDate(' '); "
Rem -Write spacer cells at beginning of first row if month doesn't start on a Sunday.
if iDOW <> 1 then
	iPosition = iDOW
	Response.Write	"        <tr>" & vbNewLine & _
			"          <td colspan=""" & iPosition - 1 & """ bgcolor=""#bbbbbb""><font face=""" & strDefaultFontFace & """ size=""" & strFooterFontSize & """ color=""" & strForumFontColor & """>&nbsp;<br /><br /></font></td>" & vbNewLine
end if
Rem -Write days of month in proper day slots
Dim strReturnFunc, dCell, strClass, blnOnClick
iCurrent = 1
iPosition = iDOW
'dDate = DateValue(dDate)
do while iCurrent <= iDIM
	Rem -If we're at the begginning of a row then write tr
	Rem -If we're at the endof a row then write /tr
	if iPosition > 7 then
		Response.Write	"        </tr>" & vbNewLine
		iPosition = 1
	end if
	if iPosition = 1 then
		Response.Write	"        <tr>" & vbNewLine
	end if
	dCell = DateSerial(Year(dDate), Month(dDate), iCurrent)
	Rem -Get the current date in string Format (YYYYMMDD)
	strReturnFunc = "returnDate('" & Year(dDate) & doublenum(Month(dDate)) & doublenum(iCurrent) & "');"
	Rem -if Cell contains todays Date then highlight
	if dCell = dDate then 'and dDate < strForumTimeAdjust then
		strClass = ""
		blnOnClick = true
		Rem -if we are in the past then if history is 'off' the show cell disabled
	elseif dCell <= strForumTimeAdjust then
		if Request("History") = "on" then
			strClass = ""
			blnOnClick = false
		else
			strClass = "spnMessageText"
			blnOnClick = true
		end if
	Rem -else must be in the future
	else
		strClass = ""
		blnOnClick = false
	end if
	Call WriteDayOfMonth(strReturnFunc, strClass, iCurrent, blnOnClick)
	Rem -Increment variables
	iCurrent = iCurrent + 1
	iPosition = iPosition + 1
loop
Rem -Write spacer cells at end of last row if month doesn't end on a Saturday.
iPosition = iPosition - 1
if iPosition < 7 then
	Response.Write	"          <td colspan=""" & 7 - iPosition & """ bgcolor=""#bbbbbb""><font face=""" & strDefaultFontFace & """ size=""" & strFooterFontSize & """ color=""" & strForumFontColor & """>&nbsp;<br /><br /></font></td>" & vbNewLine & _
			"        </tr>" & vbNewLine
end if
Response.Write	"      </table>" & vbNewLine & _
		"      <table width=""275"" border=""0"" cellspacing=""0"" bgcolor=""" & strPageBGColor & """>" & vbNewLine & _
		"        <tr>" & vbNewLine & _
		"          <td align=""center""><input type=""button"" value=""Clear DOB"" onclick=""" & strReturnFuncEmpty & """></td>" & vbNewLine & _
		"        </tr>" & vbNewLine & _
		"        <tr>" & vbNewLine & _
		"          <td align=""left""><font face=""" & strDefaultFontFace & """ size=""" & strFooterFontSize & """><b>Birthdate Selection/Removal:</b><br /><li>Select Month and Year and press GO,<br />&nbsp;&nbsp;&nbsp;&nbsp;then click on the date.<br /><li>Click on ClearDOB to remove the Birthdate.</font></td>" & vbNewLine & _
		"        </tr>" & vbNewLine & _
		"      </table>" & vbNewLine & _
		"    </td>" & vbNewLine & _
		"  </tr>" & vbNewLine & _
		"</table>" & vbNewLine & _
		"</form>" & vbNewLine & _
		"</body>" & vbNewLine & _
		"</html>" & vbNewline
%>