تقييم الموضوع :
  • 0 أصوات - بمعدل 0
  • 1
  • 2
  • 3
  • 4
  • 5
طريقة التفقيط لعملة دينار كويتى وقرائة 3 ارقام بعد العلامة
#1
استخدم الكود الاتى للتفقيط ولكن الدينار يتطلب 3 ارقام بعد العلامة
المطلوب تعديل الكود حتى يفقط ثلاث ارقام بعد العلامة من فضلكم
كود :
Module ClassMony_Count
    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
End Module
الرد
تم الشكر بواسطة: rateb
#2
اتوقع المطلوب
تحويل العمله الى نص مكتوب
الرد
تم الشكر بواسطة: baha , ahmedramzyaish , عبد العزيز البسكري
#3
(14-11-19, 12:50 AM)smalw كتب : اتوقع المطلوب
تحويل العمله الى نص مكتوب

اشكرك الكود يعمل ولكن فى مشكلة عندما يكون الرقم يبدا بألفين مثلا 2190.709
تكتب ألاف مائة وتسعون
اما ياقى الاعداد تمام
هل لها حل
الرد
تم الشكر بواسطة:
#4
استخدم الكود التالي ولا تنسى تعدل اسماء الارقام الى العربية في الكود



كود :
Public Class NumeriCon

   Public Shared Function ConvertNum(ByVal Input As Long) As String 'Call this function passing the number you desire to be changed
       Dim output As String = Nothing
       If Input < 1000 Then
           output = FindNumber(Input) 'if its less than 1000 then just look it up
       Else
           Dim nparts() As String 'used to break the number up into 3 digit parts
           Dim n As String = Input 'string version of the number
           Dim i As Long = Input.ToString.Length 'length of the string to help break it up

           Do Until i - 3 <= 0
               n = n.Insert(i - 3, ",") 'insert commas to use as splitters
               i = i - 3 'this insures that we get the correct number of parts
           Loop
           nparts = n.Split(",") 'split the string into the array

           i = Input.ToString.Length 'return i to initial value for reuse
           Dim p As Integer = 0 'p for parts, used for finding correct suffix
           For Each s As String In nparts
               Dim x As Long = CLng(s) 'x is used to compare the part value to other values
               p = p + 1
               If p = nparts.Length Then 'if p = number of elements in the array then we need to do something different
                   If x <> 0 Then
                       If CLng(s) < 100 Then
                           output = output & " And " & FindNumber(CLng(s)) ' look up the number, no suffix
                       Else                                                ' required as this is the last part
                           output = output & " " & FindNumber(CLng(s))
                       End If
                   End If
               Else 'if its not the last element in the array
                   If x <> 0 Then
                       If output = Nothing Then 'we have to check this so we don't add a leading space
                           output = output & FindNumber(CLng(s)) & " " & FindSuffix(i, CLng(s)) 'look up the number and suffix
                       Else 'spaces must go in the right place
                           output = output & " " & FindNumber(CLng(s)) & " " & FindSuffix(i, CLng(s)) 'look up the snumber and suffix
                       End If
                   End If
               End If
               i = i - 3 'reduce the suffix counter by 3 to step down to the next suffix
           Next
       End If
       Return output
   End Function

   Private Shared Function FindNumber(ByVal Number As Long) As String
       Dim Words As String = Nothing
       Dim Digits() As String = {"Zero","One","Two","Three","Four","Five","Six","Seven", _
     "Eight","Nine","Ten"}
       Dim Teens() As String = {"", "Eleven", "Twelve", "Thirteen", "Fourteen", "Fifteen", "Sixteen", "Seventeen", _
      "Eighteen", "Nineteen"}

       If Number < 11 Then
           Words = Digits(Number)

       ElseIf Number < 20 Then
           Words = Teens(Number - 10)

       ElseIf Number = 20 Then
           Words = "Twenty"

       ElseIf Number < 30 Then
           Words = "Twenty " & Digits(Number - 20)

       ElseIf Number = 30 Then
           Words = "Thirty"

       ElseIf Number < 40 Then
           Words = "Thirty " & Digits(Number - 30)

       ElseIf Number = 40 Then
           Words = "Fourty"

       ElseIf Number < 50 Then
           Words = "Fourty " & Digits(Number - 40)

       ElseIf Number = 50 Then
           Words = "Fifty"

       ElseIf Number < 60 Then
           Words = "Fifty " & Digits(Number - 50)

       ElseIf Number = 60 Then
           Words = "Sixty"

       ElseIf Number < 70 Then
           Words = "Sixty " & Digits(Number - 60)

       ElseIf Number = 70 Then
           Words = "Seventy"

       ElseIf Number < 80 Then
           Words = "Seventy " & Digits(Number - 70)

       ElseIf Number = 80 Then
           Words = "Eighty"

       ElseIf Number < 90 Then
           Words = "Eighty " & Digits(Number - 80)

       ElseIf Number = 90 Then
           Words = "Ninety"

       ElseIf Number < 100 Then
           Words = "Ninety " & Digits(Number - 90)

       ElseIf Number < 1000 Then
           Words = Number.ToString
           Words = Words.Insert(1, ",")
           Dim wparts As String() = Words.Split(",")
           Words = FindNumber(wparts(0)) & " " & "Hundred"
           Dim n As String = FindNumber(wparts(1))
           If CLng(wparts(1)) <> 0 Then
               Words = Words & " And " & n
           End If
       End If

       Return Words
   End Function

   Private Shared Function FindSuffix(ByVal Length As Long, ByVal l As Long) As String
       Dim word As String

       If l <> 0 Then
           If Length > 12 Then
               word = "Trillion"
           ElseIf Length > 9 Then
               word = "Billion"
           ElseIf Length > 6 Then
               word = "Million"
           ElseIf Length > 3 Then
               word = "Thousand"
           ElseIf Length > 2 Then
               word = "Hundred"
           Else
               word = ""
           End If
       Else
           word = ""
       End If

       Return word
   End Function

