VB.NET 编写仿微软的日历控件_vbnet datagridview 单元格添加日历选择控件-CSDN博客

本文链接：https://blog.csdn.net/ncqingchuan1976/article/details/3722349

控件名称	控件类型	设置属性
DatePanl	TableLayoutPanle
MonthAddbtn, MonthSubbtn YearAddBtn, YearSubBtn	Button	Flatstyle=Flat
MonthLbl, Yearlbl,label3	Label	Dock=Fill
Picture	PictureBox

思路是先利用用户控件，做出日历的主体，然后利用ToolStripControlHost作为容器将日历的主体包含在里面利用ToolStripDropDown控件做弹出效果，最后重写Combobox控件形成完整的日历控件。

对于日历的主体，通过将背景分成不同的小格，然后将数字绘制在背景上。在编写的时候需要注意以下几个问题。

（一）在绘制的时注意定位，我以每个月的1号做为定位点通过StartDay = CDate(m_Date.Year & "-" & m_Date.Month & "-1").DayOfWeek – 1这个计算将星期和日期定位以便绘制。

（二）通过边缘检测也就是检测没个小格的坐标然后再反算为日期以产生通过点击日历产生不同日期的效果。

（三）通过申明事件Public Event DateChanged(ByVal Sender As Object, ByVal e As EventArgs)然后在不同的时候触发以传出数据。

（四）特别是Picturebox控件没有实质的用处，但是没有他的时候当整个控件包装在ToolStripDropDown控件的时候会不能完全显示，所以只有将它放在右下角。

下面是主体代码：

 
 Imports System.Drawing.Drawing2D
