تقييم الموضوع :
  • 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
 
 
الرد
تم الشكر بواسطة:


المواضيع المحتمل أن تكون متشابهة .
الموضوع : الكاتب الردود : المشاهدات : آخر رد
  مشكلة في كود اضافة الى sql 2012 moh developer 12 208 , 12:03 PM
آخر رد: ابراهيم ايبو
Rainbow [كود] ماهو الخطا في الكود الموضح لكم محمد مسافر 2 54 , 01:09 AM
آخر رد: محمد مسافر
  هل يمكن اضافة اشعار صوتى mostafa nada 5 83 22-09-20, 03:48 PM
آخر رد: enjoy
  عندي مشكلة بخصوص الكود هدا The program '[13020] MainProj.exe' has exited with code 0 ٍOfelas 1 46 21-09-20, 12:27 AM
آخر رد: Anas Mahmoud
  التعديل على الكود للتخلص من مشكلة البطىء حيث عدد السجلات كبير momani33 0 108 09-09-20, 01:33 PM
آخر رد: momani33
  ماهو الخطاء في هذا الكود عمور2016 1 105 06-09-20, 06:33 PM
آخر رد: حريف برمجة
  [سؤال] طرب الويندوز ومحتاج اجداد الكود سحاب روابط قائيمة تشغيل من اليتيوب Ali Edal 11 937 05-09-20, 03:36 PM
آخر رد: معاند الحظ
  مشكلة فى اضافة البيانات ممكن المساعدة talatm 7 335 04-09-20, 04:10 PM
آخر رد: عبد العزيز البسكري
  هل يجب اضافة ملف الريبورت فيور مع مشروع الفيجوال ستوديو adnan gharbi 2 164 02-09-20, 09:27 PM
آخر رد: adnan gharbi
Question [سؤال] اضافة ميعاد التسليم للبرنامج maaadooo2001 1 137 01-09-20, 04:37 PM
آخر رد: اسامه الهرماوي

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


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