Author:水如烟
''' <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))
Next
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))
Next
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, "^零", "")
'元开头的,前加零
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"
&nb