不用日期控件的智能日期输入法

作者：林永华
地址：福建省莆田县农业银行电脑中心 351100 tel:0594-2298794  E-mail:ptnh.lyh@163.com


本人在编程过程中，常遇到要编写记载日期信息的功能程序，为此，我曾经也下载选用了一些日期控件，但都觉得不好用（比如：不能随意改变大小、或它是按月递变等等，不信你自己去体验吧）。就连Ｗindows98中查找功能的日期选项卡中的那个日期控件（在VB6部件中的MicrosoftWindows Common Controls-2 6.0中也有DTPicker控件 ）我也觉得不是很好用，因为它是按月递变等等。鉴于这些，我还是钟情于VB自带的标准文本框控件，因为它可以随意改变框的大小（包括显示区文本的大小）、颜色、字体。所以，我就编写了以下的那段程序，用以进行日期型信息录入。“优点”如下：  

1、在文本框中只接受“0-9”这10字符。而且年月日分隔符会自动生成。  

2、VB的年份为100-9999，本人限在1000-2999，不够用吗？如果真得不够用，你可以自己改造加以控制。或许你会问：为什么年份不用两位数来表示？  

我的观点：  

1、两位数的年份格式不直观。   

2、如果碰到要记载出生年月日信息时，很可能会很难办。  

3、月份只能从01-12，而且，当输入3-9时，系统会自动默认为03-09。  

4、日期如果输入4-9时系统也会自动默认为04-09。还有：  

A：当月份为1、3、5、7、8、10、12时，日期不能超过31  

B：当月份为4、6、9、11时，日期不能超过30  

C：当月份为2时且为闰年时，日期不能超过29  

D：当月份为2时且为非闰年，日期不能超过28  

有了以上的“优点”，只要输入年月日完毕，就会确保它是一个合法的日期表达式。朋友，赶快把下面那段程序粘贴到VB工程中（当然，你也许要改变Text1为其它的文本框编号如：Text3）去试一下吧，相信，你会立即爱上她，直到永远......  

Private Sub Text1_Change()  

Dim a, b, c As String
'---------------------------------------------------------------------------
'年份输入的控制
'---------------------------------------------------------------------------
'限制第一位必须为"1"或"2" ，也就说年份必须在1000-2999之间，够用吧！  

If Len(Text1.Text) = 1 Then  

If Left((Text1.Text), 1) <> "1" And Left((Text1.Text), 1) <> "2" Then  

Text1.Text = ""  

End If  

End If
'限制第二、三、四位必须为“1、2、3、4、5、6、7、8、9、0”  

If Len(Text1.Text) = 2 Or Len(Text1.Text) = 3 Or Len(Text1.Text) = 4 Then  

If Right((Text1.Text), 1) <> "0" And Right((Text1.Text), 1) <> "1" And _  

Right((Text1.Text), 1) <> "2" And Right((Text1.Text), 1) <> "3" And _  

Right((Text1.Text), 1) <> "4" And Right((Text1.Text), 1) <> "5" And _  

Right((Text1.Text), 1) <> "6" And Right((Text1.Text), 1) <> "7" And _  

Right((Text1.Text), 1) <> "8" And Right((Text1.Text), 1) <> "9" Then  

Text1.Text = Left((Text1.Text), Len(Text1.Text) - 1)  

Text1.SelStart = Len(Text1.Text)  

End If  

End If  

If Len(Text1.Text) = 4 Then  

Text1.Text = Text1.Text + "-"  

Text1.SelStart = Len(Text1.Text)  

End If '当年份正确输入后就自动加上的“-”分隔符
'---------------------------------------------------------------------------
'月份输入的控制
'---------------------------------------------------------------------------  

If Len(Text1.Text) = 6 Then  

If Right((Text1.Text), 1) <> "0" And Right((Text1.Text), 1) <> "1" Then  

If Right((Text1.Text), 1) = "2" Or Right((Text1.Text), 1) = "3" Or _  

Right((Text1.Text), 1) = "4" Or Right((Text1.Text), 1) = "5" Or _  

Right((Text1.Text), 1) = "6" Or Right((Text1.Text), 1) = "7" Or _  

Right((Text1.Text), 1) = "8" Or Right((Text1.Text), 1) = "9" Then  

a = Right((Text1.Text), 1)  

Text1.Text = Left((Text1.Text), 5) + "0" + a + "-"  

'如果这样，那下面一段if len(text1.text)=7的判断自然就自动跳过去了。  

Text1.SelStart = Len(Text1.Text)  

Else '限制只能输入“0-9”  

Text1.Text = Left((Text1.Text), Len(Text1.Text) - 1)  

Text1.SelStart = Len(Text1.Text)  

End If  

End If  

End If  

If Len(Text1.Text) = 7 Then  

If Left(Right(Text1.Text, 2), 1) = "0" Then '如果月份第一位为“0”  

If Right((Text1.Text), 1) <> "1" And Right((Text1.Text), 1) <> "2" And _  

Right((Text1.Text), 1) <> "3" And Right((Text1.Text), 1) <> "4" And _  

Right((Text1.Text), 1) <> "5" And Right((Text1.Text), 1) <> "6" And _  

Right((Text1.Text), 1) <> "7" And Right((Text1.Text), 1) <> "8" And _  

Right((Text1.Text), 1) <> "9" Then  

Text1.Text = Left((Text1.Text), Len(Text1.Text) - 1)  

Text1.SelStart = Len(Text1.Text)  

Else  

Text1.Text = Text1.Text + "-" '当月份输入正确后自动加一个“-”分隔符  

