modvalidate.bas

VB6.0编写的医院影像系统

Attribute VB_Name = "modValidate"
Option Explicit


'-----------------------
'校验模块，现已不用
'-----------------------


Public gbValidate As Boolean    '是否自动约束

Public Function ValidateNullString(Ctl As Control, Optional Title As String = "提示") As Boolean

    '------------------------------------
    '验证控件输入值为有效字符串
    ',Ctr 为控件名,Title 为消息框的标题。
    '------------------------------------
    
    If Not gbValidate Then Exit Function
    
    Dim KeepFocus As Boolean
    Dim Ret As Integer
    
    KeepFocus = False
    
    With Ctl
        If Trim(.Text) = "" Then
            Ret = MsgBox("在前一个输入框中, 您应该输入一个非空的值, 要返回吗? ", vbYesNo + vbQuestion, Title)
            KeepFocus = (Ret = vbYes)
        End If
    End With
    
    ValidateNullString = KeepFocus

End Function



Public Function ValidatePositiveNum(Ctl As TextBox, Optional Title As String = "提示", Optional AllowNull As Boolean = True) As Boolean

    '-----------------------------------
    '验证控件输入值为正数,
    'Ctr 为控件名,Title 为消息框的标题。
    '-----------------------------------
    
    If Not gbValidate Then Exit Function

    Dim KeepFocus As Boolean
    
    KeepFocus = False
    
    With Ctl
        If .Text = "" Then
            If Not AllowNull Then
                MsgBox "请输入数值！", vbOKOnly + vbInformation, Title
                KeepFocus = True
            End If
        ElseIf Not IsNumeric(.Text) Then
            MsgBox "请输入数字！", vbOKOnly + vbInformation, Title
            KeepFocus = True
        ElseIf Val(.Text) <= 0 Then
            MsgBox "请输入正数！", vbOKOnly + vbInformation, Title
            KeepFocus = True
        End If
    End With
    
    ValidatePositiveNum = KeepFocus

End Function

Public Function ValidateDate(Ctl As TextBox, Optional Title As String = "提示", Optional AllowNull As Boolean = True) As Boolean

    '----------------------------
    '验证控件输入值为正数,
    'ctr 为控件名,title 为消息框的标题。
    '----------------------------

    If Not gbValidate Then Exit Function
    
    Dim KeepFocus As Boolean
    
    KeepFocus = False
    
    With Ctl
        If .Text = "" Then
            If Not AllowNull Then
                MsgBox "请输入日期！", vbOKOnly + vbInformation, Title
                KeepFocus = True
            End If
        ElseIf Not IsDate(.Text) Then
            KeepFocus = True
            MsgBox "请输入有效日期！", vbOKOnly + vbInformation, Title
        ElseIf CDate(.Text) > Date Then
            KeepFocus = True
            MsgBox "输入日期不能晚于当前日期！", vbOKOnly + vbInformation, Title
        End If
    End With
    
    ValidateDate = KeepFocus

End Function

Public Function SetDateSplit(str As String) As String
    
    '----------------------------------
    '将不带"-"的日期转换为带"-"的日期
    '----------------------------------
    
    If Not gbValidate Then SetDateSplit = str: Exit Function
    
    Dim DATE_SPLIT As String
    Dim l As Integer
    
    DATE_SPLIT = "-"
    l = Len(str)
    If l = 0 Then Exit Function
    If InStr(1, str, DATE_SPLIT) > 0 Then
        SetDateSplit = str
        Exit Function
    Else
        SetDateSplit = Left(str, l - 4) & DATE_SPLIT & Mid(str, l - 3, 2) & DATE_SPLIT & Right(str, 2)
    End If
    
End Function