VB.NET2005编写复合控件（日历控件）
运行效果如下图片
首先需要三个控件 一个COMBOBOX、一个NUBERICUPDAOWN、一个PICTUREBOX
COMBOBOX 先将月份添加进ITEMS中，DROPDOWNSTAYLE设置为DropDownList，NAME=MONCOMBO
NUBERICUPDAOWN MAXVALUE=2099 MINVALUE=1980，NAME=UPDOWN
PICTUREBOX NAME=DAYPIC
代码如下：
Public Class Calendar
Public Event DateChange(ByVal sender As Calendar, ByVal e As EventArgs) '设定点击日期改变时候的事件
Private mYear As Integer
Private mMonth As Integer
Private mDay As Integer
Dim n As Integer '记录每月一号是星期几
Private Week As String() = New String() {"日", "一", "二", "三", "四", "五", "六"} '星期的描述
Private DayNumberA() As Integer = New Integer(11) {31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31} '平年的每月天数
Private DayNumberB() As Integer = New Integer(11) {31, 29, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31} '闰年的每月天数
Dim FontWidth As Integer '字体的宽度
Private Shadows FontHeight As Integer '字体的高度
Dim ClipWidth As Integer '每个格子的宽度
Dim ClipHeight As Integer '每个格子的高度
Public Sub New()
InitializeComponent()
mYear = Now.Year
mMonth = Now.Month
mDay = Now.Day
End Sub
Public ReadOnly Property Year() As Integer
Get
Return mYear
End Get
End Property
Public ReadOnly Property Month() As Integer
Get
Return mMonth
End Get
End Property
Public ReadOnly Property Day() As Integer
Get
Return mDay
End Get
End Property
Private Sub Calendar_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
MonCombo.SelectedIndex = mMonth - 1
updown.Text = mYear.ToString
ClipWidth = CInt((DayPic.Size.Width) / 7) '将图片框分成7行
ClipHeight = CInt((DayPic.Size.Height) / 8) '将图片框分成8列
FontWidth = TextRenderer.MeasureText((" ").ToString, MonCombo.Font).Width '标准字体的宽度
FontHeight = TextRenderer.MeasureText((" ").ToString, MonCombo.Font).Height '标准字体的高度
End Sub
Private Sub MonCombo_SelectedIndexChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MonCombo.SelectedIndexChanged
'-----------如果选择的日期是最后一天确保在月份改变的时候使改变后的日期有效----------
If mDay = LeapYear(mYear)(mMonth - 1) Then
mDay = LeapYear(mYear)(MonCombo.SelectedIndex)
End If
mMonth = MonCombo.SelectedIndex + 1
If mDay > LeapYear(mYear)(mMonth - 1) Then
mDay = LeapYear(mYear)(mMonth - 1)
End If
'-----------------------------------------------------------------------------------
DayPic.Invalidate() '发送重新绘制图片框的消息
RaiseEvent DateChange(Me, Nothing)
End Sub
Private Sub updown_ValueChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles updown.ValueChanged
mYear = CInt(updown.Value)
DayPic.Invalidate() '发送重新绘制图片框的消息
RaiseEvent DateChange(Me, Nothing)
End Sub
Private Function LeapYear(ByVal Year As Integer) As Integer() '判断所输入的年份是否是闰年并返回当年的每月天数情况
LeapYear = DayNumberB
If Date.IsLeapYear(Year) = False Then
LeapYear = DayNumberA
End If
End Function
Private Sub DrawDay(ByVal GraphicsObj As Graphics, ByVal xday As Integer) '绘制日历的方法
Dim i, j As Integer, s As Integer
Dim Rect As Rectangle '画制阴影的大小
Dim tempday As New Date(Me.mYear, Me.mMonth, Me.mDay)
Dim m As Integer = tempday.DayOfWeek() '判断输入XDAY变量的时候是星期几
'-----------------------确定每月的1号是星期几以便定位--------------------------
Dim t As Integer = (xday - 1) Mod 7
If t > m Then
n = 7 - (t - m)
Else
n = m - t
End If
'---------------------------------'画星期 -------------------------------------
For i = 0 To 6
TextRenderer.DrawText(GraphicsObj, Week(i).ToString, MonCombo.Font, _
New Rectangle(3 + i * ClipWidth, 3, FontWidth, FontHeight), Color.Blue, TextFormatFlags.Right)
Next
'-----------------------------从第二行开始画日期-------------------------------
Dim b As New SolidBrush(Color.AliceBlue)
b.Color = Color.FromArgb(128, 128, 128, 128)
For j = 1 To 6
For i = 0 To 6
Rect = New Rectangle(3 + i * ClipWidth, 3 + j * ClipHeight, FontWidth, FontHeight)
s = (i + (j - 1) * 7 + 1 - n)
If s <= LeapYear(mYear)(mMonth - 1) AndAlso s > 0 Then '确保日期是大于0和小于该月最大日期的数据
If s = xday Then
GraphicsObj.FillRectangle(b, Rect) '画选择了日期的阴影
End If
If s = Now.Day AndAlso mMonth = Now.Month AndAlso mYear = Now.Year Then
GraphicsObj.DrawRectangle(Pens.Blue, Rect) '如果日期是当天则画上外框
End If
'GraphicsObj.DrawString(s.ToString, MonCombo.Font, Brushes.Black, Rect)
TextRenderer.DrawText(GraphicsObj, s.ToString, MonCombo.Font, Rect, Color.Black, TextFormatFlags.Right)
End If
Next
Next
End Sub
Private Sub DayPic_MouseClick(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles DayPic.MouseClick
Dim x As Integer = e.X
Dim y As Integer = e.Y
Dim i, j As Integer
For j = 1 To 6
For i = 0 To 6
If x > (3 + i * ClipWidth) _
AndAlso y > (3 + j * ClipHeight) _
AndAlso x < (3 + i * ClipWidth + FontWidth) _
AndAlso y < (3 + j * ClipHeight + FontHeight) _
AndAlso ((j - 1) * 7 + i - n + 1) <= LeapYear(mYear)(mMonth - 1) _
AndAlso ((j - 1) * 7 + i - n + 1) > 0 Then '保证选择的区域是有效区域
DayPic.Focus()
mDay = ((j - 1) * 7 + i - n + 1) '获取点击时的日期
RaiseEvent DateChange(Me, Nothing) '触发事件
End If
Next
Next
DayPic.Invalidate()
End Sub
Private Sub DayPic_Paint(ByVal sender As Object, ByVal e As System.Windows.Forms.PaintEventArgs) Handles DayPic.Paint
DrawDay(e.Graphics, mDay)
Dim fontday As New Font(MonCombo.Font, FontStyle.Bold)
TextRenderer.DrawText(e.Graphics, Now.ToLongDateString, fontday, New Rectangle(3, 7 * ClipHeight, DayPic.Size.Width, FontHeight), Color.Blue)
End Sub
Private Sub Calendar_Resize(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Resize
Me.Size = New Size(164, 176) '使控件具有固定的尺寸，用户不能调节大小
End Sub
End Class