Custom Dynamic Interactive Calendar

Introduction

Here is a custom calendar control that I built to take input from a data source for two parties and show a customized view of the dates depending on the result of those queries and the system date.

Background

Recently, I was faced with the daunting task of generating a custom calendar control. It was to be specific to the company’s checkout procedures and policies, and it needed color-coded dates with remarks written in them. Best of all, both the colors and the remarks were to be generated on load, according to a set of criteria from the user, and so needed quick DB fetches. I had little luck finding any components or free source code on the web that would even come close to what I was after. So, after a brief fit, I resigned myself to building it from scratch…here it is, with the code-behind in VB.NET. The C# version is very similar. A lot of this code will be specific to my needs on that day, and you can discard them. I’ve tried to eliminate as much of that as possible.

'First of all I chose an image button control 
'to show the finished product.
'I based this decision strictly on the fact 
'that the image button, unlike the
'image control or html image, will return the 
'coordinates of a click with no additional
'coding (e.x,e.y).
Imports System.Drawing.Graphics
Imports System.Drawing
Imports System.Drawing.Drawing2D
Imports System.Drawing.Imaging

Public Class cal
       Inherits System.Web.UI.Page

'First let’s make some public declarations, we’ll need these later to 
'identify the date (or navigation button) selected on click.
'Note: these sizes and coordinates are of course dependant on the total 
'size of the control you want to build. 
'Also notice that the rectangles do not have dates assigned to them. We 
'don’t know what dates they represent at this point. Only that the 
'first rectangle is the first sunday (not necessarily even a part of 
'the month in question), and so on.

    Public sunday1 As Rectangle = New Rectangle(0, 57, 90, 70)
    Public sunday2 As Rectangle = New Rectangle(0, 128, 90, 70)
    Public sunday3 As Rectangle = New Rectangle(0, 199, 90, 70)
    Public sunday4 As Rectangle = New Rectangle(0, 270, 90, 70)
    Public sunday5 As Rectangle = New Rectangle(0, 341, 90, 70)
    Public monday1 As Rectangle = New Rectangle(90, 57, 90, 70)
    Public monday2 As Rectangle = New Rectangle(90, 128, 90, 70)
    Public monday3 As Rectangle = New Rectangle(90, 199, 90, 70)
    Public monday4 As Rectangle = New Rectangle(90, 270, 90, 70)
    Public monday5 As Rectangle = New Rectangle(90, 341, 90, 70)
    Public tuesday1 As Rectangle = New Rectangle(180, 57, 90, 70)
    Public tuesday2 As Rectangle = New Rectangle(180, 128, 90, 70)
    Public tuesday3 As Rectangle = New Rectangle(180, 199, 90, 70)
    Public tuesday4 As Rectangle = New Rectangle(180, 270, 90, 70)
    Public tuesday5 As Rectangle = New Rectangle(180, 341, 90, 70)
    Public wednesday1 As Rectangle = New Rectangle(270, 57, 90, 70)
    Public wednesday2 As Rectangle = New Rectangle(270, 128, 90, 70)
    Public wednesday3 As Rectangle = New Rectangle(270, 199, 90, 70)
    Public wednesday4 As Rectangle = New Rectangle(270, 270, 90, 70)
    Public wednesday5 As Rectangle = New Rectangle(270, 341, 90, 70)
    Public thursday1 As Rectangle = New Rectangle(360, 57, 90, 70)
    Public thursday2 As Rectangle = New Rectangle(360, 128, 90, 70)
    Public thursday3 As Rectangle = New Rectangle(360, 199, 90, 70)
    Public thursday4 As Rectangle = New Rectangle(360, 270, 90, 70)
    Public thursday5 As Rectangle = New Rectangle(360, 341, 90, 70)
    Public friday1 As Rectangle = New Rectangle(450, 57, 90, 70)
    Public friday2 As Rectangle = New Rectangle(450, 128, 90, 70)
    Public friday3 As Rectangle = New Rectangle(450, 199, 90, 70)
    Public friday4 As Rectangle = New Rectangle(450, 270, 90, 70)
    Public friday5 As Rectangle = New Rectangle(450, 341, 90, 70)
    Public saturday1 As Rectangle = New Rectangle(540, 57, 90, 70)
    Public saturday2 As Rectangle = New Rectangle(540, 128, 90, 70)
    Public saturday3 As Rectangle = New Rectangle(540, 199, 90, 70)
    Public saturday4 As Rectangle = New Rectangle(540, 270, 90, 70)
    Public saturday5 As Rectangle = New Rectangle(540, 341, 90, 70)
    Public prevbutton As Rectangle = New Rectangle(153, 19, 20, 20)
    Public nextbutton As Rectangle = New Rectangle(462, 19, 20, 20)
    Public valid_date As Rectangle = New Rectangle(90, 57, 540, 356)


    Private Sub Page_Load(ByVal sender As System.Object, _
            ByVal e As System.EventArgs) Handles MyBase.Load
        'On page_load all we’re going to do is call the function 
        'that generates the image and apply 
        'the resulting path to the image button.
        testimg.ImageUrl = getimage()
    End Sub

