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

发布时间：2020-12-16 23:36:00 所属栏目：大数据来源：网络整理

导读：控件名称控件类型设置属性 DatePanl TableLayoutPanle MonthAddbtn,MonthSubbtn YearAddBtn,YearSubBtn Button Flatstyle=Flat MonthLbl,Yearlbl,label3 Label Dock=Fill Picture PictureBox 思路是先利用用户控件，做出日历的主体，然后利用 ToolStripCon

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

下面是主体代码：

 
 ImportsSystem.Drawing.Drawing2D
ImportsSystem.Windows.Forms.Design
ImportsSystem.Windows.Forms.ComponentModel
FriendClassCalendar
Privatem_DateAsDate
Privatem_Week()AsString=NewString(){"星期日","星期一","星期二","星期三","星期四","星期五","星期六"}
Privatem_ClipWidthAsSingle'格子的宽度 
Privatem_ClipTopAsInteger'绘制日历的顶点坐标 
ShadowsFontAsNewFont("宋体",9,FontStyle.Regular,GraphicsUnit.Point)'设置绘制时候的字体 
PrivateFormatAsNewStringFormat'绘制字体时候的对齐方式 
PrivateStartDayAsInteger'绘制时候的开始点 
PublicEventDateChanged(ByValSenderAsObject,ByValeAsEventArgs)'日期改变的事件 
Privatem_IsSelectedAsBoolean'需要在点击日期的时候才关闭主体而点击年月增减按钮不关闭所以设置该参数 
Privatei,jAsInteger,RectAsNewRectangleF
PrivateMinDateAsDate=CDate("1900-1-1")'日历可选最小日期 
PrivateMaxDateAsDate=CDate("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="今天："&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"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)
EndSelect
Ifm_Date>=MinDateAndAlsom_Date<=MaxDateThen'保证设置的日期是在可选范围之内 
m_IsSelected=False
RaiseEventDateChanged(Me,Nothing)
Me.Invalidate()
ElseIfm_Date<MinDateThen
m_Date=CDate("1900-1-"&m_Date.Day)
Else
m_Date=CDate("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&"-"&m_Date.Month&"-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&"-"&m_Date.AddMonths(-1).Month&"-"&DateString+Mindays)>=MinDateThen
m_Date=CDate(m_Date.AddMonths(-1).Year&"-"&m_Date.AddMonths(-1).Month&"-"&DateString+Mindays)
m_IsSelected=True
EndIf
ElseIfDateString>0AndAlsoDateString<=MaxDaysThen
m_Date=CDate(m_Date.Year&"-"&m_Date.Month&"-"&DateString)
m_IsSelected=True
ElseIfDateString>MaxDaysAndAlsoDateString<=42Then
IfCDate(m_Date.AddMonths(1).Year&"-"&m_Date.AddMonths(1).Month&"-"&DateString-MaxDays)<=MaxDateThen
m_Date=CDate(m_Date.AddMonths(1).Year&"-"&m_Date.AddMonths(1).Month&"-"&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&"月"
Yearlbl.Text=m_Date.Year&"年"
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
 

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

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

 
     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

运行效果如下图

（编辑：李大同）

【声明】本站内容均来自网络，其相关言论仅代表作者个人观点，不代表本站立场。若无意侵犯到您的权利，请及时与联系站长删除相关内容!