چاپ اعداد به حروف

[رضوانی]

سلام اساتید گرامی. می خوام بتونم تو برنامه ام اعداد را که در تکست می نویسم به حروف در labelنشان دهد.خیلی عجله دارم و فرصت جستجو در صفخات را ندارم.

[mpmsoft]

جستجو كن تو سايت هست

[3dboy1]

خواستم ماژول اون رو بزارم اما بدليل مشكلات فارسي نشد

يك نمونه سورس خيلي ساده در اين رابطه :
http://users5.titanichost.com/3dboy/sorce/Adad_Horof.rar

اميدوارم بدردتون بخوره

[Pr0grammer]

سلام...
شرمنده اما دوست عزیز بهتره که قوانین سایت (http://barnamenevis.org/forum/showthread.php?t=51814) رو مطالعه کنید!



قانون شماره 5
پیش از مطرح کردن سوال خود از امکان جستجوی سایت (http://barnamenevis.org/forum/search.php) استفاده کرده و در صورتی که به جواب سوال خود نرسیدید، اقدام به ساخت گفتگوی جدید نمایید.
* در صورت تخطی از قوانین ....... و 5 اشتراک کاربر متخلف حذف و دسترسی وی به انجمن ها قطع می شود. بنابراین به گمونم تاپیک حذف بشه!
موفق باشید

[AmirAmiri]

واسه اینکه فعلا کارتون راه بیفته ولی بعدا تاپیک رو حذف کنید چون از این جور آموزشها زیاده :

تبدیل عدد به حروف تا 48 رقم (هجی كردن عدد)
این برنامه قادره تا 48 رقم عدد رو به حروف تبدیل كنه یعنی هجی كنه. 48 رقم شامل 24 رقم عدد صحیح و 24 رقم اعشار هست. لازم به ذكره كه این برنامه توسط خودم نوشته شده پس اگه توش عیب و ایرادی وجود داشت اونو به حساب ضعیف بودن من در ریاضی بزارید.
یك پروژه جدید باز كنید و دو TextBox و یك Module به برنامه اضافه كنید و كد زیر رو تو Module كپی كنید :



Const va = " و "
Public Function Horoof(ByVal strAdad As String) As String
strHoroofAshar = Array("", " دهم", " صدم", " هزام", " ده هزارم", " صد هزارم", " میلیونم", " ده میلیونم", " صد میلیونم", " میلیاردم", " ده میلیاردم", " صد میلیاردم", " تریلیونم", " ده تریلیونم", " صد تریلیونم", " تریلیاردم", " ده تریلیاردم", " صد تریلیاردم", " بیلیونم", " ده بیلیونم", " صد بیلیونم", " بیلیاردم", " ده بیلیاردم", " صد بیلیاردم")
intAshar = InStr(strAdad, ".")
intTedadAshar = Len(strAdad) - intAshar
Dim strAns As String, strLeft As String, strRight As String
If intAshar > 0 Then
strLeft = Tabdil(Left(strAdad, intAshar - 1))
strRight = Tabdil(Right(strAdad, Len(strAdad) - intAshar))
strAns = IIf(Val(Left(strAdad, intAshar - 1)) = 0, "", strLeft & " ???? ") & strRight
If intTedadAshar < 22 Then strAns = strAns & strHoroofAshar(intTedadAshar)
Else
strAns = Tabdil(strAdad)
End If
Horoof = strAns
End Function

Private Function Tabdil(ByVal strAadad As String) As String
strNam = Array(" ", " هزار", " میلیون", " میلیارد", " تریلیون", " تریلیارد", " بیلیون", " بیلیارد", "")
Dim intD(8) As Integer
N = 0
intLen = Len(strAadad)
For i = 0 To 7
N = N + 3
LenNum = Len(Right(strAadad, N)) - (N - 3)
If (intLen >= N - 2) Then intD(i) = Val(Left(Right(strAadad, N), LenNum))
Next
For i = LBound(intD) To UBound(intD)
If intD(i) <> 0 Then strHoroof = IIf(intD(i + 1) <> 0, va, "") & Tabdil_3Ragham(intD(i)) & strNam(i) & strHoroof
Next
Tabdil = strHoroof
End Function

Private Function Tabdil_3Ragham(ByVal intAdad As Integer) As String
strYekan = Array("صفر", "یک", "دو", "سه", "چهار", "پنج", "شش", "هفت", "هشت", "نه", "ده", "یازده", "دوازده", "سیزده", "چهارده", "پانزده", "شانزده", "هفده", "هجده", "نوزده")
strDahgan = Array("", "ده", "بیست", "سی", "چهل", "پنجاه", "شصت", "هفتاد", "هشتاد", "نود")
strSadgan = Array("", "یکصد", "دویست", "سیصد", "چهارصد", "پانصد", "ششصد", "هفتصد", "هشتصد", "نهصد")
intY = intAdad Mod 10
intD = (intAdad Mod 100) \ 10
intS = intAdad \ 100
If intD < 2 Then
strHoroof = IIf(intS = 0, "", strSadgan(intS) & va) & strYekan(intAdad Mod 100)
If (intS > 0 And intD = 0 And intY = 0) Then strHoroof = strSadgan(intS)
Else
strHoroof = IIf(intS = 0, "", strSadgan(intS) & va) & strDahgan(intD) & IIf(intY = 0, "", va & strYekan(intY))
End If
Tabdil_3Ragham = strHoroof
End Function

حالا كد زیر رو تو قسمت جنرال فرمتون كپی كنید :


Private Sub Text1_Change()
Text2.Text = Horoof(Text1.Text)
End Sub
حالا برنامه رو اجرا كنید. موفق باشید

منبع : http://www.v-basic.mihanblog.com/post/11