Click here to Skip to main content
15,896,557 members
Articles / Web Development / IIS

Customised Calender web server Control

Rate me:
Please Sign up or sign in to vote.
1.29/5 (7 votes)
30 May 2009CPOL 48.1K   526   20  
This Customised Calender web server Control developed in .Net version 1.1
Imports System.ComponentModel
Imports System.Web.UI
Imports System.Drawing

#Region "This Calender Control is Developed By Hitesh K Chhatbar. "
<DefaultProperty("About"), _
 DefaultEvent("hdateselected"), _
 Bindable(True), _
 Description("This Generic Buttons Control is Developed By Hitesh K Chhatbar."), _
 ToolboxBitmap(GetType(Image), "HitWebcompi.bmp"), _
 ToolboxData("<{0}:Hitcalender style='position: absolute; Z-index: 1001' runat=server></{0}:Hitcalender>")> Public Class Hitcalender
    Inherits System.Web.UI.WebControls.WebControl
    Implements IPostBackEventHandler

    Dim _text As String

#Region "calender"

#Region "Global Variables"
    Public Top As Double = 0
    Public Left As Double = 0
    Public cWidth As Double = 300
    Public cHeight As Double = 300
    Public Position As String = "absolute"
    Public ZIndex As Integer
    Public TitlebarFont As String = "arial"
    Public Shared gnCellWidth
    Public Shared gnCellHeight
    Private mdDate As DateTime
    Private msToday
    Private mnDay As Integer
    Private mnMonth As Integer
    Private mnYear As Long
    Private mnDayMonthStarts As Integer
    Private mnDaysInMonth As Integer
    Private mcolDays As New ArrayList
    Private mbDaysInitialized As Boolean = False

    Private strunregmessage As String
    Protected WithEvents cal As New WebControls.Calendar
#End Region