Imports System.Windows.Forms.Design
Imports System.Windows.Forms.ComponentModel
Friend Class Calendar
    Private m_Date As Date
    Private m_Week() As String = New String() {"星期日", "星期一", "星期二", "星期三", "星期四", "星期五", "星期六"}
    Private m_ClipWidth As Single     '格子的宽度 
    Private m_ClipTop As Integer      '绘制日历的顶点坐标 
    Shadows Font As New Font("宋体", 9, FontStyle.Regular, GraphicsUnit.Point)   '设置绘制时候的字体 
    Private Format As New StringFormat                               '绘制字体时候的对齐方式 
    Private StartDay As Integer                                      '绘制时候的开始点 
    Public Event DateChanged(ByVal Sender As Object, ByVal e As EventArgs)   '日期改变的事件 
    Private m_IsSelected As Boolean                                          '需要在点击日期的时候才关闭主体而点击年月增减按钮不关闭所以设置该参数 
    Private i, j As Integer, Rect As New RectangleF
    Private MinDate As Date = CDate("1900-1-1")                              '日历可选最小日期 
    Private MaxDate As Date = CDate("2100-12-31")                            '日历可选最大日期 
    Public ReadOnly Property IsSelected() As Boolean
        Get
            Return m_IsSelected
        End Get
    End Property
    Public Sub New()
        InitializeComponent()
        m_ClipWidth = (Me.Width - 4) / 7
        m_ClipTop = 2 + DatePanl.Height
        m_Date = Now.Date
        Format.Alignment = StringAlignment.Center
    End Sub
    Public Property DateValue() As Date                           '返回日期以供其他程序使用 
        Get
            Return m_Date
        End Get
        Set(ByVal value As Date)
            If value >= MinDate AndAlso value <= MaxDate Then
                m_Date = value
                Me.Invalidate()
            End If
        End Set
    End Property
   
    Private Sub Calendar_Load(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Load
        Label3.Text = "今天：" & Now.ToShortDateString
        Label3.Left = (Me.Width - Label3.Width) / 2
    End Sub
    Private Sub AddBtn_Click(ByVal sender As System.Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles MonthAddbtn.MouseClick, MonthSubbtn.MouseClick, YearAddBtn.MouseClick, YearSubBtn.MouseClick             '几个按钮会产生相同的效果所以放在一个代码块 
        If e.Button = Windows.Forms.MouseButtons.Left Then
            DatePanl.Focus()
            Dim T As Button = CType(sender, Button)
            Select Case T.Name
                Case "MonthAddbtn"
                    m_Date = Me.DateValue.AddMonths(1)
                Case "MonthSubbtn"
                    m_Date = Me.DateValue.AddMonths(-1)
                Case "YearAddBtn"
                    m_Date = Me.DateValue.AddYears(1)
                Case "YearSubBtn"
                    m_Date = Me.DateValue.AddYears(-1)
            End Select
            If m_Date >= MinDate AndAlso m_Date <= MaxDate Then              '保证设置的日期是在可选范围之内 
                m_IsSelected = False
                RaiseEvent DateChanged(Me, Nothing)
                Me.Invalidate()
            ElseIf m_Date < MinDate Then
                m_Date = CDate("1900-1-" & m_Date.Day)
            Else
                m_Date = CDate("2100-12-" & m_Date.Day)
            End If
        End If
    End Sub
    Private Sub DrawWeek(ByVal Graphics As Graphics)    '绘制星期 
        For i = 0 To 6
            Rect = New RectangleF(2 + i * m_ClipWidth, m_ClipTop + 2, m_ClipWidth, Me.Font.Height + 2)
            Graphics.DrawString(m_Week(i), Font, Brushes.RoyalBlue, Rect)
        Next
        Graphics.DrawLine(Pens.Gray, 2, m_ClipTop + Font.Height + 2, Me.Width - 6, m_ClipTop + Font.Height + 2) '绘制星期下面的横线 
        Graphics.DrawRectangle(Pens.RoyalBlue, 40, Me.Height - Font.Height, m_ClipWidth - 1, Font.Height - 1)
        ' Graphics.Dispose() 
    End Sub
    Private Sub DrawDate(ByVal Graphics As Graphics)    '绘制日历 
        Dim MaxDays As Integer = Date.DaysInMonth(m_Date.Year, m_Date.Month)                   '由于整个主体被分成*7个格子，因此会有上个月和下个月的日期在里面，因此需要得到上个月的天数 
        Dim Mindays = Date.DaysInMonth(m_Date.AddMonths(-1).Year, m_Date.AddMonths(-1).Month)
        StartDay = CDate(m_Date.Year & "-" & m_Date.Month & "-1").DayOfWeek - 1         '由每个月的一号定位为星期几 
        Dim DateString As Integer
        For i = 0 To 6
            For j = 0 To 5
                With Rect
                    .X = 2 + i * m_ClipWidth
                    .Y = m_ClipTop + j * Font.Height + Font.Height + 8
                    .Width = m_ClipWidth
                    .Height = Font.Height
                End With
                DateString = (i + j * 7 - StartDay)
                If DateString <= 0 Then
                    Graphics.DrawString(DateString + Mindays, Font, Brushes.Gray, Rect, Format)
                ElseIf DateString > 0 AndAlso DateString <= MaxDays Then      '绘制上个月的本月的以及下个月的日期 
                    If DateString = m_Date.Day Then
                        Graphics.FillRectangle(Brushes.Silver, Rect.X - 1, Rect.Y - 1, Rect.Width, Rect.Height)
                    End If
                    If DateString = Now.Day AndAlso m_Date.Month = Now.Month AndAlso m_Date.Year = Now.Year Then
                        Graphics.DrawRectangle(Pens.RoyalBlue, Rect.X - 1, Rect.Y - 1, Rect.Width - 1, Rect.Height - 1)
                    End If
                    Graphics.DrawString(DateString, Font, Brushes.Black, Rect, Format)
                ElseIf DateString > MaxDays AndAlso DateString <= 42 Then
                    Graphics.DrawString(DateString - MaxDays, Font, Brushes.Gray, Rect, Format)
                End If
            Next
        Next
    End Sub
    Private Sub Calendar_MouseClick(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles Me.MouseDown  '通过边界检查获取点击时候所处的位置以计算为日期 
        Dim x As Integer = e.X
        Dim y As Integer = e.Y
        Dim DateString As Integer
        Dim Pen As New Pen(Color.Gray)
        Pen.DashStyle = DashStyle.Dot
        Dim MaxDays As Integer = Date.DaysInMonth(m_Date.Year, m_Date.Month)
        Dim Mindays = Date.DaysInMonth(m_Date.AddMonths(-1).Year, m_Date.AddMonths(-1).Month)
        m_IsSelected = False
        If e.Button = Windows.Forms.MouseButtons.Left Then
            For i = 0 To 6
                For j = 0 To 5
                    DateString = (i + j * 7 - StartDay)
                    With Rect
                        .X = 2 + i * m_ClipWidth
                        .Y = m_ClipTop + (j + 1) * Font.Height + 8
                        .Width = m_ClipWidth
                        .Height = Font.Height
                    End With
                    If x >= Rect.X - 1 AndAlso x <= Rect.Right AndAlso y > Rect.Y - 1 AndAlso y <= Rect.Bottom Then   '计算格子的范围使鼠标在可选范围内 
                        If DateString <= 0 Then        '根据选取不同的月份计算出当时点击时的正确日期,所计算的日期要在整个可选的范围内 
                            If CDate(m_Date.AddMonths(-1).Year & "-" & m_Date.AddMonths(-1).Month & "-" & DateString + Mindays) >= MinDate Then
                                m_Date = CDate(m_Date.AddMonths(-1).Year & "-" & m_Date.AddMonths(-1).Month & "-" & DateString + Mindays)
                                m_IsSelected = True
                            End If
                        ElseIf DateString > 0 AndAlso DateString <= MaxDays Then
                            m_Date = CDate(m_Date.Year & "-" & m_Date.Month & "-" & DateString)
                            m_IsSelected = True
                        ElseIf DateString > MaxDays AndAlso DateString <= 42 Then
                            If CDate(m_Date.AddMonths(1).Year & "-" & m_Date.AddMonths(1).Month & "-" & DateString - MaxDays) <= MaxDate Then
                                m_Date = CDate(m_Date.AddMonths(1).Year & "-" & m_Date.AddMonths(1).Month & "-" & DateString - MaxDays)
                                m_IsSelected = True
                            End If
                        End If
                        Me.CreateGraphics.DrawRectangle(Pen, Rect.X - 1, Rect.Y - 1, Rect.Width - 1, Rect.Height - 1)
                        RaiseEvent DateChanged(Me, Nothing)    '触发日期改变的事件 
                        Me.Invalidate()
                    End If
                Next
            Next
            Pen.Dispose()
        End If
    End Sub
    Private Sub Calendar_Paint(ByVal sender As Object, ByVal e As System.Windows.Forms.PaintEventArgs) Handles Me.Paint
        DrawWeek(e.Graphics)
        DrawDate(e.Graphics)
        MonthLbl.Text = m_Date.Month & "月"
        Yearlbl.Text = m_Date.Year & "年"
    End Sub
    Private Sub Label3_Click(ByVal sender As Object, ByVal e As System.EventArgs) Handles Label3.Click  '转到今天 
        m_Date = Now
        Me.m_IsSelected = True
        RaiseEvent DateChanged(Me, Nothing)
        Me.Invalidate()
    End Sub
    Private Sub Label3_MouseEnter(ByVal sender As Object, ByVal e As System.EventArgs) Handles Label3.MouseEnter
        Label3.Cursor = Cursors.Hand
    End Sub
    Private Sub Label3_MouseLeave(ByVal sender As Object, ByVal e As System.EventArgs) Handles Label3.MouseLeave
        Label3.Cursor = Cursors.Default
    End Sub
    Private Sub Calendar_Resize(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Resize '固定整个控件的大小 
        Me.Size = New Size(298, 150)
    End Sub
End Class
 

以下是主体在运行时的效果

接下来是将Combobox控件重写然后将主体包装的代码

 
     Imports Calendar
Public Class DatePicker
    Inherits ComboBox
    Private WithEvents Calendar As Calendar
    Private DateTool As ToolStripDropDown
    Private Const WM_LBUTTONDOWN = 
    Private Const WM_LBUTTONDBLCLK = 
    Public Sub New()
        InitTool()
    End Sub
    Public Property Value() As Date
        Get
            Return Calendar.DateValue
        End Get
        Set(ByVal value As Date)
            If Date.TryParse(value, Calendar.DateValue) = True Then
                Me.Text = value.ToLongDateString
            End If
        End Set
    End Property
    Protected Overrides Sub WndProc(ByRef m As System.Windows.Forms.Message)   '截获鼠标左键点击的消息以显示包装的日历主体 
        If m.Msg = WM_LBUTTONDOWN OrElse m.Msg = WM_LBUTTONDBLCLK Then
            ShowDrop()
            Me.Focus()
            Return
        End If
        MyBase.WndProc(m)
    End Sub
    Private Sub InitTool()
        Calendar = New Calendar
        Dim ToolHost As New ToolStripControlHost(Calendar)
        DateTool = New ToolStripDropDown
        DateTool.Items.Add(ToolHost)
    End Sub
    Private Sub ShowDrop()
        If Date.TryParse(Me.Text, Calendar.DateValue) = True Then
            DateTool.Show(Me, 0, Me.Height)
        End If
    End Sub
    Private Sub Calendar_DateChanged(ByVal Sender As Object, ByVal e As System.EventArgs) Handles Calendar.DateChanged
        If Calendar.IsSelected = True Then
            Threading.Thread.Sleep(100)
            DateTool.Hide()
        End If
        Me.Text = Calendar.DateValue.ToLongDateString
    End Sub
End Class
 
    

最后进行测试

测试代码如下：

 
     Private Sub Form1_Load(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Load
        DatePicker1.Text = Now.ToLongDateString
End Sub

运行效果如下图