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> <<</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>>> </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""> </td>")
Next
nDayCount = nDayCount - 1
drawhtml += send(CalenderDrawHtml) ' + send("<td height=""" & CStr(nCellHeight) & """ width=""" & CStr(nCellWidth) & """ bgcolor=""#dddddd""> </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""> </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