تقييم الموضوع :
  • 0 أصوات - بمعدل 0
  • 1
  • 2
  • 3
  • 4
  • 5
تحويل الارقام الي حروف
#1
ارجوا المساعدة في اعطائي كود لتحويل الارقام الى حروف
ملاحظة االارقام  هى ارقام ماليه مثلاً   45,564.231
خمسة واربعون الف وخمسمائة واربعة وستون دينار ومئتان وواحد وثلاثون درهم لا غير
ارجوا المساعدة في اسرع وقت ممكن 
وجزاءكم الله كل الخير
الرد
تم الشكر بواسطة:
#2
(22-01-17, 01:20 PM)محمد بوقزاحة كتب : ارجوا المساعدة في اعطائي كود لتحويل الارقام الى حروف
ملاحظة االارقام  هى ارقام ماليه مثلاً   45,564.231
خمسة واربعون الف وخمسمائة واربعة وستون دينار ومئتان وواحد وثلاثون درهم لا غير
ارجوا المساعدة في اسرع وقت ممكن 
وجزاءكم الله كل الخير
تفضل اخي  
المصدر (RamyEmad)
تنشئ ميديول وتحطها فيه لكي تستدعيها على مستوى البرنامج
كود :
Function NoToTxt(ByVal TheNo As Double, ByVal MyCur As String, ByVal MySubCur As String) As String
      Dim MyArry1(0 To 9) As String
      Dim MyArry2(0 To 9) As String
      Dim MyArry3(0 To 9) As String
      Dim MyNo As String = ""
      Dim GetNo As String = ""
      Dim RdNo As String = ""
      Dim My100 As String = ""
      Dim My10 As String = ""
      Dim My1 As String = ""
      Dim My11 As String = ""
      Dim My12 As String = ""
      Dim GetTxt As String = ""
      Dim Mybillion As String = ""
      Dim MyMillion As String = ""
      Dim MyThou As String = ""
      Dim MyHun As String = ""
      Dim MyFraction As String = ""
      Dim MyAnd As String = ""
      Dim i As Integer
      Dim ReMark As String = ""


      If TheNo > 999999999999.99 Then

      End If


      If TheNo = 0 Then
          NoToTxt = "صفر"
          Exit Function
      End If

      MyAnd = " و"
      MyArry1(0) = ""
      MyArry1(1) = "مائة"
      MyArry1(2) = "مائتان"
      MyArry1(3) = "ثلاثمائة"
      MyArry1(4) = "أربعمائة"
      MyArry1(5) = "خمسمائة"
      MyArry1(6) = "ستمائة"
      MyArry1(7) = "سبعمائة"
      MyArry1(8) = "ثمانمائة"
      MyArry1(9) = "تسعمائة"

      MyArry2(0) = ""
      MyArry2(1) = " عشر"
      MyArry2(2) = "عشرون"
      MyArry2(3) = "ثلاثون"
      MyArry2(4) = "أربعون"
      MyArry2(5) = "خمسون"
      MyArry2(6) = "ستون"
      MyArry2(7) = "سبعون"
      MyArry2(8) = "ثمانون"
      MyArry2(9) = "تسعون"

      MyArry3(0) = ""
      MyArry3(1) = "واحد"
      MyArry3(2) = "اثنان"
      MyArry3(3) = "ثلاثة"
      MyArry3(4) = "أربعة"
      MyArry3(5) = "خمسة"
      MyArry3(6) = "ستة"
      MyArry3(7) = "سبعة"
      MyArry3(8) = "ثمانية"
      MyArry3(9) = "تسعة"
      '======================
      GetNo = Format(TheNo, "000000000000.00")

      i = 0
      Do While i < 15

          If i < 12 Then
              MyNo = Mid$(GetNo, i + 1, 3)
          Else
              MyNo = "0" + Mid$(GetNo, i + 2, 2)
          End If

          If (Mid$(MyNo, 1, 3)) > 0 Then

              RdNo = Mid$(MyNo, 1, 1)
              My100 = MyArry1(RdNo)
              RdNo = Mid$(MyNo, 3, 1)
              My1 = MyArry3(RdNo)
              RdNo = Mid$(MyNo, 2, 1)
              My10 = MyArry2(RdNo)

              If Mid$(MyNo, 2, 2) = 11 Then My11 = "إحدى عشر"
              If Mid$(MyNo, 2, 2) = 12 Then My12 = "إثنى عشر"
              If Mid$(MyNo, 2, 2) = 10 Then My10 = "عشرة"

              If ((Mid$(MyNo, 1, 1)) > 0) And ((Mid$(MyNo, 2, 2)) > 0) Then My100 = My100 + MyAnd
              If ((Mid$(MyNo, 3, 1)) > 0) And ((Mid$(MyNo, 2, 1)) > 1) Then My1 = My1 + MyAnd

              GetTxt = My100 + My1 + My10

              If ((Mid$(MyNo, 3, 1)) = 1) And ((Mid$(MyNo, 2, 1)) = 1) Then
                  GetTxt = My100 + My11
                  If ((Mid$(MyNo, 1, 1)) = 0) Then GetTxt = My11
              End If

              If ((Mid$(MyNo, 3, 1)) = 2) And ((Mid$(MyNo, 2, 1)) = 1) Then
                  GetTxt = My100 + My12
                  If ((Mid$(MyNo, 1, 1)) = 0) Then GetTxt = My12
              End If

              If (i = 0) And (GetTxt <> "") Then
                  If ((Mid$(MyNo, 1, 3)) > 10) Then
                      Mybillion = GetTxt + " مليار"
                  Else
                      Mybillion = GetTxt + " مليارات"
                      If ((Mid$(MyNo, 1, 3)) = 2) Then Mybillion = " مليار"
                      If ((Mid$(MyNo, 1, 3)) = 2) Then Mybillion = " ملياران"
                  End If
              End If

              If (i = 3) And (GetTxt <> "") Then

                  If ((Mid$(MyNo, 1, 3)) > 10) Then
                      MyMillion = GetTxt + " مليون"
                  Else
                      MyMillion = GetTxt + " ملايين"
                      If ((Mid$(MyNo, 1, 3)) = 1) Then MyMillion = " مليون"
                      If ((Mid$(MyNo, 1, 3)) = 2) Then MyMillion = " مليونان"
                  End If
              End If

              If (i = 6) And (GetTxt <> "") Then
                  If ((Mid$(MyNo, 1, 3)) > 10) Then
                      MyThou = GetTxt + " ألف"
                  Else
                      MyThou = GetTxt + " آلاف"
                      If ((Mid$(MyNo, 3, 1)) = 1) Then MyThou = " ألف"
                      If ((Mid$(MyNo, 3, 1)) = 2) Then MyThou = " ألفان"
                  End If
              End If

              If (i = 9) And (GetTxt <> "") Then MyHun = GetTxt
              If (i = 12) And (GetTxt <> "") Then MyFraction = GetTxt
          End If

          i = i + 3
      Loop

      If (Mybillion <> "") Then
          If (MyMillion <> "") Or (MyThou <> "") Or (MyHun <> "") Then Mybillion = Mybillion + MyAnd
      End If

      If (MyMillion <> "") Then
          If (MyThou <> "") Or (MyHun <> "") Then MyMillion = MyMillion + MyAnd
      End If

      If (MyThou <> "") Then
          If (MyHun <> "") Then MyThou = MyThou + MyAnd
      End If

      If MyFraction <> "" Then
          If (Mybillion <> "") Or (MyMillion <> "") Or (MyThou <> "") Or (MyHun <> "") Then
              NoToTxt = ReMark + Mybillion + MyMillion + MyThou + MyHun + " " + MyCur + MyAnd + MyFraction + " " + MySubCur
          Else
              NoToTxt = ReMark + MyFraction + " " + MySubCur
          End If
      Else
          NoToTxt = ReMark + Mybillion + MyMillion + MyThou + MyHun + " " + MyCur
      End If
  End Function

