enterpro.bas

来自「一个用VB6.0开发的简单餐会管理系统。在WIN2K」· BAS 代码 · 共 107 行

Attribute VB_Name = "EnterPro"



'''''''''''''''''''''''''''
'''''''''输入数字
Public Function TextNumEnterKey(KeyAscii As Integer, Optional str As String = "", Optional nLen As Integer = 2) As Integer
    If KeyAscii <> 8 And KeyAscii <> 13 Then
        If KeyAscii < Asc("0") Or KeyAscii > Asc("9") Then
            TextNumEnterKey = 0   '取消字符。
            Exit Function
        End If
        If str <> "" Then
            If Len(str) >= nLen Then
                TextNumEnterKey = 0   '取消字符。
                Exit Function
            End If
        Else
            If KeyAscii = Asc("0") Or KeyAscii = Asc(".") Then
                TextNumEnterKey = 0
                Exit Function
            End If
        End If
    End If
    TextNumEnterKey = KeyAscii
    
End Function

Public Function TextEnterLen(str As String, Optional nLen As Integer = 2)
If Len(str) >= nLen Then
TextEnterLen = False
Else
TextEnterLen = True
End If
End Function


''''''''''''''''''''''''''''''
''''''''输入金额
Public Function EnterNumValue(KeyAscii As Integer, Optional str As String = "", Optional nLen As Integer, Optional nLOFF As Integer) As Integer
        If (Left(Right(str, nLOFF + 1), 1) = ".") Then
            EnterNumValue = TextNumEnterKey(KeyAscii, str, nLen)
        ElseIf KeyAscii <> Asc(".") Then
            If InStr(1, str, ".") = 0 And Len(str) < nLen - 3 Then
            EnterNumValue = TextNumEnterKey(KeyAscii, str, nLen)
            ElseIf InStr(1, str, ".") <> 0 Or KeyAscii = 8 Then
            EnterNumValue = TextNumEnterKey(KeyAscii, str, nLen)
            End If
        ElseIf str = "" Then
            EnterNumValue = 0
        Else
            EnterNumValue = KeyAscii
        End If
 
End Function



Public Function FixTextLen(strLen As String, strName As String, nLen As Integer)
If Len(strLen) > nLen Then
    MsgBox strName & "字数不能大于 " & nLen & "！"
    strLen = Left(strLen, nLen)
End If
FixTextLen = strLen
End Function


Public Function SetCheckValue(flag As Boolean) As Integer
If flag Then
    SetCheckValue = Checked
Else
    SetCheckValue = Unchecked
End If
End Function


''''''''''''''''''''''''''''''''
'''延时函数
Public Function WaitDelay(nTime As Integer)
Dim nS1, nS2 As Single
nS1 = Timer
nS2 = Timer
Do While nS2 - nS1 < nTime
nS2 = Timer
Loop
End Function


Public Function MSFLXMoveDataRec(da As Recordset, msfx As MSFlexGrid)
    With da
        If .RecordCount <> 0 Then
            .MoveFirst
            If .NoMatch = False Then
                MSFLXMoveDataRec = True
            Else
                MSFLXMoveDataRec = False
                MsgBox "没有记录"
                Exit Function
            End If
        Else
            MSFLXMoveDataRec = False
            MsgBox "没有记录"
            Exit Function
        End If
    End With
End Function