End Class

اما طريقة الاستخدام كالتالي :
كود :
Textbox1.Text = NumeriCon.ConvertNum("878391279")  

ملاحظة منقول : 

المصدر: https://www.codeproject.com/Articles/332...-into-Text

الرد
تم الشكر بواسطة: 3booody
#5
السلام عليكم ورحمة الله وبركاته

أخي كودك ربما يكون معقد قليلآ والي فهمتو منك تريد تحول من رقم الى رقم كتابة ,, بصراحة كنت ناوي اعطيك فكرة اسهل وبدون تعقيد لكن وجدت الامر ممتع واكملت لك كود الى حد 9999 لكن المهم بالكود هو الفكرة التي اعطيتك هي اظنها ابسط من فكرتك وامكانية تطويرها بسهولة وايضآ يقل التعقيد بزيادة الاعداد


هذا هو الكود 

كود :
Dim Nf As String = "صفر,واحد,اثنان,ثلاثة,اربعة,خمسة,ستة,سبعة,ثمانية,تسعة"
   Dim N2 As String = "عشرون,ثلاثون,اربعون,خمسون,ستون,سبعون,ثمانون,تسعون"
   Dim Nm As String = "مائة,مئتان,ثلاث مائة,أربع مائة,خمس مائة,ست مائة,سبع مائة,ثمان مائة,تسع مائة"
   Dim Nt As String = "الف,الفان,ثلاثة الف,أربعة الف,خمسة الف,ستة الف,سبعة الف,ثمانية الف,تسعة الف"
   Function Tran(ByVal i As Integer) As String
       Dim Count As Integer = i.ToString.Length
       Select Case Count
           Case 1
               Return Nf.Split(",")(i)
           Case 2
               If i.ToString.Chars(0).ToString > 1 Then
                   If i.ToString.Chars(1) = "0" Then
                       Return N2.Split(",")(i.ToString.Chars(0).ToString - 2)
                   Else
                       Return Nf.Split(",")(i.ToString.Chars(1).ToString) & " و " & N2.Split(",")(i.ToString.Chars(0).ToString - 2)
                   End If
               ElseIf i.ToString.Chars(0).ToString = 1 Then
                   If i.ToString.Chars(1) = "0" Then
                       Return "عشرة"
                   ElseIf i.ToString.Chars(1) = "1" Then
                       Return "إحدى عشر"
                   ElseIf i.ToString.Chars(1) = "2" Then
                       Return "إثنى عشر"
                   Else
                       Return Nf.Split(",")(i.ToString.Chars(1).ToString) & " " & "عشر"
                   End If
               End If
           Case 3
               If i.ToString.Chars(1).ToString = "0" And i.ToString.Chars(2).ToString = "0" Then
                   Return Nm.Split(",")(i.ToString.Chars(0).ToString - 1)
               End If
               If i.ToString.Chars(1).ToString = "0" Then
                   Return Nm.Split(",")(i.ToString.Chars(0).ToString - 1) & " و " & Tran(i.ToString.Chars(2).ToString)
               End If
               Return Nm.Split(",")(i.ToString.Chars(0).ToString - 1) & " و " & Tran(i.ToString.Remove(0, 1))
           Case 4
               If i.ToString.Chars(1).ToString = "0" And i.ToString.Chars(2).ToString = "0" And i.ToString.Chars(3).ToString = "0" Then
                   Return Nt.Split(",")(i.ToString.Chars(0).ToString - 1)
               End If
               If i.ToString.Chars(1).ToString = "0" Then
                   Return Nt.Split(",")(i.ToString.Chars(0).ToString - 1) & " و " & Tran(i.ToString.Remove(0, 2))
               End If
               Return Nt.Split(",")(i.ToString.Chars(0).ToString - 1) & " و " & Tran(i.ToString.Remove(0, 1))
       End Select

   End Function


