تقييم الموضوع :
  • 0 أصوات - بمعدل 0
  • 1
  • 2
  • 3
  • 4
  • 5
هل من اضافة الترليون لهذا الكود
#1
 
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
 
 
الرد }}}
تم الشكر بواسطة:


المواضيع المحتمل أن تكون متشابهة .
الموضوع : الكاتب الردود : المشاهدات : آخر رد
  ممكن حل المشكلة فى الكود التالي - من مشاركة استاذنا القدير / عبدالله الدوسري new_programer 4 169 02-03-24, 07:36 PM
آخر رد: new_programer
  ماهو حل هذا الخطأ في الكود melad2002 7 264 25-02-24, 12:25 AM
آخر رد: justforit
  كيفية انشاء سكريبت لقاعدة بيانات من خلال الكود heem1986 1 194 20-02-24, 12:00 AM
آخر رد: Kamil
Sad ممكن حل لهذا المشكل melad2002 0 240 30-01-24, 08:01 PM
آخر رد: melad2002
  [VB.NET] أرغب فى استخدام هذا الكود بالتحديد على الإصدار 10 AmeenRashed 3 206 19-01-24, 12:42 PM
آخر رد: Taha Okla
  مطلوب كود الطباعة لهذا البرنامج melad2002 2 234 13-01-24, 06:42 PM
آخر رد: melad2002
  [VB.NET] ما الخطأ فى هذا الكود - كود البحث المتعدد Ashraf Elafify 7 464 27-12-23, 10:50 PM
آخر رد: Ashraf Elafify
  اضافة ادوات لفيجوال بيسك خالد20 10 1,977 18-12-23, 07:51 PM
آخر رد: ابراهيم عبدالباقى
  [VB.NET] اريد تعديل في الكود عند طباعة DGV abu_hisham7 1 431 03-12-23, 02:40 AM
آخر رد: abu_hisham7
  رجاء التعديل على الكود المرفق - كلاس لعرض كود المورد new_programer 4 357 13-10-23, 01:47 AM
آخر رد: new_programer

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


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