白开心
  IT博客 :: 首页 ::  :: 联系 :: 聚合  :: 管理 ::
  9 随笔 :: 76 文章 :: 28 评论 :: 0 Trackbacks
数字转换成中文(Asp)

 

'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
'数字转换成文字格式
'2005-10-27号，黄杰
'主函数:Transfer(Str)
Function Transfer(Str)
'主函数,调用方法  Transfer(1001) 或者 Transfer("1000000000000000000000000000000000000001")
'经过强度测试，数字只能规定范围以内，字符型则无限长度均可
 If Not IsNumeric(Str) Then Call AlertAndBack("请输入一个有效数字")
 Dim StrLength
 StrLength = Len(Trim(Str))
 
 Select Case StrLength
  Case 1,2,3,4
   Response.Write(WriteThound(Str))
  Case 5,6,7,8
   Response.Write(WriteMillon(Str))
  Case Else
   Response.Write(WriteBillon(Str))
 End Select
End Function

Sub AlertAndBack(Str)
 Response.Write("<script language=javascript>alert('"&Str&"');history.go(-1);</script>")
 Response.End()
End Sub

Function WriteThound(Str)
'处理1-4位情况,1234
Dim Zero
 For i=1 to Len(Str)
  ThisNum = Mid(Str,i,1)
  If ThisNum=0 Then
   If i<>Len(Str) and i<>Zero+1 Then
    WriteThound = WriteThound & "零"
    Zero = i
   End If
  Else
   WriteThound = WriteThound & ReplaceNum(ThisNum) & Unit(Len(Str)-i+1)
  End If
 Next
 
 If Right(WriteThound,1)="零" Then WriteThound = Left(WriteThound,Len(WriteThound)-1) '去除当后面几个零时写出的零
End Function

Function WriteMillon(Str)
'处理5-8位情况
 MillonNum = Left(Str,Len(Str)-4)
 ThoundNum = Right(Str,4)
 
 AllZero = True
 For i=1 to Len(MillonNum)
  if Mid(MillonNum,i,1)<>0 Then AllZero=False:Exit For
 Next
 
 If(AllZero) Then
  WriteMillon = WriteThound(ThoundNum)
 Else
  WriteMillon = WriteThound(MillonNum) & "万" & WriteThound(ThoundNum)
 End If
End Function

Function WriteBillon(Str)
'处理亿位以上情况
 StrLength = Len(Str)
 FieldNum = StrLength \ 8
 If FieldNum * 8 < StrLength Then FieldNum = FieldNum + 1   '每8位一个分段，计算多少个分段
 '123,12345678,23456789 
 FirstFieldLength = StrLength-(FieldNum-1)*8

 For i=1 To FieldNum
  If i=1 Then 
   ThisField = Left(Str,FirstFieldLength)
  Else
   ThisField = Mid(Str,(i-2)*8+1+FirstFieldLength,8)
  End If

  If i=1 And Len(ThisField)<5 Then
   WriteBillon = WriteThound(ThisField) & "亿"
  ElseIf i = FieldNum Then
   WriteBillon = WriteBillon & WriteMillon(ThisField)
  Else
   WriteBillon = WriteBillon & WriteMillon(ThisField) & "亿"
  End If
 Next
 
End Function

Function Unit(Num)
 Select Case Num
  Case 1
   Unit = ""
  Case 2
   Unit = "十"
  Case 3
   Unit = "百"
  Case 4
   Unit = "千"
  Case 5
   Unit = "万"
 End Select
End Function

Function ReplaceNum(Str)
 Select Case Str
  Case 0
   ReplaceNum = "零"
  Case 1
   ReplaceNum = "一"
  Case 2
   ReplaceNum = "二"
  Case 3
   ReplaceNum = "三"
  Case 4
   ReplaceNum = "四"
  Case 5
   ReplaceNum = "五"
  Case 6
   ReplaceNum = "六"
  Case 7
   ReplaceNum = "七"
  Case 8
   ReplaceNum = "八"
  Case 9
   ReplaceNum = "九"
 End Select
End Function
'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
posted on 2005-12-11 21:28 白开心 阅读(540) 评论(0)  编辑 收藏 引用 所属分类: Asp+vbScript
只有注册用户登录后才能发表评论。