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