| 控件名称
|
控件类型
|
设置属性
|
| 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这个计算将星期和日期定位以便绘制。
（二）通过边缘检测也就是检测没个小格的坐标然后再反算为日期以产生通过点击日历产生不同日期的效果。
（三）通过申明事件@H_404_260@Public Event DateChanged(ByVal Sender As Object,ByVal e As EventArgs)然后在不同的时候触发以传出数据。
（四）特别是PictureBox控件没有实质的用处，但是没有他的时候当整个控件包装在ToolStripDropDown控件的时候会不能完全显示，所以只有将它放在右下角。
下面是主体代码：
- ImportsSystem.Drawing.Drawing2D
- ImportsSystem.Windows.Forms.Design
- ImportsSystem.Windows.Forms.ComponentModel
- FriendClassCalendar
- Privatem_DateAsDate
- Privatem_Week()AsString=NewString(){@H_182_404@"星期日",@H_182_404@"星期一",@H_182_404@"星期二",@H_182_404@"星期三",@H_182_404@"星期四",@H_182_404@"星期五",@H_182_404@"星期六"}
- Privatem_ClipWidthAsSingle'格子的宽度
- Privatem_ClipTopAsInteger'绘制日历的顶点坐标
- ShadowsFontAsNewFont(@H_182_404@"宋体",9,FontStyle.Regular,GraphicsUnit.Point)'设置绘制时候的字体
- PrivateFormatAsNewStringFormat'绘制字体时候的对齐方式
- PrivateStartDayAsInteger'绘制时候的开始点
- PublicEventDateChanged(ByValSenderAsObject,ByValeAsEventArgs)'日期改变的事件
- Privatem_IsSelectedAsBoolean'需要在点击日期的时候才关闭主体而点击年月增减按钮不关闭所以设置该参数
- Privatei,jAsInteger,RectAsNewRectangleF
- PrivateMinDateAsDate=CDate(@H_182_404@"1900-1-1")'日历可选最小日期
- PrivateMaxDateAsDate=CDate(@H_182_404@"2100-12-31")'日历可选最大日期
- PublicReadOnlyPropertyIsSelected()AsBoolean
- Get
- Returnm_IsSelected
- EndGet
- EndProperty
- PublicSubNew()
- InitializeComponent()
- m_ClipWidth=(Me.Width-4)/7
- m_ClipTop=2+DatePanl.Height
- m_Date=Now.Date
- Format.Alignment=StringAlignment.Center
- EndSub
- PublicPropertyDateValue()AsDate'返回日期以供其他程序使用
- Get
- Returnm_Date
- EndGet
- Set(ByValvalueAsDate)
- Ifvalue>=MinDateAndAlsovalue<=MaxDateThen
- m_Date=value
- Me.Invalidate()
- EndIf
- EndSet
- EndProperty
- PrivateSubCalendar_Load(ByValsenderAsObject,ByValeAsSystem.EventArgs)HandlesMe.Load
- Label3.Text=@H_182_404@"今天："&Now.ToShortDateString
- Label3.Left=(Me.Width-Label3.Width)/2
- EndSub
- PrivateSubAddBtn_Click(ByValsenderAsSystem.Object,ByValeAsSystem.Windows.Forms.MouseEventArgs)HandlesMonthAddbtn.MouseClick,MonthSubbtn.MouseClick,YearAddBtn.MouseClick,YearSubBtn.MouseClick'几个按钮会产生相同的效果所以放在一个代码块
- Ife.Button=Windows.Forms.MouseButtons.LeftThen
- DatePanl.Focus()
- DimTAsButton=CType(sender,Button)
- SelectCaseT.Name
- Case@H_182_404@"MonthAddbtn"
- m_Date=Me.DateValue.AddMonths(1)
- Case@H_182_404@"MonthSubbtn"
- m_Date=Me.DateValue.AddMonths(-1)
- Case@H_182_404@"YearAddBtn"
- m_Date=Me.DateValue.AddYears(1)
- Case@H_182_404@"YearSubBtn"
- m_Date=Me.DateValue.AddYears(-1)
- EndSelect
- Ifm_Date>=MinDateAndAlsom_Date<=MaxDateThen'保证设置的日期是在可选范围之内
- m_IsSelected=False
- RaiseEventDateChanged(Me,Nothing)
- Me.Invalidate()
- ElseIfm_Date<MinDateThen
- m_Date=CDate(@H_182_404@"1900-1-"&m_Date.Day)
- Else
- m_Date=CDate(@H_182_404@"2100-12-"&m_Date.Day)
- EndIf
- EndIf
- EndSub
- PrivateSubDrawWeek(ByValGraphicsAsGraphics)'绘制星期
- Fori=0To6
- Rect=NewRectangleF(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()
- EndSub
- PrivateSubDrawDate(ByValGraphicsAsGraphics)'绘制日历
- DimMaxDaysAsInteger=Date.DaysInMonth(m_Date.Year,m_Date.Month)'由于整个主体被分成*7个格子，因此会有上个月和下个月的日期在里面，因此需要得到上个月的天数
- DimMindays=Date.DaysInMonth(m_Date.AddMonths(-1).Year,m_Date.AddMonths(-1).Month)
- StartDay=CDate(m_Date.Year&@H_182_404@"-"&m_Date.Month&@H_182_404@"-1").DayOfWeek-1'由每个月的一号定位为星期几
- DimDateStringAsInteger
- Fori=0To6
- Forj=0To5
- WithRect
- .X=2+i*m_ClipWidth
- .Y=m_ClipTop+j*Font.Height+Font.Height+8
- .Width=m_ClipWidth
- .Height=Font.Height
- EndWith
- DateString=(i+j*7-StartDay)
- IfDateString<=0Then
- Graphics.DrawString(DateString+Mindays,Brushes.Gray,Rect,Format)
- ElseIfDateString>0AndAlsoDateString<=MaxDaysThen'绘制上个月的本月的以及下个月的日期
- IfDateString=m_Date.DayThen
- Graphics.FillRectangle(Brushes.Silver,Rect.X-1,Rect.Y-1,Rect.Width,Rect.Height)
- EndIf
- IfDateString=Now.DayAndAlsom_Date.Month=Now.MonthAndAlsom_Date.Year=Now.YearThen
- Graphics.DrawRectangle(Pens.RoyalBlue,Rect.Width-1,Rect.Height-1)
- EndIf
- Graphics.DrawString(DateString,Brushes.Black,Format)
- ElseIfDateString>MaxDaysAndAlsoDateString<=42Then
- Graphics.DrawString(DateString-MaxDays,Format)
- EndIf
- Next
- Next
- EndSub
- PrivateSubCalendar_MouseClick(ByValsenderAsObject,ByValeAsSystem.Windows.Forms.MouseEventArgs)HandlesMe.MouseDown'通过边界检查获取点击时候所处的位置以计算为日期
- DimxAsInteger=e.X
- DimyAsInteger=e.Y
- DimDateStringAsInteger
- DimPenAsNewPen(Color.Gray)
- Pen.DashStyle=DashStyle.Dot
- DimMaxDaysAsInteger=Date.DaysInMonth(m_Date.Year,m_Date.Month)
- DimMindays=Date.DaysInMonth(m_Date.AddMonths(-1).Year,m_Date.AddMonths(-1).Month)
- m_IsSelected=False
- Ife.Button=Windows.Forms.MouseButtons.LeftThen
- Fori=0To6
- Forj=0To5
- DateString=(i+j*7-StartDay)
- WithRect
- .X=2+i*m_ClipWidth
- .Y=m_ClipTop+(j+1)*Font.Height+8
- .Width=m_ClipWidth
- .Height=Font.Height
- EndWith
- Ifx>=Rect.X-1AndAlsox<=Rect.RightAndAlsoy>Rect.Y-1AndAlsoy<=Rect.BottomThen'计算格子的范围使鼠标在可选范围内
- IfDateString<=0Then'根据选取不同的月份计算出当时点击时的正确日期,所计算的日期要在整个可选的范围内
- IfCDate(m_Date.AddMonths(-1).Year&@H_182_404@"-"&m_Date.AddMonths(-1).Month&@H_182_404@"-"&DateString+Mindays)>=MinDateThen
- m_Date=CDate(m_Date.AddMonths(-1).Year&@H_182_404@"-"&m_Date.AddMonths(-1).Month&@H_182_404@"-"&DateString+Mindays)
- m_IsSelected=True
- EndIf
- ElseIfDateString>0AndAlsoDateString<=MaxDaysThen
- m_Date=CDate(m_Date.Year&@H_182_404@"-"&m_Date.Month&@H_182_404@"-"&DateString)
- m_IsSelected=True
- ElseIfDateString>MaxDaysAndAlsoDateString<=42Then
- IfCDate(m_Date.AddMonths(1).Year&@H_182_404@"-"&m_Date.AddMonths(1).Month&@H_182_404@"-"&DateString-MaxDays)<=MaxDateThen
- m_Date=CDate(m_Date.AddMonths(1).Year&@H_182_404@"-"&m_Date.AddMonths(1).Month&@H_182_404@"-"&DateString-MaxDays)
- m_IsSelected=True
- EndIf
- EndIf
- Me.CreateGraphics.DrawRectangle(Pen,Rect.Height-1)
- RaiseEventDateChanged(Me,Nothing)'触发日期改变的事件
- Me.Invalidate()
- EndIf
- Next
- Next
- Pen.Dispose()
- EndIf
- EndSub
- PrivateSubCalendar_Paint(ByValsenderAsObject,ByValeAsSystem.Windows.Forms.PaintEventArgs)HandlesMe.Paint
- DrawWeek(e.Graphics)
- DrawDate(e.Graphics)
- MonthLbl.Text=m_Date.Month&@H_182_404@"月"
- Yearlbl.Text=m_Date.Year&@H_182_404@"年"
- EndSub
- PrivateSubLabel3_Click(ByValsenderAsObject,ByValeAsSystem.EventArgs)HandlesLabel3.Click'转到今天
- m_Date=Now
- Me.m_IsSelected=True
- RaiseEventDateChanged(Me,Nothing)
- Me.Invalidate()
- EndSub
- PrivateSubLabel3_MouseEnter(ByValsenderAsObject,ByValeAsSystem.EventArgs)HandlesLabel3.MouseEnter
- Label3.Cursor=Cursors.Hand
- EndSub
- PrivateSubLabel3_MouseLeave(ByValsenderAsObject,ByValeAsSystem.EventArgs)HandlesLabel3.MouseLeave
- Label3.Cursor=Cursors.Default
- EndSub
- PrivateSubCalendar_Resize(ByValsenderAsObject,ByValeAsSystem.EventArgs)HandlesMe.Resize'固定整个控件的大小
- Me.Size=NewSize(298,150)
- EndSub
- EndClass
以下是主体在运行时的效果
- ImportsCalendar
- PublicClassDatePicker
- InheritsComboBox
- PrivateWithEventsCalendarAsCalendar
- PrivateDateToolAsToolStripDropDown
- PrivateConstWM_LBUTTONDOWN=
- PrivateConstWM_LBUTTONDBLCLK=
- PublicSubNew()
- InitTool()
- EndSub
- PublicPropertyValue()AsDate
- Get
- ReturnCalendar.DateValue
- EndGet
- Set(ByValvalueAsDate)
- IfDate.TryParse(value,Calendar.DateValue)=TrueThen
- Me.Text=value.ToLongDateString
- EndIf
- EndSet
- EndProperty
- ProtectedOverridesSubWndProc(ByRefmAsSystem.Windows.Forms.Message)'截获鼠标左键点击的消息以显示包装的日历主体
- Ifm.Msg=WM_LBUTTONDOWNOrElsem.Msg=WM_LBUTTONDBLCLKThen
- ShowDrop()
- Me.Focus()
- Return
- EndIf
- MyBase.WndProc(m)
- EndSub
- PrivateSubInitTool()
- Calendar=NewCalendar
- DimToolHostAsNewToolStripControlHost(Calendar)
- DateTool=NewToolStripDropDown
- DateTool.Items.Add(ToolHost)
- EndSub
- PrivateSubShowDrop()
- IfDate.TryParse(Me.Text,Calendar.DateValue)=TrueThen
- DateTool.Show(Me,Me.Height)
- EndIf
- EndSub
- PrivateSubCalendar_DateChanged(ByValSenderAsObject,ByValeAsSystem.EventArgs)HandlesCalendar.DateChanged
- IfCalendar.IsSelected=TrueThen
- Threading.Thread.Sleep(100)
- DateTool.Hide()
- EndIf
- Me.Text=Calendar.DateValue.ToLongDateString
- EndSub
- EndClass
最后进行测试
测试代码如下：
- PrivateSubForm1_Load(ByValsenderAsObject,ByValeAsSystem.EventArgs)HandlesMe.Load
- DatePicker1.Text=Now.ToLongDateString
- EndSub
运行效果如下图