VB.NET 编写仿微软的日历控件

控件名称	控件类型	设置属性
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控件的时候会不能完全显示，所以只有将它放在右下角。

下面是主体代码：

 

1. Imports System.Drawing.Drawing2D
2. Imports System.Windows.Forms.Design
3. Imports System.Windows.Forms.ComponentModel
4. Friend Class Calendar
5.     Private m_Date As Date
6.     Private m_Week() As String = New String() {"星期日", "星期一", "星期二", "星期三", "星期四", "星期五", "星期六"}
7.     Private m_ClipWidth As Single     '格子的宽度
8.     Private m_ClipTop As Integer      '绘制日历的顶点坐标
9.     Shadows Font As New Font("宋体", 9, FontStyle.Regular, GraphicsUnit.Point)   '设置绘制时候的字体
10.     Private Format As New StringFormat                               '绘制字体时候的对齐方式
11.     Private StartDay As Integer                                      '绘制时候的开始点
12.     Public Event DateChanged(ByVal Sender As Object, ByVal e As EventArgs)   '日期改变的事件
13.     Private m_IsSelected As Boolean                                          '需要在点击日期的时候才关闭主体而点击年月增减按钮不关闭所以设置该参数
14.     Private i, j As Integer, Rect As New RectangleF
15.     Private MinDate As Date = CDate("1900-1-1")                              '日历可选最小日期
16.     Private MaxDate As Date = CDate("2100-12-31")                            '日历可选最大日期
17.     Public ReadOnly Property IsSelected() As Boolean
18.         Get
19.             Return m_IsSelected
20.         End Get
21.     End Property
22.     Public Sub New()
24.         InitializeComponent()
26.         m_ClipWidth = (Me.Width - 4) / 7
27.         m_ClipTop = 2 + DatePanl.Height
28.         m_Date = Now.Date
29.         Format.Alignment = StringAlignment.Center
31.     End Sub
32.     Public Property DateValue() As Date                           '返回日期以供其他程序使用
33.         Get
34.             Return m_Date
35.         End Get
36.         Set(ByVal value As Date)
37.             If value >= MinDate AndAlso value <= MaxDate Then
38.                 m_Date = value
39.                 Me.Invalidate()
40.             End If
42.         End Set
43.     End Property
44.    
45.     Private Sub Calendar_Load(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Load
46.         Label3.Text = "今天：" & Now.ToShortDateString
47.         Label3.Left = (Me.Width - Label3.Width) / 2
48.     End Sub
50.     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             '几个按钮会产生相同的效果所以放在一个代码块
52.         If e.Button = Windows.Forms.MouseButtons.Left Then
54.             DatePanl.Focus()
55.             Dim T As Button = CType(sender, Button)
56.             Select Case T.Name
57.                 Case "MonthAddbtn"
58.                     m_Date = Me.DateValue.AddMonths(1)
59.                 Case "MonthSubbtn"
60.                     m_Date = Me.DateValue.AddMonths(-1)
61.                 Case "YearAddBtn"
62.                     m_Date = Me.DateValue.AddYears(1)
63.                 Case "YearSubBtn"
64.                     m_Date = Me.DateValue.AddYears(-1)
65.             End Select
67.             If m_Date >= MinDate AndAlso m_Date <= MaxDate Then              '保证设置的日期是在可选范围之内
68.                 m_IsSelected = False
69.                 RaiseEvent DateChanged(Me, Nothing)
70.                 Me.Invalidate()
71.             ElseIf m_Date < MinDate Then
72.                 m_Date = CDate("1900-1-" & m_Date.Day)
73.             Else
74.                 m_Date = CDate("2100-12-" & m_Date.Day)
75.             End If
78.         End If
80.     End Sub
82.     Private Sub DrawWeek(ByVal Graphics As Graphics)    '绘制星期
84.         For i = 0 To 6
85.             Rect = New RectangleF(2 + i * m_ClipWidth, m_ClipTop + 2, m_ClipWidth, Me.Font.Height + 2)
86.             Graphics.DrawString(m_Week(i), Font, Brushes.RoyalBlue, Rect)
87.         Next
88.         Graphics.DrawLine(Pens.Gray, 2, m_ClipTop + Font.Height + 2, Me.Width - 6, m_ClipTop + Font.Height + 2) '绘制星期下面的横线
89.         Graphics.DrawRectangle(Pens.RoyalBlue, 40, Me.Height - Font.Height, m_ClipWidth - 1, Font.Height - 1)
90.         ' Graphics.Dispose()
91.     End Sub
93.     Private Sub DrawDate(ByVal Graphics As Graphics)    '绘制日历
95.         Dim MaxDays As Integer = Date.DaysInMonth(m_Date.Year, m_Date.Month)                   '由于整个主体被分成*7个格子，因此会有上个月和下个月的日期在里面，因此需要得到上个月的天数
96.         Dim Mindays = Date.DaysInMonth(m_Date.AddMonths(-1).Year, m_Date.AddMonths(-1).Month)
99.         StartDay = CDate(m_Date.Year & "-" & m_Date.Month & "-1").DayOfWeek - 1         '由每个月的一号定位为星期几
101.         Dim DateString As Integer
103.         For i = 0 To 6
104.             For j = 0 To 5
106.                 With Rect
107.                     .X = 2 + i * m_ClipWidth
108.                     .Y = m_ClipTop + j * Font.Height + Font.Height + 8
109.                     .Width = m_ClipWidth
110.                     .Height = Font.Height
111.                 End With
113.                 DateString = (i + j * 7 - StartDay)
115.                 If DateString <= 0 Then
117.                     Graphics.DrawString(DateString + Mindays, Font, Brushes.Gray, Rect, Format)
120.                 ElseIf DateString > 0 AndAlso DateString <= MaxDays Then      '绘制上个月的本月的以及下个月的日期
122.                     If DateString = m_Date.Day Then
123.                         Graphics.FillRectangle(Brushes.Silver, Rect.X - 1, Rect.Y - 1, Rect.Width, Rect.Height)
124.                     End If
126.                     If DateString = Now.Day AndAlso m_Date.Month = Now.Month AndAlso m_Date.Year = Now.Year Then
127.                         Graphics.DrawRectangle(Pens.RoyalBlue, Rect.X - 1, Rect.Y - 1, Rect.Width - 1, Rect.Height - 1)
128.                     End If
130.                     Graphics.DrawString(DateString, Font, Brushes.Black, Rect, Format)
132.                 ElseIf DateString > MaxDays AndAlso DateString <= 42 Then
134.                     Graphics.DrawString(DateString - MaxDays, Font, Brushes.Gray, Rect, Format)
136.                 End If
138.             Next
139.         Next
140.     End Sub
142.     Private Sub Calendar_MouseClick(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles Me.MouseDown  '通过边界检查获取点击时候所处的位置以计算为日期
143.         Dim x As Integer = e.X
144.         Dim y As Integer = e.Y
146.         Dim DateString As Integer
148.         Dim Pen As New Pen(Color.Gray)
149.         Pen.DashStyle = DashStyle.Dot
151.         Dim MaxDays As Integer = Date.DaysInMonth(m_Date.Year, m_Date.Month)
152.         Dim Mindays = Date.DaysInMonth(m_Date.AddMonths(-1).Year, m_Date.AddMonths(-1).Month)
155.         m_IsSelected = False
157.         If e.Button = Windows.Forms.MouseButtons.Left Then
158.             For i = 0 To 6
159.                 For j = 0 To 5
160.                     DateString = (i + j * 7 - StartDay)
161.                     With Rect
162.                         .X = 2 + i * m_ClipWidth
163.                         .Y = m_ClipTop + (j + 1) * Font.Height + 8
164.                         .Width = m_ClipWidth
165.                         .Height = Font.Height
166.                     End With
168.                     If x >= Rect.X - 1 AndAlso x <= Rect.Right AndAlso y > Rect.Y - 1 AndAlso y <= Rect.Bottom Then   '计算格子的范围使鼠标在可选范围内
170.                         If DateString <= 0 Then        '根据选取不同的月份计算出当时点击时的正确日期,所计算的日期要在整个可选的范围内
172.                             If CDate(m_Date.AddMonths(-1).Year & "-" & m_Date.AddMonths(-1).Month & "-" & DateString + Mindays) >= MinDate Then
173.                                 m_Date = CDate(m_Date.AddMonths(-1).Year & "-" & m_Date.AddMonths(-1).Month & "-" & DateString + Mindays)
174.                                 m_IsSelected = True
175.                             End If
177.                         ElseIf DateString > 0 AndAlso DateString <= MaxDays Then
178.                             m_Date = CDate(m_Date.Year & "-" & m_Date.Month & "-" & DateString)
179.                             m_IsSelected = True
180.                         ElseIf DateString > MaxDays AndAlso DateString <= 42 Then
182.                             If CDate(m_Date.AddMonths(1).Year & "-" & m_Date.AddMonths(1).Month & "-" & DateString - MaxDays) <= MaxDate Then
183.                                 m_Date = CDate(m_Date.AddMonths(1).Year & "-" & m_Date.AddMonths(1).Month & "-" & DateString - MaxDays)
184.                                 m_IsSelected = True
185.                             End If
187.                         End If
188.                         Me.CreateGraphics.DrawRectangle(Pen, Rect.X - 1, Rect.Y - 1, Rect.Width - 1, Rect.Height - 1)
189.                         RaiseEvent DateChanged(Me, Nothing)    '触发日期改变的事件
190.                         Me.Invalidate()
191.                     End If
192.                 Next
193.             Next
194.             Pen.Dispose()
195.         End If
197.     End Sub
199.     Private Sub Calendar_Paint(ByVal sender As Object, ByVal e As System.Windows.Forms.PaintEventArgs) Handles Me.Paint
201.         DrawWeek(e.Graphics)
202.         DrawDate(e.Graphics)
203.         MonthLbl.Text = m_Date.Month & "月"
204.         Yearlbl.Text = m_Date.Year & "年"
205.     End Sub
207.     Private Sub Label3_Click(ByVal sender As Object, ByVal e As System.EventArgs) Handles Label3.Click  '转到今天
208.         m_Date = Now
209.         Me.m_IsSelected = True
210.         RaiseEvent DateChanged(Me, Nothing)
211.         Me.Invalidate()
212.     End Sub
214.     Private Sub Label3_MouseEnter(ByVal sender As Object, ByVal e As System.EventArgs) Handles Label3.MouseEnter
215.         Label3.Cursor = Cursors.Hand
216.     End Sub
218.     Private Sub Label3_MouseLeave(ByVal sender As Object, ByVal e As System.EventArgs) Handles Label3.MouseLeave
219.         Label3.Cursor = Cursors.Default
220.     End Sub
222.     Private Sub Calendar_Resize(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Resize '固定整个控件的大小
223.         Me.Size = New Size(298, 150)
224.     End Sub
225. End Class

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

 

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

1. Imports Calendar
2. Public Class DatePicker
3.     Inherits ComboBox
4.     Private WithEvents Calendar As Calendar
5.     Private DateTool As ToolStripDropDown
6.     Private Const WM_LBUTTONDOWN = 
7.     Private Const WM_LBUTTONDBLCLK = 
8.     Public Sub New()
9.         InitTool()
10.     End Sub
11.     Public Property Value() As Date
12.         Get
13.             Return Calendar.DateValue
14.         End Get
15.         Set(ByVal value As Date)
16.             If Date.TryParse(value, Calendar.DateValue) = True Then
17.                 Me.Text = value.ToLongDateString
18.             End If
20.         End Set
21.     End Property
22.     Protected Overrides Sub WndProc(ByRef m As System.Windows.Forms.Message)   '截获鼠标左键点击的消息以显示包装的日历主体
23.         If m.Msg = WM_LBUTTONDOWN OrElse m.Msg = WM_LBUTTONDBLCLK Then
24.             ShowDrop()
25.             Me.Focus()
26.             Return
28.         End If
29.         MyBase.WndProc(m)
30.     End Sub
32.     Private Sub InitTool()
33.         Calendar = New Calendar
34.         Dim ToolHost As New ToolStripControlHost(Calendar)
35.         DateTool = New ToolStripDropDown
36.         DateTool.Items.Add(ToolHost)
37.     End Sub
38.     Private Sub ShowDrop()
39.         If Date.TryParse(Me.Text, Calendar.DateValue) = True Then
40.             DateTool.Show(Me, 0, Me.Height)
41.         End If
43.     End Sub
45.     Private Sub Calendar_DateChanged(ByVal Sender As Object, ByVal e As System.EventArgs) Handles Calendar.DateChanged
46.         If Calendar.IsSelected = True Then
47.             Threading.Thread.Sleep(100)
48.             DateTool.Hide()
50.         End If
51.         Me.Text = Calendar.DateValue.ToLongDateString
52.     End Sub
53. End Class

最后进行测试

测试代码如下：

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

运行效果如下图