+- منتدى فيجوال بيسك لكل العرب | منتدى المبرمجين العرب (http://vb4arb.com/vb)
+-- قسم : قسم أسئلة واستفسارات الأعضاء - المنتدى القديم (http://vb4arb.com/vb/forumdisplay.php?fid=94)
+--- قسم : قسم Visual Basic 6 وما قبله (http://vb4arb.com/vb/forumdisplay.php?fid=167)
+--- الموضوع : تحويل الارقام الى حروف Convertir des chiffres en lettres (/showthread.php?tid=9872)
تحويل الارقام الى حروف Convertir des chiffres en lettres - derbaliammar - 31-07-13
الادوات المطلوبة :
- text1 نسميه TxtNombre
- label 1 نسميها LblConverti
- commande نسميه CmdConvertir
- commande نسميه CmdFin
- commande نسميه CmdNewConv
- فورمة واحدة
- Module
- class Module
اذا ننطلق في البرمجة ضع هذا الكود في الفورمة التي نسميها FrmPrincipale :
كود :
Option Explicit
Dim ClsConvertir As ClsChiffresEnLettres
Private Sub CmdConvertir_Click()
' instanciation de la classe dans laquelle se trouve la fonction de conversion
Set ClsConvertir = New ClsChiffresEnLettres
Dim Nombre As Variant
Nombre = TxtNombre.Text
' appel de la classe en donnant le nombre à convertir
ClsConvertir.NombreChiffres = Nombre
' puis appel pour convertir réellement ce nombre
LblConverti.Caption = ClsConvertir.Conversion(Nombre)
CmdNewConv.Visible = True
End Sub
Private Sub CmdFin_Click()
Unload Me
End
End Sub
Private Sub CmdNewConv_Click()
LblConverti.Caption = ""
TxtNombre.Text = ""
TxtNombre.SetFocus
CmdNewConv.Visible = False
End Sub
Private Sub Form_Load()
ImgFond.Picture = LoadPicture(App.Path & "\confetti.jpg")
TxtNombre.Text = ""
End Sub
Private Sub Form_Resize()
ImgFond.Move 0, 0, ScaleWidth, ScaleHeight
End Sub
Private Sub TxtNombre_KeyPress(KeyAscii As Integer)
Select Case KeyAscii
Case Asc(".") ' change le "." en ","
KeyAscii = Asc(",")
Case 8 ' gère le backspace
TxtNombre = Left(TxtNombre, Len(TxtNombre))
Case 48 To 57, Asc(",") ' accepte si c'est un chiffre correct
Case Else 'n'inscrit rien si c'est un caractère incorrect
KeyAscii = 0
End Select
End Sub[SIZE=5]نظيف [/SIZE]Module و نسمه ModuleChLet و نظيف له الكود التالي
كود :
Option Explicit
' j'ai pris le principe du fichier ini pour lire dans un fichier la traduction en lettre des chiffres
' il suffit donc de changer ce fichier pour avoir les chiffres dans une autre langue
' et aussi d'adapter un peu la routines (par ex pour les français : 70 = soixante-dix)
Public CheminFichierLettres As String
Private Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" _
(ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpDefault As String, _
ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long
Private Declare Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" _
(ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpString As Any, _
ByVal lpFileName As String) As Long
Public fMainForm As FrmPrincipale
Sub main()
Set fMainForm = New FrmPrincipale
CheminFichierLettres = App.Path & "\ChToLet.ini"
fMainForm.Show
End Sub
Public Function EcritDansFichierLettres(Section As String, Cle As String, _
Valeur As String, Fichier As String) As Long
EcritDansFichierLettres = WritePrivateProfileString(Section, Cle, Valeur, Fichier)
End Function
Public Function LitDansFichierLettres(Section As String, Cle As String, Fichier As String, _
Optional ValeurParDefaut As String = "") As String
Dim strReturn As String
strReturn = String(255, 0)
GetPrivateProfileString Section, Cle, ValeurParDefaut, strReturn, Len(strReturn), Fichier
LitDansFichierLettres = Left(strReturn, InStr(strReturn, Chr(0)) - 1)
End Functionنظيف classmodule و نسمه ClsChiffresEnLettres و نظيف له الكود التالي
كود :
Option Explicit
'variables locales de stockage des valeurs de propriétés
Private mvarNombreChiffres As Variant 'copie locale
Private mvarNombreLettres As String 'copie locale
Public Function Conversion(ByVal nb As String) As String
Dim NbDeci As String
Dim Affichage As String
Dim Entier As String
Dim Décimal As String
If InStr(nb, ",") = 0 Then ' un entier
Affichage = Decodage(nb)
Else ' un décimal
Do While Right(nb, 1) = "0" 'suppression des zéros à droite de la partie décimale
If Right(nb, 1) = "0" Then nb = Left(nb, Len(nb) - 1)
Loop
Entier = Decodage(Left(nb, InStr(nb, ",") - 1))
If Right(Entier, 2) = "un" Then Entier = Entier & "e"
If Entier = "une" Then
Entier = Entier & " unité "
Else
If Entier <> "" Then
Entier = Entier & " unités "
End If
End If
Décimal = Decodage(Mid(nb, InStr(nb, ",") + 1))
Affichage = Entier & Décimal & " "
' calcul du nombre de décimales
NbDeci = Len(Mid(nb, InStr(nb, ",") + 1))
Affichage = Affichage & LitDansFichierLettres("Decimale", NbDeci, CheminFichierLettres)
If Décimal <> "un" Then Affichage = Affichage & "s"
End If
Conversion = Affichage
End Function
Public Property Let NombreLettres(ByVal vData As String)
'utilisé lors de l'affectation d'une valeur à la propriété, du coté gauche de l'affectation.
'Syntax: X.NombreLettres = 5
mvarNombreLettres = vData
End Property
Public Property Get NombreLettres() As String
'utilisé lors de la lecture de la valeur de la propriété, du coté droit de l'instruction.
'Syntax: Debug.Print X.NombreLettres
NombreLettres = mvarNombreLettres
End Property
Public Property Let NombreChiffres(ByVal vData As Variant)
'utilisé lors de l'affectation d'une valeur à la propriété, du coté gauche de l'affectation.
'Syntax: X.NombreChiffres = 5
mvarNombreChiffres = vData
End Property
Public Property Get NombreChiffres() As Variant
'utilisé lors de la lecture de la valeur de la propriété, du coté droit de l'instruction.
'Syntax: Debug.Print X.NombreChiffres
If IsObject(mvarNombreChiffres) Then
Set NombreChiffres = mvarNombreChiffres
Else
NombreChiffres = mvarNombreChiffres
End If
End Property
Private Function Decodage(ByVal nb As String) As String
Dim nb1 As String
Do While Left(nb, 1) = "0"
If Left(nb, 1) = "0" Then nb = Mid(nb, 2) 'suppression des zéros à gauche
Loop
Select Case Len(nb)
Case 0
Decodage = ""
Case 1
Decodage = LitDansFichierLettres("Chiffres", nb, CheminFichierLettres)
Case 2
If nb < 17 Then
Decodage = LitDansFichierLettres("Chiffres", nb, CheminFichierLettres)
Else
nb1 = nb - Right(nb, 1)
Decodage = LitDansFichierLettres("Chiffres", nb1, CheminFichierLettres)
nb1 = Right(nb, 1)
Decodage = Decodage & "-" & LitDansFichierLettres("Chiffres", nb1, CheminFichierLettres)
End If
If Right(Decodage, 2) = "un" And nb > 20 Then Decodage = Left(Decodage, Len(Decodage) - 2) & "et un"
If Right(Decodage, 4) = "zéro" Then Decodage = Left(Decodage, Len(Decodage) - 5)
Case 3
Select Case Left(nb, 1)
Case "1"
Decodage = "cent " & Decodage(Mid(nb, 2))
Case Else
Decodage = Decodage(Left(nb, 1)) & " cent " & Decodage(Mid(nb, 2))
If Right(Decodage, 6) = " cent " Then Decodage = Left(Decodage, Len(Decodage) - 1) & "s"
End Select
Case 4 To 6
Decodage = Decodage(Left(nb, Len(nb) - 3)) & " mille " & Decodage(Right(nb, 3))
If Left(Decodage, 2) = "un" Then Decodage = Mid(Decodage, 4)
Case 7 To 9
Decodage = Decodage(Left(nb, Len(nb) - 6)) & " millions " & Decodage(Right(nb, 6))
If Left(Decodage, 2) = "un" Then Decodage = Left(Decodage, 10) & Mid(Decodage, 12)
Case 10 To 12
Decodage = Decodage(Left(nb, Len(nb) - 9)) & " milliards " & Decodage(Right(nb, 9))
If Left(Decodage, 2) = "un" Then Decodage = Left(Decodage, 11) & Mid(Decodage, 13)
End Select
End Functionتحويل الارقام الى حروف Convertir des chiffres en lettres - عبدالله الصافي - 31-07-13
لو تفضل الأخ الكريم لم أفهم ما الغرض من المشروع بالضبط فلقد قمت بنسخ الأكواد وعمل رن للمشروع ولكني لم استوعب النتيجة أرجو التوضيح أكثر
تحويل الارقام الى حروف Convertir des chiffres en lettres - derbaliammar - 31-07-13
هذا المشروع يقوم باستبدال الارقام مثلا [SIZE=7]3 الى كلمات trois[/SIZE]
تحويل الارقام الى حروف Convertir des chiffres en lettres - ahmed3d - 19-08-13
اخي انا لصراحة اكره انسخ الاكواد و الصقها بدون ما افهم شي طبعا هون صعب الشرح بس ياريت حد يعلمني انتو كيف كتبتو هاي الاكواد كلها
تحويل الارقام الى حروف Convertir des chiffres en lettres - ولد رائع - 19-08-13
PHP كود :
Public Function Horof(X)
Ma = " ريال"
Mi = " هللة"
N = Int(X)
b = Val(Right(Format(X, "000000000000.00"), 2))
R = SHorof(N)
If R <> "" And b > 0 Then Result = R & Ma & " و " & b & Mi
If R <> "" And b = 0 Then Result = R & Ma
If R = "" And b <> 0 Then Result = b & Mi
Horof = Result
End Function
Private Function SHorof(X)
N = Int(X)
C = Format(N, "000000000000")
C1 = Val(Mid(C, 12, 1))
Select Case C1
Case Is = 1: Letter1 = "واحد"
Case Is = 2: Letter1 = "اثنان"
Case Is = 3: Letter1 = "ثلاثة"
Case Is = 4: Letter1 = "اربعة"
Case Is = 5: Letter1 = "خمسة"
Case Is = 6: Letter1 = "ستة"
Case Is = 7: Letter1 = "سبعة"
Case Is = 8: Letter1 = "ثمانية"
Case Is = 9: Letter1 = "تسعة"
End Select
C2 = Val(Mid(C, 11, 1))
Select Case C2
Case Is = 1: Letter2 = "عشر"
Case Is = 2: Letter2 = "عشرون"
Case Is = 3: Letter2 = "ثلاثون"
Case Is = 4: Letter2 = "اربعون"
Case Is = 5: Letter2 = "خمسون"
Case Is = 6: Letter2 = "ستون"
Case Is = 7: Letter2 = "سبعون"
Case Is = 8: Letter2 = "ثمانون"
Case Is = 9: Letter2 = "تسعون"
End Select
If Letter1 <> "" And C2 > 1 Then Letter2 = Letter1 + " و" + Letter2
If Letter2 = "" Then Letter2 = Letter1
If C1 = 0 And C2 = 1 Then Letter2 = Letter2 + "ة"
If C1 = 1 And C2 = 1 Then Letter2 = "احدى عشر"
If C1 = 2 And C2 = 1 Then Letter2 = "اثنى عشر"
If C1 > 2 And C2 = 1 Then Letter2 = Letter1 + " " + Letter2
C3 = Val(Mid(C, 10, 1))
Select Case C3
Case Is = 1: Letter3 = "مائة"
Case Is = 2: Letter3 = "مئتان"
Case Is > 2: Letter3 = Left(SHorof(C3), Len(SHorof(C3)) - 1) + "مائة"
End Select
If Letter3 <> "" And Letter2 <> "" Then Letter3 = Letter3 + " و" + Letter2
If Letter3 = "" Then Letter3 = Letter2
C4 = Val(Mid(C, 7, 3))
Select Case C4
Case Is = 1: Letter4 = "الف"
Case Is = 2: Letter4 = "الفان"
Case 3 To 10: Letter4 = SHorof(C4) + " آلاف"
Case Is > 10: Letter4 = SHorof(C4) + " الف"
End Select
If Letter4 <> "" And Letter3 <> "" Then Letter4 = Letter4 + " و" + Letter3
If Letter4 = "" Then Letter4 = Letter3
C5 = Val(Mid(C, 4, 3))
Select Case C5
Case Is = 1: Letter5 = "مليون"
Case Is = 2: Letter5 = "مليونان"
Case 3 To 10: Letter5 = SHorof(C5) + " ملايين"
Case Is > 10: Letter5 = SHorof(C5) + " مليون"
End Select
If Letter5 <> "" And Letter4 <> "" Then Letter5 = Letter5 + " و" + Letter4
If Letter5 = "" Then Letter5 = Letter4
C6 = Val(Mid(C, 1, 3))
Select Case C6
Case Is = 1: Letter6 = "مليار"
Case Is = 2: Letter6 = "ملياران"
Case Is > 2: Letter6 = SHorof(C6) + " مليار"
End Select
If Letter6 <> "" And Letter5 <> "" Then Letter6 = Letter6 + " و" + Letter5
If Letter6 = "" Then Letter6 = Letter5
SHorof = Letter6
End Function
وهذا كود بحث باكثر من طريقة والجمع بالارقام واظهارها بالحروف بجانب الارقام (( عبر label وعددهم 11 label))
PHP كود :
Private Sub Command1_Click()
Dim b As String
b = " هذا أجمالي السحب لجميع الموظفين "
Select Case Combo1.ListIndex
Case 0
Adodc1.RecordSource = "select *from stor where no_job=" & Val(Text1.Text)
Adodc1.Refresh
Adodc2.RecordSource = "select sum(op),sum(do),sum(cheke),sum(teeth),sum(eye),sum(bayby),sum(ded),sum(out),sum(help),sum(hurt),sum(totel) from stor where no_job=" & Val(Text1.Text)
Adodc2.Refresh
If Val(Text3.Text) Or Val(Text4.Text) Or Val(Text5.Text) Or Val(Text6.Text) Or Val(Text7.Text) Or Val(Text8.Text) Or Val(Text9.Text) Or Val(Text10.Text) Or Val(Text11.Text) > 0 Then
S1 = Horof(Text3.Text)
S2 = Horof(Text2.Text)
S3 = Horof(Text7.Text)
S4 = Horof(Text8.Text)
S5 = Horof(Text9.Text)
S6 = Horof(Text10.Text)
S7 = Horof(Text13.Text)
S8 = Horof(Text11.Text)
S9 = Horof(Text4.Text)
S10 = Horof(Text5.Text)
S11 = Horof(Text6.Text)
Else
S1.Caption = "صفر ريال"
S2.Caption = "صفر ريال"
S3.Caption = "صفر ريال"
S4.Caption = "صفر ريال"
S5.Caption = "صفر ريال"
S6.Caption = "صفر ريال"
S7.Caption = "صفر ريال"
S8.Caption = "صفر ريال"
S9.Caption = "صفر ريال"
S10.Caption = "صفر ريال"
S11.Caption = "صفر ريال"
End If
Case 1
Adodc1.RecordSource = "select *from stor where name= '" & Text1.Text & "'"
Adodc1.Refresh
Adodc2.RecordSource = "select sum(op),sum(do),sum(cheke),sum(teeth),sum(eye),sum(bayby),sum(ded),sum(out),sum(help),sum(hurt),sum(totel) from stor where name= '" & Text1.Text & "'"
Adodc2.Refresh
If Val(Text3.Text) Or Val(Text4.Text) Or Val(Text5.Text) Or Val(Text6.Text) Or Val(Text7.Text) Or Val(Text8.Text) Or Val(Text9.Text) Or Val(Text10.Text) Or Val(Text11.Text) > 0 Then
S1 = Horof(Text3.Text)
S2 = Horof(Text2.Text)
S3 = Horof(Text7.Text)
S4 = Horof(Text8.Text)
S5 = Horof(Text9.Text)
S6 = Horof(Text10.Text)
S7 = Horof(Text13.Text)
S8 = Horof(Text11.Text)
S9 = Horof(Text4.Text)
S10 = Horof(Text5.Text)
S11 = Horof(Text6.Text)
Else
S1.Caption = "صفر ريال"
S2.Caption = "صفر ريال"
S3.Caption = "صفر ريال"
S4.Caption = "صفر ريال"
S5.Caption = "صفر ريال"
S6.Caption = "صفر ريال"
S7.Caption = "صفر ريال"
S8.Caption = "صفر ريال"
S9.Caption = "صفر ريال"
S10.Caption = "صفر ريال"
S11.Caption = "صفر ريال"
End If
Case 2
Adodc1.RecordSource = "select *from stor where no_bil=" & Val(Text1.Text)
Adodc1.Refresh
Adodc2.RecordSource = "select sum(op),sum(do),sum(cheke),sum(teeth),sum(eye),sum(bayby),sum(ded),sum(out),sum(help),sum(hurt),sum(totel) from stor where no_bil=" & Val(Text1.Text)
Adodc2.Refresh
If Val(Text3.Text) Or Val(Text4.Text) Or Val(Text5.Text) Or Val(Text6.Text) Or Val(Text7.Text) Or Val(Text8.Text) Or Val(Text9.Text) Or Val(Text10.Text) Or Val(Text11.Text) > 0 Then
S1 = Horof(Text3.Text)
S2 = Horof(Text2.Text)
S3 = Horof(Text7.Text)
S4 = Horof(Text8.Text)
S5 = Horof(Text9.Text)
S6 = Horof(Text10.Text)
S7 = Horof(Text13.Text)
S8 = Horof(Text11.Text)
S9 = Horof(Text4.Text)
S10 = Horof(Text5.Text)
S11 = Horof(Text6.Text)
Else
S1.Caption = "صفر ريال"
S2.Caption = "صفر ريال"
S3.Caption = "صفر ريال"
S4.Caption = "صفر ريال"
S5.Caption = "صفر ريال"
S6.Caption = "صفر ريال"
S7.Caption = "صفر ريال"
S8.Caption = "صفر ريال"
S9.Caption = "صفر ريال"
S10.Caption = "صفر ريال"
S11.Caption = "صفر ريال"
End If
Case 3
Adodc1.RecordSource = "select *from stor where on_Card=" & Val(Text1.Text)
Adodc1.Refresh
Adodc2.RecordSource = "select sum(op),sum(do),sum(cheke),sum(teeth),sum(eye),sum(bayby),sum(ded),sum(out),sum(help),sum(hurt),sum(totel) from stor where on_Card=" & Val(Text1.Text)
Adodc2.Refresh
Text14.Text = Text14.Text + Text1.Text
If Val(Text3.Text) Or Val(Text4.Text) Or Val(Text5.Text) Or Val(Text6.Text) Or Val(Text7.Text) Or Val(Text8.Text) Or Val(Text9.Text) Or Val(Text10.Text) Or Val(Text11.Text) > 0 Then
S1 = Horof(Text3.Text)
S2 = Horof(Text2.Text)
S3 = Horof(Text7.Text)
S4 = Horof(Text8.Text)
S5 = Horof(Text9.Text)
S6 = Horof(Text10.Text)
S7 = Horof(Text13.Text)
S8 = Horof(Text11.Text)
S9 = Horof(Text4.Text)
S10 = Horof(Text5.Text)
S11 = Horof(Text6.Text)
Else
S1.Caption = "صفر ريال"
S2.Caption = "صفر ريال"
S3.Caption = "صفر ريال"
S4.Caption = "صفر ريال"
S5.Caption = "صفر ريال"
S6.Caption = "صفر ريال"
S7.Caption = "صفر ريال"
S8.Caption = "صفر ريال"
S9.Caption = "صفر ريال"
S10.Caption = "صفر ريال"
S11.Caption = "صفر ريال"
End If
Case 4
Adodc1.RecordSource = "select *from stor;"
Adodc1.Refresh
Adodc2.RecordSource = "select sum(op),sum(do),sum(cheke),sum(teeth),sum(eye),sum(bayby),sum(ded),sum(out),sum(help),sum(hurt),sum(totel) from stor;"
Adodc2.Refresh
Text14.Text = b
If Val(Text3.Text) Or Val(Text4.Text) Or Val(Text5.Text) Or Val(Text6.Text) Or Val(Text7.Text) Or Val(Text8.Text) Or Val(Text9.Text) Or Val(Text10.Text) Or Val(Text11.Text) > 0 Then
S1 = Horof(Text3.Text)
S2 = Horof(Text2.Text)
S3 = Horof(Text7.Text)
S4 = Horof(Text8.Text)
S5 = Horof(Text9.Text)
S6 = Horof(Text10.Text)
S7 = Horof(Text13.Text)
S8 = Horof(Text11.Text)
S9 = Horof(Text4.Text)
S10 = Horof(Text5.Text)
S11 = Horof(Text6.Text)
Else
S1.Caption = "صفر ريال"
S2.Caption = "صفر ريال"
S3.Caption = "صفر ريال"
S4.Caption = "صفر ريال"
S5.Caption = "صفر ريال"
S6.Caption = "صفر ريال"
S7.Caption = "صفر ريال"
S8.Caption = "صفر ريال"
S9.Caption = "صفر ريال"
S10.Caption = "صفر ريال"
S11.Caption = "صفر ريال"
End If
End Select
End Sub
ان شاء الله تستفيد منه