modprint.bas

通用书店管理系统

Attribute VB_Name = "modPrint"
'从某字符串中找某关键字的值
'参数：
'           varOld      旧变量
'           strAim      目标对象
'           strSource   数据源
'返回值：
'           如果存在则获得新值，否则返回旧值；如果中途出错，则返回空
'作者：Activeer;创建时间：2002-04-28
'版本号：1.02;修改时间:2002-05-29;修改人：Activeer
'时间：2002-06-01  17：57
Public Function g_GetValueByString(varOld As Variant, ByVal strAim As String, ByVal strSource As String) As Variant
    On Error GoTo err
    
    Dim strOldSource$
    strOldSource = strSource
    strAim = UCase(Trim(strAim)) & "="
    strSource = UCase(strSource)
    
    Dim intCharAt%, intCharAtSign%, strTemp$
    Dim intCharAtQuotation_Bef%, intCharAtQuotation_Aft%
    Dim intCharAtEqual%
    
    intCharAt = InStr(1, " " & strSource, " " & strAim)
    If intCharAt = 0 Then g_GetValueByString = varOld: Exit Function
    
    intCharAtEqual = InStr(intCharAt, strSource, "=")
    If intCharAtEqual <> 0 Then
        If Mid(strSource, intCharAtEqual + 1, 1) = "'" Then
            intCharAtQuotation_Bef = intCharAtEqual + 1
            intCharAtQuotation_Aft = InStr(intCharAtQuotation_Bef + 1, strSource, "'")
        End If
    End If
    
    If intCharAtQuotation_Aft <> 0 Then
        intCharAtSign = InStr(intCharAtQuotation_Aft, strSource, " ")
    Else
        intCharAtSign = InStr(intCharAt, strSource, " ")
    End If
    
    If intCharAtSign = 0 Then
        strTemp = Mid(strOldSource, intCharAt)
    Else
        strTemp = Mid(strOldSource, intCharAt, intCharAtSign - intCharAt)
    End If
    
    strTemp = Trim(Mid(strTemp, InStr(1, strTemp, "=") + 1))
    strTemp = Replace(strTemp, "'", "")
    Select Case TypeName(varOld)
    Case "String"   '字符串
        g_GetValueByString = strTemp: Exit Function
    Case "Integer"  '整型
        g_GetValueByString = CInt(strTemp): Exit Function
    Case "Long"     '长整型
        g_GetValueByString = CLng(strTemp): Exit Function
    Case "Single"   '单精度
        g_GetValueByString = CSng(strTemp): Exit Function
    Case "Double"   '双精度
        g_GetValueByString = CDbl(strTemp): Exit Function
    Case "Boolean"  '布尔变量
        g_GetValueByString = CBool(strTemp): Exit Function
    '----------类型扩展
    End Select
        
    '如果无满足条件的返回NUll
        g_GetValueByString = Null
    Exit Function
err:
    MsgBox "获得变量值出错：" & err.Description, vbInformation, "获得变量", VbMsgInfoMortalError
    g_GetValueByString = Null
End Function


