2024年1月25日发(作者:)

非常实用asp日历代码

charset=gb2312" />

日历

<%

' 要调用的函数声明

'根据年份及月份得到每月的总天数

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(tring("date")) Then

dDate = CDate(tring("date"))

Else

If

Then

dDate = CDate(tring("month") & "-" &

tring("day") & "-" & tring("year"))

Else

dDate = Date()

IsDate(tring("month") & "-" &

tring("day") & "-" & tring("year"))

If Len(tring("month"))

<>

<>

<>

0

0

0 Or

Or

Or

Len(tring("day"))

Len(tring("year"))

Len(tring("date")) <> 0 Then

"您所选择的日期格式不正确,系统会使用当前日期.

"

End If

End If

End If

'得到日期后我们先得到这个月的天数及这个月的起始日期.

iDIM = GetDaysInMonth(Month(dDate), Year(dDate))

iDOW = GetWeekdayMonthStartsOn(dDate)

%>

align="center"><%=

& " " & MonthName(Month(dDate))

Year(dDate) %>

height="22" align="right">SubtractOneMonth(dDate) %>"><<

AddOneMonth(dDate) %>">>>

href="?date=<%=

align="center" colspan="7">

cellpadding="0" cellspacing="0"width="100%">

width="180" border="1" align="center"

cellpadding="1" cellspacing="1" bordercolor="#F3F3F3">

<%

' 如果这个月的起始日期不是周日的话就加空的单元.

If iDOW <> 1 Then

vbTab & "

" & vbCrLf

iPosition = 1

Do While iPosition < iDOW

vbTab & vbTab & "

" & vbCrLf

iPosition = iPosition + 1

Loop

End If

' 绘制这个月的日历

iCurrent = 1

iPosition = iDOW

Do While iCurrent <= iDIM

' 如果是一行的开头就使用 TR 标记

If iPosition = 1 Then

vbTab & "

" & vbCrLf

End If

' 如果这一天是我们选择的日期就高亮度显示该日期.

If iCurrent = Day(dDate) Then

vbTab & vbTab & "

" &

vbCrLf

Else

vbTab & vbTab & "

"

& vbCrLf

End If

' 如果满一周的话表格就另起一行

If iPosition = 7 Then

vbTab & "

" & vbCrLf

iPosition = 0

End If

iCurrent = iCurrent + 1

iPosition = iPosition + 1

Loop

' 如果一个月不是以周六结束则加上相应的空单元.

If iPosition <> 1 Then

Do While iPosition <= 7

vbTab & vbTab & "

" & vbCrLf

iPosition = iPosition + 1

Loop

vbTab & "

" & vbCrLf

End If

%>

color="d08c00">

height=18 align=center>" & iCurrent & "

align=center>

iCurrent & "-" & Year(dDate) & """>" & iCurrent & "