领星动网编程开发之爆炸小宇宙

cnitblog.com/lxasp - - 有一种信念叫做编程
posts - 54, comments - 34, trackbacks - 0, articles - 0

类模块:


Private mTenMode, mCaseMode, mZeroMode
Private c0, c1, c2, c3, c4, c5, c6, c7, c8, c9, c00
Private d1, d2, d3, d4, d5, d6

Private Sub ToUCase()
    
    
If mZeroMode Then
        c0 
= ""
        c00 
= "〇〇"
    
Else
        c0 
= ""
        c00 
= "零零"
    
End If
    
    c1 
= ""
    c2 
= ""
    c3 
= ""
    c4 
= ""
    c5 
= ""
    c6 
= ""
    c7 
= ""
    c8 
= ""
    c9 
= ""

    d1 
= ""
    d2 
= ""
    d3 
= ""
    d4 
= ""
    d5 
= "亿"
    d6 
= ""

End Sub

Private Sub ToLCase()
    
    
If mZeroMode Then
        c0 
= ""
        c00 
= "〇〇"
    
Else
        c0 
= ""
        c00 
= "零零"
    
End If
    
    c1 
= ""
    c2 
= ""
    c3 
= ""
    c4 
= ""
    c5 
= ""
    c6 
= ""
    c7 
= ""
    c8 
= ""
    c9 
= ""

    d1 
= ""
    d2 
= ""
    d3 
= ""
    d4 
= ""
    d5 
= "亿"
    d6 
= ""

End Sub


Public Function NumberToWord(number)
    
'-------------------------------------------------------------------
    '目的:转换一串阿拉伯数字为中文数字
    '参数:一串阿拉伯数字
    '返回值:转换后的一串中文数字
    '---------------------------------------------------------------------------------------------------------------------------------
    '注: 此一 Function 必须包含以下三个 Function
    '1.mapword:转换单一数字为国数字(0123456789->零壹贰参肆伍陆柒捌玖)
    '2.StringCleaner:清除字串中不要的字元
    '3.convtoword:将传入的四个数字转成中文数字字串(1234->壹仟贰佰参拾肆)
    '---------------------------------------------------------------------------------------------------------------------------------
    
    
Dim wlength  '数字字串总长度
    wlength = CInt("0")
    
Dim wsection  '归属的段落 (0:万以下/1:万/2:亿/3:兆)
    wsection = CInt("0")
    
Dim wcount  '剩余的数字字串长度
    wcount = CInt("0")
    
Dim wstr  '暂存字串
    Dim wstr1  '暂存字串-兆
    Dim wstr2  '暂存字串-亿
    Dim wstr3  '暂存字串-万
    Dim wstr4  '暂存字串-万以下
    
    
'未输入或0不做
    '-----------------------------------------------
    If Trim(number) = "" Or Trim(number) = "0" Then
        NumberToWord 
= c0
        
Exit Function
    
End If
    
'-----------------------------------------------
    wlength = Len(number)
    wsection 
= wlength \ 4
    wcount 
= wlength Mod 4
    
'-----------------------------------------------
    '每四位一组, 分段 (兆/亿/万/万以下)
    If wcount = 0 Then
        wcount 
= 4
        wsection 
= wsection - 1
    
End If
    
'----------------------------------------------
    '大于兆的四位数转换
    If wsection = 3 Then
        
'抓出大于兆的四位数
        wstr = Left(FormatNumber(number, "0000000000000000"), 4)
        
'转换
        wstr1 = convtoword(wstr)
        
If wstr1 <> c0 Then wstr1 = wstr1 & d6
    
End If
    
'----------------------------------------------
    '大于亿的四位数转换
    If wsection >= 2 Then
        
'抓出大于亿的四位数
        If Len(number) > 12 Then
            wstr 
= Left(Right(number, 12), 4)
        
Else
            wstr 
= Left(FormatNumber(number, "000000000000"), 4)
        
End If
    
'转换
        wstr2 = convtoword(wstr)
        
If wstr2 <> c0 Then wstr2 = wstr2 & d5
    
End If
    
'----------------------------------------------
    '大于万的四位数转换
    If wsection >= 1 Then
        
'抓出大于万的四位数
        If Len(number) > 8 Then
            wstr 
= Left(Right(number, 8), 4)
        
Else
            wstr 
= Left(FormatNumber(number, "00000000"), 4)
        
End If
        
