VB自定义日期控件的笔记

1，

 

Select Case Month(dates) '得到各月份天数 Case 1, 3, 5, 7, 8, 10, 12 r = 31 Case 4, 6, 9, 11 r = 30 Case 2 If Year(dates) Mod 4 = 0 And Year(dates) Mod 100 <> 0 Or Year(dates) Mod 400 = 0 Then r = 29 Else '闰年判断，是闰年则2月份为29天，否则28 r = 28 End If End Select

 

2，

 

  '星期判断，确定日历布局 ty3 = Weekday(CDate(Format(dates, "YYYY-MM"))) '本周第几天，(第一天为周日) For I = 1 To r If I < 10 Then Label7(I + ty3 - 1) = "0" & I Else Label7(I + ty3 - 1) = I End If '刷新当日的label颜色并将过期日期颜色设为不可用 If dates < Date Then Label7(I + ty3 - 1).ForeColor = &H80000011 Else If Month(dates) = Month(Date) And I < Day(dates) Then Label7(I + ty3 - 1).ForeColor = &H80000011 End If If dates = Date And I = Day(dates) Then Label7(I + ty3 - 1).ForeColor = &HFF& Next I

 

3，

 

   '初始化日期控件信息 '还原日期 For I = 1 To 42 Label7(I).Caption = "" Label7(I).ForeColor = &H80000012 Next I Select Case Month(Date) Case 1 Combo4.Text = "一月" r = 31 Case 2 Combo4.Text = "二月" '闰年判断，是闰年则2月份为29天，否则28 If Year(Date) Mod 4 = 0 And Year(Date) Mod 100 <> 0 Or Year(Date) Mod 400 = 0 Then r = 29 Else r = 28 End If Case 3 Combo4.Text = "三月" r = 31 Case 4 Combo4.Text = "四月" r = 30 Case 5 Combo4.Text = "五月" r = 31 Case 6 Combo4.Text = "六月" r = 30 Case 7 Combo4.Text = "七月" r = 31 Case 8 Combo4.Text = "八月" r = 31 Case 9 Combo4.Text = "九月" r = 30 Case 10 Combo4.Text = "十月" r = 31 Case 11 Combo4.Text = "十一月" r = 30 Case 12 Combo4.Text = "十二月" r = 31 End Select

 

4，

 

总结：

 

初始化6*7的二维数组，确定当前月的天数和当月1号的星期，可用循环来实现，同时标注颜色，如过期灰色，当日红色等。label点击事件前判断颜色，过期则不可用。

 

代码总结与记录，仅供个人参考，未优化，效率低下是目前主要的问题。