nima898
پنج شنبه 25 شهریور 1389, 10:51 صبح
این تابع رو چند وقت پیش نوشتم میذارم اینجا شاید به درد دوستان بخوره.
سورس تابع تبدیل عدد به حروف:
Private Function a2h(ByVal st As String) As String
Dim i, l As Integer, sign, s(9), sa(4), s11, s12, s21, s22, s31, s32, s41, s42 As String
Dim b, o, o2, o3, o5, o4, c As String
If st = "" Then Return ""
sign = Strings.GetChar(st, 1)
st = Math.Abs(Val(st)).ToString
If sign = "+" Then
If st <> "0" Then sign = "مثبت "
ElseIf sign = "-" Then
If st <> "0" Then sign = "منفی "
Else
sign = ""
End If
l = st.Length
Do While l > 3
s(i) = Strings.Right(st, 3)
i = i + 1
st = Strings.Left(st, l - 3)
l = st.Length
Loop
s(i) = st
For i = 0 To 4
b = Strings.GetChar(Strings.Right("000" + s(i), 3), 1)
o = ""
Select Case b
Case "1"
o = "یکصد"
Case "2"
o = "دویست"
Case "3"
o = "سیصد"
Case "4"
o = "چهارصد"
Case "5"
o = "پانصد"
Case "6"
o = "ششصد"
Case "7"
o = "هفتصد"
Case "8"
o = "هشصد"
Case "9"
o = "نهصد"
End Select
o2 = o
b = Strings.GetChar(Strings.Right("000" + s(i), 3), 2)
If b <> "1" Then
o = ""
Select Case b
Case "2"
o = "بیست"
Case "3"
o = "سی"
Case "4"
o = "چهل"
Case "5"
o = "پنجاه"
Case "6"
o = "شصت"
Case "7"
o = "هفتاد"
Case "8"
o = "هشتاد"
Case "9"
o = "نود"
End Select
ElseIf b = "1" Then
c = Strings.GetChar(Strings.Right("000" + s(i), 3), 3)
o = ""
Select Case c
Case "0"
o = "ده"
Case "1"
o = "یازده"
Case "2"
o = "دوازده"
Case "3"
o = "سیزده"
Case "4"
o = "چهارده"
Case "5"
o = "پانزده"
Case "6"
o = "شانزده"
Case "7"
o = "هفده"
Case "8"
o = "هجده"
Case "9"
o = "نوزده"
End Select
End If
o3 = o
If b <> 1 Then
c = Strings.GetChar(Strings.Right("000" + s(i), 3), 3)
o = ""
Select Case c
Case "1"
o = "یک"
Case "2"
o = "دو"
Case "3"
o = "سه"
Case "4"
o = "چهار"
Case "5"
o = "پنج"
Case "6"
o = "شش"
Case "7"
o = "هفت"
Case "8"
o = "هشت"
Case "9"
o = "نه"
End Select
End If
o4 = ""
If b = "1" Then
If o2 <> "" And o3 <> "" Then o4 = " و "
sa(i) = o2 + o4 + o3
Else
o4 = ""
o5 = ""
If o2 <> "" And (o3 <> "" Or o <> "") Then o4 = " و "
If o3 <> "" And o <> "" Then o5 = " و "
sa(i) = o2 + o4 + o3 + o5 + o
End If
Next
If sa(4) = "" Then s41 = "" Else s41 = " تریلیون"
If sa(3) = "" Then s31 = "" Else s31 = " میلیارد"
If sa(2) = "" Then s21 = "" Else s21 = " میلیون"
If sa(1) = "" Then s11 = "" Else s11 = " هزار"
If s41 <> "" And (sa(3) <> "" Or sa(2) <> "" Or sa(1) <> "" Or sa(0) <> "") Then s42 = " و " Else s42 = ""
If s31 <> "" And (sa(2) <> "" Or sa(1) <> "" Or sa(0) <> "") Then s32 = " و " Else s32 = ""
If s21 <> "" And (sa(1) <> "" Or sa(0) <> "") Then s22 = " و " Else s22 = ""
If s11 <> "" And sa(0) <> "" Then s12 = " و " Else s12 = ""
If st = "0" Then Return "صفر"
Return sign + sa(4) + s41 + s42 + sa(3) + s31 + s32 + sa(2) + s21 + s22 + sa(1) + s11 + s12 + sa(0)
End Function
سورس تابع تبدیل عدد به حروف:
Private Function a2h(ByVal st As String) As String
Dim i, l As Integer, sign, s(9), sa(4), s11, s12, s21, s22, s31, s32, s41, s42 As String
Dim b, o, o2, o3, o5, o4, c As String
If st = "" Then Return ""
sign = Strings.GetChar(st, 1)
st = Math.Abs(Val(st)).ToString
If sign = "+" Then
If st <> "0" Then sign = "مثبت "
ElseIf sign = "-" Then
If st <> "0" Then sign = "منفی "
Else
sign = ""
End If
l = st.Length
Do While l > 3
s(i) = Strings.Right(st, 3)
i = i + 1
st = Strings.Left(st, l - 3)
l = st.Length
Loop
s(i) = st
For i = 0 To 4
b = Strings.GetChar(Strings.Right("000" + s(i), 3), 1)
o = ""
Select Case b
Case "1"
o = "یکصد"
Case "2"
o = "دویست"
Case "3"
o = "سیصد"
Case "4"
o = "چهارصد"
Case "5"
o = "پانصد"
Case "6"
o = "ششصد"
Case "7"
o = "هفتصد"
Case "8"
o = "هشصد"
Case "9"
o = "نهصد"
End Select
o2 = o
b = Strings.GetChar(Strings.Right("000" + s(i), 3), 2)
If b <> "1" Then
o = ""
Select Case b
Case "2"
o = "بیست"
Case "3"
o = "سی"
Case "4"
o = "چهل"
Case "5"
o = "پنجاه"
Case "6"
o = "شصت"
Case "7"
o = "هفتاد"
Case "8"
o = "هشتاد"
Case "9"
o = "نود"
End Select
ElseIf b = "1" Then
c = Strings.GetChar(Strings.Right("000" + s(i), 3), 3)
o = ""
Select Case c
Case "0"
o = "ده"
Case "1"
o = "یازده"
Case "2"
o = "دوازده"
Case "3"
o = "سیزده"
Case "4"
o = "چهارده"
Case "5"
o = "پانزده"
Case "6"
o = "شانزده"
Case "7"
o = "هفده"
Case "8"
o = "هجده"
Case "9"
o = "نوزده"
End Select
End If
o3 = o
If b <> 1 Then
c = Strings.GetChar(Strings.Right("000" + s(i), 3), 3)
o = ""
Select Case c
Case "1"
o = "یک"
Case "2"
o = "دو"
Case "3"
o = "سه"
Case "4"
o = "چهار"
Case "5"
o = "پنج"
Case "6"
o = "شش"
Case "7"
o = "هفت"
Case "8"
o = "هشت"
Case "9"
o = "نه"
End Select
End If
o4 = ""
If b = "1" Then
If o2 <> "" And o3 <> "" Then o4 = " و "
sa(i) = o2 + o4 + o3
Else
o4 = ""
o5 = ""
If o2 <> "" And (o3 <> "" Or o <> "") Then o4 = " و "
If o3 <> "" And o <> "" Then o5 = " و "
sa(i) = o2 + o4 + o3 + o5 + o
End If
Next
If sa(4) = "" Then s41 = "" Else s41 = " تریلیون"
If sa(3) = "" Then s31 = "" Else s31 = " میلیارد"
If sa(2) = "" Then s21 = "" Else s21 = " میلیون"
If sa(1) = "" Then s11 = "" Else s11 = " هزار"
If s41 <> "" And (sa(3) <> "" Or sa(2) <> "" Or sa(1) <> "" Or sa(0) <> "") Then s42 = " و " Else s42 = ""
If s31 <> "" And (sa(2) <> "" Or sa(1) <> "" Or sa(0) <> "") Then s32 = " و " Else s32 = ""
If s21 <> "" And (sa(1) <> "" Or sa(0) <> "") Then s22 = " و " Else s22 = ""
If s11 <> "" And sa(0) <> "" Then s12 = " و " Else s12 = ""
If st = "0" Then Return "صفر"
Return sign + sa(4) + s41 + s42 + sa(3) + s31 + s32 + sa(2) + s21 + s22 + sa(1) + s11 + s12 + sa(0)
End Function