St. Theresa School - Calendar of Events
<% Const ICON_TASK = 1 Const ICON_EVENT = 2 Const ICON_HOLIDAY = 3 Dim strBoldOn ' As String Dim strBoldOff ' As String Dim strForce ' As String Dim attRedOn ' As String Dim attRedOff ' As String strBoldOn = "" strBoldOff = "" strForce = "
" attRedOn = "" attRedOff = "" Call Main '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' ' Sub Main ' ' Processing for this page starts in this routine. It ' contains a dispatcher to call the appropriate routine, ' based on what function was needed. ' '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Sub Main Dim cnDB ' As ADODB.Connection Set cnDB = OpenDB() If Request("month") = "" Or Request("year") = "" Then ShowCalendar cnDB, Month(Date), Year(Date) Else ShowCalendar cnDB, _ CInt(Request("month")), CInt(Request("year")) End If CloseDB cnDB End Sub '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' ' Sub ShowCalendar ' ' This routine generates the calendar grid and puts all the ' events into it. ' '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Sub ShowCalendar(cnDB, intMonth, intYear) Dim rsEvents ' As ADODB.Recordset Dim rsHoliday ' As ADODB.Recordset Dim rsTasks ' As ADODB.Recordset Dim strSQL ' As String Dim datCurrent ' As Date Dim intWeekday ' As Integer Dim intPreviousMonthDays ' As Integer Dim intCurrentMonthDays ' As Integer Dim i ' As Integer Dim intMonthLink ' As Integer Dim intYearLink ' As Integer Dim strColor ' As String Dim strBoldOn ' As String Dim strBoldOff ' As String strBoldOn = "" strBoldOff = "" datCurrent = CDate(intMonth & "/1/" & intYear) intCurrentMonthDays = _ Day(DateAdd("d", -1, DateAdd("m", 1, datCurrent))) intWeekday = Weekday(datCurrent) Set rsEvents = Server.CreateObject("ADODB.Recordset") strSQL = "SELECT * FROM Events " _ & " WHERE ((Month(StartDate) = " & intMonth _ & " AND Year(StartDate) = " & intYear & "))" _ & " OR ((Month(EndDate) = " & intMonth _ & " AND Year(EndDate) = " & intYear & "))" _ & "ORDER BY StartDate, StartTime" rsEvents.Open strSQL, cnDB, adOpenStatic Set rsHoliday = Server.CreateObject("ADODB.Recordset") strSQL = "SELECT * FROM Holiday " _ & " WHERE ((Month(StartDate) = " & intMonth _ & " AND Year(StartDate) = " & intYear & "))" _ & " OR ((Month(EndDate) = " & intMonth _ & " AND Year(EndDate) = " & intYear & "))" _ & "ORDER BY StartDate" rsHoliday.Open strSQL, cnDB, adOpenStatic Set rsTasks = Server.CreateObject("ADODB.Recordset") strSQL = "SELECT * FROM Tasks " _ & " WHERE Month(DueDate) = " & intMonth _ & " AND Year(DueDate) = " & intYear rsTasks.Open strSQL, cnDB, adOpenStatic ' ' Print calendar header information and ' setup table. '5/4/02 Put Head inside table see '''HEAD ''''PrintHeader "
Calendar for " _ '''' & MonthName(intMonth) & " " & intYear & "
" 'Original was 500 WriteLine "" '''HEAD WriteLine "" ''' ' ' Add weekday names to column headings ' WriteLine "" For i = 1 To 7 WriteLine "" Next ' i WriteLine "" ' ' The first row of calendar cells will contain gray ' boxes for all the days in the previous month. ' WriteLine "" If intWeekday <> 1 then intPreviousMonthDays = Day(DateAdd("d", -1, datCurrent)) For i = intWeekday -1 to 1 Step - 1 CreateCell intPreviousMonthDays - i + 1, "#FFFFF8", "" Next ' i End If ' ' Start main loop through days of the month. When we hit ' 7 days in a row, the loop starts a new table row. ' For i = 1 to intCurrentMonthDays ' ' Mark the current date's box in a ' different color. ' If Date = CDate(intMonth & "/" & i & "/" & intYear) Then strColor = "#FFFFD8" Else strColor = "#FFFFFF" End If CreateCell i, strColor, _ GetDayItems(rsEvents, rsHoliday, rsTasks, intMonth, i, intYear) ' ' Start a new row if we have 7 days in the grid ' If intWeekday = 7 Then intWeekday = 1 WriteLine "" WriteLine "" Else intWeekday = intWeekday + 1 End If Next ' i ' ' Add days of next month to grid in last row. ' If intWeekday <= 7 and intWeekday > 1 Then For i = intWeekday To 7 CreateCell i - intWeekday + 1, "#FFFFF8", "" Next ' i End If WriteLine "
Scheduled for " _ & MonthName(intMonth) & " " & intYear & "
" WriteLine "" _ & WeekdayName(i) & "" WriteLine "
" rsTasks.Close rsEvents.Close rsHoliday.Close ' ' Add navigation buttons (previous, next) to bottom of calendar ' WriteLine "" intMonthLink = intMonth - 1 intYearLink = intYear If intMonth = 1 Then intMonthLink = 12 intYearLink = intYearLink - 1 End If WriteLine "" ' ' Add navigation to middle of bottom row of calendar. This ' allow the user to pick any month/year to view. ' WriteLine "" intMonthLink = intMonth + 1 intYearLink = intYear If intMonth = 12 Then intMonthLink = 1 intYearLink = intYearLink + 1 End If WriteLine "" WriteLine "
" WriteLine "<< Previous" WriteLine "
" WriteLine "Select Month: " WriteLine "" WriteLine "Year: " WriteLine "" WriteLine "" WriteLine "" WriteLine "
" _ & "" WriteLine "Next >>
" PrintFooter End Sub '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' ' Function GetDayItems ' ' This routine displays the events in each calendar cell. ' The events are returned to the caller as a string so that ' they can be printed into the calendar cell. ' '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Function GetDayItems(rsEvents, rsHoliday, rsTasks, intCurMonth, _ intCurDay, intCurYear) Dim blnShowEvent ' As Boolean Dim i ' As Integer Dim strResult ' As String Dim intStartMonth Dim intStartDay Dim intStartYear Dim intEndMonth Dim intEndDay Dim intEndYear If rsTasks.RecordCount > 0 Then rsTasks.MoveFirst Do Until rsTasks.EOF If Day(rsTasks("DueDate")) = intCurDay Then strResult = strResult & CreateIcon(ICON_TASK, rsTasks) End If rsTasks.MoveNext Loop If rsHoliday.RecordCount > 0 Then rsHoliday.MoveFirst Do Until rsHoliday.EOF blnShowEvent = False intStartMonth = Month(rsHoliday("StartDate")) intStartDay = Day(rsHoliday("StartDate")) intStartYear = Year(rsHoliday("StartDate")) intEndMonth = Month(rsHoliday("EndDate")) intEndDay = Day(rsHoliday("EndDate")) intEndYear = Year(rsHoliday("EndDate")) ' ' Non-wrapping case - start and end month/year are the same. ' If intStartMonth = intCurMonth _ And intEndMonth = intCurMonth _ And intStartYear = intCurYear _ And intEndYear = intCurYear Then blnShowEvent = (intStartDay <= intCurDay) _ And intEndDay >= intCurDay Else ' ' Wrapping case - if event started in ' previous month, only check day. ' If intStartMonth < intCurMonth Then ' event started before current month blnShowEvent = (intCurDay <= intEndDay) ElseIf intEndMonth > intCurMonth Then ' event ended after current month blnShowEvent = (intCurDay >= intStartDay) End If End If If blnShowEvent Then strResult = strResult & CreateIcon(ICON_HOLIDAY, rsHoliday) End If rsHoliday.MoveNext Loop If rsEvents.RecordCount > 0 Then rsEvents.MoveFirst Do Until rsEvents.EOF blnShowEvent = False intStartMonth = Month(rsEvents("StartDate")) intStartDay = Day(rsEvents("StartDate")) intStartYear = Year(rsEvents("StartDate")) intEndMonth = Month(rsEvents("EndDate")) intEndDay = Day(rsEvents("EndDate")) intEndYear = Year(rsEvents("EndDate")) ' ' Non-wrapping case - start and end month/year are the same. ' If intStartMonth = intCurMonth _ And intEndMonth = intCurMonth _ And intStartYear = intCurYear _ And intEndYear = intCurYear Then blnShowEvent = (intStartDay <= intCurDay) _ And intEndDay >= intCurDay Else ' ' Wrapping case - if event started in ' previous month, only check day. ' If intStartMonth < intCurMonth Then ' event started before current month blnShowEvent = (intCurDay <= intEndDay) ElseIf intEndMonth > intCurMonth Then ' event ended after current month blnShowEvent = (intCurDay >= intStartDay) End If End If If blnShowEvent Then strResult = strResult & CreateIcon(ICON_EVENT, rsEvents) End If rsEvents.MoveNext Loop GetDayItems = strResult End Function ''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' ' Sub CreateCell ' ' This function puts content into a cell, including ' all the necessary HTML and formatting tags. ' ' Oricinal CLASS calcell ''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Sub CreateCell(strNumber, strColor, strText) WriteLine "" WriteLine "" WriteLine "" WriteLine "" WriteLine "
" _ & "" _ & strNumber & "
" WriteLine strText WriteLine "
" End Sub ''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' ' Function CreateIcon ' ' This function generates an icon for an item to ' be added to the calendar. This routine knows ' what fields to pull, based on the type of icon ' to be shown. ' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Function CreateIcon(intCode, rsData) Dim strResult ' As String Dim lngID ' As Long Dim datStart ' As Date Dim datEnd ' As Date Dim strTime ' As String Dim strGraphic ' As String Dim strPage ' As String Dim strDesc1 ' As String Dim strPerson1 ' As String strDesc1 = "" strPerson1 ="" If intCode = ICON_TASK Then strGraphic = "Events/eorganizer/pics/task.gif" strPage = "tasks.asp" lngID = rsData("pkTaskID") datStart = rsData("StartDate") datEnd = rsData("DueDate") strTime = "" strPerson1 = rsData("Name") ElseIf intCode = ICON_HOLIDAY Then strGraphic = "Events/eorganizer/pics/task.gif" strPage = "holidays.asp" lngID = rsData("HolidayId") datStart = rsData("StartDate") datEnd = rsData("EndDate") strTime = "" strPerson1 = rsData("HolidayName") ElseIf intCode = ICON_EVENT Then strGraphic = "Events/eorganizer/pics/event.gif" strPage = "events.asp" lngID = rsData("EventId") datStart = rsData("StartDate") datEnd = rsData("EndDate") strTime = rsData("StartTime") strPerson1 = rsData("EventName") End If 'ORIGINAL ' strResult = "" _ ' & " & DQ _ ' & strPerson1 & vbCrLf ' If strTime <>  " ' CreateIcon = strResult ' If strTime <> "" Then ' strResult = strBoldOn & strTime & strBoldOff & " " & strPerson1 & strForce ' Else ' strResult = strBoldOn & attRedOn & strPerson1 & attRedOff & strBoldOff & strForce ' End If If intCode = ICON_EVENT Then strResult = strBoldOn & strTime & strBoldOff & " " & strPerson1 & strForce Elseif intCode = ICON_TASK Then strResult = strBoldOn & attRedOn & strPerson1 & attRedOff & strBoldOff & strForce Elseif intCode = ICON_HOLIDAY Then strResult = strBoldOn & attRedOn & strPerson1 & attRedOff & strBoldOff & strForce End If CreateIcon = strResult End Function %>
! = Important Notice $=FUNDRAISER * = No School
N= Noon Dismissal P = Parents Notice C = Closed Period
S = Service Project # = Important Notice % = Home School
SL=School Library MH=McVeigh Hall CAF=School Cafeteria
YMO=Youth Ministry Office REO=Religious Education Office UR=Upper Room
CH=Church CHA=Chapel