یه سوال در مورد تبدیل عدد به حروف

[jaberaghidat]

با سلام

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

مثلا :

100 = صد

1000 = هزار

258 = دویست و پنجاه و هشت

1000010 = یک میلیون و ده

و ............

اگه بشه اعداد از 1 شروع بشه تا 9999999999999999999999999999 یا کمتر

هر کی داره لطف کنه لینک دانلودیشو بزاره

خواهشا اگه میخواین کمک کنید به صورت پروژه بزارین برنامه رو !

[AmirAmiri]

بیا عزیزم این دقیقا همون چیزیه که تو میخوای و یه کمی هم بیشتر از اون....
تبدیل عدد به حروف تا 48 رقم (24 رقم عدد صحیح و 24 رقم عدد اعشاری) به بهترین فرمت و بدون خطا.

لینک : http://www.v-basic.mihanblog.com/post/11
لینک دانلود نیست ها........ وبلاگه. کد رو اونجا نوشتم برو ببین.

[jaberaghidat]

آدرس اشتباه هست قربون دستت دوباره چک کن
در ضمن اگه میشه در حد توان پروژه بزارین قربون دستتون

[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


حالا برنامه رو اجرا كنید. موفق باشید.

[shahmahi]

اینم یک پروژه :چشمک:

[xxxxx_xxxxx]

قبلاً دو نمونه از این برنامه تو سایت قرار داده شده. یکی فارسی. یکی انگلیسی.
جستجو کنید

[a_mohammadi_m]

با سلام
خوبه فقط نام اعداد بزرگ اشتباهه
جهت اطلاع دقيق به آخرين شماره مجله رياضي برهان ( مقاله : تا چند بلدي بشماري ؟ ) مراجعه كنيد