منتدى فيجوال بيسك لكل العرب | منتدى المبرمجين العرب
هل يوجد مثال للتفقيط حسب عملة البلد - نسخة قابلة للطباعة

+- منتدى فيجوال بيسك لكل العرب | منتدى المبرمجين العرب (http://vb4arb.com/vb)
+-- قسم : قسم لغة الفيجوال بيسك VB.NET (http://vb4arb.com/vb/forumdisplay.php?fid=182)
+--- قسم : قسم اسئلة VB.NET (http://vb4arb.com/vb/forumdisplay.php?fid=183)
+--- الموضوع : هل يوجد مثال للتفقيط حسب عملة البلد (/showthread.php?tid=24069)



هل يوجد مثال للتفقيط حسب عملة البلد - السيد الجوهري - 05-03-18

هل يوجد مثال للتفقيط حسب عملة البلد
بمعني لدي تكست بوكس   عندما اكتب اسم العمله  يفقط حسب عملة الدولة


RE: هل يوجد مثال للتفقيط حسب عملة البلد - Dev Saeed - 05-03-18

لن تجد دالة جاهزة داخل الفيجوال بيسك لعملية "التفقيط"، ( يجب أن يصنع العرب مثل هذه الدوال )


جرب الرابط التالي :

http://vb4arb.com/vb/showthread.php?tid=20671



أو


http://vb4arb.com/vb/search.php?action=results&sid=009db1a79bdf480fa08a20e781a803c3&sortby=&order=desc


أو 

قم بالبحث في Google  عن عبارة   "تفقيط VB.net"

أعتقد أنك ستجد أكواد مكتوبة بواسطة مبرمجين عرب.


RE: هل يوجد مثال للتفقيط حسب عملة البلد - السيد الجوهري - 05-03-18

يبدو انك لم تفهم ما اريدة

لدي تكست بوكس                     مكتوب فية  عملة البلد اى كانت العملة

عندما اضغط زر تقفيط   يفقط حسب ما هو مكتوب فى تكست بوكس


RE: هل يوجد مثال للتفقيط حسب عملة البلد - spoony - 08-03-18

نعم في هناك طريقة للتفقيط حسب العملة الموجودة في السند تواصل معي خاص


RE: هل يوجد مثال للتفقيط حسب عملة البلد - Abdulhakeem Swisi - 09-03-18

السلام عليكم ورحمة الله وبركاته
قمت قبل فترة قصيرة بتطوير دالة تفقيط تكون مرنة ودقيقة في ضبط المسافة بين الكلمات
وهي تعتمد على مبدأ باقي القسمة mod وفكرتها بسيطة جدا.
أولا قم بانشاء module وضع فيه هذا الكود:
كود :
'# Created By Abdulhakeem Swissi, Libya, 01/02/2018.#
'www.abdulhakeemswissi@gmail.com

Module ConvertNumbersToWords_Module

   Dim and_Str As String = " و "

   Public Function ConvertNumbersToWords(ByVal Number As Decimal, ByVal NameOfUnitBeforeDecimal As String, ByVal NameOfUnitAfterDecimal As String, Optional ByVal CustomTextBeforeWordsOfDigits As String = "", Optional ByVal CustomTextAfterWordsOfDigits As String = "") As String
       ConvertNumbersToWords = String.Empty
       Dim numbersArray_Str(2) As String
       numbersArray_Str = Split(CStr(Number), ".")
       Dim numberBeforePoint_Lng, numberAfterPoint_Lng As Long
       If numbersArray_Str(0).Length <= 15 Then
           If numbersArray_Str(0) <> String.Empty Then
               numberBeforePoint_Lng = CLng(numbersArray_Str(0))
           End If
       Else
           Return String.Empty
           Exit Function
       End If
       If numbersArray_Str.Length > 1 Then
           If numbersArray_Str(1).Length <= 15 Then
               If numbersArray_Str(1) <> String.Empty Then
                   numberAfterPoint_Lng = CLng(numbersArray_Str(1))
               End If
           Else
               Return String.Empty
               Exit Function
           End If
       End If
       If numberAfterPoint_Lng <> 0 Then
           If numberBeforePoint_Lng > 0 Then
               Return (CustomTextBeforeWordsOfDigits & " " & wordsOfDigits(numberBeforePoint_Lng) & " " & NameOfUnitBeforeDecimal & and_Str & wordsOfDigits(numberAfterPoint_Lng) & " " & NameOfUnitAfterDecimal & " " & CustomTextAfterWordsOfDigits).Trim
           Else
               Return (CustomTextBeforeWordsOfDigits & " " & wordsOfDigits(numberAfterPoint_Lng) & " " & NameOfUnitAfterDecimal & " " & CustomTextAfterWordsOfDigits).Trim
           End If
       Else
           If numberBeforePoint_Lng > 0 Then
               Return (CustomTextBeforeWordsOfDigits & " " & wordsOfDigits(numberBeforePoint_Lng) & " " & NameOfUnitBeforeDecimal & " " & CustomTextAfterWordsOfDigits).Trim
           End If
       End If
   End Function

   Private Function wordsOfDigits(ByVal number As Long) As String
       wordsOfDigits = String.Empty
       If number <= 10 Then
           Select Case number
               Case Is = 1 : Return "واحد"
               Case Is = 2 : Return "اثنان"
               Case Is = 3 : Return "ثلاثة"
               Case Is = 4 : Return "أربعة"
               Case Is = 5 : Return "خمسة"
               Case Is = 6 : Return "ستة"
               Case Is = 7 : Return "سبعة"
               Case Is = 8 : Return "ثمانية"
               Case Is = 9 : Return "تسعة"
               Case Is = 10 : Return "عشرة"
           End Select
       End If
       If number >= 11 And number <= 19 Then
           Select Case number
               Case Is = 11 : Return "أحد عشر"
               Case Is = 12 : Return "اثنا عشر"
               Case Is = 13 : Return "ثلاثة عشر"
               Case Is = 14 : Return "أربعة عشر"
               Case Is = 15 : Return "خمسة عشر"
               Case Is = 16 : Return "ستة عشر"
               Case Is = 17 : Return "سبعة عشر"
               Case Is = 18 : Return "ثمانية عشر"
               Case Is = 19 : Return "تسعة عشر"
           End Select
       End If
       If number >= 20 And number <= 99 Then
           Dim firstDigit_Lng As Long = number Mod 10
           Dim secondDigit_Lng As Long = number \ 10
           Dim wordOfDigit_Str As String = String.Empty
           Select Case secondDigit_Lng
               Case Is = 2 : wordOfDigit_Str = "عشرون"
               Case Is = 3 : wordOfDigit_Str = "ثلاثون"
               Case Is = 4 : wordOfDigit_Str = "أربعون"
               Case Is = 5 : wordOfDigit_Str = "خمسون"
               Case Is = 6 : wordOfDigit_Str = "ستون"
               Case Is = 7 : wordOfDigit_Str = "سبعون"
               Case Is = 8 : wordOfDigit_Str = "ثمانون"
               Case Is = 9 : wordOfDigit_Str = "تسعون"
           End Select
           If firstDigit_Lng <> 0 Then
               wordOfDigit_Str = wordsOfDigits(firstDigit_Lng) & and_Str & wordOfDigit_Str
           End If
           Return wordOfDigit_Str
       End If
       If number >= 100 And number <= 999 Then
           Dim firstDigit_Lng As Long = number Mod 100
           Dim secondDigit_Lng As Long = number \ 100
           Dim wordOfDigit_Str As String = String.Empty
           Select Case secondDigit_Lng
               Case Is = 1 : wordOfDigit_Str = "مائة"
               Case Is = 2 : wordOfDigit_Str = "مائتان"
               Case Is = 3 : wordOfDigit_Str = "ثلاثمائة"
               Case Is = 4 : wordOfDigit_Str = "أربعمائة"
               Case Is = 5 : wordOfDigit_Str = "خمسمائة"
               Case Is = 6 : wordOfDigit_Str = "ستمائة"
               Case Is = 7 : wordOfDigit_Str = "سبعمائة"
               Case Is = 8 : wordOfDigit_Str = "ثمانمائة"
               Case Is = 9 : wordOfDigit_Str = "تسعمائة"
           End Select
           If firstDigit_Lng <> 0 Then
               wordOfDigit_Str = wordOfDigit_Str & and_Str & wordsOfDigits(firstDigit_Lng)
           End If
           Return wordOfDigit_Str
       End If
       If number >= 1000 And number <= 999999 Then
           Dim firstDigit_Lng As Long = number Mod 1000
           Dim secondDigit_Lng As Long = number \ 1000
           Dim wordOfDigit_Str As String = String.Empty
           Select Case secondDigit_Lng
               Case Is = 1 : wordOfDigit_Str = "ألف"
               Case Is = 2 : wordOfDigit_Str = "ألفان"
               Case Is <= 10
                   wordOfDigit_Str = " آلاف"
                   wordOfDigit_Str = wordsOfDigits(secondDigit_Lng) & wordOfDigit_Str
               Case Else
                   wordOfDigit_Str = " ألف"
                   wordOfDigit_Str = wordsOfDigits(secondDigit_Lng) & wordOfDigit_Str
           End Select
           If firstDigit_Lng <> 0 Then
               wordOfDigit_Str = wordOfDigit_Str & and_Str & wordsOfDigits(firstDigit_Lng)
           End If
           Return wordOfDigit_Str
       End If
       If number >= 1000000 And number <= 999999999 Then
           Dim firstDigit_Lng As Long = number Mod 1000000
           Dim secondDigit_Lng As Long = number \ 1000000
           Dim wordOfDigit_Str As String = String.Empty
           Select Case secondDigit_Lng
               Case Is = 1 : wordOfDigit_Str = "مليون"
               Case Is = 2 : wordOfDigit_Str = "مليونان"
               Case Is <= 10
                   wordOfDigit_Str = " ملايين"
                   wordOfDigit_Str = wordsOfDigits(secondDigit_Lng) & wordOfDigit_Str
               Case Else
                   wordOfDigit_Str = " مليون"
                   wordOfDigit_Str = wordsOfDigits(secondDigit_Lng) & wordOfDigit_Str
           End Select
           If firstDigit_Lng <> 0 Then
               wordOfDigit_Str = wordOfDigit_Str & and_Str & wordsOfDigits(firstDigit_Lng)
           End If
           Return wordOfDigit_Str
       End If
       If number >= 1000000000 And number <= 999999999999 Then
           Dim firstDigit_Lng As Long = number Mod 1000000000
           Dim secondDigit_Lng As Long = number \ 1000000000
           Dim wordOfDigit_Str As String = String.Empty
           Select Case secondDigit_Lng
               Case Is = 1 : wordOfDigit_Str = "مليار"
               Case Is = 2 : wordOfDigit_Str = "ملياران"
               Case Else
                   wordOfDigit_Str = " مليار"
                   wordOfDigit_Str = wordsOfDigits(secondDigit_Lng) & wordOfDigit_Str
           End Select
           If firstDigit_Lng <> 0 Then
               wordOfDigit_Str = wordOfDigit_Str & and_Str & wordsOfDigits(firstDigit_Lng)
           End If
           Return wordOfDigit_Str
       End If
       If number >= 1000000000000 And number <= 999999999999999 Then
           Dim firstDigit_Lng As Long = number Mod 1000000000000
           Dim secondDigit_Lng As Long = number \ 1000000000000
           Dim wordOfDigit_Str As String = String.Empty
           Select Case secondDigit_Lng
               Case Is = 1 : wordOfDigit_Str = "تريليون"
               Case Else
                   wordOfDigit_Str = " تريليون"
                   wordOfDigit_Str = wordsOfDigits(secondDigit_Lng) & wordOfDigit_Str
           End Select
           If firstDigit_Lng <> 0 Then
               wordOfDigit_Str = wordOfDigit_Str & and_Str & wordsOfDigits(firstDigit_Lng)
           End If
           Return wordOfDigit_Str
       End If
   End Function

End Module

ثم يمكن ارسالة بارميترات للدالة كالتالي:
كود :
ConvertNumbersToWords(123.123D, "دينار", "درهم", "فقط (", ") لاغير .")
أو :
كود :
ConvertNumbersToWords(123.123D, "دينار", "درهم")
بارميترات دالة التحويل كالتالي:
أولا الرقم المراد تفقيطه وهو من نوع decimal ثم اسم الوحدة قبل الفاصلة العشرية ثم اسم الوحدة بعد الفاصلة العشرية ثم نص مخصص قبل وبعد نص التفقيط وهما بارميترات اختيارية يمكن تجاهلهما.

ولتوضيح أي جزء من الكود أو أي تعديل أنا حاضر


RE: هل يوجد مثال للتفقيط حسب عملة البلد - السيد الجوهري - 11-03-18

(09-03-18, 01:30 PM)Abdulhakeem Swisi كتب : السلام عليكم ورحمة الله وبركاته
قمت قبل فترة قصيرة بتطوير دالة تفقيط تكون مرنة ودقيقة في ضبط المسافة بين الكلمات
وهي تعتمد على مبدأ باقي القسمة mod وفكرتها بسيطة جدا.
أولا قم بانشاء module وضع فيه هذا الكود:
كود :
'# Created By Abdulhakeem Swissi, Libya, 01/02/2018.#
'www.abdulhakeemswissi@gmail.com

Module ConvertNumbersToWords_Module

   Dim and_Str As String = " و "

   Public Function ConvertNumbersToWords(ByVal Number As Decimal, ByVal NameOfUnitBeforeDecimal As String, ByVal NameOfUnitAfterDecimal As String, Optional ByVal CustomTextBeforeWordsOfDigits As String = "", Optional ByVal CustomTextAfterWordsOfDigits As String = "") As String
       ConvertNumbersToWords = String.Empty
       Dim numbersArray_Str(2) As String
       numbersArray_Str = Split(CStr(Number), ".")
       Dim numberBeforePoint_Lng, numberAfterPoint_Lng As Long
       If numbersArray_Str(0).Length <= 15 Then
           If numbersArray_Str(0) <> String.Empty Then
               numberBeforePoint_Lng = CLng(numbersArray_Str(0))
           End If
       Else
           Return String.Empty
           Exit Function
       End If
       If numbersArray_Str.Length > 1 Then
           If numbersArray_Str(1).Length <= 15 Then
               If numbersArray_Str(1) <> String.Empty Then
                   numberAfterPoint_Lng = CLng(numbersArray_Str(1))
               End If
           Else
               Return String.Empty
               Exit Function
           End If
       End If
       If numberAfterPoint_Lng <> 0 Then
           If numberBeforePoint_Lng > 0 Then
               Return (CustomTextBeforeWordsOfDigits & " " & wordsOfDigits(numberBeforePoint_Lng) & " " & NameOfUnitBeforeDecimal & and_Str & wordsOfDigits(numberAfterPoint_Lng) & " " & NameOfUnitAfterDecimal & " " & CustomTextAfterWordsOfDigits).Trim
           Else
               Return (CustomTextBeforeWordsOfDigits & " " & wordsOfDigits(numberAfterPoint_Lng) & " " & NameOfUnitAfterDecimal & " " & CustomTextAfterWordsOfDigits).Trim
           End If
       Else
           If numberBeforePoint_Lng > 0 Then
               Return (CustomTextBeforeWordsOfDigits & " " & wordsOfDigits(numberBeforePoint_Lng) & " " & NameOfUnitBeforeDecimal & " " & CustomTextAfterWordsOfDigits).Trim
           End If
       End If
   End Function

   Private Function wordsOfDigits(ByVal number As Long) As String
       wordsOfDigits = String.Empty
       If number <= 10 Then
           Select Case number
               Case Is = 1 : Return "واحد"
               Case Is = 2 : Return "اثنان"
               Case Is = 3 : Return "ثلاثة"
               Case Is = 4 : Return "أربعة"
               Case Is = 5 : Return "خمسة"
               Case Is = 6 : Return "ستة"
               Case Is = 7 : Return "سبعة"
               Case Is = 8 : Return "ثمانية"
               Case Is = 9 : Return "تسعة"
               Case Is = 10 : Return "عشرة"
           End Select
       End If
       If number >= 11 And number <= 19 Then
           Select Case number
               Case Is = 11 : Return "أحد عشر"
               Case Is = 12 : Return "اثنا عشر"
               Case Is = 13 : Return "ثلاثة عشر"
               Case Is = 14 : Return "أربعة عشر"
               Case Is = 15 : Return "خمسة عشر"
               Case Is = 16 : Return "ستة عشر"
               Case Is = 17 : Return "سبعة عشر"
               Case Is = 18 : Return "ثمانية عشر"
               Case Is = 19 : Return "تسعة عشر"
           End Select
       End If
       If number >= 20 And number <= 99 Then
           Dim firstDigit_Lng As Long = number Mod 10
           Dim secondDigit_Lng As Long = number \ 10
           Dim wordOfDigit_Str As String = String.Empty
           Select Case secondDigit_Lng
               Case Is = 2 : wordOfDigit_Str = "عشرون"
               Case Is = 3 : wordOfDigit_Str = "ثلاثون"
               Case Is = 4 : wordOfDigit_Str = "أربعون"
               Case Is = 5 : wordOfDigit_Str = "خمسون"
               Case Is = 6 : wordOfDigit_Str = "ستون"
               Case Is = 7 : wordOfDigit_Str = "سبعون"
               Case Is = 8 : wordOfDigit_Str = "ثمانون"
               Case Is = 9 : wordOfDigit_Str = "تسعون"
           End Select
           If firstDigit_Lng <> 0 Then
               wordOfDigit_Str = wordsOfDigits(firstDigit_Lng) & and_Str & wordOfDigit_Str
           End If
           Return wordOfDigit_Str
       End If
       If number >= 100 And number <= 999 Then
           Dim firstDigit_Lng As Long = number Mod 100
           Dim secondDigit_Lng As Long = number \ 100
           Dim wordOfDigit_Str As String = String.Empty
           Select Case secondDigit_Lng
               Case Is = 1 : wordOfDigit_Str = "مائة"
               Case Is = 2 : wordOfDigit_Str = "مائتان"
               Case Is = 3 : wordOfDigit_Str = "ثلاثمائة"
               Case Is = 4 : wordOfDigit_Str = "أربعمائة"
               Case Is = 5 : wordOfDigit_Str = "خمسمائة"
               Case Is = 6 : wordOfDigit_Str = "ستمائة"
               Case Is = 7 : wordOfDigit_Str = "سبعمائة"
               Case Is = 8 : wordOfDigit_Str = "ثمانمائة"
               Case Is = 9 : wordOfDigit_Str = "تسعمائة"
           End Select
           If firstDigit_Lng <> 0 Then
               wordOfDigit_Str = wordOfDigit_Str & and_Str & wordsOfDigits(firstDigit_Lng)
           End If
           Return wordOfDigit_Str
       End If
       If number >= 1000 And number <= 999999 Then
           Dim firstDigit_Lng As Long = number Mod 1000
           Dim secondDigit_Lng As Long = number \ 1000
           Dim wordOfDigit_Str As String = String.Empty
           Select Case secondDigit_Lng
               Case Is = 1 : wordOfDigit_Str = "ألف"
               Case Is = 2 : wordOfDigit_Str = "ألفان"
               Case Is <= 10
                   wordOfDigit_Str = " آلاف"
                   wordOfDigit_Str = wordsOfDigits(secondDigit_Lng) & wordOfDigit_Str
               Case Else
                   wordOfDigit_Str = " ألف"
                   wordOfDigit_Str = wordsOfDigits(secondDigit_Lng) & wordOfDigit_Str
           End Select
           If firstDigit_Lng <> 0 Then
               wordOfDigit_Str = wordOfDigit_Str & and_Str & wordsOfDigits(firstDigit_Lng)
           End If
           Return wordOfDigit_Str
       End If
       If number >= 1000000 And number <= 999999999 Then
           Dim firstDigit_Lng As Long = number Mod 1000000
           Dim secondDigit_Lng As Long = number \ 1000000
           Dim wordOfDigit_Str As String = String.Empty
           Select Case secondDigit_Lng
               Case Is = 1 : wordOfDigit_Str = "مليون"
               Case Is = 2 : wordOfDigit_Str = "مليونان"
               Case Is <= 10
                   wordOfDigit_Str = " ملايين"
                   wordOfDigit_Str = wordsOfDigits(secondDigit_Lng) & wordOfDigit_Str
               Case Else
                   wordOfDigit_Str = " مليون"
                   wordOfDigit_Str = wordsOfDigits(secondDigit_Lng) & wordOfDigit_Str
           End Select
           If firstDigit_Lng <> 0 Then
               wordOfDigit_Str = wordOfDigit_Str & and_Str & wordsOfDigits(firstDigit_Lng)
           End If
           Return wordOfDigit_Str
       End If
       If number >= 1000000000 And number <= 999999999999 Then
           Dim firstDigit_Lng As Long = number Mod 1000000000
           Dim secondDigit_Lng As Long = number \ 1000000000
           Dim wordOfDigit_Str As String = String.Empty
           Select Case secondDigit_Lng
               Case Is = 1 : wordOfDigit_Str = "مليار"
               Case Is = 2 : wordOfDigit_Str = "ملياران"
               Case Else
                   wordOfDigit_Str = " مليار"
                   wordOfDigit_Str = wordsOfDigits(secondDigit_Lng) & wordOfDigit_Str
           End Select
           If firstDigit_Lng <> 0 Then
               wordOfDigit_Str = wordOfDigit_Str & and_Str & wordsOfDigits(firstDigit_Lng)
           End If
           Return wordOfDigit_Str
       End If
       If number >= 1000000000000 And number <= 999999999999999 Then
           Dim firstDigit_Lng As Long = number Mod 1000000000000
           Dim secondDigit_Lng As Long = number \ 1000000000000
           Dim wordOfDigit_Str As String = String.Empty
           Select Case secondDigit_Lng
               Case Is = 1 : wordOfDigit_Str = "تريليون"
               Case Else
                   wordOfDigit_Str = " تريليون"
                   wordOfDigit_Str = wordsOfDigits(secondDigit_Lng) & wordOfDigit_Str
           End Select
           If firstDigit_Lng <> 0 Then
               wordOfDigit_Str = wordOfDigit_Str & and_Str & wordsOfDigits(firstDigit_Lng)
           End If
           Return wordOfDigit_Str
       End If
   End Function

End Module

ثم يمكن ارسالة بارميترات للدالة كالتالي:
كود :
ConvertNumbersToWords(123.123D, "دينار", "درهم", "فقط (", ") لاغير .")
أو :
كود :
ConvertNumbersToWords(123.123D, "دينار", "درهم")
بارميترات دالة التحويل كالتالي:
أولا الرقم المراد تفقيطه وهو من نوع decimal ثم اسم الوحدة قبل الفاصلة العشرية ثم اسم الوحدة بعد الفاصلة العشرية ثم نص مخصص قبل وبعد نص التفقيط وهما بارميترات اختيارية يمكن تجاهلهما.

ولتوضيح أي جزء من الكود أو أي تعديل أنا حاضر
شكرا جزيلا وجزاك الله كل خير
هل من الممكن تفقيط الكسر بدلا من حروف الي ارقام
مثلا  بدل من مائة دينار وسبعمائة وخمسون فلس 

ليكون  مائة دينار و 750 فلس 

وشكرا جزيلا


RE: هل يوجد مثال للتفقيط حسب عملة البلد - Abdulhakeem Swisi - 11-03-18

نعم ممكن سوف أعدل على السورس إن شاء الله

السلام عليكم ورحمة الله وبركاته
قمت باضافة بارميتر خامس للدالة وهو اختياري يمكنك من تفقيط الرقم بعد الفاصلة أو أبقاء الرقم كعدد
ولتفقيط الرقم اكتب الكود كتالي:
PHP كود :
ConvertNumbersToWords(123.123D"دينار""درهم",,,True
ولتجاهل التفقيط يمكن أرسال قيمة false للبارميتر أو حتى يمكن تجاهل كتابة البارميتر
PHP كود :
ConvertNumbersToWords(123.123D"دينار""درهم",,,False

السورس كود:


RE: هل يوجد مثال للتفقيط حسب عملة البلد - السيد الجوهري - 11-03-18

شكرا جزيلا 
جزاك الله كل خير