#Region "DateTimePickerFormat enum"
Public Enum DateTimePickerFormat
[Long]
[Short]
End Enum
#End Region
#Region "DateTimePicker class"
Public Class DateTimePicker
Inherits Control
Class ConstValues
' size of the drop arrow on far right
Public Shared DropArrowSize As New Size(7, 4)
End Class
' offscreen bitmap
Private m_bmp As Bitmap
Private m_graphics As Graphics
' gdi objects
Private m_brushFore As SolidBrush
Private m_brushDisabled As SolidBrush
Private m_brushFrame As SolidBrush
Private m_penFrame As Pen
' down arrow coordinates
Private m_arrowPoints(2) As Point
' day picker, displays popup month calendar
Private m_dayPicker As New DayPickerPopup
' date format, short or long
Private m_format As DateTimePickerFormat = DateTimePickerFormat.Long
' exposed events
Public Event ValueChanged As EventHandler
Public Event CloseUp As EventHandler
Public Event DropDown As EventHandler
' properties
' Gets the maximum date value.
Public Shared ReadOnly Property MaxDateTime() As DateTime
Get
Return DateTime.MaxValue
End Get
End Property
' Gets the minimum date value.
Public Shared ReadOnly Property MinDateTime() As DateTime
Get
Return DateTime.MinValue
End Get
End Property
' Gets or sets the format of the date displayed in the control.
Public Property Format() As DateTimePickerFormat
Get
Return m_format
End Get
Set(ByVal Value As DateTimePickerFormat)
' update format and repaint
m_format = Value
Invalidate()
End Set
End Property
' Gets or sets the date value assigned to the control.
Public Property Value() As DateTime
' setting the picker value raises the ValueChanged
' event which causes the control to repaint
Get
Return m_dayPicker.Value
End Get
Set(ByVal Value As DateTime)
m_dayPicker.Value = Value
End Set
End Property
' Gets or sets the text associated with this control. Throws a
' FormatException if the specified text is not a valid date.
Public Overrides Property Text() As String
Get
' return date as string in the correct format
If m_format = DateTimePickerFormat.Short Then
Return Me.Value.ToShortDateString()
Else
Return Me.Value.ToLongDateString()
End If
End Get
Set(ByVal Value As String)
' update the datetime value
Me.Value = DateTime.Parse(Value)
End Set
End Property
' Constructor. Initializes a new instance of the DateTimePicker
class.
Public Sub New()
' hookup day picker events
AddHandler m_dayPicker.CloseUp, AddressOf OnDayPickerCloseUp
AddHandler m_dayPicker.ValueChanged, AddressOf
OnDayPickerValueChanged
End Sub
' drawing methods
Protected Overrides Sub OnPaint(ByVal e As PaintEventArgs)
' draw to memory bitmap
CreateMemoryBitmap()
CreateGdiObjects()
' init background
m_graphics.Clear(Me.BackColor)
' label
Dim size As Size = m_graphics.MeasureString(Me.Text,
Me.Font).ToSize()
'naim
'switched the brushes for enable and disbled
If Me.Enabled Then
m_graphics.DrawString(Me.Text, Me.Font, m_brushFore, _
4, CSng((Me.Height - size.Height) / 2))
Else
m_graphics.DrawString(Me.Text, Me.Font, m_brushDisabled, _
4, CSng((Me.Height - size.Height) / 2))
End If
' drop arrow
m_graphics.FillPolygon(m_brushFrame, m_arrowPoints)
' frame around control
m_graphics.DrawRectangle(m_penFrame, 0, 0, _
Me.Width - 1, Me.Height - 1)
' blit memory bitmap to screen
e.Graphics.DrawImage(m_bmp, 0, 0)
End Sub
Protected Overrides Sub OnPaintBackground(ByVal e As PaintEventArgs)
' don't pass to base since we paint everything, avoid flashing
End Sub
' events
' Show or hide the day picker popup control. Determine the
' best location to display the day picker.
Protected Overrides Sub OnMouseDown(ByVal e As MouseEventArgs)
MyBase.OnMouseDown(e)
' add day picker control to the toplevel window
' this allows the control to display on top of
' tabs and other controls
If m_dayPicker.Parent Is Nothing Then
Me.TopLevelControl.Controls.Add(m_dayPicker)
End If
' intelligently calculate where the day picker should be
displayed,
' try to display below the label control, display above the
control
' if there is not enough room
Dim pos As New Point(Me.Left, Me.Bottom + 1)
' map points to top level window
Dim parentPos As Point =
Me.Parent.PointToScreen(Me.Parent.Location)
Dim topParentPos As Point =
Me.TopLevelControl.PointToScreen(Me.Parent.Location)
pos.Offset(parentPos.X - topParentPos.X, parentPos.Y -
topParentPos.Y)
' see if there is enough room to display day picker below label
If pos.Y + m_dayPicker.Size.Height >
Me.TopLevelControl.ClientRectangle.Height Then
' there is not enough room, try displaying above the label
pos.Y -= Me.Height + m_dayPicker.Size.Height + 2
If pos.Y < 0 Then
' there was not enough room, display at bottom of screen
pos.Y = Me.TopLevelControl.ClientRectangle.Height -
m_dayPicker.Size.Height
End If
End If
' try displaying aligned with the label control
If pos.X + m_dayPicker.Size.Width >
Me.TopLevelControl.ClientRectangle.Width Then
pos.X = Me.TopLevelControl.ClientRectangle.Width -
m_dayPicker.Size.Width
End If
' display or hide the day picker control
m_dayPicker.Display(Not m_dayPicker.Visible, pos.X, pos.Y,
Me.BackColor, Me.ForeColor)
' raise the DropDown or CloseUp event
If m_dayPicker.Visible Then
RaiseEvent DropDown(Me, EventArgs.Empty)
Else
RaiseEvent CloseUp(Me, EventArgs.Empty)
End If
End Sub
' CloseUp event from the day picker control
Private Sub OnDayPickerCloseUp(ByVal sender As Object, ByVal e As
System.EventArgs)
' pass to our container
RaiseEvent CloseUp(Me, EventArgs.Empty)
End Sub
' ValueChanged event from the day picker control
Private Sub OnDayPickerValueChanged(ByVal sender As Object, ByVal e
As System.EventArgs)
' repaint to display the new value
Invalidate()
' pass along to our container
RaiseEvent ValueChanged(Me, e)
End Sub
' helper methods
' Create offsceeen bitmap. This bitmap is used for double-buffering
' to prevent flashing.
Private Sub CreateMemoryBitmap()
If m_bmp Is Nothing OrElse m_bmp.Width <> Me.Width OrElse
m_bmp.Height <> Me.Height Then
' memory bitmap
m_bmp = New Bitmap(Me.Width, Me.Height)
m_graphics = Graphics.FromImage(m_bmp)
' calculate down arrow points
m_arrowPoints(0).X = Me.Width -
ConstValues.DropArrowSize.Width - 4
m_arrowPoints(0).Y = CInt((Me.Height -
ConstValues.DropArrowSize.Height + 1) / 2)
m_arrowPoints(1).X = m_arrowPoints(0).X +
ConstValues.DropArrowSize.Width
m_arrowPoints(1).Y = m_arrowPoints(0).Y
m_arrowPoints(2).X = m_arrowPoints(0).X +
CInt(ConstValues.DropArrowSize.Width / 2)
m_arrowPoints(2).Y = m_arrowPoints(0).Y +
ConstValues.DropArrowSize.Height
End If
End Sub
' Create GDI objects required to paint the control.
Private Sub CreateGdiObjects()
' window frame brush
If m_brushFrame Is Nothing Then
m_brushFrame = New SolidBrush(SystemColors.WindowFrame)
End If
' window frame pen
If m_penFrame Is Nothing Then
m_penFrame = New Pen(SystemColors.WindowFrame)
End If
' fore color brush, the .Net CF does not support
OnForeColorChanged,
' so we detect if the forecolor changed here
If m_brushFore Is Nothing OrElse Not
m_brushFore.Color.Equals(Me.ForeColor) Then
m_brushFore = New SolidBrush(Me.ForeColor)
End If
' disabled brush
If m_brushDisabled Is Nothing Then
m_brushDisabled = New SolidBrush(SystemColors.GrayText)
End If
End Sub
End Class
#End Region
#Region "DayPickerPopup class"
' Displays a calendar that allows user to select a new date.
' Displays box around today and user can hover over dates.
' Allows quick access to month with month context menu and year
' with numeric updown control.
Class DayPickerPopup
Inherits Control
Class ConstValues
' font for caption, days of week and days
Public Const FontName As String = "Arial"
Public Const FontSize As Integer = 9
' location and size of different elements in calendar
Public Const ControlWidth As Integer = 164
Public Const CaptionHeight As Integer = 28
Public Shared DaysGrid As New Point(6, 43)
Public Shared DaysCell As New Size(23, 14)
Public Const NumCols As Integer = 7
Public Const NumRows As Integer = 6
' arrow buttons
Public Shared ArrowButtonOffset As New Size(6, 6)
Public Shared ArrowButtonSize As New Size(20, 15)
Public Shared ArrowPointsOffset As New Size(13, 9)
Public Shared ArrowPointsSize As New Size(5, 10)
' bottom today label
Public Shared BottomLabelsPos As New Point(6, 135)
Public Const BottomLabelHeight As Integer = 12
End Class
' exposed events
Public Event CloseUp As EventHandler
Public Event ValueChanged As EventHandler
' memory bitmap to prevent flashing
Private m_bmp As Bitmap
Private m_graphics As Graphics
' gdi objects
Private m_font As Font
' days
Private m_brushCur As SolidBrush
Private m_brushOther As SolidBrush
Private m_brushSelBack As SolidBrush
Private m_brushSelText As SolidBrush
Private m_penHoverBox As Pen
' caption
Private m_fontCaption As Font
Private m_brushCaptionBack As SolidBrush
Private m_brushCaptionText As SolidBrush
' general
Private m_brushBack As SolidBrush
Private m_penBack As Pen
Private m_brushFrame As SolidBrush
Private m_penFrame As Pen
' store dates; today, current selection, current hover
' and the first date in the calendar
Private m_today As DateTime = DateTime.Today
Private m_curSel As DateTime = DateTime.Today
Private m_hoverSel As DateTime = DateTime.Today
Private m_firstDate As DateTime
' if capturing mouse events (hovering over days)
Private m_captureMouse As Boolean = False
' cache calendar for better performance, each DateTime
' structure if only 8 bytes
Private m_curMonth As Integer = -1
Private m_curYear As Integer = -1
Private m_days(41) As DateTime
' caption controls; user can click on month and year
' in caption to quickly change values
Private m_monthMenu As ContextMenu
Private m_yearUpDown As NumericUpDown
' hit testing
Private m_rcLeftButton As Rectangle = Rectangle.Empty
Private m_rcRightButton As Rectangle = Rectangle.Empty
Private m_rcMonth As Rectangle = Rectangle.Empty
Private m_rcYear As Rectangle = Rectangle.Empty
' arrow button coordinates
Private m_leftArrowPoints(2) As Point
Private m_rightArrowPoints(2) As Point
' properties
' Selected date.
Public Property Value() As DateTime
Get
Return m_curSel
End Get
Set(ByVal Value As DateTime)
If Value <> m_curSel Then
UpdateCurSel(Value)
End If
End Set
End Property
' Constructor.
Public Sub New()
' init controls that popup when click on the
' month or year in the caption
InitMonthContextMenu()
InitYearUpDown()
' init display properties
Me.Visible = False
Me.Location = New Point(0, 0)
Me.Size = New Size(ConstValues.ControlWidth, _
ConstValues.BottomLabelsPos.Y + ConstValues.BottomLabelHeight +
5)
End Sub
' public methods
' Show or hide the calendar.
Public Sub Display(ByVal visible As Boolean, ByVal x As Integer,
ByVal y As Integer, ByVal backColor As Color, ByVal foreColor As Color)
If visible Then
' initialize properties if being displayed
m_captureMouse = False
m_yearUpDown.Hide()
Me.BackColor = backColor
Me.ForeColor = foreColor
Me.Left = x
Me.Top = y
Me.BringToFront()
Me.Focus()
' default to hovering over the current selection
m_hoverSel = m_curSel
End If
' hide or show the calendar
Me.Visible = visible
End Sub
' drawing methods
Protected Overrides Sub OnPaint(ByVal e As PaintEventArgs)
' draw to memory bitmap
CreateMemoryBitmap()
CreateGdiObjects()
' calculate the fist date in the days grid, this is used
' to draw the previous month days, the current month days,
' and any days in the next month
CalculateFirstDate()
' init the background
m_graphics.Clear(Me.BackColor)
' draw elements of the calendar
' the caption and days of week
DrawCaption(m_graphics)
DrawDaysOfWeek(m_graphics)
' the days grid and different selections
DrawDays(m_graphics)
DrawCurSelection(m_graphics)
DrawHoverSelection(m_graphics, m_hoverSel, True)
DrawTodaySelection(m_graphics)
' the today label at the bottom
DrawBottomLabels(m_graphics)
' frame around the control
m_graphics.DrawRectangle(m_penFrame, 0, 0, Me.Width - 1,
Me.Height - 1)
' blit memory bitmap to screen
e.Graphics.DrawImage(m_bmp, 0, 0)
End Sub
Protected Overrides Sub OnPaintBackground(ByVal e As PaintEventArgs)
' don't pass to base since we paint everything, avoid flashing
End Sub
' Draw caption; current month, current year,
' left and right arrow buttons.
Private Sub DrawCaption(ByVal g As Graphics)
' back area
g.FillRectangle(m_brushCaptionBack, 0, 0, Me.Width,
ConstValues.CaptionHeight)
' draw the caption centered in the area
Dim str As String = m_curSel.ToString("MMMM yyyy")
Dim totalSize As Size = g.MeasureString(str,
m_fontCaption).ToSize()
Dim x As Integer = CInt((Me.Width - totalSize.Width) / 2)
Dim y As Integer = CInt((ConstValues.CaptionHeight -
totalSize.Height) / 2)
g.DrawString(str, m_fontCaption, m_brushCaptionText, x, y)
' calculate the bounding rectangle for each element (the
' month and year) so we can detect if the user clicked on
' either element later
' calculate the month bounding rectangle
str = m_curSel.ToString("MMMM")
Dim size As Size = g.MeasureString(str, m_fontCaption).ToSize()
m_rcMonth.X = x
m_rcMonth.Y = y
m_rcMonth.Width = size.Width
m_rcMonth.Height = size.Height
' calculate the year bounding rectangle
str = m_curSel.ToString("yyyy")
size = g.MeasureString(str, m_fontCaption).ToSize()
m_rcYear.X = x + totalSize.Width - size.Width
m_rcYear.Y = y
m_rcYear.Width = size.Width
m_rcYear.Height = size.Height
' draw the left arrow button
g.FillRectangle(m_brushBack, m_rcLeftButton)
g.DrawRectangle(m_penFrame, m_rcLeftButton)
g.FillPolygon(m_brushFrame, m_leftArrowPoints)
' draw the right arrow button
g.FillRectangle(m_brushBack, m_rcRightButton)
g.DrawRectangle(m_penFrame, m_rcRightButton)
g.FillPolygon(m_brushFrame, m_rightArrowPoints)
End Sub
' Draw days of week header.
Private Sub DrawDaysOfWeek(ByVal g As Graphics)
Const dow As String = "SMTWTFS"
' calculate where to draw days of week
Dim pos As New Point(ConstValues.DaysGrid.X + 3,
ConstValues.CaptionHeight)
' go through and draw each character
Dim c As Char
For Each c In dow
g.DrawString(c.ToString(), m_fontCaption,
m_brushCaptionBack, pos.X, pos.Y)
pos.X += ConstValues.DaysCell.Width
Next c
' separator line
g.DrawLine(m_penFrame, ConstValues.DaysGrid.X,
ConstValues.DaysGrid.Y - 1, _
Me.Width - ConstValues.DaysGrid.X, ConstValues.DaysGrid.Y - 1)
End Sub
' Draw days in the grid. Recalculate and cache days if the
' month or year changed.
Private Sub DrawDays(ByVal g As Graphics)
' see if need to calculate new set of days
If m_curSel.Month <> m_curMonth Or m_curSel.Year <> m_curYear
Then
' the month of year changed, calculate and cache new set of
days
CalculateDays()
m_curMonth = m_curSel.Month
m_curYear = m_curSel.Year
End If
' starting point of grid
Dim pos As Point = ConstValues.DaysGrid
' any extra pixels (used for single digit numbers)
Dim extra As Integer
' loop through and draw each day in the grid
Dim y As Integer
For y = 0 To ConstValues.NumRows - 1
Dim x As Integer
For x = 0 To ConstValues.NumCols - 1
' get the date from the cache
Dim display As DateTime = m_days((y * 7 + x))
' see if requires extra pixels (single digit day)
If display.Day < 10 Then
extra = 4
Else
extra = 0
End If
If display.Month = m_curMonth Then
g.DrawString(display.Day.ToString(), m_font,
m_brushCur, pos.X + extra, pos.Y)
Else
g.DrawString(display.Day.ToString(), m_font,
m_brushOther, pos.X + extra, pos.Y)
End If
' update position within the grid
pos.X += ConstValues.DaysCell.Width
Next x
' update position within the grid
pos.X = ConstValues.DaysGrid.X
pos.Y += ConstValues.DaysCell.Height + 1
Next y
End Sub
' Draw the specified day.
Private Sub DrawDay(ByVal g As Graphics, ByVal day As DateTime,
ByVal selected As Boolean)
' get the position of this cell in the grid
Dim index As Integer = GetDayIndex(day)
Dim pos As Point = GetDayCellPosition(index)
' cell background
If selected Then
g.FillRectangle(m_brushSelBack, pos.X - 5, pos.Y, _
ConstValues.DaysCell.Width, ConstValues.DaysCell.Height)
Else
g.FillRectangle(m_brushBack, pos.X - 5, pos.Y, _
ConstValues.DaysCell.Width, ConstValues.DaysCell.Height)
End If
' extra space if single digit
If day.Day < 10 Then
pos.X += 4
End If
' the day
If selected Then
g.DrawString(day.Day.ToString(), m_font, m_brushSelText,
pos.X, pos.Y)
Else
g.DrawString(day.Day.ToString(), m_font, m_brushCur, pos.X,
pos.Y)
End If
End Sub
' Draw the currently selected day.
Private Sub DrawCurSelection(ByVal g As Graphics)
' calculate the coordinates of the current cell
Dim index As Integer = GetDayIndex(m_curSel)
Dim pos As Point = GetDayCellPosition(index)
' background
m_graphics.FillRectangle(m_brushSelBack, pos.X - 5, pos.Y, _
ConstValues.DaysCell.Width, ConstValues.DaysCell.Height)
' extra space for single digit days
If m_curSel.Day < 10 Then
pos.X += 4
End If
' the day
m_graphics.DrawString(m_curSel.Day.ToString(), m_font, _
m_brushSelText, pos.X, pos.Y)
End Sub
' Draws of erases the hover selection box.
Private Sub DrawHoverSelection(ByVal g As Graphics, ByVal dateValue
As DateTime, ByVal draw As Boolean)
' see if hovering over a cell, return right away
' if outside of the grid area
Dim index As Integer = GetDayIndex(dateValue)
If index < 0 Or index >= m_days.Length Then
Return
End If
' get the coordinates of cell
Dim pos As Point = GetDayCellPosition(index)
' draw or erase the hover selection
If draw Then
g.DrawRectangle(m_penHoverBox, pos.X - 5, pos.Y, _
ConstValues.DaysCell.Width, ConstValues.DaysCell.Height)
Else
g.DrawRectangle(m_penBack, pos.X - 5, pos.Y, _
ConstValues.DaysCell.Width, ConstValues.DaysCell.Height)
End If
End Sub
' Draw box around today on grid.
Private Sub DrawTodaySelection(ByVal g As Graphics)
' see if today is visible in the current grid
Dim index As Integer = GetDayIndex(m_today)
If index < 0 Or index >= m_days.Length Then
Return
End If
' only draw on current month
If m_today.Month <> m_curSel.Month Then
Return
End If
' today is visible, draw box around cell
Dim pos As Point = GetDayCellPosition(index)
g.DrawRectangle(m_penFrame, pos.X - 5, pos.Y, _
ConstValues.DaysCell.Width, ConstValues.DaysCell.Height)
g.DrawRectangle(m_penFrame, pos.X - 4, pos.Y + 1, _
ConstValues.DaysCell.Width - 2, ConstValues.DaysCell.Height -
2)
End Sub
' Draw the today label at bottom of calendar.
Private Sub DrawBottomLabels(ByVal g As Graphics)
' draw today string, don't store bounding rectangle since
' hit testing is the entire width of the calendar
Dim str As String = String.Format("Today: {0}",
m_today.ToShortDateString())
g.DrawString(str, Me.m_fontCaption, Me.m_brushCur, _
ConstValues.BottomLabelsPos.X, ConstValues.BottomLabelsPos.Y)
End Sub
' events
' Determine what area was taped (clicked) and take the appropriate
' action. If no items were taped, see if should start tracking
mouse.
Protected Overrides Sub OnMouseDown(ByVal e As MouseEventArgs)
MyBase.OnMouseDown(e)
' see if should hide the year updown control
If m_yearUpDown.Visible Then
If Not m_yearUpDown.Bounds.Contains(e.X, e.Y) Then
' user clicked outside of updown control,
' update grid with the new year specified
' in the updown control
OnYearUpDownValueChanged(Nothing, EventArgs.Empty)
m_yearUpDown.Hide()
Me.Focus()
End If
End If
' left arrow button
If m_rcLeftButton.Contains(e.X, e.Y) Then
' display previous month
UpdateCurSel(m_curSel.AddMonths(-1))
Return
End If
' right arrow button
If m_rcRightButton.Contains(e.X, e.Y) Then
' display the next month
UpdateCurSel(m_curSel.AddMonths(1))
Return
End If
' month part of caption
If m_rcMonth.Contains(e.X, e.Y) Then
' display the context menu, the days grid is updated
' if the user selects a new month
DisplayMonthMenu(e.X, e.Y)
Return
End If
' year part of caption
If m_rcYear.Contains(e.X, e.Y) Then
' display the number updown year control, the days
' grid is updated if the user selects a new year
DisplayYearUpDown(e.X, e.Y)
Return
End If
' today label
If e.Y >= ConstValues.BottomLabelsPos.Y Then
' select today in grid
UpdateCurSel(m_today)
Me.Close()
Return
End If
' otherwise, start tracking mouse movements
m_captureMouse = True
UpdateHoverCell(e.X, e.Y)
End Sub
' User is done hovering over days. Set the current day
' if they stopped on a day, otherwise they let up outside
' of the day grid.
Protected Overrides Sub OnMouseUp(ByVal e As MouseEventArgs)
MyBase.OnMouseUp(e)
If m_captureMouse Then
' done capturing mouse movements
m_captureMouse = False
' update the current selection to the day
' last hovered over
Dim index As Integer = GetDayIndex(m_hoverSel)
If index >= 0 And index < m_days.Length Then
UpdateCurSel(m_hoverSel)
Me.Close()
Else
' canceled hovering by moving outside of grid
UpdateCurSel(m_curSel)
End If
End If
End Sub
' Update the hover cell (mouse-over) if necessary.
Protected Overrides Sub OnMouseMove(ByVal e As MouseEventArgs)
MyBase.OnMouseMove(e)
' update the hover cell
If m_captureMouse Then
UpdateHoverCell(e.X, e.Y)
End If
End Sub
' User can navigate days with the hardware device jog buttons.
Protected Overrides Sub OnKeyUp(ByVal e As KeyEventArgs)
' holds the number of days to change
Dim days As Integer = 0
Select Case e.KeyCode
Case Keys.Left
days = -1
Case Keys.Right
days = 1
Case Keys.Up
days = -7
Case Keys.Down
days = 7
Case Keys.Return
Me.Close()
End Select
' see if pressed any of the jog buttons
If days <> 0 Then
' calculate the new day that should be selected
Dim newDay As DateTime = m_curSel.AddDays(days)
If m_curSel.Month <> newDay.Month Then
' user navigated to previous or next month
UpdateCurSel(newDay)
Else
' the month did not change so update the current
' selection by calling CreateGraphics (instead of
' invalidating and repainting) for better performance
Dim g As Graphics = Me.CreateGraphics()
DrawDay(g, m_curSel, False)
DrawDay(g, newDay, True)
g.Dispose()
m_curSel = newDay
' update hover selection
UpdateHoverCell(GetDayIndex(m_curSel))
' raise the ValueChanged event
RaiseEvent ValueChanged(Me, EventArgs.Empty)
End If
End If
End Sub
' Event from the month context menu. Put a checkmark
' next to the currently selected month.
Private Sub OnMonthMenuPopup(ByVal sender As System.Object, ByVal e
As System.EventArgs)
' clear all checks
Dim item As MenuItem
For Each item In m_monthMenu.MenuItems
item.Checked = False
Next item
' check the current month
If m_curMonth > 0 And m_curMonth <= 12 Then
m_monthMenu.MenuItems((m_curMonth - 1)).Checked = True
End If
End Sub
' Event from the month context menu. Update the current selection
' to the month that was clicked.
Private Sub OnMonthMenuClick(ByVal sender As System.Object, ByVal e
As System.EventArgs)
' determine what menu item was clicked
Dim item As MenuItem = CType(sender, MenuItem)
If Not (item Is Nothing) Then
' update the current date selection
Dim newDate As DateTime = DateTime.Parse(String.Format( _
"{0}, {1} {2}", item.Text, m_curSel.Day, m_curSel.Year))
UpdateCurSel(newDate)
End If
End Sub
' Event from year updown control. Update current selection
' with the year in the updown control.
Private Sub OnYearUpDownValueChanged(ByVal sender As System.Object,
ByVal e As System.EventArgs)
Try
' only want to update the current selection
' when the user is interacting with the
' control (when it's visible)
If m_yearUpDown.Visible Then
' update the current selection to the year
Dim newDate As New DateTime(CInt(m_yearUpDown.Value), _
m_curSel.Month, m_curSel.Day)
UpdateCurSel(newDate)
End If
Catch
' catch if the user entered an invalid year
' in the control
End Try
End Sub
' helper methods
' Initialize the numeric updown control that is displayed
' when the year part of the caption is clicked.
Private Sub InitYearUpDown()
' create the numeric updown control
m_yearUpDown = New NumericUpDown
Me.Controls.Add(m_yearUpDown)
' hookup the valuechanged event
AddHandler m_yearUpDown.ValueChanged, AddressOf
OnYearUpDownValueChanged
' init other properties
m_yearUpDown.Minimum = DateTime.MinValue.Year
m_yearUpDown.Maximum = DateTime.MaxValue.Year
m_yearUpDown.Visible = False
End Sub
' Display the numeric updown year control.
Private Sub DisplayYearUpDown(ByVal x As Integer, ByVal y As
Integer)
' init year to currently selected year
m_yearUpDown.Text = m_curSel.Year.ToString()
' init the position and size of the control
m_yearUpDown.Left = m_rcYear.Left - 3
m_yearUpDown.Top = m_rcYear.Top - 3
m_yearUpDown.Width = m_rcYear.Width + 30
m_yearUpDown.Height = m_rcYear.Height + 6
m_yearUpDown.Show()
End Sub
' Initialize the context menu that is displayed when the
' user clicks the month part of the caption.
Private Sub InitMonthContextMenu()
' create a menu that contains list of months
m_monthMenu = New ContextMenu
Dim i As Integer
For i = 1 To 12
' create new menu item and hookup the click event
Dim item As New MenuItem
m_monthMenu.MenuItems.Add(item)
AddHandler item.Click, AddressOf OnMonthMenuClick
item.Text = DateTime.Parse( _
String.Format("{0}/1/2000", i)).ToString("MMMM")
Next i
' hookup popup event so can check the current month
AddHandler m_monthMenu.Popup, AddressOf OnMonthMenuPopup
End Sub
' Show the month context menu. The current month
' is checked in the popup event.
Private Sub DisplayMonthMenu(ByVal x As Integer, ByVal y As Integer)
m_monthMenu.Show(Me, New Point(x, y))
End Sub
' Calculates the date for the first cell in the days
' grid. Always show at least one day of previous month.
Private Sub CalculateFirstDate()
m_firstDate = New DateTime(m_curSel.Year, m_curSel.Month, 1)
If m_firstDate.DayOfWeek = DayOfWeek.Sunday Then
m_firstDate = m_firstDate.AddDays(-7)
Else
m_firstDate =
m_firstDate.AddDays(-CInt(m_firstDate.DayOfWeek))
End If
End Sub
' Calculate and cache the days that are displayed in the calendar.
' The days are cached for better performance, each day is only 8
bytes.
Private Sub CalculateDays()
Dim i As Integer
For i = 0 To m_days.Length - 1
m_days(i) = m_firstDate.AddDays(i)
Next i
End Sub
' Return the upper left x / y coordinates for the specified index.
Private Function GetDayCellPosition(ByVal index As Integer) As Point
' calculate the x and y coordinates for the specified index
Return New Point( _
ConstValues.DaysGrid.X + (index Mod ConstValues.NumCols) *
ConstValues.DaysCell.Width, _
CInt(ConstValues.DaysGrid.Y + Math.Floor(index /
ConstValues.NumCols) * (ConstValues.DaysCell.Height + 1)))
End Function
' Create memory bitmap for double-buffering.
Private Sub CreateMemoryBitmap()
If m_bmp Is Nothing OrElse m_bmp.Width <> Me.Width OrElse
m_bmp.Height <> Me.Height Then
' create the memory bitmap
m_bmp = New Bitmap(Me.Width, Me.Height)
m_graphics = Graphics.FromImage(m_bmp)
' calculate the coordinates of the left and right
' arrow buttons now instead of each time paint
' left button
m_rcLeftButton = New
Rectangle(ConstValues.ArrowButtonOffset.Width,
ConstValues.ArrowButtonOffset.Height, ConstValues.ArrowButtonSize.Width,
ConstValues.ArrowButtonSize.Height)
' right button
m_rcRightButton = New Rectangle(Me.Width -
ConstValues.ArrowButtonOffset.Width - ConstValues.ArrowButtonSize.Width
- 1, ConstValues.ArrowButtonOffset.Height,
ConstValues.ArrowButtonSize.Width, ConstValues.ArrowButtonSize.Height)
' left arrow in button
m_leftArrowPoints(0).X = ConstValues.ArrowPointsOffset.Width
m_leftArrowPoints(0).Y =
CInt(ConstValues.ArrowPointsOffset.Height +
ConstValues.ArrowPointsSize.Height / 2)
m_leftArrowPoints(1).X = m_leftArrowPoints(0).X +
ConstValues.ArrowPointsSize.Width
m_leftArrowPoints(1).Y =
ConstValues.ArrowPointsOffset.Height
m_leftArrowPoints(2).X = m_leftArrowPoints(1).X
m_leftArrowPoints(2).Y = m_leftArrowPoints(1).Y +
ConstValues.ArrowPointsSize.Height
' right arrow in button
m_rightArrowPoints = CType(m_leftArrowPoints.Clone(),
Point())
m_rightArrowPoints(0).X = Me.Width -
ConstValues.ArrowPointsOffset.Width
m_rightArrowPoints(1).X = m_rightArrowPoints(0).X -
ConstValues.ArrowPointsSize.Width
m_rightArrowPoints(2).X = m_rightArrowPoints(1).X
End If
End Sub
' Create any gdi objects required for drawing.
Private Sub CreateGdiObjects()
If m_font Is Nothing Then
m_font = New Font(ConstValues.FontName,
ConstValues.FontSize, FontStyle.Regular)
End If
' days grid
If m_brushCur Is Nothing OrElse Not
m_brushCur.Color.Equals(Me.ForeColor) Then
m_brushCur = New SolidBrush(Me.ForeColor)
End If
If m_brushOther Is Nothing Then
m_brushOther = New SolidBrush(SystemColors.GrayText)
End If
If m_brushSelBack Is Nothing Then
m_brushSelBack = New SolidBrush(SystemColors.Highlight)
End If
If m_brushSelText Is Nothing Then
m_brushSelText = New SolidBrush(SystemColors.HighlightText)
End If
If m_penHoverBox Is Nothing Then
m_penHoverBox = New Pen(SystemColors.GrayText)
End If
' caption
If m_brushCaptionBack Is Nothing Then
m_brushCaptionBack = New
SolidBrush(SystemColors.ActiveCaption)
End If
If m_brushCaptionText Is Nothing Then
m_brushCaptionText = New
SolidBrush(SystemColors.ActiveCaptionText)
End If
If m_fontCaption Is Nothing Then
m_fontCaption = New Font(ConstValues.FontName, _
ConstValues.FontSize, FontStyle.Bold)
End If
' general
If m_brushBack Is Nothing OrElse Not
m_brushBack.Color.Equals(Me.BackColor) Then
m_brushBack = New SolidBrush(Me.BackColor)
End If
If m_penBack Is Nothing OrElse Not
m_penBack.Color.Equals(Me.BackColor) Then
m_penBack = New Pen(Me.BackColor)
End If
If m_brushFrame Is Nothing Then
m_brushFrame = New SolidBrush(SystemColors.WindowFrame)
End If
If m_penFrame Is Nothing Then
m_penFrame = New Pen(SystemColors.WindowFrame)
End If
End Sub
' Update the current selection with the specified date.
Private Sub UpdateCurSel(ByVal newDate As DateTime)
' see if should raise ValueChanged event
Dim difDate As Boolean = True
If m_curSel = newDate Then
difDate = False
End If
' store new date selection
m_curSel = newDate
m_hoverSel = m_curSel
' repaint
Invalidate()
Update()
' raise ValueChanged event
If difDate Then
RaiseEvent ValueChanged(Me, EventArgs.Empty)
End If
End Sub
' Return index into days array for the specified date.
Private Overloads Function GetDayIndex(ByVal dateValue As DateTime)
As Integer
Dim span As TimeSpan = dateValue.Subtract(m_firstDate)
Return CInt(span.TotalDays)
End Function
' Return index into the days array for the specified coordinates.
Private Overloads Function GetDayIndex(ByVal x As Integer, ByVal y
As Integer) As Integer
' see if in the day grid bounding rectangle
Dim rc As New Rectangle(0, ConstValues.DaysGrid.Y, _
ConstValues.NumCols * ConstValues.DaysCell.Width, _
ConstValues.BottomLabelsPos.Y)
If Not rc.Contains(x, y) Then
Return -1
End If
' calculate the index
Return CInt( _
Math.Floor(x / ConstValues.DaysCell.Width) + _
Math.Floor((y - ConstValues.DaysGrid.Y) /
(ConstValues.DaysCell.Height + 1)) _
* ConstValues.NumCols)
End Function
' Update the cell that has the hover mark.
Private Overloads Sub UpdateHoverCell(ByVal x As Integer, ByVal y As
Integer)
' calculate index into grid and then update the cell
Dim index As Integer = GetDayIndex(x, y)
UpdateHoverCell(index)
End Sub
' Update the cell that has the hover mark. Call CreateGraphics
' instead of invalidating for better performance.
Private Overloads Sub UpdateHoverCell(ByVal newIndex As Integer)
' see if over the days grid
If newIndex < 0 Or newIndex >= m_days.Length Then
' outside of grid, erase current hover mark
Dim g As Graphics = Me.CreateGraphics()
DrawHoverSelection(g, m_hoverSel, False)
DrawTodaySelection(g)
g.Dispose()
m_hoverSel = DateTime.MinValue
Return
End If
' see if hover date has changed
If m_hoverSel <> m_days(newIndex) Then
' earase old hover mark and draw new mark
Dim g As Graphics = Me.CreateGraphics()
DrawHoverSelection(g, m_hoverSel, False)
DrawHoverSelection(g, m_days(newIndex), True)
DrawTodaySelection(g)
g.Dispose()
' store current hover date
m_hoverSel = m_days(newIndex)
End If
End Sub
' Close the control. Raise the CloseUp event.
Private Sub Close()
Me.Hide()
' raise the CloseUp event
RaiseEvent CloseUp(Me, EventArgs.Empty)
End Sub
End Class
#End Region