'Here’s the function that does most of the work. It is dependant on so
'many other functions though, and you’ll see most of them below. 
'Again whatever isn’t relevant has been omitted.
Public Function getimage()

    Dim mybitmap As New Bitmap(631, 414)
    Dim chartimage As Graphics = Graphics.FromImage(mybitmap)
    chartimage.Clear(Color.White)

    'IN THE NEXT LINE YOU’LL SEE THAT I STARTED WITH A BITMAP 
    'IMAGE THAT CONTAINS THE HEADER BACKGROUND 
    'AND BUTTONS ALREADY PAINTED ON. 
    chartimage.DrawImage(Image.FromFile("c:\CAL_BGRND"), 0, 0)
    Dim intmonth As Integer = Request.QueryString("month")
    Dim strmonth_year As String = convert_month(intmonth) & " " & Now.Year
    Dim myfont As Font = New Font("Tahoma", 12, FontStyle.Bold)

    'The next block i put together in order to center the headline 
    '"month/year" in the header, as different months are of different 
    'lengths, i decided to arrived at the right location 
    'for the header ‘string on demand.

    Dim size As SizeF = _
     Graphics.FromImage(mybitmap).MeasureString(strmonth_year, myfont)
    Dim intwidth As Integer = size.ToSize.Width
    chartimage.DrawString(strmonth_year, myfont, _
                          Brushes.Black, find_x(intwidth) + 10, 17)
    Dim graph_font As Font = New Font("Tahoma", 10, FontStyle.Bold)
    Dim charges_font As Font = New Font("Tahoma", 8, FontStyle.Regular)
    'SHADE THE WEEKEND
    chartimage.FillRectangle(Brushes.Gray, New Rectangle(0, 57, 90, 413))
    'COLOR CODE THE DATEBOXES
    Dim day_counter As Integer
    Dim box_counter As Integer = 0
    For day_counter = 2 To 7
        'Here’s where i color code that dates, 
        'note that the loop does not run
        'from the beginning of the month to the end, 
        'but from the beginning of ‘each week to the end 
        'in five separate sets of if statements.

        chartimage.FillRectangle(choose_color(itemid, _
           box_date(day_counter - 1, intmonth)), _
           New Rectangle(70 + ((day_counter - 1) * 90), 57, 20, 20))
        If choose_color(itemid, box_date(day_counter - 1, _
                        intmonth)) Is Brushes.Red Then
            chartimage.DrawString("Unavailable", charges_font, _
                  Brushes.Black, ((day_counter - 1) * 90), 82)
        End If
        chartimage.FillRectangle(choose_color(itemid, _
             box_date(day_counter + 6, intmonth)), _
             New Rectangle(70 + ((day_counter - 1) * 90), 128, 20, 20))
        If choose_color(itemid, box_date(day_counter + 6, _
                        intmonth)) Is Brushes.Red Then
            chartimage.DrawString("Unavailable", charges_font, _
                 Brushes.Black, ((day_counter - 1) * 90), 153)
        End If
        chartimage.FillRectangle(choose_color(itemid, _
                    box_date(day_counter + 13, intmonth)), _
                    New Rectangle(70 + ((day_counter - 1) * 90), 199, 20, 20))
        If choose_color(itemid, box_date(day_counter + 13, _
                        intmonth)) Is Brushes.Red Then
            chartimage.DrawString("Unavailable", charges_font, _
                       Brushes.Black, ((day_counter - 1) * 90), 224)
        End If
        chartimage.FillRectangle(choose_color(itemid, _
                   box_date(day_counter + 20, intmonth)), _
                   New Rectangle(70 + ((day_counter - 1) * 90), 270, 20, 20))
        If choose_color(itemid, box_date(day_counter + 20, _
                        intmonth)) Is Brushes.Red Then
            chartimage.DrawString("Unavailable", charges_font, _
                 Brushes.Black, ((day_counter - 1) * 90), 295)

        End If
        chartimage.FillRectangle(choose_color(itemid, _
                   box_date(day_counter + 27, intmonth)), _
                   New Rectangle(70 + ((day_counter - 1) * 90), 341, 20, 20))
        If choose_color(itemid, box_date(day_counter + 27, _
                        intmonth)) Is Brushes.Red Then
            chartimage.DrawString("Unavailable", charges_font, _
                  Brushes.Black, ((day_counter - 1) * 90), 366)
        End If
    Next day_counter
    'Fill the date boxes
    'here’s where we write the dates themselves into the dateboxes. 
    'again, we’re running in weeks monday through saturday, not straight
    'through the month.

    Dim intboxw1 As Integer
    Dim xw1 As Integer = 71
    For intboxw1 = 0 To 6
        Dim datefont As Font = New Font("Tahoma", 10, FontStyle.Bold)
        chartimage.DrawString(box_date(intboxw1, intmonth).day, _
                   datefont, Brushes.Black, xw1 + (intboxw1 * 90), 58)
        chartimage.DrawString(box_date(intboxw1 + 7, intmonth).day, _
                   datefont, Brushes.Black, xw1 + (intboxw1 * 90), 129)
        chartimage.DrawString(box_date(intboxw1 + 14, intmonth).day, _
                   datefont, Brushes.Black, xw1 + (intboxw1 * 90), 200)
        chartimage.DrawString(box_date(intboxw1 + 21, intmonth).day, _
                   datefont, Brushes.Black, xw1 + (intboxw1 * 90), 271)
        chartimage.DrawString(box_date(intboxw1 + 28, intmonth).day, _
                   datefont, Brushes.Black, xw1 + (intboxw1 * 90), 342)
    Next intboxw1
    'DRAW CHARTLINES
    ''HORIZONTAL
    chartimage.DrawLine(New Pen(Color.Black), 0, 57, 633, 57)
    chartimage.DrawLine(New Pen(Color.Black), 0, 128, 633, 128)
    chartimage.DrawLine(New Pen(Color.Black), 0, 199, 633, 199)
    chartimage.DrawLine(New Pen(Color.Black), 0, 270, 633, 270)
    chartimage.DrawLine(New Pen(Color.Black), 0, 341, 633, 341)
    ''VERTICAL
    chartimage.DrawLine(New Pen(Color.Black), 90, 57, 90, 413)
    chartimage.DrawLine(New Pen(Color.Black), 180, 57, 180, 413)
    chartimage.DrawLine(New Pen(Color.Black), 270, 57, 270, 413)
    chartimage.DrawLine(New Pen(Color.Black), 360, 57, 360, 413)
    chartimage.DrawLine(New Pen(Color.Black), 450, 57, 450, 413)
    chartimage.DrawLine(New Pen(Color.Black), 540, 57, 540, 413)
    Dim dhfont As Font = New Font("tahoma", 10, FontStyle.Bold)
    'DRAW DAY HEADER STRINGS
    chartimage.DrawString("Sunday", dhfont, Brushes.Black, 3, 42)
    chartimage.DrawString("Monday", dhfont, Brushes.Black, 93, 42)
    chartimage.DrawString("Tuesday", dhfont, Brushes.Black, 183, 42)
    chartimage.DrawString("Wednesday", dhfont, Brushes.Black, 273, 42)
    chartimage.DrawString("Thursday", dhfont, Brushes.Black, 363, 42)
    chartimage.DrawString("Friday", dhfont, Brushes.Black, 453, 42)
    chartimage.DrawString("Saturday", dhfont, Brushes.Black, 543, 42)
    'DRAW DATE BOXES
    Dim i As Integer
    For i = 0 To 6
        chartimage.DrawLine(New Pen(Color.Black), _
                   (70 + (i * 90)), 57, (70 + (i * 90)), 77)
        chartimage.DrawLine(New Pen(Color.Black), _
                   (70 + (i * 90)), 77, (70 + (i * 90)) + 20, 77)
        chartimage.DrawLine(New Pen(Color.Black), _
                   (70 + (i * 90)), 128, (70 + (i * 90)), 148)
        chartimage.DrawLine(New Pen(Color.Black), _
                   (70 + (i * 90)), 148, (70 + (i * 90)) + 20, 148)
        chartimage.DrawLine(New Pen(Color.Black), _
                   (70 + (i * 90)), 199, (70 + (i * 90)), 219)
        chartimage.DrawLine(New Pen(Color.Black), _
                   (70 + (i * 90)), 219, (70 + (i * 90)) + 20, 219)
        chartimage.DrawLine(New Pen(Color.Black), _
                   (70 + (i * 90)), 270, (70 + (i * 90)), 290)
        chartimage.DrawLine(New Pen(Color.Black), _
                   (70 + (i * 90)), 290, (70 + (i * 90)) + 20, 290)
        chartimage.DrawLine(New Pen(Color.Black), _
                   (70 + (i * 90)), 341, (70 + (i * 90)), 361)
        chartimage.DrawLine(New Pen(Color.Black), _
                   (70 + (i * 90)), 361, (70 + (i * 90)) + 20, 361)
    Next i
    'DRAW BORDERS
    chartimage.DrawLine(New Pen(Color.Black), 0, 57, 0, 413)
    chartimage.DrawLine(New Pen(Color.Black), 630, 57, 630, 413)
    chartimage.DrawLine(New Pen(Color.Black), 0, 413, 630, 413)

    Dim tempfile As String = Date.Now.Ticks & ".bmp"
    Dim localresource As String = _
            "C:\Websites\thiswebsite.com\images\" & tempfile
    mybitmap.Save(localresource, ImageFormat.Bmp)

    Return "images/" & tempfile

    End Function

    'Next is the function that gets a value for click.
    'here’s where those public declarations come in handy…

    Public Function find_click(ByVal x As Integer, ByVal y As Integer)
        Dim spot As Point = New Point(x, y)
        Dim bi As Integer
        If sunday1.Contains(spot) = True Then
            bi = 0
        ElseIf monday1.Contains(spot) = True Then
            bi = 1
        ElseIf tuesday1.Contains(spot) = True Then
            bi = 2
        ElseIf wednesday1.Contains(spot) = True Then
            bi = 3
        ElseIf thursday1.Contains(spot) = True Then
            bi = 4
        ElseIf friday1.Contains(spot) = True Then
            bi = 5
        ElseIf saturday1.Contains(spot) = True Then
            bi = 6
        ElseIf sunday2.Contains(spot) = True Then
            bi = 7
        ElseIf monday2.Contains(spot) = True Then
            bi = 8
        ElseIf tuesday2.Contains(spot) = True Then
            bi = 9
        ElseIf wednesday2.Contains(spot) = True Then
            bi = 10
        ElseIf thursday2.Contains(spot) = True Then
            bi = 11
        ElseIf friday2.Contains(spot) = True Then
            bi = 12
        ElseIf saturday2.Contains(spot) = True Then
            bi = 13
        ElseIf sunday3.Contains(spot) = True Then
            bi = 14
        ElseIf monday3.Contains(spot) = True Then
            bi = 15
        ElseIf tuesday3.Contains(spot) = True Then
            bi = 16
        ElseIf wednesday3.Contains(spot) = True Then
            bi = 17
        ElseIf thursday3.Contains(spot) = True Then
            bi = 18
        ElseIf friday3.Contains(spot) = True Then
            bi = 19
        ElseIf saturday3.Contains(spot) = True Then
            bi = 20
        ElseIf sunday4.Contains(spot) = True Then
            bi = 21
        ElseIf monday4.Contains(spot) = True Then
            bi = 22
        ElseIf tuesday4.Contains(spot) = True Then
            bi = 23
        ElseIf wednesday4.Contains(spot) = True Then
            bi = 24
        ElseIf thursday4.Contains(spot) = True Then
            bi = 25
        ElseIf friday4.Contains(spot) = True Then
            bi = 26
        ElseIf saturday4.Contains(spot) = True Then
            bi = 27
        ElseIf sunday5.Contains(spot) = True Then
            bi = 28
        ElseIf monday5.Contains(spot) = True Then
            bi = 29
        ElseIf tuesday5.Contains(spot) = True Then
            bi = 30
        ElseIf wednesday5.Contains(spot) = True Then
            bi = 31
        ElseIf thursday5.Contains(spot) = True Then
            bi = 32
        ElseIf friday5.Contains(spot) = True Then
            bi = 33
        ElseIf saturday5.Contains(spot) = True Then
            bi = 34
        End If
        Return bi
     End Function

    Public Function box_date(ByVal box_index As Integer, _
                             ByVal month As Integer)
    'Now here’s how I determine where to start the 
    'month (in case you were ‘wondering).
        Dim strstartdate As String = month & "/01/2006"
        Dim dt_strtdate As Date = strstartdate
        Dim int_dy_firstday As Integer = dt_strtdate.DayOfWeek
        Dim edate As Date = _
          dt_strtdate.AddDays(-(int_dy_firstday - box_index))
        Return edate.Date
    End Function

    Public Function choose_color(ByVal itemid _
           As String, ByVal boxdate As Date)
    'Here’s the function that actually decides 
    'what color belongs where…
    'i had to pull data for both parties along 
    'with system time to use them
    'all to arrive at the color, you might not need as much code.
        Dim cmd As New OleDb.OleDbCommand(myconnectionstring, _
                       OleDbConnection1)
        Dim da As New OleDb.OleDbDataAdapter(cmd)
        Dim ds As New DataSet
        OleDbConnection1.Open()
        da.Fill(ds)
        OleDbConnection1.Close()
        Dim sellerlocal As Integer = ds.Tables(0).Rows(0).Item(0)
        Dim buyerid As String = ds.Tables(0).Rows(0).Item(1).ToString
        Dim buyerlocal As Integer = _
                          get_buyerlocal(buyerid)
        Dim sellerlag As Integer = _
                         ds.Tables(0).Rows(0).Item(2)
        Dim auto_lag As Integer = 0
        If sellerlocal = 0 Then
            auto_lag = auto_lag + 1
        ElseIf sellerlocal > 0 Then
            auto_lag = auto_lag + 3
        End If
        If buyerlocal = 0 Then
            auto_lag = auto_lag + 1
        ElseIf buyerlocal > 0 Then
            auto_lag = auto_lag + 3
        End If

        'The following dates are the start of each color range…
        Dim orangebase As Date = Now.Date.AddDays(auto_lag).Date
        Dim yellowbase As Date = _
            orangebase.Date.AddDays(sellerlag + 1).Date
        Dim greenbase As Date = yellowbase.Date.AddDays(2).Date
        Dim ebrush As System.Drawing.Brush
        If boxdate >= orangebase And boxdate < yellowbase Then
            ebrush = Brushes.Orange
        ElseIf boxdate >= yellowbase And boxdate < greenbase Then
            ebrush = Brushes.Yellow
        ElseIf boxdate >= greenbase Then
            ebrush = Brushes.Green
        ElseIf boxdate < orangebase Then
            ebrush = Brushes.Red
        End If
        'I return a brush, since i figure if i’m calling 
        'this function i must ‘be ready to paint…
         Return ebrush
    End Function

    'Now here’s the click event, the most 
    'important action here is going 
    'to be making sure that the date we record 
    '(and corresponding charges)
    'is exactly what the user saw when they clicked…
    Private Sub Img_Click(ByVal sender As System.Object, _
            ByVal e As System.Web.UI.ImageClickEventArgs) _
            Handles testimg.Click

        If prevbutton.Contains(e.X, e.Y) = True Then
        'REDIRECT TO MONTH - 1
        ElseIf nextbutton.Contains(e.X, e.Y) = True Then
           'REDIRECT TO MONTH + 1
        ElseIf valid_date.Contains(e.X, e.Y) = True Then
            Dim bi As Integer = find_click(e.X, e.Y)
            Dim dateselected As Date = box_date(bi, month).date
            If choose_color(itemid, dateselected) Is Brushes.Green _
               Or choose_color(itemid, dateselected) Is _
               Brushes.Orange Or choose_color(itemid, _
               dateselected) Is Brushes.Yellow Then
            '…Then the date is valid,not a button,not a sunday 
            'and not in some ‘random whitespace, so record it and continue…
            End If
        End If
     End Sub

    'Oh one last thing. Since you’ll never need this image again…
    Private Sub Page_Unload(ByVal sender As Object, _
            ByVal e As System.EventArgs) Handles MyBase.Unload
        Dim oldpic As New FileInfo("C:\websites\thiswebsite.com\" & _
                                   testimg.ImageUrl)
        oldpic.Delete()
    End Sub End Class

And that's it.