<% Class Calendar Public Top Public Left Public Width Public Height Public Position Public ZIndex Public TitlebarColor Public TitlebarFontColor Public TodayBGColor Public ViewingBGColor Public DataBGColor Public strSQL Public dbRS 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_Initialize() Top = 0 Left = 0 Width = 300 Height= 300 Position = "absolute" TitlebarColor = "darkblue" TitlebarFontColor = "navy" TodayBGColor = "#C1C9E1" DataBGColor = "#E0E0E0" ViewingBGColor = "#8BACDB" ShowDateSelect = True msToday = FormatDateTime(DateSerial(Year(Now()), Month(Now()), Day(Now())), 2) zIndex = 1 Set mcolDays = Server.CreateObject("Scripting.Dictionary") If Request("date") <> "" Then SetDate(Request("date")) Else if Request("caldate") = "yes" then SetDate(DateSerial(request("year"),request("month"),1)) else SetDate(Now()) end if end if OnDayClick = Request.ServerVariables("SCRIPT_NAME") OnNextMonthClick = Request.ServerVariables("SCRIPT_NAME") & "?date=" & Server.URLEncode(DateSerial(mnYear, mnMonth + 1, 01)) OnPrevMonthClick = Request.ServerVariables("SCRIPT_NAME") & "?date=" & Server.URLEncode(DateSerial(mnYear, mnMonth - 1, 01)) mbDaysInitialized = False End Sub 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 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 Send "
" Send "" Send "" Send "" Send "" Send "" Send "" Send "" Send "" Send "" For nDayCount = 1 To mnDayMonthStarts - 1 Send "" Next nDayCount = nDayCount - 1 strSQL = "SELECT DISTINCT blog_date FROM blog_contents " _ & " WHERE blog_date LIKE '" & mnYear & "-" & Right(Cstr(mnMonth + 100),2) & "%' " set dbRS = conn.execute(strSQL) dim date_string do while not dbRS.EOF date_string = date_string + dbRS(0) & " , " dbRS.movenext loop dbRS.close set dbRS = nothing For Each objDay In mcolDays.Items If nDayCount = 7 Then Send "" nDayCount = 0 End If Response.Write "" nDayCount = nDayCount + 1 Next If nDayCount < 7 Then For nDayCount = nDayCount To 6 Send "" Next End If Send "" If ShowDateSelect Then Send "" End If Send "
" Send "" Send " " Send "
 <<" & MonthName(mnMonth) & " " & mnYear & ">> 
SMTWTFS
 
" else if InStr(date_string,IsoDate(objDay.DateString)) then Send DataBGColor & """ onMouseOver=""highlight(this)"" onMouseOut=""unhighlight2(this)"">" Else Send "white"" onMouseOver=""highlight(this)"" onMouseOut=""unhighlight(this)"">" end if end if objDay.Draw() Send " 
" DrawDateSelect() Send "
" End Sub Private Sub DrawDateSelect() Dim nIndex Send "
    
" End Sub Private Sub Send(sHTML) Response.Write sHTML & vbCrLf End Sub End Class Class CalendarDay Public DateString Public OnClick Public Sub Draw() Dim objActivity Send "" Send "
" & Day(DateString) & "
" End Sub Private Sub Send(sHTML) Response.Write sHTML & vbCrLf End Sub End Class %>