【vb精品源码栏目提醒】:网学会员--在 vb精品源码编辑为广大网友搜集整理了:【精品】VB对时间格式的精准判断(源码) - 其它资料绩等信息,祝愿广大网友取得需要的信息,参考学习。
VB 对时间格式的精准判断(
源码)Option Explicit验证数据的合法性Public Function DataCheckobj As Object dataType As String Optional minLength As Long 0Optional maxLength As Long 0 As Boolean Dim objName As String 将数据还原 DataCheck True objName TypeNameobj dataType ReplacedataType - - dataType ReplacedataType / - dataType ReplacedataType - dataType ReplacedataType . - If minLength 0 Then minLength 0 If maxLength 0 Then maxLength 0 TextBox If objName TextBox Or objName ComboBox Or objName RichTextBox Then 去掉两端空格 If objName textbox Or objName RichTextBox Then obj.Text Trimobj.Text “-”表示检测是否为空 If dataType - Then DataCheck checkTextEmptyobj: If Not DataCheck Then Exit Function End If “number”表示在不为空的情况下检测是否为数字 If dataType number Then If Trimobj.Text Then DataCheck checkTextNumberobj: If Not DataCheck Then Exit Function End If End If “-number”表示不允许为空,且只能输入数字 If dataType -number Then DataCheck checkTextEmptyobj: If Not DataCheck Then Exit Function DataCheck checkTextNumberobj: If Not DataCheck Then Exit FunctionEnd If“date”表示在不为空的情况下检测是否为日期(yyyy-mm-dd)If dataType date Then If Trimobj.Text Then DataCheck checkTextDateobj: If Not DataCheck Then Exit Function End IfEnd If“-date”表示不允许为空,且只能输入日期(yyyy-mm-dd)If dataType -date Then DataCheck checkTextEmptyobj: If Not DataCheck Then Exit Function DataCheck checkTextDateobj: If Not DataCheck Then Exit FunctionEnd If“time”表示在不为空的情况下检测是否为时间(hh:nn:ss)If dataType time Then If Trimobj.Text Then DataCheck checkTextTimeobj: If Not DataCheck Then Exit Function End IfEnd If“-time”表示不允许为空,且只能输入日期(hh:nn:ss)If dataType -time Then DataCheck checkTextEmptyobj: If Not DataCheck Then Exit Function DataCheck checkTextTimeobj: If Not DataCheck Then Exit FunctionEnd If“datetime”表示在不为空的情况下检测是否为日期+时间(yyyy-mm-dd hh:nn:ss)If dataType datetime Then If Trimobj.Text Then DataCheck checkTextDateTimeobj: If Not DataCheck Then Exit Function End IfEnd If“-datetime”表示不允许为空,且只能输入日期+时间(yyyy-mm-dd hh:nn:ss)If dataType -datetime Then DataCheck checkTextEmptyobj: If Not DataCheck Then Exit Function DataCheck checkTextDateTimeobj: If Not DataCheck Then Exit FunctionEnd IfIf obj.Text Then Dim objLen As Integer Dim loopNum As Long If minLength 0 Or maxLength 0 Then For loopNum 1 To Lenobj.Text If AscMidobj.Text loopNum 1 0 Then objLen objLen 2 Else objLen objLen 1 End If Next End If If minLength 0 Then If objLen minLength Then DataCheck False MsgBox 『 obj.Tag 』不能少于 minLength 个字半角算半个,全角算 1 个! vbOKOnly vbExclamation obj.Tag 错误 selectText obj 0 0 Exit Function End If End If If maxLength 0 Then If objLen maxLength Then DataCheck False MsgBox 『 obj.Tag 』不能多于 maxLength 个字半角算半个,全角算 1 个! vbOKOnly vbExclamation obj.Tag 错误 selectText obj 0 0 Exit Function End If End If End If End IfEnd Function选取文本,并获取焦点如果 beginPos 和 txtLength 均为 0,则表示全选Function selectTextobj As Object Optional beginPos As Long Optional txtLength As Long On Error Resume Next Dim selectLength As Long Dim selectStart As Long If IsMissingtxtLength Then selectLength Lenobj.Text Else If txtLength 0 Then selectLength 0 If txtLength 0 Then selectLength Lenobj.Text End If If IsMissingbeginPos Then selectStart 0 Else selectStart beginPos End If If TypeNameobj TextBox Then obj.SelStart selectStart obj.SelLength selectLength obj.SetFocus End If If pubTeacherId 8143 Then If Err.Number 0 Then MsgBox Err.Description vbOKOnly vbCritical SelectText End IfEnd FunctionFunction checkTextEmptyobj As Object As Boolean checkTextEmpty True If Trimobj.Text Then MsgBox 『 obj.Tag 』不能为空! vbOKOnly vbExclamation obj.Tag 错误 selectText obj 0 0 checkTextEmpty False End IfEnd FunctionFunction checkTextNumberobj As Object As Boolean checkTextNumber True 将全角数字切换成半角数字 obj.Text Replaceobj.Text 0 0 obj.Text Replaceobj.Text 1 1 obj.Text Replaceobj.Text 2 2 obj.Text Replaceobj.Text 3 3 obj.Text Replaceobj.Text 4 4 obj.Text Replaceobj.Text 5 5 obj.Text Replaceobj.Text 6 6 obj.Text Replaceobj.Text 7 7 obj.Text Replaceobj.Text 8 8 obj.Text Replaceobj.Text 9 9 If Not IsNumericobj.Text Then 『 MsgBox obj.Tag 』 只能输入数字! vbOKOnly vbExclamation obj.Tag 错误 selectText obj 0 0 checkTextNumber False Else 很奇怪,当数字中存在“”时居然仍然判断是数字,此处专门剔除逗号 obj.Text Replaceobj.Text , If Leftobj.Text 1 Or Rightobj.Text 1 Then MsgBox 『 obj.Tag 』只能输入数字! vbOKOnly vbExclamationobj.Tag 错误 selectText obj 0 0 checkTextNumber False End If End IfEnd FunctionFunction checkTextDateobj As Object As Boolean checkTextDate True 将全角数字切换成半角数字 obj.Text Replaceobj.Text 0 0 obj.Text Replaceobj.Text 1 1 obj.Text Replaceobj.Text 2 2 obj.Text Replaceobj.Text 3 3 obj.Text Replaceobj.Text 4 4 obj.Text Replaceobj.Text 5 5 obj.Text Replaceobj.Text 6 6 obj.Text Replaceobj.Text 7 7 obj.Text Replaceobj.Text 8 8 obj.Text Replaceobj.Text 9 9 obj.Text Replaceobj.Text - - obj.Text Replaceobj.Text : : If Not IsDateobj.Text Then 防止类似符号影响程序 MsgBox 『 obj.Tag 』中只能输入标准的日期格式,您输入的日期格式错误! vbCrLf vbCrLf 格式举例:2008-08-08 vbOKOnly vbExclamation obj.Tag 错误 selectText obj 0 0 checkTextDate False Else 防止出现时刻 If Lenobj.Text 8 Or Lenobj.Text 10 Or InStrobj.Text : 0 Then MsgBox 『 obj.Tag 』中只能输入标准的日期格式,您输入的日期格式错误! vbCrLf vbCrLf 格式举例: 2008-08-08 vbOKOnly vbExclamation obj.Tag 错误 selectText obj 0 0 checkTextDate False End If End IfEnd FunctionFunction checkTextTimeobj As Object As Boolean checkTextTime True 将全角数字切换成半角数字 obj.Text Replaceobj.Text 0 0 obj.Text Replaceobj.Text 1 1 obj.Text Replaceobj.Text 2 2 obj.Text Replaceobj.Text 3 3 obj.Text Replaceobj.Text 4 4 obj.Text Replaceobj.Text 5 5 obj.Text Replaceobj.Text 6 6 obj.Text Replaceobj.Text 7 7 obj.Text Replaceobj.Text 8 8 obj.Text Replaceobj.Text 9 9 obj.Text Replaceobj.Text - - obj.Text Replaceobj.Text : : If Not IsDateobj.Text Then 防止类似符号影响
程序 MsgBox 『 obj.Tag 』中只能输入标准的时间格式,您输入的时间格式错误! vbCrLf vbCrLf 格式举例:8:08 vbOKOnly vbExclamation obj.Tag 错误 selectText obj 0 0 checkTextTime False Else 防止出现日期 If Lenobj.Text 4 Or Lenobj.Text 8 Or InStrobj.Text - 0 Then MsgBox 『 obj.Tag 』中只能输入标准的时间格式,您输入的时间格式错误! vbCrLf vbCrLf 格式举例: 8:08 vbOKOnly vbExclamation obj.Tag 错误 selectText obj 0 0 checkTextTime False End If End IfEnd FunctionFunction checkTextDateTimeobj As Object As Boolean checkTextDateTime True 将全角数字切换成半角数字 obj.Text Replaceobj.Text 0 0 obj.Text Replaceobj.Text 1 1 obj.Text Replaceobj.Text 2 2 obj.Text Replaceobj.Text 3 3 obj.Text Replaceobj.Text 4 4 obj.Text Replaceobj.Text 5 5 obj.Text Replaceobj.Text 6 6 obj.Text Replaceobj.Text 7 7 obj.Text Replaceobj.Text 8 8 obj.Text Replaceobj.Text 9 9 obj.Text Replaceobj.Text - - obj.Text Replaceobj.Text : : obj.Text Replaceobj.Text Do While InStrobj.Text 0 obj.Text Replaceobj.Text Loop obj.Text Trimobj.Text If Not IsDateobj.Text Then 防止类似符号影响程序 MsgBox 『 obj.Tag 』中只能输入标准的时间格式,您输入的时间格式错误! vbCrLf vbCrLf 格式举例: 2008-08-08 8:08 vbOKOnly vbExclamation obj.Tag 错误 selectText obj 0 0 checkTextDateTime False Else 防止出现只有日期或只有时刻的情形 If Not InStrobj.Text - 0 And InStrobj.Text : 0 Then MsgBox 『 obj.Tag 』中只能输入标准的时间格式,您输入的时间格式错误! vbCrLf vbCrLf 格式举例:2008-08-08 8:08 vbOKOnly vbExclamationobj.Tag 错误 selectText obj 0 0 checkTextDateTime False End If End IfEnd Function