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

前端之家收集整理的这篇文章主要介绍了VB.NET 编写仿微软的日历控件前端之家小编觉得挺不错的,现在分享给大家,也给大家做个参考。

控件名称

控件类型

设置属性

DatePanl

TableLayoutPanle

MonthAddbtn,MonthSubbtn

YearAddBtn,YearSubBtn

Button

Flatstyle=Flat

MonthLbl,Yearlbl,label3

Label

Dock=Fill

Picture

PictureBox

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

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

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

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

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

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

下面是主体代码

  1. ImportsSystem.Drawing.Drawing2D
  2. ImportsSystem.Windows.Forms.Design
  3. ImportsSystem.Windows.Forms.ComponentModel
  4. FriendClassCalendar
  5. Privatem_DateAsDate
  6. Privatem_Week()AsString=NewString(){@H_636_404@"星期日",@H_636_404@"星期一",@H_636_404@"星期二",@H_636_404@"星期三",@H_636_404@"星期四",@H_636_404@"星期五",@H_636_404@"星期六"}
  7. Privatem_ClipWidthAsSingle'格子的宽度
  8. Privatem_ClipTopAsInteger'绘制日历的顶点坐标
  9. ShadowsFontAsNewFont(@H_636_404@"宋体",9,FontStyle.Regular,GraphicsUnit.Point)'设置绘制时候的字体
  10. PrivateFormatAsNewStringFormat'绘制字体时候的对齐方式
  11. PrivateStartDayAsInteger'绘制时候的开始点
  12. PublicEventDateChanged(ByValSenderAsObject,ByValeAsEventArgs)'日期改变的事件
  13. Privatem_IsSelectedAsBoolean'需要在点击日期的时候才关闭主体而点击年月增减按钮不关闭所以设置该参数
  14. Privatei,jAsInteger,RectAsNewRectangleF
  15. PrivateMinDateAsDate=CDate(@H_636_404@"1900-1-1")'日历可选最小日期
  16. PrivateMaxDateAsDate=CDate(@H_636_404@"2100-12-31")'日历可选最大日期
  17. PublicReadOnlyPropertyIsSelected()AsBoolean
  18. Get
  19. Returnm_IsSelected
  20. EndGet
  21. EndProperty
  22. PublicSubNew()
  23. InitializeComponent()
  24. m_ClipWidth=(Me.Width-4)/7
  25. m_ClipTop=2+DatePanl.Height
  26. m_Date=Now.Date
  27. Format.Alignment=StringAlignment.Center
  28. EndSub
  29. PublicPropertyDateValue()AsDate'返回日期以供其他程序使用
  30. Get
  31. Returnm_Date
  32. EndGet
  33. Set(ByValvalueAsDate)
  34. Ifvalue>=MinDateAndAlsovalue<=MaxDateThen
  35. m_Date=value
  36. Me.Invalidate()
  37. EndIf
  38. EndSet
  39. EndProperty
  40. PrivateSubCalendar_Load(ByValsenderAsObject,ByValeAsSystem.EventArgs)HandlesMe.Load
  41. Label3.Text=@H_636_404@"今天:"&Now.ToShortDateString
  42. Label3.Left=(Me.Width-Label3.Width)/2
  43. EndSub
  44. PrivateSubAddBtn_Click(ByValsenderAsSystem.Object,ByValeAsSystem.Windows.Forms.MouseEventArgs)HandlesMonthAddbtn.MouseClick,MonthSubbtn.MouseClick,YearAddBtn.MouseClick,YearSubBtn.MouseClick'几个按钮会产生相同的效果所以放在一个代码
  45. Ife.Button=Windows.Forms.MouseButtons.LeftThen
  46. DatePanl.Focus()
  47. DimTAsButton=CType(sender,Button)
  48. SelectCaseT.Name
  49. Case@H_636_404@"MonthAddbtn"
  50. m_Date=Me.DateValue.AddMonths(1)
  51. Case@H_636_404@"MonthSubbtn"
  52. m_Date=Me.DateValue.AddMonths(-1)
  53. Case@H_636_404@"YearAddBtn"
  54. m_Date=Me.DateValue.AddYears(1)
  55. Case@H_636_404@"YearSubBtn"
  56. m_Date=Me.DateValue.AddYears(-1)
  57. EndSelect
  58. Ifm_Date>=MinDateAndAlsom_Date<=MaxDateThen'保证设置的日期是在可选范围之内
  59. m_IsSelected=False
  60. RaiseEventDateChanged(Me,Nothing)
  61. Me.Invalidate()
  62. ElseIfm_Date<MinDateThen
  63. m_Date=CDate(@H_636_404@"1900-1-"&m_Date.Day)
  64. Else
  65. m_Date=CDate(@H_636_404@"2100-12-"&m_Date.Day)
  66. EndIf
  67. EndIf
  68. EndSub
  69. PrivateSubDrawWeek(ByValGraphicsAsGraphics)'绘制星期
  70. Fori=0To6
  71. Rect=NewRectangleF(2+i*m_ClipWidth,m_ClipTop+2,m_ClipWidth,Me.Font.Height+2)
  72. Graphics.DrawString(m_Week(i),Font,Brushes.RoyalBlue,Rect)
  73. Next
  74. Graphics.DrawLine(Pens.Gray,2,m_ClipTop+Font.Height+2,Me.Width-6,m_ClipTop+Font.Height+2)'绘制星期下面的横线
  75. Graphics.DrawRectangle(Pens.RoyalBlue,40,Me.Height-Font.Height,m_ClipWidth-1,Font.Height-1)
  76. 'Graphics.Dispose()
  77. EndSub
  78. PrivateSubDrawDate(ByValGraphicsAsGraphics)'绘制日历
  79. DimMaxDaysAsInteger=Date.DaysInMonth(m_Date.Year,m_Date.Month)'由于整个主体被分成*7个格子,因此会有上个月和下个月的日期在里面,因此需要得到上个月的天数
  80. DimMindays=Date.DaysInMonth(m_Date.AddMonths(-1).Year,m_Date.AddMonths(-1).Month)
  81. StartDay=CDate(m_Date.Year&@H_636_404@"-"&m_Date.Month&@H_636_404@"-1").DayOfWeek-1'由每个月的一号定位为星期几
  82. DimDateStringAsInteger
  83. Fori=0To6
  84. Forj=0To5
  85. WithRect
  86. .X=2+i*m_ClipWidth
  87. .Y=m_ClipTop+j*Font.Height+Font.Height+8
  88. .Width=m_ClipWidth
  89. .Height=Font.Height
  90. EndWith
  91. DateString=(i+j*7-StartDay)
  92. IfDateString<=0Then
  93. Graphics.DrawString(DateString+Mindays,Brushes.Gray,Rect,Format)
  94. ElseIfDateString>0AndAlsoDateString<=MaxDaysThen'绘制上个月的本月的以及下个月的日期
  95. IfDateString=m_Date.DayThen
  96. Graphics.FillRectangle(Brushes.Silver,Rect.X-1,Rect.Y-1,Rect.Width,Rect.Height)
  97. EndIf
  98. IfDateString=Now.DayAndAlsom_Date.Month=Now.MonthAndAlsom_Date.Year=Now.YearThen
  99. Graphics.DrawRectangle(Pens.RoyalBlue,Rect.Width-1,Rect.Height-1)
  100. EndIf
  101. Graphics.DrawString(DateString,Brushes.Black,Format)
  102. ElseIfDateString>MaxDaysAndAlsoDateString<=42Then
  103. Graphics.DrawString(DateString-MaxDays,Format)
  104. EndIf
  105. Next
  106. Next
  107. EndSub
  108. PrivateSubCalendar_MouseClick(ByValsenderAsObject,ByValeAsSystem.Windows.Forms.MouseEventArgs)HandlesMe.MouseDown'通过边界检查获取点击时候所处的位置以计算为日期
  109. DimxAsInteger=e.X
  110. DimyAsInteger=e.Y
  111. DimDateStringAsInteger
  112. DimPenAsNewPen(Color.Gray)
  113. Pen.DashStyle=DashStyle.Dot
  114. DimMaxDaysAsInteger=Date.DaysInMonth(m_Date.Year,m_Date.Month)
  115. DimMindays=Date.DaysInMonth(m_Date.AddMonths(-1).Year,m_Date.AddMonths(-1).Month)
  116. m_IsSelected=False
  117. Ife.Button=Windows.Forms.MouseButtons.LeftThen
  118. Fori=0To6
  119. Forj=0To5
  120. DateString=(i+j*7-StartDay)
  121. WithRect
  122. .X=2+i*m_ClipWidth
  123. .Y=m_ClipTop+(j+1)*Font.Height+8
  124. .Width=m_ClipWidth
  125. .Height=Font.Height
  126. EndWith
  127. Ifx>=Rect.X-1AndAlsox<=Rect.RightAndAlsoy>Rect.Y-1AndAlsoy<=Rect.BottomThen'计算格子的范围使鼠标在可选范围内
  128. IfDateString<=0Then'根据选取不同的月份计算出当时点击时的正确日期,所计算的日期要在整个可选的范围内
  129. IfCDate(m_Date.AddMonths(-1).Year&@H_636_404@"-"&m_Date.AddMonths(-1).Month&@H_636_404@"-"&DateString+Mindays)>=MinDateThen
  130. m_Date=CDate(m_Date.AddMonths(-1).Year&@H_636_404@"-"&m_Date.AddMonths(-1).Month&@H_636_404@"-"&DateString+Mindays)
  131. m_IsSelected=True
  132. EndIf
  133. ElseIfDateString>0AndAlsoDateString<=MaxDaysThen
  134. m_Date=CDate(m_Date.Year&@H_636_404@"-"&m_Date.Month&@H_636_404@"-"&DateString)
  135. m_IsSelected=True
  136. ElseIfDateString>MaxDaysAndAlsoDateString<=42Then
  137. IfCDate(m_Date.AddMonths(1).Year&@H_636_404@"-"&m_Date.AddMonths(1).Month&@H_636_404@"-"&DateString-MaxDays)<=MaxDateThen
  138. m_Date=CDate(m_Date.AddMonths(1).Year&@H_636_404@"-"&m_Date.AddMonths(1).Month&@H_636_404@"-"&DateString-MaxDays)
  139. m_IsSelected=True
  140. EndIf
  141. EndIf
  142. Me.CreateGraphics.DrawRectangle(Pen,Rect.Height-1)
  143. RaiseEventDateChanged(Me,Nothing)'触发日期改变的事件
  144. Me.Invalidate()
  145. EndIf
  146. Next
  147. Next
  148. Pen.Dispose()
  149. EndIf
  150. EndSub
  151. PrivateSubCalendar_Paint(ByValsenderAsObject,ByValeAsSystem.Windows.Forms.PaintEventArgs)HandlesMe.Paint
  152. DrawWeek(e.Graphics)
  153. DrawDate(e.Graphics)
  154. MonthLbl.Text=m_Date.Month&@H_636_404@"月"
  155. Yearlbl.Text=m_Date.Year&@H_636_404@"年"
  156. EndSub
  157. PrivateSubLabel3_Click(ByValsenderAsObject,ByValeAsSystem.EventArgs)HandlesLabel3.Click'转到今天
  158. m_Date=Now
  159. Me.m_IsSelected=True
  160. RaiseEventDateChanged(Me,Nothing)
  161. Me.Invalidate()
  162. EndSub
  163. PrivateSubLabel3_MouseEnter(ByValsenderAsObject,ByValeAsSystem.EventArgs)HandlesLabel3.MouseEnter
  164. Label3.Cursor=Cursors.Hand
  165. EndSub
  166. PrivateSubLabel3_MouseLeave(ByValsenderAsObject,ByValeAsSystem.EventArgs)HandlesLabel3.MouseLeave
  167. Label3.Cursor=Cursors.Default
  168. EndSub
  169. PrivateSubCalendar_Resize(ByValsenderAsObject,ByValeAsSystem.EventArgs)HandlesMe.Resize'固定整个控件的大小
  170. Me.Size=NewSize(298,150)
  171. EndSub
  172. EndClass

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

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

  1. ImportsCalendar
  2. PublicClassDatePicker
  3. InheritsComboBox
  4. PrivateWithEventsCalendarAsCalendar
  5. PrivateDateToolAsToolStripDropDown
  6. PrivateConstWM_LBUTTONDOWN=
  7. PrivateConstWM_LBUTTONDBLCLK=
  8. PublicSubNew()
  9. InitTool()
  10. EndSub
  11. PublicPropertyValue()AsDate
  12. Get
  13. ReturnCalendar.DateValue
  14. EndGet
  15. Set(ByValvalueAsDate)
  16. IfDate.TryParse(value,Calendar.DateValue)=TrueThen
  17. Me.Text=value.ToLongDateString
  18. EndIf
  19. EndSet
  20. EndProperty
  21. ProtectedOverridesSubWndProc(ByRefmAsSystem.Windows.Forms.Message)'截获鼠标左键点击的消息以显示包装的日历主体
  22. Ifm.Msg=WM_LBUTTONDOWNOrElsem.Msg=WM_LBUTTONDBLCLKThen
  23. ShowDrop()
  24. Me.Focus()
  25. Return
  26. EndIf
  27. MyBase.WndProc(m)
  28. EndSub
  29. PrivateSubInitTool()
  30. Calendar=NewCalendar
  31. DimToolHostAsNewToolStripControlHost(Calendar)
  32. DateTool=NewToolStripDropDown
  33. DateTool.Items.Add(ToolHost)
  34. EndSub
  35. PrivateSubShowDrop()
  36. IfDate.TryParse(Me.Text,Calendar.DateValue)=TrueThen
  37. DateTool.Show(Me,Me.Height)
  38. EndIf
  39. EndSub
  40. PrivateSubCalendar_DateChanged(ByValSenderAsObject,ByValeAsSystem.EventArgs)HandlesCalendar.DateChanged
  41. IfCalendar.IsSelected=TrueThen
  42. Threading.Thread.Sleep(100)
  43. DateTool.Hide()
  44. EndIf
  45. Me.Text=Calendar.DateValue.ToLongDateString
  46. EndSub
  47. EndClass

最后进行测试

测试代码如下:

  1. PrivateSubForm1_Load(ByValsenderAsObject,ByValeAsSystem.EventArgs)HandlesMe.Load
  2. DatePicker1.Text=Now.ToLongDateString
  3. EndSub

运行效果如下图

猜你在找的VB相关文章