تقييم الموضوع :
  • 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 ك ب / التحميلات : 546)
Mish3l
الرد }}}
تم الشكر بواسطة:
#8
Heart 
مطلوب كود التفقيط  في ملف  txt

مطلوب كود التفقيط (تحويل الارقام إلى حروف) في ملف txt وبالامكان تحميلة او في ملف مضغوط
الرد }}}
تم الشكر بواسطة:


المواضيع المحتمل أن تكون متشابهة .
الموضوع : الكاتب الردود : المشاهدات : آخر رد
  عدد الارقام العشريه ف الLabel Shafaga 29 8,549 31-01-24, 11:57 PM
آخر رد: muhammad_nasr
  [VB.NET] تحويل المشروع سطح المكتب للعمل على الويب Doby 3 359 13-01-24, 04:22 AM
آخر رد: dr.programming
  تحويل مشروع من c# الى فيجول بيسك Lathe1 4 718 05-01-24, 01:05 AM
آخر رد: HALIM ELEULMA
  [VB.NET] تحويل التاريخ بين أداتين تايم بيكر في نفس الفورم محمد العموري 1 268 29-12-23, 10:44 PM
آخر رد: Kamil
  تحويل مشروع من 2008 الي 2015 atefkhalf2004 0 259 23-11-23, 03:10 PM
آخر رد: atefkhalf2004
  طريقة تحويل الأرقام إلى حروف Adel27213 2 495 18-11-23, 01:40 AM
آخر رد: sniper2030
  [سؤال] توزيع الارقام على أكثر من تكست بوكس أبووسم 11 692 17-11-23, 12:04 AM
آخر رد: أبووسم
Star [VB.NET] كود لتوليد الارقام تلقائي في text box Raaf 5 620 08-11-23, 03:03 AM
آخر رد: VIP_YEMEN
  تحويل التاريخ في الداتاقريدفيو إلى أيام عربية صالح عبدالله 2 318 08-10-23, 12:17 AM
آخر رد: صالح عبدالله
  تحويل مشروع دوت نت الى native code ابو محمد محمد محمد 0 406 26-07-23, 12:18 AM
آخر رد: ابو محمد محمد محمد

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


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