货币金额拼写转换类

   ' '' <summary>
' '' 货币拼写转换
' '' </summary>
' '' <remarks>LzmTW 20060127</remarks>
Public   Class CurrencySpell Class CurrencySpell
    '定义为静态类
   Private Sub New()Sub New()
    End Sub

    ''' <summary>
    ''' 货币金额拼写转换
    ''' </summary>
    ''' <param name="Money">金额</param>
    ''' <param name="mType">格式类型</param>
    ''' <returns>拼写字符串</returns>
  Public Shared Function Convert()Function Convert(ByVal Money As Decimal, ByVal mType As CurrencyType) As String
        Dim mMinus As String = "" '“负”符号
        Dim mResult As String = ""

        '如果是负金额,定义“负”符号,将输入金额转为正金额
        '!不懂财会,不知以下的定义是否正确
        If Money < 0 Then
            Select Case mType
                Case CurrencyType.Dollar
                    mMinus = "Minus "
                Case CurrencyType.RMB
                    mMinus = "负"
                Case CurrencyType.RMB36
                    mMinus = "负"
                Case CurrencyType.RMBCaps
                    mMinus = "负"
            End Select
            Money = -Money
        End If

        Select Case mType
            Case CurrencyType.Dollar
                mResult = Dollar.Spellout(Money)
            Case CurrencyType.RMB36
                mResult = RMB.SpelloutAll(Money)
            Case CurrencyType.RMB
                mResult = RMB.Spellout(Money)
            Case CurrencyType.RMBCaps
                mResult = RMB.SpellCaps(Money)
        End Select

        mResult = mMinus & mResult
        Return mResult
    End Function

    ''' <summary>
    ''' 货币金额拼写转换
    ''' </summary>
    ''' <param name="Money">金额</param>
    ''' <param name="mType">格式类型</param>
    ''' <returns>拼写字符串</returns>
 Public Shared Function Convert()Function Convert(ByVal Money As String, ByVal mType As CurrencyType) As String
        Dim mResult As String = ""
        Dim mMoney As Decimal '处理字符串Money后供函数调用的实际参考值

        '对输入字符串进行处理、验证有效性,最后转为Decimal类型
        '除去前后空格
        Money = Money.Trim

        If Money = "" OrElse Money = "." OrElse Money = "-" OrElse Money = "-." Then
            mMoney = 0 '若为空,“.”或“-”或“-.”,当0处理
        Else
            '输入字串转为Decimal类型
            '这里偷懒了,如用正则判别,不符的话也要Throw New Exception
            mMoney = Decimal.Parse(Money)
        End If

        '调用函数输出结果
        mResult = Convert(mMoney, mType)
        Return mResult
    End Function

    ''' <summary>
    ''' 格式类型
    ''' </summary>
    Public Enum CurrencyTypeEnum CurrencyType
        ''' <summary>
        ''' 美元
        ''' </summary>
        Dollar
        ''' <summary>
        ''' 人民币
        ''' </summary>
        RMB
        ''' <summary>
        ''' 人民币36位格式
        ''' </summary>
        RMB36
        ''' <summary>
        ''' 数字大写
        ''' </summary>
        RMBCaps
    End Enum

    Private Class RMBClass RMB
        '定义为静态类
       Private Sub New()Sub New()
        End Sub
        ''' <summary>
        ''' 拼写单个数字
        ''' </summary>
        ''' <param name="Digit">数字字符</param>
        ''' <returns>字符串数字</returns>
       Private Shared Function spSingle()Function spSingle(ByVal Digit As String) As String
            Dim mResult As String = ""
            Select Case Digit
                Case "0"
                    mResult = "零"
                Case "1"
                    mResult = "壹"
                Case "2"
                    mResult = "贰"
                Case "3"
                    mResult = "叁"
                Case "4"
                    mResult = "肆"
                Case "5"
                    mResult = "伍"
                Case "6"
                    mResult = "陆"
                Case "7"
                    mResult = "柒"
                Case "8"
                    mResult = "捌"
                Case "9"
                    mResult = "玖"
                Case "."
                    mResult = "."
            End Select
            Return mResult
        End Function

        ''' <summary>
        ''' 数字大写
        ''' </summary>
        ''' <param name="mMoney"></param>
        Friend Shared Function SpellCaps()Function SpellCaps(ByVal mMoney As Decimal) As String
            Dim mResult(mMoney.ToString.Length - 1) As String
            Dim tmp As String = mMoney.ToString
            For i As Integer = 0 To tmp.Length - 1
                mResult(i) = spSingle(tmp.Substring(i, 1))
            Next
            Return String.Concat(mResult)
        End Function

        '本函数采用格式化来处理.
        '定义金额最大格式,然后将金额转为相应字符数组装填

        ''' <summary>
        ''' 36位格式,形如“零仟零佰零拾零兆零仟零佰零拾零亿零仟零佰壹拾贰万叁仟肆佰伍拾陆元柒角捌分”共36位
        ''' </summary>
        ''' <param name="mMoney">金额</param>
        Friend Shared Function SpelloutAll()Function SpelloutAll(ByVal mMoney As Decimal) As String
            Dim mSpellFormat As String = _
            "{0}仟{1}佰{2}拾{3}兆{4}仟{5}佰{6}拾{7}亿{8}仟{9}佰{10}拾{11}万{12}仟{13}佰{14}拾{15}元{16}角{17}分" '共18位数字
            Dim mResult As String = ""

            '这里加上0.00000001是为了保证有小数位
            mMoney += 0.00000001D

            '小数角分部分依逢五进一取.对于Net1.0版本的Decimal.Round,若舍去位是5,前头一位是奇数则进位,偶数则不进.而Net2.0可用以下方法实现
            mMoney = Decimal.Round(mMoney, 2, MidpointRounding.AwayFromZero)

            '临时转为字符串存到mResult中
            mResult = mMoney.ToString

            mResult = mResult.Replace(".", "")   '金额字符串,小数二位,略去小数点
            '为保证18位数字字符,前面置0
            mResult = mResult.PadLeft(18, "0"c)

            '将数字字符串转为数组,使用spSingle函数得到相应的拼写,存到tmp临时数组中.再格式化存入mResult去.
            Dim tmp(17) As String
            For i As Integer = 0 To 17
                tmp(i) = spSingle(mResult.Substring(i, 1))
            Next
            mResult = String.Format(mSpellFormat, tmp)
            '到了这里,金额为123456.775转换成以下字符串.这个字符串对票据固有格式的填位较为方便,使用时按实际要求进行截取和格式化
            '零仟零佰零拾零兆零仟零佰零拾零亿零仟零佰壹拾贰万叁仟肆佰伍拾陆元柒角捌分

            Return mResult
        End Function


        ''' <summary>
        ''' 拼写输出
        ''' </summary>
        ''' <param name="mMoney">金额</param>
        ''' <returns>金额拼写字符串</returns>
        Friend Shared Function Spellout()Function Spellout(ByVal mMoney As Decimal) As String
            Dim mResult As String = ""
            '取36位格式
            mResult = SpelloutAll(mMoney)
            '转规范处理
            mResult = Normalization(mResult)

            Return mResult
        End Function


        ''' <summary>
        ''' 格式字符串的规范处理
        ''' </summary>
        ''' <param name="spellFormatString">36位格式</param>
        Private Shared Function Normalization()Function Normalization(ByVal spellFormatString As String) As String
            Dim mResult As String = ""
            '取36位格式
            mResult = spellFormatString

            '处理元后面部分.
            '除去零角或零分.
            mResult = System.Text.RegularExpressions.Regex.Replace(mResult, "零[角分]", "")
            '若结尾是元,用元整来代替.
            mResult = System.Text.RegularExpressions.Regex.Replace(mResult, "元$", "元整")

            '零仟零佰零拾零[兆亿万元],都要除去.只是元为基本单位需要保留,所以这里加上一个元,判别完后置回
            mResult = System.Text.RegularExpressions.Regex.Replace(mResult, "元", "元元")
            mResult = System.Text.RegularExpressions.Regex.Replace(mResult, "零仟零佰零拾零[兆亿万元]", "")
            mResult = System.Text.RegularExpressions.Regex.Replace(mResult, "元元", "元")

            '现在的焦点是看 X仟X佰X拾X[兆亿万元],其中四个X中至少有一个不为零.
            '凡零[仟佰拾]的,都用一个零表示
            mResult = System.Text.RegularExpressions.Regex.Replace(mResult, "零[仟佰拾]", "零")
            '出现两个零及以上的,用一个零表示
            mResult = System.Text.RegularExpressions.Regex.Replace(mResult, "零{2,}", "零")
            '零[兆亿万元]的,去掉零
            mResult = System.Text.RegularExpressions.Regex.Replace(mResult, "零([兆亿万元])", "${1}")

            '最后结果整理
            '零开头的,去掉零
            mResult = System.Text.RegularExpressions.Regex.Replace(mResult, "^零", "")
            '元开头的,前加零
            mResult = System.Text.RegularExpressions.Regex.Replace(mResult, "^元", "零元")

            Return mResult
        End Function
    End Class

    '本类参照《SQL Server 7编程技术内幕》8.2.3章节关于拼写金额存储过程而做,该书作者John Papa,Matthew Shepker等。
    '英文书名 Microsoft SQL Server 7.0 Programming Unleashed
    '机械工业出版社 ISBN 7-111-07649-4
    Private Class DollarClass Dollar
        '定义为静态类
        Private Sub New()Sub New()
        End Sub

        ''' <summary>
        ''' 拼写单个数字
        ''' </summary>
        ''' <param name="Digit">数字字符</param>
        ''' <returns>字符串数字</returns>
        Private Shared Function spSingle()Function spSingle(ByVal Digit As String) As String
            Dim mResult As String = ""
            Select Case Digit
                Case "0"
                Case "1"
                    mResult = "One"
                Case "2"
                    mResult = "Two"
                Case "3"
                    mResult = "Three"
                Case "4"
                    mResult = "Four"
                Case "5"
                    mResult = "Five"
                Case "6"
                    mResult = "Six"
                Case "7"
                    mResult = "Seven"
                Case "8"
                    mResult = "Eight"
                Case "9"
                    mResult = "Nine"
            End Select
            Return mResult
        End Function

        ''' <summary>
        ''' 拼写十位列
        ''' </summary>
        ''' <param name="Digit">两位数字字符串</param>
        ''' <returns>十位字符串</returns>
        Private Shared Function spTwonum()Function spTwonum(ByVal Digit As String) As String
            Dim mResult As String = ""
            Select Case Digit.Substring(0, 1)
                Case "0"
                Case "1"
                    Select Case Digit
                        Case "10"
                            mResult = "Ten"
                        Case "11"
                            mResult = "Eleven"
                        Case "12"
                            mResult = "Twelve"
                        Case "13"
                            mResult = "Thirteen"
                        Case "14"
                            mResult = "Fourteen"
                        Case "15"
                            mResult = "Fifteen"
                        Case "16"
                            mResult = "Sixteen"
                        Case "17"
                            mResult = "Seventeen"
                        Case "18"
                            mResult = "Eighteen"
                        Case "19"
                            mResult = "Nineteen"
                    End Select
                Case "2"
                    mResult = "Twenty"
                Case "3"
                    mResult = "Thirty"
                Case "4"
                    mResult = "Forty"
                Case "5"
                    mResult = "Fifty"
                Case "6"
                    mResult = "Sixty"
                Case "7"
                    mResult = "Seventy"
                Case "8"
                    mResult = "Eighty"
                Case "9"
                    mResult = "Ninety"
            End Select
            Return mResult
        End Function

        '************************过程变量说明*****************
        'mHolder        保持将来转换的数目总长度,除小数部分外.如数目12345.56存储值为4
        'mCoutdown      如果必要,它将金额数目的整数部分拆分为三个数字的组.如果长度MOD 3 余数不是0,
        '               则mCountdown被赋值为该值;否则mCountdown赋值为3.该值在转换数字到词语时用于跟踪百位、
        '               十位和个位的位置.
        'mRemlen        保持将要转换的数目剩余长度.当数字从左至右转换时,变量维持转换剩余长度.
        'mPosition      存储金额值的整数部分的位置.由mHoldlen和mRemlen计算,使用为Substring的参数以提取一个或多个字符.
        'mHoldchar      存储将要转换的金额数整数部分
        'mCompare       存储一个或两个字符,用于传送给计算百位、十位和个位的函数
        'mWordChk       让过程知道何时增加逗号,如十亿、百万等等
        'mCents         存储金额值的小数部分
        '*****************************************************

        ''' <summary>
        ''' 拼写输出
        ''' </summary>
        ''' <param name="mMoney">金额</param>
        ''' <returns>金额拼写字符串</returns>
        Friend Shared Function Spellout()Function Spellout(ByVal mMoney As Decimal) As String
            Dim mResult As String = Space(255)

            Dim mHoldlen As Integer
            Dim mCountdown As Integer
            Dim mRemlen As Integer
            Dim mPosition As Integer
            Dim mHoldchar As String
            Dim mCompare As String
            Dim mWordchk As String = ""
            Dim mCents As String = ""

            mHoldlen = Decimal.Floor(mMoney).ToString.Trim.Length
            mHoldchar = Decimal.Floor(mMoney).ToString.Trim
            mRemlen = mHoldlen
            mCents = (Decimal.Floor(((mMoney - Decimal.Floor(mMoney)) * 100))).ToString.Trim

            While mRemlen > 0
                If mHoldlen = 1 AndAlso mHoldchar = "0" Then
                    mResult += "Zero"
                End If

                If mRemlen Mod 3 = 0 Then
                    mCountdown = 3
                End If

                If mHoldlen > 2 Then
                    If mHoldchar.Substring(mHoldlen - mRemlen + 1 - 1, 3) <> "000" Then
                        mWordchk = "Y"
                    Else
                        mWordchk = "N"
                    End If
                End If


                If mRemlen Mod 3 = 1 Then
                    mCountdown = 1
                    mWordchk = "Y"
                End If

                If mRemlen Mod 3 = 2 Then
                    mCountdown = 2
                    mWordchk = "Y"
                End If

                While mCountdown > 0
                    Dim mSpellIt As String = Space(10)
                    mRemlen -= 1
                    mPosition = mHoldlen - mRemlen

                    Select Case mCountdown
                        Case 3
                            mCompare = mHoldchar.Substring(mPosition - 1, 1)
                            mSpellIt = spSingle(mCompare)
                            If mHoldchar.Substring(mPosition - 1, 1) <> "0" Then
                                mResult += mSpellIt + " Hundred"
                            End If
                            mResult = mResult.Trim + " "
                        Case 2
                            mCompare = mHoldchar.Substring(mPosition - 1, 2)
                            mSpellIt = spTwonum(mCompare)
                            mResult += mSpellIt
                            mResult = mResult.Trim + " "
                        Case 1
                            If (mPosition <> 1 AndAlso mHoldchar.Substring(mPosition - 1 - 1, 1) <> "1") Or mPosition = 1 Then
                                mCompare = mHoldchar.Substring(mPosition - 1, 1)
                                mSpellIt = spSingle(mCompare)
                                mResult += mSpellIt
                                mResult = mResult.Trim + " "
                            End If
                    End Select

                    If mRemlen = 9 AndAlso mWordchk = "Y" Then
                        mResult += "Billion "
                    End If

                    If mRemlen = 6 AndAlso mWordchk = "Y" Then
                        mResult += "Million "
                    End If

                    If mRemlen = 3 AndAlso mWordchk = "Y" Then
                        mResult += "Thousand "
                    End If

                    If mRemlen = 0 Then
                        mResult += "Dollars "
                    End If

                    mCountdown -= 1
                End While

            End While

            mResult = mResult.Trim + " And " + mCents.Trim + " Cents"
            Return mResult
        End Function
    End Class

End Class

小知识:

中文数字大写的由来:

洪武18年(公元1385年)，明朝发生了一起重大贪污案件，即以户部侍郎郭恒为首，侵占、贪污国家钱粮的“秋粮案”，郭恒及其同伙通过涂改财会凭证上的数字“一二三四五六七八九十百千”的手段，大肆侵吞、贪污国家钱粮。案发后，追赃七百万石。此案从朝廷六部侍郎到地方大小官员、豪绅，牵连数万人，全部被斩首示众。

“秋粮案”使朱元璋大为震惊，他一方面更加坚定了“重典治吏”的指导思想，另一方面，他下令对全国财务管理采取一系列行之有效的改革措施，其中，最重要的做法就是将记载钱粮的数字“一二三四五六七八九十百千”分别改为汉字大写“壹贰叁肆伍陆柒捌玖拾陌阡”。在此后的实际使用中，人们逐渐用“佰仟”代替了“陌阡”二字。

大写用字:

零壹贰叁肆伍陆柒捌玖拾
佰仟万亿兆吉太拍艾
分厘毫微