mdlmain.bas

此为水费收费管理系统

    Next i
    Pwd_Len = PwdLenToInt(Left(TempPwd, 1))
    Pwd = Mid(TempPwd, 2, Pwd_Len)
    ReductionPwd = Pwd
End Function

Public Function PwdLenToInt(PwdLen As String) As Integer
    Select Case PwdLen
        Case "0"
            PwdLenToInt = 0
        Case "1"
            PwdLenToInt = 1
        Case "2"
            PwdLenToInt = 2
        Case "3"
            PwdLenToInt = 3
        Case "4"
            PwdLenToInt = 4
        Case "5"
            PwdLenToInt = 5
        Case "6"
            PwdLenToInt = 6
        Case "7"
            PwdLenToInt = 7
        Case "8"
            PwdLenToInt = 8
        Case "9"
            PwdLenToInt = 9
        Case "A"
            PwdLenToInt = 10
        Case "B"
            PwdLenToInt = 11
        Case "C"
            PwdLenToInt = 12
        Case "D"
            PwdLenToInt = 13
        Case "E"
            PwdLenToInt = 14
        Case "F"
            PwdLenToInt = 15
        Case "G"
            PwdLenToInt = 16
        Case "H"
            PwdLenToInt = 17
        Case "I"
            PwdLenToInt = 18
        Case "J"
            PwdLenToInt = 19
        Case "K"
            PwdLenToInt = 20
    End Select
End Function

Public Function PwdLenToString(PwdLen As Integer) As String
    Select Case PwdLen
        Case 0
            PwdLenToString = "0"
        Case 1
            PwdLenToString = "1"
        Case 2
            PwdLenToString = "2"
        Case 3
            PwdLenToString = "3"
        Case 4
            PwdLenToString = "4"
        Case 5
            PwdLenToString = "5"
        Case 6
            PwdLenToString = "6"
        Case 7
            PwdLenToString = "7"
        Case 8
            PwdLenToString = "8"
        Case 9
            PwdLenToString = "9"
        Case 10
            PwdLenToString = "A"
        Case 11
            PwdLenToString = "B"
        Case 12
            PwdLenToString = "C"
        Case 13
            PwdLenToString = "D"
        Case 14
            PwdLenToString = "E"
        Case 15
            PwdLenToString = "F"
        Case 16
            PwdLenToString = "G"
        Case 17
            PwdLenToString = "H"
        Case 18
            PwdLenToString = "I"
        Case 19
            PwdLenToString = "J"
        Case 20
            PwdLenToString = "K"
    End Select
End Function

'将货币转化成字符串，并返回给调用的地方
'=================================================================================================================================
Public Function ChangeMoneyToText(NumMoney As Double) As String
    If NumMoney = 0 Then
        ChangeMoneyToText = "零元整"
        Exit Function
    End If
    Dim i As Integer
    Dim Fh As String
    Dim StrMoney_L As String
    Dim StrMoney_R As String
    Dim NewMoney As String
    Fh = ""
    NewMoney = Trim(Str(NumMoney))
    If Left(NewMoney, 1) = "-" Then
        Fh = "负 "
        NewMoney = Right(NewMoney, Len(NewMoney) - 1)
    End If
    StrMoney_L = IIf(InStr(NewMoney, ".") = 0, NewMoney, Left(NewMoney, InStr(NewMoney, ".")))
    If InStr(StrMoney_L, ".") <> 0 Then
        StrMoney_L = Left(StrMoney_L, InStr(StrMoney_L, ".") - 1)
    End If
    If Len(StrMoney_L) > 12 Then
        MsgBox "金额超出运算范围，请重新检查！！", vbOKOnly + vbExclamation, "校验出错"
        ChangeMoneyToText = 0
        Exit Function
    End If
    StrMoney_R = IIf(InStr(NewMoney, ".") = 0, "", Right(NewMoney, Len(NewMoney) - InStr(NewMoney, ".")))
    If Len(StrMoney_R) > 2 Then
        StrMoney_R = Left(StrMoney_R, 2)
    End If
    NewMoney = ""
    For i = Len(StrMoney_L) To 1 Step -1
        Select Case Len(StrMoney_L) - i + 1
            Case 1
                NewMoney = NumToText(Mid(StrMoney_L, i, 1)) & "元" & NewMoney
            Case 2
                NewMoney = NumToText(Mid(StrMoney_L, i, 1)) & "拾" & NewMoney
            Case 3
                NewMoney = NumToText(Mid(StrMoney_L, i, 1)) & "佰" & NewMoney
            Case 4
                NewMoney = NumToText(Mid(StrMoney_L, i, 1)) & "仟" & NewMoney
            Case 5
                NewMoney = NumToText(Mid(StrMoney_L, i, 1)) & "万" & NewMoney
            Case 6
                NewMoney = NumToText(Mid(StrMoney_L, i, 1)) & "拾" & NewMoney
            Case 7
                NewMoney = NumToText(Mid(StrMoney_L, i, 1)) & "佰" & NewMoney
            Case 8
                NewMoney = NumToText(Mid(StrMoney_L, i, 1)) & "仟" & NewMoney
            Case 9
                NewMoney = NumToText(Mid(StrMoney_L, i, 1)) & "亿" & NewMoney
            Case 10
                NewMoney = NumToText(Mid(StrMoney_L, i, 1)) & "拾" & NewMoney
            Case 11
                NewMoney = NumToText(Mid(StrMoney_L, i, 1)) & "佰" & NewMoney
            Case 12
                NewMoney = NumToText(Mid(StrMoney_L, i, 1)) & "仟" & NewMoney
        End Select
    Next i
    For i = 1 To Len(StrMoney_R)
        Select Case i
            Case 1
                NewMoney = NewMoney & NumToText(Mid(StrMoney_R, i, 1)) & "角"
            Case 2
                NewMoney = NewMoney & NumToText(Mid(StrMoney_R, i, 1)) & "分"
        End Select
    Next i
    
    ChangeMoneyToText = Fh & NewMoney & "整"
End Function

Private Function NumToText(InNumber As Integer) As String
     Select Case InNumber
        Case "1"
            NumToText = "壹"
        Case "2"
            NumToText = "贰"
        Case "3"
            NumToText = "叁"
        Case "4"
            NumToText = "肆"
        Case "5"
            NumToText = "伍"
        Case "6"
            NumToText = "陆"
        Case "7"
            NumToText = "柒"
        Case "8"
            NumToText = "捌"
        Case "9"
            NumToText = "玖"
        Case "0"
            NumToText = "零"
     End Select
End Function
'=================================================================================================================================