#Region "Calender Properties"

    Enum eabout
        About
        AboutControl
    End Enum
    Private _About As eabout

    Public ReadOnly Property GetDate() As DateTime
        Get
            Return mdDate
        End Get
    End Property
    Public ReadOnly Property DaysInMonth() As Integer
        Get
            Return mnDaysInMonth
        End Get
    End Property

    Public ReadOnly Property WeeksInMonth() As Integer
        Get
            If (mnDayMonthStarts + mnDaysInMonth - 1) > 35 Then
                Return 6
            Else
                Return 5
            End If
        End Get
    End Property

    Private _Days As Object

    Public ReadOnly Property Days(ByVal nIndex As Object) As Object
        Get
            ''Dim mcolDays As Object
            If Not mbDaysInitialized Then InitDays()
            'UPGRADE_ISSUE: The preceding line couldn't be parsed. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1010"'
            'UPGRADE_WARNING: Couldn't resolve default property of object mcolDays.Exists. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
            'UPGRADE_WARNING: Couldn't resolve default property of object mcolDays.Item. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
            If mcolDays.Count > 0 Then Days = mcolDays.Item(nIndex)
        End Get
    End Property



    Private _CalenderDrawHtml As String
    Private ReadOnly Property CalenderDrawHtml() As String
        Get
            Return _CalenderDrawHtml
        End Get
    End Property

    Private _setdate As DateTime = Date.Now()
    Private Property SetDate() As DateTime
        Get
            Dim objsetdate As New Object
            objsetdate = ViewState("setdate")
            _setdate = objsetdate
            If objsetdate Is Nothing Then
                _setdate = Date.Now()
            End If
            Return _setdate
        End Get
        Set(ByVal Value As DateTime)
            ViewState("setdate") = Value
            _setdate = ViewState("setdate")
        End Set
    End Property

    Private _ShowDateSelect As Boolean = True
    Public Property ShowDateSelect() As Boolean
        Get
            Return _ShowDateSelect
        End Get
        Set(ByVal Value As Boolean)
            _ShowDateSelect = Value
        End Set
    End Property

    Private _HCmdButtonsmouseovercolor As Color
    <Description("This Represents MouseOverColor of Buttons")> Property HCmdButtonsmouseovercolor() As Color
        Get
            Return _HCmdButtonsmouseovercolor
        End Get
        Set(ByVal Value As Color)
            _HCmdButtonsmouseovercolor = Value
            Dim hcc As ColorTranslator
            HCmdButtonsmouseovercolorvalue = hcc.ToHtml(_HCmdButtonsmouseovercolor)
        End Set
    End Property

    Private Shared _HCmdButtonsmouseovercolorvalue As String
    Private Shared Property HCmdButtonsmouseovercolorvalue() As String
        Get
            Return _HCmdButtonsmouseovercolorvalue
        End Get
        Set(ByVal Value As String)
            _HCmdButtonsmouseovercolorvalue = Value
        End Set
    End Property

    Private _Backcolor As Color = Color.LightGray
    <Description("This Represents BackColor of Buttons")> Public Overrides Property BackColor() As Color
        Get
            Return _Backcolor
        End Get
        Set(ByVal Value As Color)
            _Backcolor = Value
            Dim hcc As ColorTranslator
            HCmdButtonsBackcolorvalue = hcc.ToHtml(_Backcolor)
        End Set
    End Property
    Private Shared _HCmdButtonsBackcolorvalue As String
    Private Shared Property HCmdButtonsBackcolorvalue() As String
        Get
            Return _HCmdButtonsBackcolorvalue
        End Get
        Set(ByVal Value As String)
            _HCmdButtonsBackcolorvalue = Value
        End Set
    End Property

    Private _ForeColor As Color = Color.Black
    <Description("This Represents ForeColor of Buttons")> Public Overrides Property ForeColor() As Color
        Get
            Return _ForeColor
        End Get
        Set(ByVal Value As Color)
            _ForeColor = Value
            Dim hcc As ColorTranslator
            HCmdButtonsForecolorvalue = hcc.ToHtml(_ForeColor)
        End Set
    End Property
    Private Shared _HCmdButtonsForecolorvalue As String
    Private Shared Property HCmdButtonsForecolorvalue() As String
        Get
            Return _HCmdButtonsForecolorvalue
        End Get
        Set(ByVal Value As String)
            _HCmdButtonsForecolorvalue = Value
        End Set
    End Property

    Private _TitlebarColor As Color = Color.RoyalBlue
    <Description("This Represents TitlebarColor of Calender")> Public Property TitlebarColor() As Color
        Get
            Return _TitlebarColor
        End Get
        Set(ByVal Value As Color)
            _TitlebarColor = Value
            Dim hcc As ColorTranslator
            TitlebarColorvalue = hcc.ToHtml(_TitlebarColor)
        End Set
    End Property
    Private Shared _TitlebarColorvalue As String
    Private Shared Property TitlebarColorvalue() As String
        Get
            Return _TitlebarColorvalue
        End Get
        Set(ByVal Value As String)
            _TitlebarColorvalue = Value
        End Set
    End Property

    Private _TodayBGColor As Color = Color.Orange
    <Description("This Represents Today BackGround Color of Calender")> Public Property TodayBGColor() As Color
        Get
            Return _TodayBGColor
        End Get
        Set(ByVal Value As Color)
            _TodayBGColor = Value
            Dim hcc As ColorTranslator
            TodayBGColorvalue = hcc.ToHtml(_TodayBGColor)
        End Set
    End Property
    Private Shared _TodayBGColorvalue As String
    Private Shared Property TodayBGColorvalue() As String
        Get
            Return _TodayBGColorvalue
        End Get
        Set(ByVal Value As String)
            _TodayBGColorvalue = Value
        End Set
    End Property


    Private _TitlebarFontColor As Color = Color.White
    <Description("This Represents Titlebar FontColor of Calender")> Public Property TitlebarFontColor() As Color
        Get
            Return _TitlebarFontColor
        End Get
        Set(ByVal Value As Color)
            _TitlebarFontColor = Value
            Dim hcc As ColorTranslator
            TitlebarFontColorvalue = hcc.ToHtml(_TitlebarFontColor)
        End Set
    End Property
    Private _TitlebarFontColorvalue As String
    Private Property TitlebarFontColorvalue() As String
        Get
            Return _TitlebarFontColorvalue
        End Get
        Set(ByVal Value As String)
            _TitlebarFontColorvalue = Value
        End Set
    End Property


    Private _SelecteddateColor As Color = Color.DarkCyan
    <Description("This Represents Selected Date Color of Calender")> Public Property SelectedDateColor() As Color
        Get
            Return _SelecteddateColor
        End Get
        Set(ByVal Value As Color)
            _SelecteddateColor = Value
            Dim hcc As ColorTranslator
            SelecteddateColorvalue = hcc.ToHtml(_SelecteddateColor)
        End Set
    End Property

    Private Shared _SelecteddateColorvalue As String
    Private Shared Property SelecteddateColorvalue() As String
        Get
            Return _SelecteddateColorvalue
        End Get
        Set(ByVal Value As String)
            _SelecteddateColorvalue = Value
        End Set
    End Property


    Private _Width As System.Web.UI.WebControls.Unit
    Public Overrides Property Width() As System.Web.UI.WebControls.Unit
        Get
            Return _Width
        End Get
        Set(ByVal Value As System.Web.UI.WebControls.Unit)
            _Width = Value
            cWidth = _Width.Value
        End Set
    End Property

    Private _Height As System.Web.UI.WebControls.Unit
    Public Overrides Property Height() As System.Web.UI.WebControls.Unit
        Get
            Return _Height
        End Get
        Set(ByVal Value As System.Web.UI.WebControls.Unit)
            _Height = Value
            cHeight = _Height.Value
        End Set
    End Property


    Private _left As System.Web.UI.WebControls.Unit
    Private Property CalenderLeft() As System.Web.UI.WebControls.Unit
        Get
            Return _left
        End Get
        Set(ByVal Value As System.Web.UI.WebControls.Unit)
            _left = Value
            Left = _left.Value
        End Set
    End Property
    Private _top As System.Web.UI.WebControls.Unit
    Private Property CalenderTop() As System.Web.UI.WebControls.Unit
        Get
            Return _top
        End Get
        Set(ByVal Value As System.Web.UI.WebControls.Unit)
            _top = Value
            Top = _top.Value
        End Set
    End Property

    Private _lft As String
    Public Property lft() As String
        Get
            Return _lft
        End Get
        Set(ByVal Value As String)
            _lft = Value
        End Set
    End Property


    Private ReadOnly Property _CFontBold() As Boolean
        Get
            Return Font.Bold
        End Get
    End Property

    Private ReadOnly Property _CFontItalic() As Boolean
        Get
            Return Font.Italic
        End Get
    End Property

    Private ReadOnly Property _CFontName() As String
        Get
            Return Font.Name
        End Get
    End Property

    Private ReadOnly Property _CFontSize() As String
        Get
            Return Font.Size.ToString
        End Get
    End Property
    Private ReadOnly Property _CFontUnderline() As Boolean
        Get
            Return Font.Underline
        End Get
    End Property
    Private ReadOnly Property _CFontOverline() As Boolean
        Get
            Return Font.Overline
        End Get
    End Property
    Private ReadOnly Property _CFontStrikeout() As Boolean
        Get
            Return Font.Strikeout
        End Get
    End Property



    <Bindable(True), Category("Appearance"), DefaultValue("")> Private Property [eText]() As String
        Get
            Return _text
        End Get

        Set(ByVal Value As String)
            _text = Value
        End Set
    End Property



