%
' #################################
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 & " "
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 & "" & VbCrLf
sH = sH & CAL_ViewIcons(DateFrom, "M; MG; FT; Y;")
sH = sH & " |
" & VbCrLf
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 & "" & WeekDayName(i,ShortDayNames,session("FirstDayOfWeek")) & ""
Next
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
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 & " | " & 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 = "" & 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
%>