Do more with
Imports System.Runtime.InteropServices
Public Class MonthCalendarEx
Inherits System.Windows.Forms.MonthCalendar
Private Const MCM_FIRST = &H1000
Private Const MCM_GETCURRENTVIEW = (MCM_FIRST + 22)
Private Const MCMV_MONTH = 0
<DllImport("user32.dll", SetLastError:=True)>
Private Shared Function SendMessage(ByVal hwnd As IntPtr, ByVal wMsg As Integer, ByVal wParam As Integer, ByVal lParam As Integer) As Integer
End Function
Private lastDown As Integer
Private Function GetWeekRange(dt As Date) As SelectionRange
Dim delta = System.Globalization.DateTimeFormatInfo.CurrentInfo.FirstDayOfWeek - 1
Dim dof = dt.DayOfWeek
If dof = 0 Then dof = 7
dt = dt.AddDays(dof * -1 + 1)
Return New SelectionRange With {.Start = dt, .End = dt.AddDays(6)}
End Function
Private Function GetWeekDays(dt As Date) As Date()
Dim delta = System.Globalization.DateTimeFormatInfo.CurrentInfo.FirstDayOfWeek - 1
Dim dof = dt.DayOfWeek
If dof = 0 Then dof = 7
dt = dt.AddDays(dof * -1 + 1)
Dim lst As New List(Of Date)
For i = 0 To 6
lst.Add(dt.AddDays(i))
Next
Return lst.ToArray
End Function
Private Sub SelectWeek(rng As SelectionRange)
Me.SelectionStart = rng.Start
Me.SelectionEnd = rng.End
End Sub
Private Sub SelectWeek(dt As Date)
SelectWeek(GetWeekRange(dt))
End Sub
Private Sub AddBold(dates As Date())
Dim lst = Me.BoldedDates.ToList
lst.AddRange(dates.ToList)
Me.BoldedDates = lst.ToArray
End Sub
Private Sub RemoveBold(dates As Date())
Dim lst = Me.BoldedDates.ToList
For Each dt In dates
lst.Remove(dt)
Next
Me.BoldedDates = lst.ToArray
End Sub
Private Sub AddBoldWeek(dt As Date)
AddBold(GetWeekDays(dt))
End Sub
Private Sub RemoveBoldWeek(dt As Date)
RemoveBold(GetWeekDays(dt))
End Sub
Private Function isBold(dt As Date) As Boolean
Return Me.BoldedDates.Contains(dt)
End Function
Private Sub MonthCalendarEx_MouseDown(sender As Object, e As MouseEventArgs) Handles Me.MouseDown
Dim hti = Me.HitTest(e.Location)
If hti.HitArea = HitArea.Date Then
Dim dt = hti.Time
If SendMessage(Me.Handle, MCM_GETCURRENTVIEW, 0, 0) = MCMV_MONTH Then
Dim tick = Environment.TickCount
If (tick - lastDown <= SystemInformation.DoubleClickTime) Then
Dim b = isBold(dt)
If MsgBox(If(b, "Unselect", "Select") & " week?", MsgBoxStyle.YesNo) = MsgBoxResult.Yes Then
If b Then RemoveBoldWeek(dt) Else AddBoldWeek(dt)
End If
Else
lastDown = tick
SelectWeek(dt)
End If
End If
End If
End Sub
End Class
To make colored dates you need subclass OnPaint event and draw digits/background yourself.
Premium Content
You need an Expert Office subscription to comment.Start Free Trial