#End Region

#Region "Calender Events"
    Event hdateselected(ByVal sender As Object, ByVal day As Integer, ByVal month As Integer, ByVal year As Long, ByVal caldate As Date, ByVal e As EventArgs)
    Event hmonthchanged(ByVal sender As Object, ByVal day As Integer, ByVal month As Integer, ByVal year As Long, ByVal caldate As Date, ByVal e As EventArgs)
    Event hyearchanged(ByVal sender As Object, ByVal year As Long, ByVal e As EventArgs)
#End Region


    Private Sub InitDays()
        Dim nDayIndex As Integer
        Dim objNewDay As New CalendarDay
        _CalenderDrawHtml = ""
        If mcolDays.Count > 0 Then mcolDays.Clear()
        For nDayIndex = 1 To mnDaysInMonth
            objNewDay.DateString = FormatDateTime(DateSerial(mnYear, mnMonth, nDayIndex), DateFormat.ShortDate)
            objNewDay.dy = nDayIndex.ToString
            objNewDay.mainclassClientID = Me.ClientID.ToString + nDayIndex.ToString.Trim
            objNewDay.bNextline = False
            objNewDay.cSelectedDate = SetDate.Day.ToString
            objNewDay.Cfontbold = _CFontBold
            objNewDay.CfontItalic = _CFontItalic
            objNewDay.Cfontname = _CFontName
            objNewDay.Cfontsize = _CFontSize
            objNewDay.CUnderline = _CFontUnderline
            objNewDay.COverline = _CFontOverline
            objNewDay.CStrikeout = _CFontStrikeout


            If mnDayMonthStarts = 1 Then
                If nDayIndex = 7 Then
                    objNewDay.bNextline = True
                End If
                If nDayIndex = 14 Then
                    objNewDay.bNextline = True
                End If
                If nDayIndex = 21 Then
                    objNewDay.bNextline = True
                End If
                If nDayIndex = 28 Then
                    objNewDay.bNextline = True
                End If
            End If

            If mnDayMonthStarts = 2 Then
                If nDayIndex = 6 Then
                    objNewDay.bNextline = True
                End If
                If nDayIndex = 13 Then
                    objNewDay.bNextline = True
                End If
                If nDayIndex = 20 Then
                    objNewDay.bNextline = True
                End If
                If nDayIndex = 27 Then
                    objNewDay.bNextline = True
                End If
            End If


            If mnDayMonthStarts = 3 Then
                If nDayIndex = 5 Then
                    objNewDay.bNextline = True
                End If
                If nDayIndex = 12 Then
                    objNewDay.bNextline = True
                End If
                If nDayIndex = 19 Then
                    objNewDay.bNextline = True
                End If
                If nDayIndex = 26 Then
                    objNewDay.bNextline = True
                End If
            End If

            If mnDayMonthStarts = 4 Then
                If nDayIndex = 4 Then
                    objNewDay.bNextline = True
                End If
                If nDayIndex = 11 Then
                    objNewDay.bNextline = True
                End If
                If nDayIndex = 18 Then
                    objNewDay.bNextline = True
                End If
                If nDayIndex = 25 Then
                    objNewDay.bNextline = True
                End If
            End If


            If mnDayMonthStarts = 5 Then
                If nDayIndex = 3 Then
                    objNewDay.bNextline = True
                End If
                If nDayIndex = 10 Then
                    objNewDay.bNextline = True
                End If
                If nDayIndex = 17 Then
                    objNewDay.bNextline = True
                End If
                If nDayIndex = 24 Then
                    objNewDay.bNextline = True
                End If
            End If

            If mnDayMonthStarts = 6 Then
                If nDayIndex = 2 Then
                    objNewDay.bNextline = True
                End If
                If nDayIndex = 9 Then
                    objNewDay.bNextline = True
                End If
                If nDayIndex = 16 Then
                    objNewDay.bNextline = True
                End If
                If nDayIndex = 23 Then
                    objNewDay.bNextline = True
                End If
                If nDayIndex = 30 Then
                    objNewDay.bNextline = True
                End If
            End If

            If mnDayMonthStarts = 7 Then
                If nDayIndex = 1 Then
                    objNewDay.bNextline = True
                End If
                If nDayIndex = 8 Then
                    objNewDay.bNextline = True
                End If
                If nDayIndex = 15 Then
                    objNewDay.bNextline = True
                End If
                If nDayIndex = 22 Then
                    objNewDay.bNextline = True
                End If
                If nDayIndex = 29 Then
                    objNewDay.bNextline = True
                End If
            End If

            _CalenderDrawHtml += objNewDay.Draw()
            mcolDays.Add(objNewDay)
        Next
        mbDaysInitialized = True
    End Sub


    Function ShowCalender() As String
        Dim nDayCount
        Dim nCellWidth, nCellHeight, nFontSizeRatio
        Dim objDay
        Dim drawhtml As String
        Dim hcc As ColorTranslator
        procSetDate(SetDate)


        nCellWidth = CInt(cWidth / 7)
        If (mnDayMonthStarts + mnDaysInMonth - 1) > 35 Then
            nCellHeight = CInt((cHeight - 80) / 6)
        Else
            nCellHeight = CInt((cHeight - 80) / 5)
        End If

        If HCmdButtonsmouseovercolorvalue Is Nothing Then
            HCmdButtonsmouseovercolorvalue = hcc.ToHtml(Color.LightGray)
        End If
        If HCmdButtonsBackcolorvalue Is Nothing Then
            HCmdButtonsBackcolorvalue = hcc.ToHtml(Color.LightGray)
        End If
        If HCmdButtonsForecolorvalue Is Nothing Then
            HCmdButtonsForecolorvalue = hcc.ToHtml(Color.Black)
        End If

        If TitlebarColorvalue Is Nothing Then
            TitlebarColorvalue = hcc.ToHtml(Color.RoyalBlue)
        End If

        If TitlebarFontColorvalue Is Nothing Then
            TitlebarFontColorvalue = hcc.ToHtml(Color.White)
        End If

        If TodayBGColorvalue Is Nothing Then
            TodayBGColorvalue = hcc.ToHtml(Color.MediumSlateBlue)
        End If

        If SelecteddateColorvalue Is Nothing Then
            SelecteddateColorvalue = hcc.ToHtml(Color.DarkCyan)
        End If

        gnCellWidth = nCellWidth
        gnCellHeight = nCellHeight
        nFontSizeRatio = Fix(cWidth / 200)

        InitDays()

        drawhtml = ""

        Dim exText As String = ""
        exText = "<INPUT type='submit' value='" & "<<" & "' name='" & Me.ClientID & "" & "prev" & "'" & vbCrLf.ToString
        'exText = "<INPUT type='submit' value='" & dy & "' name='" & mainclassClientID & "" & dy & "'" & vbCrLf.ToString
        exText += " onmouseover=""javascript:{{this.style.backgroundColor='" & HCmdButtonsmouseovercolorvalue.ToString & "'}}"""
        exText += " onmouseout=""javascript:{{this.style.backgroundColor='" & HCmdButtonsBackcolorvalue.ToString & "'}}"""
        exText += " Style=""HEIGHT:'" & CStr(gnCellHeight) & "' ;"
        exText += " WIDTH:'" & CStr(gnCellWidth) & "' ;"
        exText += " COLOR:'" & TitlebarFontColorvalue.ToString & "' ;"
        'exText += "         text-decoration: none; "
        exText += " TEXT-DECORATION:'" & IIf(_CFontUnderline, " underline ", " ") & IIf(_CFontOverline, " overline ", " ") & IIf(_CFontStrikeout, " line-through ", " ") & "' ;"
        If _CFontBold = True Then
            exText += " FONT-WEIGHT:bold ; "
        End If
        If _CFontItalic = True Then
            exText += " FONT-STYLE: italic ; "
        End If
        exText += " FONT-FAMILY:'" & _CFontName.ToString & "' ;"
        exText += " FONT-SIZE:'" & _CFontSize.ToString & "' ;"
        exText += " BACKGROUND-COLOR:'" & HCmdButtonsBackcolorvalue.ToString & "'"""
        exText += " runat=server>" & vbCrLf.ToString

        '        drawhtml += send("<div id=""calendar"" style=""top: " & CStr(Top) & "px; left: " & CStr(Left) & "px; position: " & Position & "; z-index: " & ZIndex & """>")
        drawhtml += send("<div id=""calendar"" style=""top: " & CStr(Top) & "px; position: absolute ; left: " & CStr(Left) & "px;  Z-index: " & ZIndex & """>")
        ''drawhtml += send("<div id=""calendar"">")
        drawhtml += send("<table border=""1"" width=""" & CStr(cWidth) & """ height=""" & CStr(cHeight) & """ cellspacing=""0"" style=""FONT-SIZE: 10pt; FONT-FAMILY: Verdana; FONT-WEIGHT:Bold;"">")
        drawhtml += send("<tr><td colspan=""7"" height=""10"" bgcolor=""" & TitlebarColorvalue & """>")
        drawhtml += send("	<table border=""0"" width=""100%"" cellspacing=0>")
        drawhtml += send("	<tr>")
        'javascript:__doPostBack('" & mainclassClientID.Trim & "','')""
        ''''''drawhtml += send("	<td align=""left""><a style=""text-decoration: none; color: " & TitlebarFontColor & ";"" href=""javascript:__doPostBack('" & Replace("$date", "$date", DateSerial(mnYear, mnMonth - 1, mnDay)) & "','')""><font face=""" & TitlebarFont & """ size=""" & nFontSizeRatio & """><b>&nbsp;&lt;&lt;</b></font></a></td>")
        drawhtml += send("	<td align=""left"">" & exText.Trim & "</td>")

        drawhtml += send("	<td align=""center""><font size=""" & nFontSizeRatio + 1.5 & """ face=""" & _CFontName.ToString & """ color=""" & TitlebarFontColorvalue & """><b>" & MonthName(mnMonth) & " " & mnYear & "</b></font></td>")


        'FONT-STYLE: italic


        exText = "<INPUT type='submit' value='" & ">>" & "' name='" & Me.ClientID & "" & "next" & "'" & vbCrLf.ToString
        'exText = "<INPUT type='submit' value='" & dy & "' name='" & mainclassClientID & "" & dy & "'" & vbCrLf.ToString
        exText += " onmouseover=""javascript:{{this.style.backgroundColor='" & HCmdButtonsmouseovercolorvalue.ToString & "'}}"""
        exText += " onmouseout=""javascript:{{this.style.backgroundColor='" & HCmdButtonsBackcolorvalue.ToString & "'}}"""
        exText += " Style=""HEIGHT:'" & CStr(gnCellHeight) & "' ;"
        exText += " WIDTH:'" & CStr(gnCellWidth) & "' ;"
        exText += " COLOR:'" & TitlebarFontColorvalue.ToString & "' ;"
        'exText += "         text-decoration: none; "
        exText += " TEXT-DECORATION:'" & IIf(_CFontUnderline, " underline ", " ") & IIf(_CFontOverline, " overline ", " ") & IIf(_CFontStrikeout, " line-through ", " ") & "' ;"
        If _CFontBold = True Then
            exText += " FONT-WEIGHT:bold ; "
        End If
        If _CFontItalic = True Then
            exText += " FONT-STYLE: italic ; "
        End If
        exText += " FONT-FAMILY:'" & _CFontName.ToString & "' ;"
        exText += " FONT-SIZE:'" & _CFontSize.ToString & "' ;"
        exText += " BACKGROUND-COLOR:'" & HCmdButtonsBackcolorvalue.ToString & "'"""
        exText += " runat=server>" & vbCrLf.ToString


        drawhtml += send("	<td align=""right"">" & exText.Trim & "</td>")
        ''''''drawhtml += send("	<td align=""right""><a style=""text-decoration: none; color: " & TitlebarFontColor & ";"" href=""javascript:__doPostBack('" & Replace("$date", "$date", DateSerial(mnYear, mnMonth + 1, mnDay)) & "','')""><font face=""" & TitlebarFont & """ size=""" & nFontSizeRatio & """><b>&gt;&gt;&nbsp;</b></font></a></td>")
        drawhtml += send("	</tr>")
        drawhtml += send("	</table>")
        drawhtml += send("</td></tr>")
        drawhtml += send("<tr>")
        drawhtml += send("<td height=""15"" width=""" & CStr(nCellWidth) & """ align=""center""><small>Sun</small></td>")
        drawhtml += send("<td height=""15"" width=""" & CStr(nCellWidth) & """ align=""center""><small>Mon</small></td>")
        drawhtml += send("<td height=""15"" width=""" & CStr(nCellWidth) & """ align=""center""><small>Tue</small></td>")
        drawhtml += send("<td height=""15"" width=""" & CStr(nCellWidth) & """ align=""center""><small>Wed</small></td>")
        drawhtml += send("<td height=""15"" width=""" & CStr(nCellWidth) & """ align=""center""><small>Thur</small></td>")
        drawhtml += send("<td height=""15"" width=""" & CStr(nCellWidth) & """ align=""center""><small>Fri</small></td>")
        drawhtml += send("<td height=""15"" width=""" & CStr(nCellWidth) & """ align=""center""><small>Sat</small></td>")
        drawhtml += send("</tr>")

        drawhtml += send("<tr>")


        For nDayCount = 1 To mnDayMonthStarts - 1
            drawhtml += send("<td height=""" & CStr(nCellHeight) & """ width=""" & CStr(nCellWidth) & """ bgcolor=""#dddddd"">&nbsp;</td>")
        Next

        nDayCount = nDayCount - 1
        drawhtml += send(CalenderDrawHtml) ' + send("<td height=""" & CStr(nCellHeight) & """ width=""" & CStr(nCellWidth) & """ bgcolor=""#dddddd"">&nbsp;</td>")
        For objDay = 1 To mcolDays.Count
            If nDayCount = 7 Then
                'drawhtml += send("</tr><tr>")
                nDayCount = 0
            End If

            'drawhtml += send("</tr>")
            nDayCount = nDayCount + 1
        Next

        If nDayCount < 7 Then
            For nDayCount = nDayCount To 6
                drawhtml += send("<td height=""" & CStr(nCellHeight) & """ width=""" & CStr(nCellWidth) & """ bgcolor=""#dddddd"">&nbsp;</td>")
            Next
        End If

        drawhtml += send("</tr>")

        If ShowDateSelect = True Then
            drawhtml += send("<tr><td height=""30"" colspan=""7"" align=""center""")
            drawhtml += " Style="" BACKGROUND-COLOR:'" & TitlebarColorvalue.ToString & "'"""
            drawhtml += " >"
            drawhtml += DrawDateSelect()
            drawhtml += send("</td></tr>")
        End If

        drawhtml += send("</table>")
        drawhtml += send("</div>")

        Return drawhtml

    End Function

    Private Function DrawDateSelect() As String
        Dim nIndex As Integer
        Dim opt As New Web.UI.WebControls.DropDownList
        opt = New Web.UI.WebControls.DropDownList
        opt.ID = Me.ClientID + "month"
        DrawDateSelect = ""
        ''DrawDateSelect += send("	<form id=frmGO name=frmGO>")
        DrawDateSelect += send("	<table border=""0"">")
        DrawDateSelect += send("	<tr>")
        DrawDateSelect += send("	<td><select name='" & Me.ClientID & "month" & "' onchange=""" & Page.GetPostBackEventReference(opt, Me.ClientID & "monthchanged") & """>")
        For nIndex = 1 To 12
            DrawDateSelect += "<option value=""" & nIndex & """"
            If nIndex = Month(mdDate) Then
                DrawDateSelect += send(" selected>" & MonthName(nIndex, True) & "</option>")
            Else
                DrawDateSelect += send(">" & MonthName(nIndex, True) & "</option>")
            End If
        Next

        opt = New Web.UI.WebControls.DropDownList
        opt.ID = Me.ClientID + "year"
        DrawDateSelect += send("	</select></td>")
        DrawDateSelect += send("	<td><select name='" & Me.ClientID & "year" & "' onchange=""" & Page.GetPostBackEventReference(opt, Me.ClientID & "yearchanged") & """>")
        For nIndex = Year(SetDate) - 1 To Year(SetDate) + 1  '-5 previous 5 yrs... + 20 will show next 20 yrs 
            DrawDateSelect += "<option value=""" & nIndex & """"
            If nIndex = Year(mdDate) Then DrawDateSelect += "  selected"
            DrawDateSelect += send(">" & CStr(nIndex) & "</option>")
        Next
        DrawDateSelect += send("	</select></td>")
        'DrawDateSelect += send("	<td><input type=""submit"" Value=""Go""   id=1 name=1></td>")
        ''''DrawDateSelect += send("	</form>")
        DrawDateSelect += send("	</tr></table>")
        opt.Dispose()
        Return DrawDateSelect
    End Function

    Private Sub procSetDate(ByVal dDate As DateTime)
        mdDate = CDate(dDate)
        mnDay = dDate.Day
        mnMonth = dDate.Month
        mnYear = dDate.Year
        mnDaysInMonth = dDate.DaysInMonth(mnYear, mnMonth)
        cal.SelectedDate = FormatDateTime(DateSerial(mnYear, mnMonth, 1), DateFormat.GeneralDate)
        mnDayMonthStarts = Date.Parse(FormatDateTime(DateSerial(mnYear, mnMonth, 1), DateFormat.GeneralDate)).DayOfWeek  ''cal.FirstDayOfWeek ''''' dDate.DayOfWeek     ''Weekday(DateAdd("d", -(Day(CDate(dDate)) - 1), CDate(dDate)))
        mnDayMonthStarts = mnDayMonthStarts + 1
    End Sub

#Region "Calender Private Class"
    Private Class CalendarDay
        Public DateString As String
        Public OnClick As String
        Public mainclassClientID As String
        Public dy As String
        Public bNextline As Boolean
        Public cSelectedDate As String
        Public Cfontbold As Boolean
        Public CfontItalic As Boolean
        Public Cfontname As String
        Public Cfontsize As String
        Public CStrikeout As Boolean
        Public CUnderline As Boolean
        Public COverline As Boolean


        Public Function Draw() As String
            Dim drawhtml As String
            Dim exText As String
            Try

                exText = "<INPUT type='submit' value='" & dy & "' name='" & mainclassClientID & "" & "" & "'" & vbCrLf.ToString
                'exText = "<INPUT type='submit' value='" & dy & "' name='" & mainclassClientID & "" & dy & "'" & vbCrLf.ToString

                If dy.ToString.Trim = Me.cSelectedDate.ToString.Trim Then
                    exText += " onmouseover=""javascript:{{this.style.backgroundColor='" & SelecteddateColorvalue.ToString & "'}}"""
                Else
                    exText += " onmouseover=""javascript:{{this.style.backgroundColor='" & HCmdButtonsmouseovercolorvalue.ToString & "'}}"""
                End If

                If dy = Now.Today.Day.ToString Then
                    exText += " onmouseout=""javascript:{{this.style.backgroundColor='" & TodayBGColorvalue.ToString & "'}}"""
                Else
                    If dy.ToString.Trim = Me.cSelectedDate.ToString.Trim Then
                        exText += " onmouseout=""javascript:{{this.style.backgroundColor='" & SelecteddateColorvalue.ToString & "'}}"""
                    Else
                        exText += " onmouseout=""javascript:{{this.style.backgroundColor='" & HCmdButtonsBackcolorvalue.ToString & "'}}"""
                    End If
                End If

                exText += " Style=""HEIGHT:'" & CStr(gnCellHeight) & "' ;"
                exText += " WIDTH:'" & CStr(gnCellWidth) & "' ;"
                exText += " COLOR:'" & HCmdButtonsForecolorvalue.ToString & "' ;"

                If Cfontbold = True Then
                    exText += " FONT-WEIGHT:bold ; "
                End If

                If CfontItalic = True Then
                    exText += " FONT-STYLE: italic ; "
                End If

                exText += " FONT-FAMILY:'" & Cfontname.ToString & "' ;"

                exText += " FONT-SIZE:'" & Cfontsize.ToString & "' ;"

                exText += " TEXT-DECORATION:'" & IIf(CUnderline, " underline ", " ") & IIf(COverline, " overline ", " ") & IIf(CStrikeout, " line-through ", " ") & "' ;"


                If dy = Now.Today.Day.ToString Then
                    exText += " BACKGROUND-COLOR:'" & TodayBGColorvalue.ToString & "'"""
                ElseIf dy.ToString.Trim = Me.cSelectedDate.ToString.Trim Then
                    exText += " BACKGROUND-COLOR:'" & SelecteddateColorvalue.ToString & "'"""
                Else
                    exText += " BACKGROUND-COLOR:'" & HCmdButtonsBackcolorvalue.ToString & "'"""
                End If

                exText += " runat=server>" & vbCrLf.ToString
                '<a href=""" & Replace(OnClick, "$date", DateString) & """><small>" & Day(DateString) & "</small></a>
                'drawhtml += send("<table width=""100%"" border=""0"" cellspacing=""2"" cellpadding=""1"" style=""FONT-SIZE: 10pt; FONT-FAMILY: Verdana; FONT-WEIGHT:Bold;"" >")
                ' drawhtml += send("<td align=""left"" halign=""top""><a name=" & mainclassClientID.Trim & " href=""javascript:__doPostBack('" & mainclassClientID.Trim & "','')"">" & dy & "</a></td>")
                drawhtml += send("<td height=""" & CStr(gnCellHeight) & """ width=""" & CStr(gnCellWidth) & """align=""center"">" & exText.Trim & "</td>")
                ''drawhtml += send("<td height=""" & CStr(gnCellHeight) & """ width=""" & CStr(gnCellWidth) & """align=""center""><a id='" & mainclassClientID.Trim & "' name='" & mainclassClientID.Trim & "' href=""javascript:__doPostBack('" & mainclassClientID.Trim & "','" & dy & "')"">" & dy & "</a></td>")
                If bNextline = True Then
                    drawhtml += send("<tr>")
                    drawhtml += send("</tr>")
                End If

                'drawhtml += send("<tr><td height=""20""" & "" & "</td></tr>")
                ' drawhtml += send("</table>")
                Return drawhtml
            Catch ex As Exception
            End Try


        End Function
    End Class
#End Region

#Region "Calender Shared Functions"
    Shared Function send(ByVal sHtml As String) As String
        Return sHtml & vbCrLf
    End Function
#End Region

#End Region



#Region "Calender Private procedures"

    Protected Overrides Sub OnInit(ByVal e As System.EventArgs)
        Dim keyss As String
        Dim cnt As Long
        Dim _calleft As System.Web.UI.WebControls.Unit
        Dim _caltop As System.Web.UI.WebControls.Unit
        Try
            For Each keyss In Me.Style.Keys
                If keyss.ToLower = "left" Then
                    CalenderLeft = _calleft.Pixel(Val(Me.Style.Item(keyss)))
                End If
                If keyss.ToLower = "top" Then
                    CalenderTop = _caltop.Pixel(Val(Me.Style.Item(keyss)))
                End If
            Next
            ZIndex = CInt(Val("1001"))
        Catch ex As Exception
        End Try
    End Sub

    Protected Overrides Sub Render(ByVal output As System.Web.UI.HtmlTextWriter)
        Try

            output.AddAttribute("onclick", Page.GetPostBackEventReference(Me))
            output.Write(ShowCalender())

        Catch ex As Exception
        End Try
    End Sub
    Private Sub Hitcalender_Load(ByVal sender As Object, ByVal e As System.EventArgs) Handles MyBase.Load
        If Page.IsPostBack = True Then
            raisecontrolspostevents(sender, e)
        End If
    End Sub
    Private Sub raisecontrolspostevents(ByVal sender As Object, ByVal e As System.EventArgs)
        Try

            Dim fcnt As Long
            Dim strfoundobj As String
            Dim streventarg As String
            Dim day As New Object
            Dim month As New Object
            Dim year As New Object
            Dim [date] As New Object

            For fcnt = 0 To Page.Request.Form.Keys.Count
                If Page.Request.Form.Keys.Get(fcnt).ToString.IndexOf(Me.ClientID, 0) = 0 Then
                    strfoundobj = Page.Request.Form.Keys.Get(fcnt).ToString
                    ''Page.Response.Write(strfoundobj.ToString)
                    ''Page.Response.Write("<BR>")
                    Exit For
                Else
                End If
            Next

            streventarg = Page.Request.Form.Item("__EVENTARGUMENT")

            If Not streventarg Is Nothing Then
                If streventarg = Me.ClientID & "yearchanged" Then
                    year = CLng(Page.Request.Form.Item(Me.ClientID & "year"))
                    SetDate = DateSerial(year, SetDate.Month, 1)
                    RaiseEvent hyearchanged(Me, CLng(year), e)
                    Exit Sub
                End If

                If streventarg = Me.ClientID & "monthchanged" Then
                    day = "1"
                    month = CInt(Page.Request.Form.Item(Me.ClientID & "month"))
                    year = Me.SetDate.Year.ToString
                    [date] = DateSerial(CInt(year), CInt(month), CInt(day))
                    SetDate = [date]
                    RaiseEvent hmonthchanged(Me, CInt(day), CInt(month), CLng(year), [date], e)
                    Exit Sub
                End If
            End If

            Dim Strsender As String = strfoundobj '''Page.Request.Form.Keys.Get(1).ToString   ''Page.Request.Form.Item("__EVENTARGUMENT")
            Dim strsendsender As String = Strsender
            Strsender = strsendsender.Replace(Me.ClientID, "") ''Right(strsendsender.ToString.Trim, 1)

            If Strsender.ToString.ToLower = "next" Then
                SetDate = SetDate.AddMonths(1)
                day = "1"
                month = Me.SetDate.Month.ToString
                year = Me.SetDate.Year.ToString
                [date] = DateSerial(Me.SetDate.Year, Me.SetDate.Month, CInt(day))
                SetDate = [date]
                RaiseEvent hmonthchanged(Me, CInt(day), CInt(month), CLng(year), [date], e)
                Exit Sub
            End If
            If Strsender.ToString.ToLower = "prev" Then
                SetDate = SetDate.AddMonths(-1)
                day = "1"
                month = Me.SetDate.Month.ToString
                year = Me.SetDate.Year.ToString
                [date] = DateSerial(Me.SetDate.Year, Me.SetDate.Month, CInt(day))
                SetDate = [date]
                RaiseEvent hmonthchanged(Me, CInt(day), CInt(month), CLng(year), [date], e)
                Exit Sub
            End If
            day = Strsender.ToString.Trim
            month = Me.SetDate.Month.ToString
            year = Me.SetDate.Year.ToString
            [date] = DateSerial(Me.SetDate.Year, Me.SetDate.Month, CInt(Strsender))
            SetDate = [date]
            RaiseEvent hdateselected(Me, CInt(day), CInt(month), CLng(year), [date], e)
        Catch ex As Exception
        End Try
    End Sub

    Public Sub PostBackEvent(ByVal eventargs As String) Implements IPostBackEventHandler.RaisePostBackEvent
        If ViewState(ID & eventargs) = 1 Then
            ViewState(ID & eventargs) = 0
        Else
            ViewState(ID & eventargs) = 1
        End If
    End Sub
#End Region


End Class



#End Region

By viewing downloads associated with this article you agree to the Terms of Service and the article's licence.

If a file you wish to view isn't highlighted, and is a text file (not binary), please let us know and we'll add colourisation support for it.

License

This article, along with any associated source code and files, is licensed under The Code Project Open License (CPOL)


Written By
Web Developer
India India
This member has not yet provided a Biography. Assume it's interesting and varied, and probably something to do with programming.

Comments and Discussions