货币金额拼写转换类

' '' <summary>

' '' 货币拼写转换

' '' </summary>

' '' <remarks>LzmTW 20060127</remarks>

Public Class CurrencySpell

'定义为静态类

Private Sub New()

End Sub

''' <summary>

''' 货币金额拼写转换

''' </summary>

''' <param name="Money">金额</param>

''' <param name="mType">格式类型</param>

''' <returns>拼写字符串</returns>

Public Shared 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(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 CurrencyType

''' <summary>

''' 美元

''' </summary>

Dollar

''' <summary>

''' 人民币

''' </summary>

RMB

''' <summary>

''' 人民币36位格式

''' </summary>

RMB36

''' <summary>

''' 数字大写

''' </summary>

RMBCaps

End Enum

Private Class RMB

'定义为静态类

Private Sub New()

End Sub

''' <summary>

''' 拼写单个数字

''' </summary>

''' <param name="Digit">数字字符</param>

''' <returns>字符串数字</returns>

Private Shared 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(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))

Return String.Concat(mResult)

End Function

'本函数采用格式化来处理.

'定义金额最大格式,然后将金额转为相应字符数组装填

''' <summary>

''' 36位格式,形如“零仟零佰零拾零兆零仟零佰零拾零亿零仟零佰壹拾贰万叁仟肆佰伍拾陆元柒角捌分”共36位

''' </summary>

''' <param name="mMoney">金额</param>

Friend Shared 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))

mResult = String.Format(mSpellFormat, tmp)

'到了这里,金额为123456.775转换成以下字符串.这个字符串对票据固有格式的填位较为方便,使用时按实际要求进行截取和格式化

'零仟零佰零拾零兆零仟零佰零拾零亿零仟零佰壹拾贰万叁仟肆佰伍拾陆元柒角捌分

Return mResult

End Function

''' <summary>

''' 拼写输出

''' </summary>

''' <param name="mMoney">金额</param>

''' <returns>金额拼写字符串</returns>

Friend Shared 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(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, "^元", "零元")

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 Dollar

'定义为静态类

Private Sub New()

End Sub

''' <summary>

''' 拼写单个数字

''' </summary>

''' <param name="Digit">数字字符</param>

''' <returns>字符串数字</returns>

Private Shared 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(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(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

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

mResult = mResult.Trim + " And " + mCents.Trim + " Cents"

Return mResult

End Function

End Class

小知识:

中文数字大写的由来:

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

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

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

货币金额拼写转换类

相关推荐