Text1.SelStart = Len(Text1.Text)  

Exit Sub '少不了！如果少，那当月份为“01”时，紧接的If...End IF就  

'成立，这样会在这里出现死循环，而出现溢出堆栈空间的错误！
'注：本程序好几个地方都可以用上Exit Sub，要加你自己补上吧！  

End If  

End If  

If Left(Right((Text1.Text), 2), 1) = "1" Then '如果月份第一位为“1”  

If Right((Text1.Text), 1) <> "0" And Right((Text1.Text), 1) <> "1" And _  

Right((Text1.Text), 1) <> "2" Then  

Text1.Text = Left((Text1.Text), Len(Text1.Text) - 1)  

Text1.SelStart = Len(Text1.Text)  

Else  

Text1.Text = Text1.Text + "-" '当月份输入正确后自动加一个“-”分隔符  

Text1.SelStart = Len(Text1.Text)  

End If  

End If  

End If
'---------------------------------------------------------------------------
'日期输入的控制。
'---------------------------------------------------------------------------  

If Len(Text1.Text) = 9 Then  

If Right((Text1.Text), 1) <> "0" And Right((Text1.Text), 1) <> "1" And _  

Right((Text1.Text), 1) <> "2" And Right((Text1.Text), 1) <> "3" Then
If Right((Text1.Text), 1) = "4" Or Right((Text1.Text), 1) = "5" Or _
Right((Text1.Text), 1) = "6" Or Right((Text1.Text), 1) = "7" Or _
Right((Text1.Text), 1) = "8" Or Right((Text1.Text), 1) = "9" Then
a = Right((Text1.Text), 1)
Text1.Text = Left((Text1.Text), 8) + "0" + a
Text1.SelStart = Len(Text1.Text)
'Exit Sub
'日期小于10时下面字符长度为10的判断当然是正确的。让它执行又如何？
Else
Text1.Text = Left((Text1.Text), Len(Text1.Text) - 1)
Text1.SelStart = Len(Text1.Text)
End If
End If
End If
'当要修改日期的最后一位时的控制。
If Len(Text1.Text) = 10 Then
b = Left(Right(Text1.Text, 5), 2) '取月份值，用于下面的日期正确性判断！
c = Left(Text1.Text, 4) '取年份值，用于下面的日期正确性判断！
If Right((Text1.Text), 1) <> "0" And Right((Text1.Text), 1) <> "1" And _
Right((Text1.Text), 1) <> "2" And Right((Text1.Text), 1) <> "3" And _
Right((Text1.Text), 1) <> "4" And Right((Text1.Text), 1) <> "5" And _
Right((Text1.Text), 1) <> "6" And Right((Text1.Text), 1) <> "7" And _
Right((Text1.Text), 1) <> "8" And Right((Text1.Text), 1) <> "9" Then
Text1.Text = Left((Text1.Text), Len(Text1.Text) - 1)
Text1.SelStart = Len(Text1.Text)
End If '限制非法字符的输入。
If Right(Text1.Text, 2) = "00" Then
Text1.Text = Left((Text1.Text), Len(Text1.Text) - 2)
Text1.SelStart = Len(Text1.Text)
End If '限制日期不能为0
If (b = "01" And Val(Right(Text1.Text, 2)) > 31) Or _
(b = "03" And Val(Right(Text1.Text, 2)) > 31) Or _
(b = "05" And Val(Right(Text1.Text, 2)) > 31) Or _
(b = "07" And Val(Right(Text1.Text, 2)) > 31) Or _
(b = "08" And Val(Right(Text1.Text, 2)) > 31) Or _
(b = "10" And Val(Right(Text1.Text, 2)) > 31) Or _
(b = "12" And Val(Right(Text1.Text, 2)) > 31) Then
Text1.Text = Left((Text1.Text), Len(Text1.Text) - 2)
Text1.SelStart = Len(Text1.Text)
End If '当月份为大月份时日期不能大于31。
If (b = "04" And Val(Right(Text1.Text, 2)) > 30) Or _
(b = "06" And Val(Right(Text1.Text, 2)) > 30) Or _
(b = "09" And Val(Right(Text1.Text, 2)) > 30) Or _
(b = "11" And Val(Right(Text1.Text, 2)) > 30) Then
Text1.Text = Left((Text1.Text), Len(Text1.Text) - 2)
Text1.SelStart = Len(Text1.Text)
End If '当月份为小月份时日期不能大于30。
If b = "02" Then
If Val(c) Mod 4 <> 0 And Val(Right(Text1.Text, 2)) > 28 Then
Text1.Text = Left((Text1.Text), Len(Text1.Text) - 2)
Text1.SelStart = Len(Text1.Text)
End If '非闰年日期不得超过28。
If Val(c) Mod 4 = 0 And Val(Right(Text1.Text, 2)) > 29 Then
Text1.Text = Left((Text1.Text), Len(Text1.Text) - 2)
Text1.SelStart = Len(Text1.Text)
End If '闰年日期不得超过29。
End If '当月份为2时的日期正确性判断！
End If
'---------------------------------------------------------------------------
'当年月日输入后就不再接受其它字符了。方法如下：
'---------------------------------------------------------------------------
'第一种方法：
'在Text1的属性窗口中设Maxlength=10
'第二种方法：
'Text2.Setfocus 即在适当的地方设一个跳转语句使下一个对象得到焦点。
'第三种方法：
If Len(Text1.Text) = 11 Then
Text1.Text = Left((Text1.Text), Len(Text1.Text) - 1)
Text1.SelStart = Len(Text1.Text)
End If
End Sub

原文转自：http://www.ltesting.net