'/* ************************************************************
'**功能描述:'将小写金额转换成对应的大写金额，用于金额大写转换
'** 函数名:g_MoneyUp
'** 参数说明:转入要转换的小写金额
'** 输  出:对应的大写金额
'** 作  者:QSL
'[** 创建日期: 2002-05                 ]
'[** 修  改:                    ]
'[** 修改日期:                  ]
'[** 版本          1.0             ]
'*********************************************************/
Public Function g_MoneyUp(ByVal NN As String) As String
    Dim num As String
    Dim money1 As String
    Dim tn
    Dim k1 As String
    Dim k2 As String
    Dim k3 As String
    Dim k4 As String
    Dim st1 As String
    Dim t1 As String
    num = Val(Format(NN, "#0.00"))
    If num = 0 Then
        g_MoneyUp = "零元整"
        Exit Function
    End If
    If num < 0 Then
        g_MoneyUp = "负" + g_MoneyUp(Abs(num))
        Exit Function
    End If
    money1 = Trim(str(num))
    tn = InStr(money1, ".")  '小数位置
    k1 = ""
    If tn <> 0 Then
        st1 = Right(money1, Len(money1) - tn)
        If st1 <> "" Then
            t1 = Left(st1, 1)
            st1 = Right(st1, Len(st1) - 1)
            If t1 <> "0" Then
                k1 = k1 + g_TranANum(Val(t1)) + "角"
            End If
            If st1 <> "" Then
                t1 = Left(st1, 1)
                k1 = k1 + g_TranANum(t1) + "分"
            End If
        
        End If
        st1 = Left(money1, tn - 1)
        If InStr(k1, "角") = 0 And Val(st1) <> 0 Then k1 = "零" & k1
    Else
        st1 = money1
    End If

    k2 = ""
    If st1 <> "" Then
        t1 = Right(st1, 1)
        st1 = Left(st1, Len(st1) - 1)
        k2 = g_TranANum(t1) + k2
    End If

    If st1 <> "" Then
        t1 = Right(st1, 1)
        st1 = Left(st1, Len(st1) - 1)
        If t1 <> "0" Then
            k2 = g_TranANum(t1) + "拾" + k2
        Else
            If Left(k2, 1) <> "零" Then k2 = "零" + k2
        End If
    End If

    If st1 <> "" Then
        t1 = Right(st1, 1)
        st1 = Left(st1, Len(st1) - 1)
        If t1 <> "0" Then
            k2 = g_TranANum(t1) + "佰" + k2
        Else
            If Left(k2, 1) <> "零" Then k2 = "零" + k2
        End If
    End If

    If st1 <> "" Then
        t1 = Right(st1, 1)
        st1 = Left(st1, Len(st1) - 1)
        If t1 <> "0" Then
            k2 = g_TranANum(t1) + "仟" + k2
        Else
            If Left(k2, 1) <> "零" Then k2 = "零" + k2
        End If
    End If

    k3 = ""
    If st1 <> "" Then
        t1 = Right(st1, 1)
        st1 = Left(st1, Len(st1) - 1)
        k3 = g_TranANum(t1) + k3
    End If


    If st1 <> "" Then
        t1 = Right(st1, 1)
        st1 = Left(st1, Len(st1) - 1)
        If t1 <> "0" Then
            k3 = g_TranANum(t1) + "拾" + k3
        Else
            If Left(k3, 1) <> "零" Then k3 = "零" + k3
        End If
    End If

    If st1 <> "" Then
        t1 = Right(st1, 1)
        st1 = Left(st1, Len(st1) - 1)
        If t1 <> "0" Then
            k3 = g_TranANum(t1) + "佰" + k3
        Else
            If Left(k3, 1) <> "零" Then k3 = "零" + k3
        End If
    End If

    If st1 <> "" Then
        t1 = Right(st1, 1)
        st1 = Left(st1, Len(st1) - 1)
        If t1 <> "0" Then
            k3 = g_TranANum(t1) + "仟" + k3
        Else
            If Left(k3, 1) <> "零" Then k3 = "零" + k3
        End If
        
    End If
    k4 = ""
    If st1 <> "" Then
        t1 = Right(st1, 1)
        st1 = Left(st1, Len(st1) - 1)
        k4 = g_TranANum(t1) + k4
    End If
    If st1 <> "" Then
        t1 = Right(st1, 1)
        st1 = Left(st1, Len(st1) - 1)
        If t1 <> "0" Then
            k4 = g_TranANum(t1) + "拾" + k4
        Else
            If Left(k4, 1) <> "零" Then k4 = "零" + k4
        End If
    End If
    
    If Right(k2, 1) = "零" Then k2 = Left(k2, Len(k2) - 1)
    If Len(k3) > 0 Then
        If Right(k3, 1) = "零" Then k3 = Left(k3, Len(k3) - 1)
        If k3 <> "" Then k3 = k3 & "万"
    End If
    If Len(k4) > 0 Then
        If Right(k4, 1) = "零" Then k4 = Left(k4, Len(k4) - 1)
        k4 = k4 & "亿"
    End If
    g_MoneyUp = IIf(k4 & k3 & k2 = "", k1, k4 & k3 & k2 & "元" & k1)
    If Right(g_MoneyUp, 1) = "元" Or Right(g_MoneyUp, 1) = "角" Then g_MoneyUp = g_MoneyUp & "整"
    
End Function

'/* ************************************************************
'**功能描述:'将单个数字转换成对应的大写数字，用于金额大写和日期大写转换
'** 函数名:g_TranANum
'** 参数说明:转入要转换的单个数字
'** 输  出:对应的大写数字
'** 作  者:QSL
'[** 创建日期: 2002-05                 ]
'[** 修  改:                    ]
'[** 修改日期:                  ]
'[** 版本          1.0             ]
'*********************************************************/
Public Function g_TranANum(ByVal NumStr As String) As String
    Select Case Val(NumStr)
      Case 0
         g_TranANum = "零"
      Case 1
         g_TranANum = "壹"
      Case 2
         g_TranANum = "贰"
      Case 3
         g_TranANum = "叁"
      Case 4
         g_TranANum = "肆"
      Case 5
         g_TranANum = "伍"
      Case 6
         g_TranANum = "陆"
      Case 7
         g_TranANum = "柒"
      Case 8
         g_TranANum = "捌"
      Case 9
         g_TranANum = "玖"
    End Select
End Function