>
' 要调用的函数声明
'根据年份及月份得到每月的总天数
Function GetDaysInMonth(iMonth, iYear)
Select Case iMonth
Case 1, 3, 5, 7, 8, 10, 12
GetDaysInMonth = 31
Case 4, 6, 9, 11
GetDaysInMonth = 30
Case 2
If IsDate("February 29, " & iYear) Then
GetDaysInMonth = 29
Else
GetDaysInMonth = 28
End If
End Select
End Function
'得到一个月开始的日期.
Function GetWeekdayMonthStartsOn(dAnyDayInTheMonth)
Dim dTemp
dTemp = DateAdd("d", -(Day(dAnyDayInTheMonth) - 1), dAnyDayInTheMonth)
GetWeekdayMonthStartsOn = WeekDay(dTemp)
End Function
'得到当前一个月的上一个月.
Function SubtractOneMonth(dDate)
SubtractOneMonth = DateAdd("m", -1, dDate)
End Function
'得到当前一个月的下一个月.
Function AddOneMonth(dDate)
AddOneMonth = DateAdd("m", 1, dDate)
End Function
' 函数声明结束
Dim dDate ' 日历显示的日期
Dim iDOW ' 每一月开始的日期
Dim iCurrent ' 当前日期
Dim iPosition ' 表格中的当前位置
' 得到选择的日期并检查日期的合法性
If IsDate(Request.QueryString("date")) Then
dDate = CDate(Request.QueryString("date"))
Else
If IsDate(Request.QueryString("month") & "-" & Request.QueryString("day") & "-" & Request.QueryString("year")) Then
dDate = CDate(Request.QueryString("month") & "-" & Request.QueryString("day") & "-" & Request.QueryString("year"))
Else
dDate = Date()
If Len(Request.QueryString("month")) <> 0 Or Len(Request.QueryString("day")) <> 0 Or Len(Request.QueryString("year")) <> 0 Or Len(Request.QueryString("date")) <> 0 Then
Response.Write "您所选择的日期格式不正确,系统会使用当前日期.
"
End If
End If
End If
'得到日期后我们先得到这个月的天数及这个月的起始日期.
iDIM = GetDaysInMonth(Month(dDate), Year(dDate))
iDOW = GetWeekdayMonthStartsOn(dDate)
%>
' 如果这个月的起始日期不是周日的话就加空的单元. If iDOW <> 1 Then Response.Write vbTab & " |
iPosition = 1
Do While iPosition < iDOW
Response.Write vbTab & vbTab & "
" & vbCrLfiPosition = iPosition + 1
Loop
End If
' 绘制这个月的日历
iCurrent = 1
iPosition = iDOW
Do While iCurrent <= iDIM
' 如果是一行的开头就使用 TR 标记
If iPosition = 1 Then
Response.Write vbTab & "
" & vbCrLfEnd If
' 如果这一天是我们选择的日期就高亮度显示该日期.
If iCurrent = Day(dDate) Then
Response.Write vbTab & vbTab & "
" & iCurrent & "" & vbCrLfElse
Response.Write vbTab & vbTab & "
" & iCurrent & "" & vbCrLfEnd If
' 如果满一周的话表格就另起一行
If iPosition = 7 Then
Response.Write vbTab & "
" & vbCrLfiPosition = 0
End If
iCurrent = iCurrent + 1
iPosition = iPosition + 1
Loop
' 如果一个月不是以周六结束则加上相应的空单元.
If iPosition <> 1 Then
Do While iPosition <= 7
Response.Write vbTab & vbTab & "
" & vbCrLfiPosition = iPosition + 1
Loop
Response.Write vbTab & "" & vbCrLf
End If
%>