وعند استدعاء الكود 
PHP كود :
TextBox1.text NoToTxt(TextBox1.text"جنية""قرش"
لا شيء مستحيل
الرد
تم الشكر بواسطة:
#3
جزاك الله خير ( لم يشتغل الكود ) نرفق لك صوره من الخطأ

صوره من الخطأ


الملفات المرفقة صورة/صور
   
الرد
تم الشكر بواسطة:
#4
من الواضع انك قمت بتحديد نص فارغ

قم بربفع المشروع
لا شيء مستحيل
الرد
تم الشكر بواسطة:
#5
انا جربت اكواد من قيل ونفس المشكلة اعاني منها هي اخر درهم 
هذه صوره توضح لك انا اخر درهم لم يحتسب  555       الصحيح         خمسمائة وخمسة وخمسون درهم 
في الكود      ستة وخمسون درهم
الرد
تم الشكر بواسطة:
#6
(22-01-17, 03:41 PM)محمد بوقزاحة كتب : انا جربت اكواد من قيل ونفس المشكلة اعاني منها هي اخر درهم 
هذه صوره توضح لك انا اخر درهم لم يحتسب  555       الصحيح         خمسمائة وخمسة وخمسون درهم 
في الكود      ستة وخمسون درهم

قم بإرفاق المشروووووووع
لا شيء مستحيل
الرد
تم الشكر بواسطة:
#7
الكود صحيح  ما فية اي مشكلة

وهذا مثال على السريع


الملفات المرفقة
.zip   NumberToWords.zip (الحجم : 82.09 ك ب / التحميلات : 361)
Mish3l
الرد
تم الشكر بواسطة:


المواضيع المحتمل أن تكون متشابهة .
الموضوع : الكاتب الردود : المشاهدات : آخر رد
  [VB.NET] ارجو المساعدة في برنامج لتشغيل الملفات الصوتية لنطق الارقام eman kh 5 241 13-09-20, 06:05 PM
آخر رد: eman kh
  [سؤال] هل يمكن تحويل مشروع الي ملف DLL saleh101 1 178 14-08-20, 02:14 AM
آخر رد: asemshahen5
  [سؤال] تحويل نص يحتوي عملية الى عملية حسابية عبد الهادي بهاب 4 222 09-08-20, 02:29 AM
آخر رد: عبد الهادي بهاب
  [VB.NET] مشكلة في الحفاظ على تنسيق الارقام والتاريخ في المشروع محمد العامر 4 373 23-07-20, 01:45 PM
آخر رد: محمد العامر
  هل يمكن تحويل Print Document إلى PDF ؟ Hazem1 1 214 04-07-20, 11:36 AM
آخر رد: Hazem1
  منع كتابة حروف معينة cordava 3 278 03-07-20, 10:26 PM
آخر رد: kiki
  تحويل من سي شارب ssayed111 0 192 22-06-20, 03:28 PM
آخر رد: ssayed111
  [VB.NET] تحويل القيمة فارغة الي صفر في قاعدة البيانات sql Codack 2 282 16-06-20, 06:43 PM
آخر رد: kiki
  هل يمكن تحويل تطبيق من لغة الفيجوال بيسك إلى الأندرويد Hazem1 5 538 06-06-20, 11:57 PM
آخر رد: WaeLx
  تحويل الأرقام عربيه DOX.1 8 532 04-06-20, 02:53 AM
آخر رد: kiki

التنقل السريع :


يقوم بقرائة الموضوع: بالاضافة الى ( 1 ) ضيف كريم