الان لو وضعت اثنان تكست بوكس وكتبت الكود التالي


كود :
TextBox2.Text = Tran(TextBox1.Text)


سوف يعطيك النتيجة ان شاء الله
الرد
تم الشكر بواسطة: asemshahen5 , asemshahen5


المواضيع المحتمل أن تكون متشابهة .
الموضوع : الكاتب الردود : المشاهدات : آخر رد
  من فضلكم طريقة عمل فورميلا في كريستال ريبورت كريم عبودي 2 124 30-06-20, 03:35 AM
آخر رد: كريم عبودي
  كيف اجع من التاكست بوكس تعرض ارقام با فواصل ahmedbezia 10 189 27-06-20, 07:36 PM
آخر رد: kiki
  طريقة حسب عدد الموظفين والذكور والاناث mazentq 2 124 18-06-20, 02:46 AM
آخر رد: mazentq
  [سؤال] اريد شرح طريقة السداد عن طريق دفعات عاصم النجار 2 156 03-06-20, 06:50 PM
آخر رد: عاصم النجار
  [VB.NET] طريقة عمل مستخدمين وتحديد الصلاحيات adnan gharbi 4 179 28-05-20, 12:11 AM
آخر رد: adnan gharbi
Brick [VB.NET] عايز طريقة اضافه رقم لحقل معين لمجموعة بيانات x4ahmad 2 185 23-05-20, 01:09 AM
آخر رد: x4ahmad
  سؤال في طريقة التعامل مع قاعدة البيانات عند تحزيم المشروع adnan gharbi 4 363 15-05-20, 01:03 PM
آخر رد: adnan gharbi
Wink [سؤال] طريقة عمل برنامج تعديل علي التاريخ والوقت في الويندوز Ali Edal 2022 4 237 12-05-20, 03:05 AM
آخر رد: Ali Edal 2022
  [سؤال] اريد طريقة اظافة شريط متحرك للفورم vb2010 الرجل الطيب 2 4,724 02-05-20, 05:46 PM
آخر رد: habeb4all
  سوال خفيفي طريقة اغلاق المجلدات Ali Edal 2022 2 160 28-04-20, 05:03 AM
آخر رد: Ali Edal 2022

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


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