Private Function setdata(num As Integer) As String '数字转换
Select Case num
Case 0
setdata = "零"
Case 1
setdata = "壹"
Case 2
setdata = "贰"
Case 3
setdata = "叁"
Case 4
setdata = "肆"
Case 5
setdata = "伍"
Case 6
setdata = "陆"
Case 7
setdata = "柒"
Case 8
setdata = "捌"
Case 9
setdata = "玖"
End Select
End Function
Private Function chang(aaa As Integer) As String '位数转换
Select Case aaa
Case 1
chang = ""
Case 2
chang = "十"
Case 3
chang = "百"
Case 4
chang = "千"
Case 5
chang = "万"
Case 6
chang = "十"
Case 7
chang = "百"
Case 8
chang = "千"
Case 9
chang = "亿"
Case 10
chang = "十"
End Select
End Function
Private Sub Form_Activate() '设定文本长度
Text2.MaxLength = 10
Text2.SetFocus
End Sub
Private Sub Text2_Change() '小写转大写
Dim i As Integer
Dim j As Integer
Dim myint As Integer
Dim myint1 As Integer
Dim mydoub As Double
Dim mystr As String
Dim mystr1 As String
Dim mystr2 As String
Dim mystr3 As String
Dim mystr4 As String
Dim money As Long
Dim money1 As Integer
Dim money2 As Long
mystr = Text2.Text
myint = InStr(mystr, ".")
If myint = 0 Then
mystr = Text2.Text
Else
mystr3 = Right(Text2.Text, Len(Text2.Text) - myint)
If mystr3 <> "" Then '转换小数位
mystr4 = Left(mystr3, 1)
mystr3 = Right(mystr3, Len(mystr3) - 1)
If mystr4 <> "0" Then
mystr2 = mystr2 + setdata(Val(mystr4)) + "角"
End If
If mystr3 <> "" Then
mystr4 = Left(mystr3, 1)
mystr2 = mystr2 + setdata(Val(mystr4)) + "分"
End If
End If
mystr = Left(Text2.Text, myint - 1)
End If
j = Len(mystr)
For i = 1 To Len(mystr) '转换整数位
money2 = Left(mystr, i)
money1 = Right(money2, 1)
If money1 = 0 Then
If j = 5 Then
If Right(mystr1, 1) <> "万" Then mystr1 = mystr1 & "万"
Else
If Right(mystr1, 1) <> "零" And Right(money, j) > 0 Then mystr1 = mystr1 & "零"
End If
Else
mystr1 = mystr1 & setdata(money1) + chang(j)
End If
j = j - 1
Next i
Text1.Text = mystr1 & "元" & mystr2 '显示大写
End Sub
Private Sub Command1_Click()
End
End Sub