白开心

  IT博客 :: 首页 ::  :: 联系 :: 聚合  :: 管理 ::
  9 随笔 :: 76 文章 :: 28 评论 :: 0 Trackbacks

 

'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
'
数字转换成文字格式
'
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 白开心 阅读(599) 评论(0)  编辑 收藏 引用 所属分类: Asp+vbScript
只有注册用户登录后才能发表评论。