یه کدی که عدد وارد کنی معادل اون عدد رو به حروف بده

[elmira_63]

سلام دوستان
توی یه برنامه دیدم که وقتی کاربر قیمت یه کالا رو وارد می کرد توی تکست باکس دیگه ای اون عدد رو به حروف می نوشت
مثلا وقتی می زد 1000 توی اونجا می نوشت هزار تومان

[afsharm]

یک آقایی به اسم احسان شهشهانی زحمت این کار را کشیده و آن را در اینجا (http://www.prdev.com/search/aisearch.asp?id=218)گذاشته‌اند. من از این کد در یک برنامه استفاده کرده‌ام و ظاهرا مشکل خاصی ندارد.

[ali_md110]

استفاده کن شاید مناسب بود
این هم یکی دیگه

Option Strict Off
Option Explicit On
Imports VB = Microsoft.VisualBasic
Friend Class Form1
Inherits System.Windows.Forms.Form
Private Function NumToText(ByRef Adad As Double) As String
Static sefr_ta_noh(9) As String
Static dah_ta_noozdah(9) As String
Static bist_ta_navado(9) As String
Static sad_ta_nohsad(9) As String
Static hezar_ta_trilion(4) As String

Dim i As Short
Dim tamam_sefr As Boolean
Dim show_balatar_az_hezar As Boolean
Dim adad_vorodi As String
Dim string_temp As String
Dim tabdil As String
Dim Ragham As Short
Dim character As Short
System.Diagnostics.Debug.Assert(Adad > 0, "")

sefr_ta_noh(0) = "صفر"
sefr_ta_noh(1) = "يک"
sefr_ta_noh(2) = "دو"
sefr_ta_noh(3) = "سه"
sefr_ta_noh(4) = "چهار"
sefr_ta_noh(5) = "پنج"
sefr_ta_noh(6) = "شش"
sefr_ta_noh(7) = "هفت"
sefr_ta_noh(8) = "هشت"
sefr_ta_noh(9) = "نه"
dah_ta_noozdah(0) = "ده"
dah_ta_noozdah(1) = "يازده"
dah_ta_noozdah(2) = "دوازده"
dah_ta_noozdah(3) = "سيزده"
dah_ta_noozdah(4) = "چهارده"
dah_ta_noozdah(5) = "بانزده"
dah_ta_noozdah(6) = "شانزده"
dah_ta_noozdah(7) = "هفده"
dah_ta_noozdah(8) = "هجده"
dah_ta_noozdah(9) = "نوزده"
'bist_ta_navado(0) = ""
'bist_ta_navado(1) = "ده"
bist_ta_navado(2) = "بيست"
bist_ta_navado(3) = "سي"
bist_ta_navado(4) = "چهل"
bist_ta_navado(5) = "بنجاه"
bist_ta_navado(6) = "شصت"
bist_ta_navado(7) = "هفتاد"
bist_ta_navado(8) = "هشتاد"
bist_ta_navado(9) = "نود"
'sad_ta_nohsad(0) = ""
sad_ta_nohsad(1) = "يک صد"
sad_ta_nohsad(2) = "دويست"
sad_ta_nohsad(3) = "سيصد"
sad_ta_nohsad(4) = "حهارصد"
sad_ta_nohsad(5) = "بانصد"
sad_ta_nohsad(6) = "ششصد"
sad_ta_nohsad(7) = "هفتصد"
sad_ta_nohsad(8) = "هشتصد"
sad_ta_nohsad(9) = "تهصد"
'hezar_ta_trilion(0) = ""
hezar_ta_trilion(1) = "هزار"
hezar_ta_trilion(2) = "ميليون"
hezar_ta_trilion(3) = "ميليارد"
hezar_ta_trilion(4) = "تريليون"


On Error GoTo vbErrorHandler

adad_vorodi = CStr(Adad)

tamam_sefr = True

For i = Len(adad_vorodi) To 1 Step -1
character = Val(Mid(adad_vorodi, i, 1))
Ragham = (Len(adad_vorodi) - i) + 1

Select Case (Ragham Mod 3)
Case 0
If character > 0 Then
tabdil = sad_ta_nohsad(character) & " و " & tabdil
End If
Case 1
show_balatar_az_hezar = True
If i = 1 Then
string_temp = sefr_ta_noh(character) & " "
ElseIf Mid(adad_vorodi, i - 1, 1) = "1" Then
string_temp = dah_ta_noozdah(character) & " "
i = i - 1
ElseIf character > 0 Then
string_temp = sefr_ta_noh(character) & " "
Else
show_balatar_az_hezar = False
If Mid(adad_vorodi, i - 1, 1) <> "0" Then
show_balatar_az_hezar = True
ElseIf i > 2 Then
If Mid(adad_vorodi, i - 2, 1) <> "0" Then
show_balatar_az_hezar = True
End If
End If
string_temp = ""
End If
If show_balatar_az_hezar = True Then
If Ragham > 1 Then

string_temp = string_temp & hezar_ta_trilion(Ragham \ 3)
If tamam_sefr = True Then
string_temp = string_temp & " "
Else
string_temp = string_temp & " و "
End If
End If
tamam_sefr = False
End If
tabdil = string_temp & tabdil
Case 2
If character > 0 Then
If Mid(adad_vorodi, i + 1, 1) <> "0" Then
tabdil = bist_ta_navado(character) & " و " & tabdil
Else
tabdil = bist_ta_navado(character) & " " & tabdil
End If
End If

End Select
Next i

tabdil = UCase(VB.Left(tabdil, 1)) & Mid(tabdil, 2)

EndNumToText:
NumToText = tabdil
Exit Function

vbErrorHandler:
tabdil = "خطا"
Resume EndNumToText
End Function

End Class

[parsavb]

این رو یه نگاهی کن ببین به دردت می خوره