Mad_Angel
09-04-08, 20:33
تبديل عدد به حروف تا 48 رقم (هجي كردن عدد) :
اين برنامه قادره تا 48 رقم عدد رو به حروف تبديل كنه يعني هجي كنه. 48 رقم شامل 24 رقم عدد صحيح و 24
رقم اعشار هست
يك پروژه جديد باز كنيد و دو TextBox و يك Module به برنامه اضافه كنيد و كد زير رو تو Module كپي كنيد :
Const strHezar = " هزار"
Const strMilion = " ميليون"
Const strMiliyard = " ميليارد"
Const strTrilion = " تريليون"
Const strTriliyard = " تريليارد"
Const strBilion = " بيليون"
Const strBiliyard = " بيليارد"
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
Dim intS As Integer, intH As Integer, intM1 As Integer, intM2 As Integer, intT1 As Integer, intT2 As Integer, intB1 As Integer, intB2 As Integer
intLen = Len(strAadad)
If intLen >= 4 Then
intS = Val(Right(strAadad, 3)) ' sadgan
intH = Val(Left(Right(strAadad, 6), Len(Right(strAadad, 6)) - 3)) ' hezargan
End If
If intLen >= 7 Then intM1 = Val(Left(Right(strAadad, 9), Len(Right(strAadad, 9)) - 6)) ' miliongan
If intLen >= 10 Then intM2 = Val(Left(Right(strAadad, 12), Len(Right(strAadad, 12)) - 9)) ' miliyardgan
If intLen >= 13 Then intT1 = Val(Left(Right(strAadad, 15), Len(Right(strAadad, 15)) - 12)) ' triliongan
If intLen >= 16 Then intT2 = Val(Left(Right(strAadad, 18), Len(Right(strAadad, 18)) - 15)) ' triliyardgan
If intLen >= 19 Then intB1 = Val(Left(Right(strAadad, 21), Len(Right(strAadad, 21)) - 18)) ' bilion
If intLen >= 22 Then intB2 = Val(Left(Right(strAadad, 24), Len(Right(strAadad, 24)) - 21)) ' biliyard
Select Case intLen
Case 1 To 3 'Sadgan
strHoroof = Tabdil_3Ragham(strAadad)
Case 4 To 6 ' Hezargn
strHoroof = Tabdil_3Ragham(intH) & strHezar & IIf(strAadad Mod 1000 = 0, "", va & (Tabdil_3Ragham(strAadad Mod 1000)))
Case 7 To 9 ' Miliongan
strHoroof = Tabdil_3Ragham(intM1) & strMilion & IIf(intH = 0, "", va & Tabdil_3Ragham(intH) & strHezar) & IIf(intS = 0, "", va & Tabdil_3Ragham(intS))
Case 10 To 12 ' Miliyardgan
strHoroof = Tabdil_3Ragham(intM2) & strMiliyard & IIf(intM1 = 0, "", va & Tabdil_3Ragham(intM1) & strMilion) & IIf(intH = 0, "", va & Tabdil_3Ragham(intH) & strHezar) & IIf(intS = 0, "", va & Tabdil_3Ragham(intS))
Case 13 To 15 ' Triliongan
strHoroof = Tabdil_3Ragham(intT1) & strTrilion & IIf(intM2 = 0, "", va & Tabdil_3Ragham(intM2) & strMiliyard) & IIf(intM1 = 0, "", va & Tabdil_3Ragham(intM1) & strMilion) & IIf(intH = 0, "", va & Tabdil_3Ragham(intH) & strHezar) & IIf(intS = 0, "", va & Tabdil_3Ragham(intS))
Case 16 To 18 ' Triliyardgan
strHoroof = Tabdil_3Ragham(intT2) & strTriliyard & IIf(intT1 = 0, "", va & Tabdil_3Ragham(intT1) & strTrilion) & IIf(intM2 = 0, "", va & Tabdil_3Ragham(intM2) & strMiliyard) & IIf(intM1 = 0, "", va & Tabdil_3Ragham(intM1) & strMilion) & IIf(intH = 0, "", va & Tabdil_3Ragham(intH) & strHezar) & IIf(intS = 0, "", va & Tabdil_3Ragham(intS))
Case 19 To 21 ' Bilion
strHoroof = Tabdil_3Ragham(intB1) & strBilion & IIf(intT2 = 0, "", va & Tabdil_3Ragham(intT2) & strTriliyard) & IIf(intT1 = 0, "", va & Tabdil_3Ragham(intT1) & strTrilion) & IIf(intM2 = 0, "", va & Tabdil_3Ragham(intM2) & strMiliyard) & IIf(intM1 = 0, "", va & Tabdil_3Ragham(intM1) & strMilion) & IIf(intH = 0, "", va & Tabdil_3Ragham(intH) & strHezar) & IIf(intS = 0, "", va & Tabdil_3Ragham(intS))
Case 22 To 24 ' Biliyard
strHoroof = Tabdil_3Ragham(intB2) & strBiliyard & IIf(intB1 = 0, "", va & Tabdil_3Ragham(intB1) & strBilion) & IIf(intT2 = 0, "", va & Tabdil_3Ragham(intT2) & strTriliyard) & IIf(intT1 = 0, "", va & Tabdil_3Ragham(intT1) & strTrilion) & IIf(intM2 = 0, "", va & Tabdil_3Ragham(intM2) & strMiliyard) & IIf(intM1 = 0, "", va & Tabdil_3Ragham(intM1) & strMilion) & IIf(intH = 0, "", va & Tabdil_3Ragham(intH) & strHezar) & IIf(intS = 0, "", va & Tabdil_3Ragham(intS))
Case Is > 24
strHoroof = "عدد بزرگتر از محدوده بيليارد است"
End Select
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
حالا برنامه رو اجرا كنيد. موفق باشيد.
اين برنامه قادره تا 48 رقم عدد رو به حروف تبديل كنه يعني هجي كنه. 48 رقم شامل 24 رقم عدد صحيح و 24
رقم اعشار هست
يك پروژه جديد باز كنيد و دو TextBox و يك Module به برنامه اضافه كنيد و كد زير رو تو Module كپي كنيد :
Const strHezar = " هزار"
Const strMilion = " ميليون"
Const strMiliyard = " ميليارد"
Const strTrilion = " تريليون"
Const strTriliyard = " تريليارد"
Const strBilion = " بيليون"
Const strBiliyard = " بيليارد"
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
Dim intS As Integer, intH As Integer, intM1 As Integer, intM2 As Integer, intT1 As Integer, intT2 As Integer, intB1 As Integer, intB2 As Integer
intLen = Len(strAadad)
If intLen >= 4 Then
intS = Val(Right(strAadad, 3)) ' sadgan
intH = Val(Left(Right(strAadad, 6), Len(Right(strAadad, 6)) - 3)) ' hezargan
End If
If intLen >= 7 Then intM1 = Val(Left(Right(strAadad, 9), Len(Right(strAadad, 9)) - 6)) ' miliongan
If intLen >= 10 Then intM2 = Val(Left(Right(strAadad, 12), Len(Right(strAadad, 12)) - 9)) ' miliyardgan
If intLen >= 13 Then intT1 = Val(Left(Right(strAadad, 15), Len(Right(strAadad, 15)) - 12)) ' triliongan
If intLen >= 16 Then intT2 = Val(Left(Right(strAadad, 18), Len(Right(strAadad, 18)) - 15)) ' triliyardgan
If intLen >= 19 Then intB1 = Val(Left(Right(strAadad, 21), Len(Right(strAadad, 21)) - 18)) ' bilion
If intLen >= 22 Then intB2 = Val(Left(Right(strAadad, 24), Len(Right(strAadad, 24)) - 21)) ' biliyard
Select Case intLen
Case 1 To 3 'Sadgan
strHoroof = Tabdil_3Ragham(strAadad)
Case 4 To 6 ' Hezargn
strHoroof = Tabdil_3Ragham(intH) & strHezar & IIf(strAadad Mod 1000 = 0, "", va & (Tabdil_3Ragham(strAadad Mod 1000)))
Case 7 To 9 ' Miliongan
strHoroof = Tabdil_3Ragham(intM1) & strMilion & IIf(intH = 0, "", va & Tabdil_3Ragham(intH) & strHezar) & IIf(intS = 0, "", va & Tabdil_3Ragham(intS))
Case 10 To 12 ' Miliyardgan
strHoroof = Tabdil_3Ragham(intM2) & strMiliyard & IIf(intM1 = 0, "", va & Tabdil_3Ragham(intM1) & strMilion) & IIf(intH = 0, "", va & Tabdil_3Ragham(intH) & strHezar) & IIf(intS = 0, "", va & Tabdil_3Ragham(intS))
Case 13 To 15 ' Triliongan
strHoroof = Tabdil_3Ragham(intT1) & strTrilion & IIf(intM2 = 0, "", va & Tabdil_3Ragham(intM2) & strMiliyard) & IIf(intM1 = 0, "", va & Tabdil_3Ragham(intM1) & strMilion) & IIf(intH = 0, "", va & Tabdil_3Ragham(intH) & strHezar) & IIf(intS = 0, "", va & Tabdil_3Ragham(intS))
Case 16 To 18 ' Triliyardgan
strHoroof = Tabdil_3Ragham(intT2) & strTriliyard & IIf(intT1 = 0, "", va & Tabdil_3Ragham(intT1) & strTrilion) & IIf(intM2 = 0, "", va & Tabdil_3Ragham(intM2) & strMiliyard) & IIf(intM1 = 0, "", va & Tabdil_3Ragham(intM1) & strMilion) & IIf(intH = 0, "", va & Tabdil_3Ragham(intH) & strHezar) & IIf(intS = 0, "", va & Tabdil_3Ragham(intS))
Case 19 To 21 ' Bilion
strHoroof = Tabdil_3Ragham(intB1) & strBilion & IIf(intT2 = 0, "", va & Tabdil_3Ragham(intT2) & strTriliyard) & IIf(intT1 = 0, "", va & Tabdil_3Ragham(intT1) & strTrilion) & IIf(intM2 = 0, "", va & Tabdil_3Ragham(intM2) & strMiliyard) & IIf(intM1 = 0, "", va & Tabdil_3Ragham(intM1) & strMilion) & IIf(intH = 0, "", va & Tabdil_3Ragham(intH) & strHezar) & IIf(intS = 0, "", va & Tabdil_3Ragham(intS))
Case 22 To 24 ' Biliyard
strHoroof = Tabdil_3Ragham(intB2) & strBiliyard & IIf(intB1 = 0, "", va & Tabdil_3Ragham(intB1) & strBilion) & IIf(intT2 = 0, "", va & Tabdil_3Ragham(intT2) & strTriliyard) & IIf(intT1 = 0, "", va & Tabdil_3Ragham(intT1) & strTrilion) & IIf(intM2 = 0, "", va & Tabdil_3Ragham(intM2) & strMiliyard) & IIf(intM1 = 0, "", va & Tabdil_3Ragham(intM1) & strMilion) & IIf(intH = 0, "", va & Tabdil_3Ragham(intH) & strHezar) & IIf(intS = 0, "", va & Tabdil_3Ragham(intS))
Case Is > 24
strHoroof = "عدد بزرگتر از محدوده بيليارد است"
End Select
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
حالا برنامه رو اجرا كنيد. موفق باشيد.