هل يوجد مثال للتفقيط حسب عملة البلد - السيد الجوهري - 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
شكرا جزيلا
جزاك الله كل خير
|