End Class
Class CalendarDay
Public DateString
Public OnClick
Private mcolActivities
Private mbActivitiesInit
Private Sub Class_Initialize()
mbActivitiesInit = False
End Sub
Private Sub Class_Terminate()
If IsObject(mcolActivities) Then
mcolActivities.RemoveAll()
Set mcolActivities = Nothing
End If
End Sub
Private Sub InitActivities()
Set mcolActivities = Server.CreateObject("Scripting.Dictionary")
mbActivitiesInit = True
End Sub
Public Sub AddActivity(sActivity, sColor)
If Not mbActivitiesInit Then InitActivities()
mcolActivities.Add mcolActivities.Count + 1, "bgcolor=""" & sColor & """>" & sActivity
End Sub
Public Sub Draw()
Dim objActivity
Send "<table width=""100%"" border=""0"" cellspacing=""2"" cellpadding=""1"">"
Send "<tr><td align=""left"" valign=""top""><a href=""" & Replace(OnClick, "$date", DateString) & """><small>" & Day(DateString) & "</small></a></td></tr>"
If mbActivitiesInit Then
For Each objActivity In mcolActivities.Items
Send "<tr><td height=""20""" & objActivity & "</td></tr>"
Next
End If
Send "</table>"
End Sub
Private Sub Send(sHTML)
Response.Write sHTML & vbCrLf
End Sub
End Class
calendar.apsp
--------------------------
<%
Class Calendar
Public Top
Public Left
Public Width
Public Height
Public Position
Public ZIndex
Public TitlebarColor
Public TitlebarFont
Public TitlebarFontColor
Public TodayBGColor
Public OnDayClick
Public OnNextMonthClick
Public OnPrevMonthClick
Public ShowDateSelect
Private mdDate
Private msToday
Private mnDay
Private mnMonth
Private mnYear
Private mnDayMonthStarts
Private mnDaysInMonth
Private mcolDays
Private mbDaysInitialized
Private Sub Class_Terminate()
If IsObject(mcolDays) Then
mcolDays.RemoveAll
Set mcolDays = Nothing
End If
End Sub
Public Property Get GetDate()
GetDate = mdDate
End Property
Public Property Get DaysInMonth()
DaysInMonth = mnDaysInMonth
End Property
Public Property Get WeeksInMonth()
If (mnDayMonthStarts + mnDaysInMonth - 1) > 35 Then
WeeksInMonth = 6
Else
WeeksInMonth = 5
End If
End Property
Public Property Get Days(nIndex)
If Not mbDaysInitialized Then InitDays()
If mcolDays.Exists(nIndex) Then Set Days = mcolDays.Item(nIndex)
End Property
Private Sub InitDays()
Dim nDayIndex
Dim objNewDay
If mcolDays.Count > 0 Then mcolDays.RemoveAll()
For nDayIndex = 1 To mnDaysInMonth
Set objNewDay = New CalendarDay
objNewDay.DateString = FormatDateTime(DateSerial(mnYear, mnMonth, nDayIndex),2)
objNewDay.OnClick = OnDayClick
mcolDays.Add nDayIndex, objNewDay
Next
mbDaysInitialized = True
End Sub
Public Sub SetDate(dDate)
mdDate = CDate(dDate)
mnDay = Day(dDate)
mnMonth = Month(dDate)
mnYear = Year(dDate)
mnDaysInMonth = Day(DateAdd("d", -1, DateSerial(mnYear, mnMonth + 1, 1)))
mnDayMonthStarts = WeekDay(DateAdd("d", -(Day(CDate(dDate)) - 1), CDate(dDate)))
End Sub
Public Sub Draw()
Dim nDayCount
Dim nCellWidth, nCellHeight, nFontSizeRatio
Dim objDay
If Not mbDaysInitialized Then InitDays()
nCellWidth = CInt(Width / 7)
If (mnDayMonthStarts + mnDaysInMonth - 1) > 35 Then
nCellHeight = CInt((Height - 80) / 6)
Else
nCellHeight = CInt((Height - 80) / 5)
End If
If nDayCount < 7 Then
For nDayCount = nDayCount To 6
Send "<td height=""" & CStr(nCellHeight) & """ width=""" & CStr(nCellWidth) & """ bgcolor=""#dddddd""> </td>"
Next
End If
Send "</tr>"
If ShowDateSelect Then
Send "<tr><td height=""30"" colspan=""7"" align=""center"">"
DrawDateSelect()
Send "</td></tr>"
End If
Send "</table>"
Send "</div>"
End Sub
Private Sub DrawDateSelect()
Dim nIndex
Send " <form id=frmGO name=frmGO>"
Send " <table border=""0"">"
Send " <tr>"
Send " <td><select name=""month"">"
For nIndex = 1 To 12
Response.Write "<option value=""" & nIndex & """"
If nIndex = Month(mdDate) Then Response.Write " selected"
Send ">" & MonthName(nIndex, True) & "</option>"
Next
Send " </select></td>"
Send " <td><select name=""year"">"
For nIndex = Year(Now()) - 4 To Year(Now()) + 6
Response.Write "<option value=""" & nIndex & """"
If nIndex = Year(mdDate) Then Response.Write " selected"
Send ">" & CStr(nIndex) & "</option>"
Next
Send " </select></td>"
Send " <td><input type=""button"" Value=""Go"" onclick=""document.location='" & Request.ServerVariables("SCRIPT_NAME") & "?date='+this.form.month.options[this.form.month.selectedIndex].value+'/1/'+this.form.year.options[this.form.year.selectedIndex].value;"" id=1 name=1></td>"
Send " </form>"
Send " </tr></table>"
End Sub
Private Sub Send(sHTML)
Response.Write sHTML & vbCrLf
End Sub