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"
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
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
''' <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" 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 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 ClassEnd Class
小知识:
中文数字大写的由来:
洪武18年(公元1385年)，明朝发生了一起重大贪污案件，即以户部侍郎郭恒为首，侵占、贪污国家钱粮的“秋粮案”，郭恒及其同伙通过涂改财会凭证上的数字“一二三四五六七八九十百千”的手段，大肆侵吞、贪污国家钱粮。案发后，追赃七百万石。此案从朝廷六部侍郎到地方大小官员、豪绅，牵连数万人，全部被斩首示众。
“秋粮案”使朱元璋大为震惊，他一方面更加坚定了“重典治吏”的指导思想，另一方面，他下令对全国财务管理采取一系列行之有效的改革措施，其中，最重要的做法就是将记载钱粮的数字“一二三四五六七八九十百千”分别改为汉字大写“壹贰叁肆伍陆柒捌玖拾陌阡”。在此后的实际使用中，人们逐渐用“佰仟”代替了“陌阡”二字。
大写用字:
零壹贰叁肆伍陆柒捌玖拾
佰仟万亿兆吉太拍艾
分厘毫微
