<% ' ################################# public function CAL_ViewMonth() dim MonthTest dim sH : sH = "" dim DateTo dim DateFrom dim Q_DATE dim dtPrev: dtPrev = dateadd("m",-1,dtDate) dim dtNext: dtNext = dateadd("m",+1,dtDate) DateFrom = VMonth() DateFrom = dateSerial(year(DateFrom), month(DateFrom), 1) DateTo = DateAdd("d",-1,DateAdd("m",+1,DateFrom)) sH = sH & "" & VbCrlf sH = sH & "" & VbCrLf sH = sH & "" & VbCrLf sH = sH & "
" & VbCrLf sH = sH & "  " sH = sH & monthname(month(DateFrom)) & " " & Year(DateFrom) & VbCrLf sH = sH & "  
" if session("FILTER_CATEGORY") <> "" then sH = sH & CAL_SHOWCATFILTERS() 'writes list of categories in filter end if sH = sH & "
" & VbCrLf sH = sH & CAL_ViewIcons(DateFrom, "M; MG; FT; Y;") sH = sH & "

" & VbCrlf select case request.queryString("View") case "MonthGraphical" sH = sH & CAL_DisplayMBG( 0, false) case else sH = sH & ListEvents(DateFrom, DateTo) end select CAL_ViewMonth = sH end function ' ################################# public function CAL_DisplayMBG(intDIFFERENCE, blVIEWTODAY) ' This function will display small navigation menu dim ShortDayNames dim sH : sH = "" dim DtText dim Prev dim Nex dim VDay dim NumOfWeeks dim i dim iDay dim X, Y dim Amount dim iWeek dim CellBG dim WhatView dim CountEventSET dim intCOUNTEVENTS dim strEVENTS dim dtMBG dtMBG = dateserial(year(dtDate()), month(dtDate()),1) DtText = "" Prev = DateAdd("m", -1, dtMBG) Nex = DateAdd("m", +1, dtMBG) VDay = CAL_FirstWeekDay(dtMBG) NumOfWeeks = DateDiff("ww", dtMBG, dateadd("m",1,dtMBG)-1, session("FirstDayOfWeek"), FirstWeekOfYear) sH = sH & "" sH = sH & "" sH = sH & "" sH = sH & "" For i = 1 To 7 sH = sH & "" For iWeek = 0 To NumOfWeeks sH = sH & "" For iDay = 0 To 7 If VDay = date() AND iDay>0 Then ' BgColor of today CellBG = "Class=""MBGDAYSTODAY""" else CellBG="class=""MBGDAYSCURRENT""" End If WhatView = "" IF iDay >0 then ' P5 if CellBG = "" then CellBG = "class=""MBGDAYSCURRENT""" If Month(VDay) <> Month(dtMBG) then CellBG="class=""MBGDAYSOVER""" sH = sH & " " & VbCrLf end if CountEventSET.MoveNext Loop CountEventSET.Close set CountEventSET=Nothing if intCOUNTEVENTS= 0 then ' no events WhatView = WhatView & ">"& vbcrlf WhatView = WhatView & Day(VDay) & vbcrlf else select case intCOUNTEVENTS case 1 WhatView = WhatView & "Title='There is an event in this day.'>" case else WhatView = WhatView & "Title='There are " & intCOUNTEVENTS & " events in this day.'>" end select WhatView = WhatView & "" & Day(VDay) & "" & vbcrlf end if WhatView = WhatView & "
" & vbcrlf if strEVENTS<>"" then strEVENTS = "
 " & WeekDayName(i,ShortDayNames,session("FirstDayOfWeek")) & "" Next sH = sH & "
" & vbcrlf WhatView = WhatView & "0 AND EventDate = " & funcs.VDate(VDay) if Session("FILTER_CATEGORY") <> "" then strSQL = strSQL & " AND wcal_eventcat.IDCat IN (" & Session("FILTER_CATEGORY") & "0)" if Session("FILTER_LOCATION") <> "" then strSQL = strSQL & " AND wcal_events.Place like '%" & Session("FILTER_LOCATION") & "%'" case else strSQL = "SELECT wcal_events.*, wcal_eventrec.IDEvent as ID FROM wcal_eventcat LEFT JOIN wcal_events ON wcal_eventcat.IDEvent = wcal_events.IDEvent LEFT JOIN wcal_eventrec ON wcal_events.IDEvent = wcal_eventrec.IDEvent INNER JOIN wcal_category ON wcal_eventcat.IDCat = wcal_category.IDCat where (UserPrivate=0 OR UserPrivate=" & session("WCAL_USERID") & ") AND wcal_events.Client=" & session("Client") & " and wcal_events.Lang=" & session("LANG") & " and wcal_eventcat.CatType<>0 AND EventDate = " & funcs.VDate(VDay) if Session("FILTER_CATEGORY") <> "" then strSQL = strSQL & " AND wcal_eventcat.IDCat IN (" & Session("FILTER_CATEGORY") & "0)" if Session("FILTER_LOCATION") <> "" then strSQL = strSQL & " AND wcal_events.Place like '%" & Session("FILTER_LOCATION") & "%'" end select intCOUNTEVENTS = 0 strEVENTS = "" set CountEventSET = Server.CreateObject("ADODB.Recordset") CountEventSET.CursorLocation = 3 CountEventSET.Open strSql, my_conn CountEventSET.CacheSize = 100 do until CountEventSET.EOF ' Need to check access level if CAL_Wcal_CheckGroupAccess(CountEventSET("ID")) then intCOUNTEVENTS = intCOUNTEVENTS + 1 ' List of events for this day strEVENTS = strEVENTS & "
" & VbCrLf strEVENTS = strEVENTS & "" & VbCrLf strEVENTS = strEVENTS & CountEventSET("EventName") & VbCrLf strEVENTS = strEVENTS & "" & VbCrLf strEVENTS = strEVENTS & "
" & strEVENTS & "
" & VbCrLf WhatView = WhatView & strEVENTS sH = sH & WhatView VDay = DateAdd("d", 1, VDay) ' Increment of day pointer Else ' P5 sH = sH & " " If month(vday) = month(dtMBG) or month(DateAdd("d", +6, VDay)) = month(dtMBG) then X = dateadd("y", +6,VDay) X = DatePart("WW", x, session("FirstDayOfWeek"), FirstWeekOfYear) Y = DatePart("WW", VDay, session("FirstDayOfWeek"), FirstWeekOfYear) ' if Week view is allowed if blView4 then sH = sH & "View week" end if ' if Week view based on place is allowed if blView5 then sH = sH & "
Week schedule" end if else sH = sH & " " End if End If ' P5 sH = sH & " " Next sH = sH & "" Next set Amount = Nothing sH = sH & "" sH = sH & "" CAL_DisplayMBG= sH end function %>