'转换
        wstr3 = convtoword(wstr)
        
If wstr3 <> c0 Then wstr3 = wstr3 & d4
    
End If
    
'----------------------------------------------
    '万以下的四位数转换
    '抓出万以下的四位数
    If Len(number) > 4 Then
        wstr 
= Right(number, 4)
    
Else
        wstr 
= FormatNumber(number, "0000")
    
End If
    
'转换
    wstr4 = convtoword(wstr)
    
    
'----------------------------------------------
    '组合最多四组字串(兆/亿/万/万以下)
    NumberToWord = wstr1 & wstr2 & wstr3 & wstr4
    
'去除重复的零 ('零零'-->'零')
    Do While InStr(1, NumberToWord, c00)
        NumberToWord 
= StringCleaner(NumberToWord, c00)
    
Loop
    
'----------------------------------------------
    '去除最左边的零
    If Left(NumberToWord, 1= c0 Then
        NumberToWord 
= Mid(NumberToWord, 2)
    
End If
    
'----------------------------------------------
    '去除最右边的零
    If Right(NumberToWord, 1= c0 Then
        NumberToWord 
= Mid(NumberToWord, 1Len(NumberToWord) - 1)
    
End If
End Function


Private Function mapword(no)
    
'-----------------------------------------------------------
    '目的:转换单一数字为国数字(0123456789->零壹贰参肆伍陆柒捌玖)
    '参数:数字(0123456789)
    '返回值:国数字(零壹贰参肆伍陆柒捌玖)
    '-----------------------------------------------------------
    Select Case no
        
Case "0"
        mapword 
= c0
        
Case "1"
        mapword 
= c1
        
Case "2"
        mapword 
= c2
        
Case "3"
        mapword 
= c3
        
Case "4"
        mapword 
= c4
        
Case "5"
        mapword 
= c5
        
Case "6"
        mapword 
= c6
        
Case "7"
        mapword 
= c7
        
Case "8"
        mapword 
= c8
        
Case "9"
        mapword 
= c9
    
End Select


End Function

Private Function StringCleaner(ByVal s, ByVal Search)
    
'-----------------------------------------------------------
    '目的:清除字串中不要的字元
    '参数:1.完整字串. 2.要清除的字元(可含多字元)
    '返回值:清除后的字串
    '''此段之主要目的在去除重复的 '零' ('零零'-->'零')
    '-----------------------------------------------------------
    Dim i, res
    res 
= s
    
Do While InStr(res, Search)
        i 
= InStr(res, Search)
        res 
= Left(res, i - 1& Mid(res, i + 1)
    
Loop
    StringCleaner 
= res
End Function

Private Function convtoword(ByVal wstr)
    
'-----------------------------------------------------------
    '目的:将传入的四个数字转成中文数字字串(1234->壹仟贰佰参拾肆)
    '参数:4位数的数字 (前面空白补0)
    '返回值:转换后的中文数字字串
    '-----------------------------------------------------------
    Dim tempword
    
'仟位数
    tempword = mapword(Mid(wstr, 11))
    
If tempword <> c0 Then tempword = tempword & d3
    convtoword 
= convtoword & tempword
    
'佰位数
    tempword = mapword(Mid(wstr, 21))
    
If tempword <> c0 Then tempword = tempword & d2
    convtoword 
= convtoword & tempword
    
'拾位数
    tempword = mapword(Mid(wstr, 31))
    
If tempword <> c0 And tempword <> c1 Then tempword = tempword & d1
    
    
If mTenMode Then
        
If convtoword = c00 And tempword = c1 Then tempword = tempword & d1
    
Else
        
If convtoword = c00 And tempword = c1 Then tempword = d1
    
End If
    
    
If convtoword <> c00 And tempword = c1 Then tempword = tempword & d1
    convtoword 
= convtoword & tempword
    
'个位数
    tempword = mapword(Mid(wstr, 41))
    convtoword 
= convtoword & tempword
    
'去除最右边的零
    Do While Right(convtoword, 1= c0 And Len(convtoword) > 1
        convtoword 
= Mid(convtoword, 1Len(convtoword) - 1)
    
Loop
End Function

Public Property Get TenMode()
    TenMode 
= mTenMode
End Property

Public Property Let TenMode(ByVal vNewValue)
    mTenMode 
= vNewValue
End Property


Public Property Get CaseMode()
    CaseMode 
= mCaseMode
End Property

Public Property Let CaseMode(ByVal vNewValue)
    mCaseMode 
= vNewValue
    
If mCaseMode Then
        ToUCase
    
Else
        ToLCase
    
End If
End Property

Public Property Get ZeroMode()
    ZeroMode 
= mZeroMode
End Property

Public Property Let ZeroMode(ByVal vNewValue)
    mZeroMode 
= vNewValue
    
If mCaseMode Then
        ToUCase
    
Else
        ToLCase
    
End If
End Property

Private Sub Class_Initialize()
    mTenMode 
= False
    mCaseMode 
= False
    mZeroMode 
= False
    ToLCase
End Sub

Private Function FormatNumber(num, fa)
    
Dim lm, lf
    lf 
= Len(fa)
    lm 
= Len(num)
    
If lm < lf Then
        
FormatNumber = String(lf - lm, "0"& Trim(CStr(num))
    
Else
        
FormatNumber = Trim(CStr(num))
    
End If
End Function


模块:

 


Function Num2Chs(num, ten, cas, zero)
    
Dim c As cNumToChs
    
Set c = New cNumToChs
    c.TenMode 
= ten
    c.CaseMode 
= cas
    c.ZeroMode 
= zero
    Num2Chs 
= c.NumberToWord(num)
    
Set c = Nothing
End Function

'主要调用函数,将输入的货币格式的数值转化为中文大写
Public Function CChinese(Pr As DoubleAs String


    
Dim sp, sp0 As String, sp1 As String, u As Integer
    
Dim jiao As Integer, feng As Integer
    
    
Dim r As String

    
Dim chap(10As String
    chap(
0= ""
    chap(
1= ""
    chap(
2= ""
    chap(
3= ""
    chap(
4= ""
    chap(
5= ""
    chap(
6= ""
    chap(
7= ""
    chap(
8= ""
    chap(
9= ""

    sp 
= Split(CStr(Pr), "."2)

    
If IsArray(sp) Then
        u 
= UBound(sp)
        
If u = 0 Then
            sp0 
= sp(0)
            r 
= Num2Chs(sp0, 110)
            r 
= r & "元整"
        
Else
            sp0 
= sp(0)
            sp1 
= Left(sp(1), 2)
            
            r 
= Num2Chs(sp0, 110)
            
            
            
If Len(sp1) = 2 Then
                jiao 
= Val(Left(sp1, 1))
                feng 
= Val(Right(sp1, 1))
    
                
If jiao = 0 Then
                    r 
= r & "元零"
                
Else
                    r 
= r & "" & chap(jiao) & ""
                
End If
                r 
= r & chap(feng) & ""
            
Else
                jiao 
= Val(Left(sp1, 1))
                feng 
= 0
                
                
If jiao = 0 Then
                    r 
= r & "元整"
                
Else
                    r 
= r & "" & chap(jiao) & ""
                
End If
            
End If
        
End If
    
Else
        sp0 
= CStr(Pr)
        r 
= Num2Chs(sp0, 110)
        r 
= r & "元整"
    
End If
    
    CChinese 
= r

End Function



'外部调用函数,将输入的日期(年或月或日)转化为中文大写
Public Function BigCovert(sData$, Optional IsLink As BooleanAs String
    
Dim i%, r$, s$

    
If IsLink Then
        
For i = 1 To Len(sData)
            
If Mid(sData, 11= 0 Then
                r 
= "" & r & BigWord(Mid(sData, 21))
                
Exit For
            
End If
            
If Len(r) = 1 Then r = r & ""

            s 
= Mid(sData, i, 1)
            
If s <> "0" Then
                r 
= r & BigWord(s)
            
End If

        
Next
    
Else
        
For i = 1 To Len(sData)
            r 
= r & BigWord(Mid(sData, i, 1))
        
Next

    
End If
    BigCovert 
= r
End Function

Private Function BigWord(s$) As String
    
Dim r$
    
Select Case s
    
Case "0"
        r 
= ""
    
Case "1"
        r 
= ""
    
Case "2"
        r 
= ""
    
Case "3"
        r 
= ""
    
Case "4"
        r 
= ""
    
Case "5"
        r 
= ""
    
Case "6"
        r 
= ""
    
Case "7"
        r 
= ""
    
Case "8"
        r 
= ""
    
Case "9"
        r 
= ""

    
End Select
    BigWord 
= r
End Function

只有注册用户登录后才能发表评论。