ASP.Net Draw Google like Calendar to add/delete/show events


Function call in code behind:

  lblCal.Text = DrawCalender(Session("month"), Session("year"), shrink)



Function Module to Draw Calander:
(dayevent function will connect to your database to get events as datatable and render it into calander dates.
  myquery = "select   project , concat(coord, ' Venue-', venue, ' ') as coord, start_dt,day(start_dt) as day, project as highlight, concat(' on ', date_format(start_dt,'%d.%m.%y')) as description, if(start_dt=end_dt, project ,concat(project,'(',convert(day(start_dt),char(2)),'-', convert(day(end_dt),char(2)),')')) as trim , 'PRT/PDRM' as type, '' as file, uid from diaryPRT where month(prtmonth) = " & Session("month") & " and year(prtmonth) = " & Session("year")
 ViewState("mydata") = dbOperation.getCalenderData(myquery)
)

Function DrawCalender(ByVal month As Integer, ByVal year As Integer, Optional ByVal shrink As Boolean = False) As String
        Try
            'to hold current date of this day for presentation peropse
            Dim today As Date = New Date(Now.Year, Now.Month, Now.Day)
            'object of passed month and year
            Dim currentDate As Date = New Date(year, CInt(month), 1)
            'array hold days of week
            Dim days() As String = New String() {"Sun", "Mon", "Tue", "Wed", "Thu", "Fri", "Sat"}
            'temp holder to hold week name from array above
            Dim day As String
            'number of days in selected month
            Dim numDays As Integer = Date.DaysInMonth(year, month)
            Dim index, position As Integer
            Dim returnData As String = ""
            '1st day of month day number
            Dim offset As Integer = currentDate.DayOfWeek()
            'MsgBox(offset)
            Dim mode1 = If(Not Session("mode") Is Nothing, "&mode=" & Session("mode"), "")
            returnData = ""
            returnData &= " "
            Dim lastmonth As Date = New DateTime(currentDate.Year, currentDate.Month, 1).AddMonths(-1)
            returnData &= "" & MonthName(currentDate.Month) & " - " & currentDate.Year & "
"
            Dim nextmonth As Date = New DateTime(currentDate.Year, currentDate.Month, 1).AddMonths(1)
            returnData &= "
"
            returnData &= " "
            For Each day In days
                returnData &= "" & day & "
"
            Next
            returnData &= "
"
            position = 0
            Dim shrinkhieght = 100
            For index = 1 - offset To numDays
                If position Mod 7 = 0 Then
                    returnData &= " "
                End If
                shrinkhieght = If((shrink And index <= 15), 40, 180)
                If index < 1 Then
                    returnData &= "-"
                ElseIf index = today.Day AndAlso year = today.Year AndAlso month = today.Month Then
                    returnData &= " & shrinkhieght & """ bgcolor=""#E0FFFF"">
& (index).ToString() & "," & month.ToString & ", " & year.ToString & " )""  style = ""width:100%;height:100%;z-index:1000;"" > " & _
                                     "         " & (index).ToString() & "

" & dayEvents(index) & ""
                Else
                    returnData &= " & shrinkhieght & """>
& (index).ToString() & "," & month.ToString & ", " & year.ToString & " )""  style = ""width:100%;height:100%;z-index:1000;"" > " & _
                                      "         " & (index).ToString() & "

" & dayEvents(index) & ""
                    '    "         " & (index).ToString() & "

" & dayEvents(index) & "
"
                End If

                position += 1
                If position Mod 7 = 0 Then returnData &= "
"
            Next

            If position Mod 7 <> 0 Then
                For index = 1 To 7 - (position Mod 7)
                    returnData &= "-"
                Next
                returnData &= "
"
            End If
            returnData &= "
"
            Return returnData
        Catch exp As Exception
            Return "Error: Please refresh the page : " & exp.Message & year & month
        End Try

    End Function
    Private Function Years() As String()
        Dim str(10) As String
        Dim index As Integer
        For index = 0 To str.Length - 1
            str(index) = Now.Year - str.Length + index + 1
        Next
        Return str
    End Function
    Private Function dayEvents(ByVal myday As String) As String
        Try
            Dim tmp As String = ""
            Dim detail As String = ""
            Dim bubble As String = ""
            Dim dt As New System.Data.DataTable
            dt = CType(ViewState("mydata"), System.Data.DataTable)
            Dim i As Integer = dt.Rows.Count
            If i = 0 Then
                Return "




"
            Else
                Dim j As Integer = 0
                Dim k As Integer = 1
                While j < i
                    'highlight,reviewby,reviewdate, day , project , description, trim, type, file , uid

                    If dt.Rows(j).Item(3).ToString() = myday Then

                        If j Mod 2 = 0 Then
                            tmp = tmp & " "
                            detail = detail & ""
                        Else
                            tmp = tmp & " "
                            detail = detail & ""
                        End If
                        Dim rdate As Date = dt.Rows(j).Item(2).ToString
                        detail = (k).ToString & ": " & dt.Rows(j).Item(0).ToString() & " " & dt.Rows(j).Item(5).ToString() & "


- " & dt.Rows(j).Item(1).ToString() & " Loc/Proj: " & dt.Rows(j).Item(4).ToString() & "


"
                        bubble = "onMouseOver=""return overlib('" & detail & "',CAPTION,'" & dt.Rows(j).Item(7).ToString() & ": " & rdate.ToString("dd-MM-yyyy") & "',TEXTSIZE,'14px',CAPTIONSIZE,'14px',CAPCOLOR,'#000000',HAUTO,VAUTO, FGCOLOR, '#ffffff', BGCOLOR, '#C1DAD7', BORDER, 1, CAPTIONFONT, 'Garamond', TEXTFONT, 'Courier');"" onMouseOut=""nd();"""
                        Dim link = "javascript:void(0);"
                        Dim icon = ""
                        If Not String.IsNullOrEmpty(dt.Rows(j).Item(8).ToString()) Then
                            link = "/ppm/upload/diary/" & dt.Rows(j).Item(8).ToString
                            icon = " & Right(dt.Rows(j).Item(8).ToString, 3) & ".gif border=0 align=middle height=13px onerror=" & Chr(34) & "this.src='images/file.gif';" & Chr(34) & "/>"
                        End If

                        tmp = tmp & " & bubble & " style='text-decoration:none'>" & dt.Rows(j).Item(6).ToString() & icon & "

"
                        k = k + 1
                    End If

                    j = j + 1

                End While
                Return " " & tmp & "
"
            End If
        Catch exp As Exception
            Return "Error: Please refresh the page : " & exp.Message & myday

        End Try



    End Function

Output:

To made the code complex for add/delete event Use popup control/or open other page and write code for that.

Comments