تحويل الأعداد إلى الصيغة الحرفية (التفقيط)
صفحة 1 من اصل 1 • شاطر
تحويل الأعداد إلى الصيغة الحرفية (التفقيط)
هذا المقال نقلا عن مدونة م /محمد حمدى
وقد وجدت فئة مكتوبة بالجافا سكربت تقوم بهذا الأمر، مؤلفها الأخ MazenB، وقد بذل فيها جهدا يستحق الشكر لمراعاة بعض القواعد العربية، وقد أخذت أنا هذه الفئة وحولتها إلى فيجوال بيزيك وأصلحت بعض أخطائها، وأدخلت عليها بعض التعديلات والإضافات لضبط نحو اللغة العربية، فيما يتعلق بنصب تمييز العدد في بعض الحالات (مثل خمسة عشر ألفا)، وحذف نون المثنى عند الإضافة (مثل مئتا ألف)، ومراعاة قواعد التأنيث والتذكير بين العدد وتمييزه، وكذلك مراعاة إفراد تمييز العدد أو جمعه (مثل: ثلاث نساء، تسع عشرة امرأة).. وأظن أن الفئة بهذه الصيغة صارت منضبطة على قواعد اللغة العربية تمام الانضباط.
كما أني وضعت بعض علامات الترقيم في الصيغة الناتجة لجعلها أكثر وضوحا، فوضعت فاصلة بعد مواضع الآلاف والملايين والمليارت... إلخ، ووضعت الصيغة كلها بين قوسين لفصلها عن تمييز العدد إن تم ذكره.
إليكم كود الفئة، وسأشرح لكم كيفية استخدامها في موضوع لاحق بإذن الله:
- الكود:
Public Class NumericToLiteral
Private Const Zero = "صفر"
Private Const One = "واحد"
Private Const OneFemale = "واحدة"
Private Const Ahad = "أحد"
Private Const Ehda = "إحدى"
Private Const Two = "اثنان"
Private Const TwoFemales = "اثنتان"
Private Const Ethna = "اثنا"
Private Const Ethnta = "اثنتا"
Private Const Three = "ثلاثة"
Private Const Four = "أربعة"
Private Const Five = "خمسة"
Private Const Six = "ستة"
Private Const Seven = "سبعة"
Private Const Eight = "ثمانية"
Private Const Nine = "تسعة"
Private Const Ten = "عشرة"
Private Const Ten2 = "عشر"
Private Const Twenty = "عشرون"
Private Const Thirty = "ثلاثون"
Private Const Fourty = "أربعون"
Private Const Fifty = "خمسون"
Private Const Sixty = "ستون"
Private Const Seventy = "سبعون"
Private Const Eighty = "ثمانون"
Private Const Ninety = "تسعون"
Private Const Hundred = "مئة"
Private Const TwoHundreds = "مئتان"
Private Const Thousand = "ألف"
Private Const Thousands = "آلاف"
Private Const Million = "مليون"
Private Const Millions = "ملايين"
Private Const Pillion = "مليار"
Private Const Pillions = "مليارات"
Private Const Trillion = "تريليون"
Private Const Trillions = "تريليونات"
Private Const Quadrillion = "كدريليون"
Private Const Quadrillions = "كدريليونات"
Private Const Quintillion = "كوينتيليون"
Private Const Quintillions = "كوينتيليونات"
Private Shared namesMap As New Dictionary(Of Long, String)
Private Shared Sub Map()
If namesMap.Count > 0 Then Return
namesMap.Add(0, Zero)
namesMap.Add(1, One)
namesMap.Add(2, Two)
namesMap.Add(3, Three)
namesMap.Add(4, Four)
namesMap.Add(5, Five)
namesMap.Add(6, Six)
namesMap.Add(7, Seven)
namesMap.Add(8, Eight)
namesMap.Add(9, Nine)
namesMap.Add(10, Ten)
namesMap.Add(20, Twenty)
namesMap.Add(30, Thirty)
namesMap.Add(40, Fourty)
namesMap.Add(50, Fifty)
namesMap.Add(60, Sixty)
namesMap.Add(70, Seventy)
namesMap.Add(80, Eighty)
namesMap.Add(90, Ninety)
namesMap.Add(100, Hundred)
namesMap.Add(1000, Thousand)
namesMap.Add(10 ^ 6, Million)
namesMap.Add(10 ^ 9, Pillion)
namesMap.Add(10 ^ 12, Trillion)
namesMap.Add(10 ^ 15, Quadrillion)
namesMap.Add(10 ^ 18, Quintillion)
End Sub
Private Shared Function Parse(a As Long, Female As Boolean, SingleName As String, PluralName As String) As String
Map()
Dim buf As String = a.ToString()
buf = StrReverse(buf)
Dim index As Long = 0
Dim negative As Boolean = (buf(buf.Length() - 1) = "-"c)
Dim len As Long = If(negative, buf.Length - 1, buf.Length)
Dim name(len - 1) As String
Dim unitValue As Long = 0
Do While index < len
Dim n = Val(buf(index))
Dim decimalPos As Long = index Mod 3
If decimalPos = 0 Then
unitValue = Math.Pow(10, index)
End If
Dim decimalPlace As Long = Math.Pow(10, decimalPos)
Select Case decimalPlace
Case 1
If unitValue > 1 AndAlso index + 1 = len Then
Select Case n
Case 1
name(index) = namesMap(unitValue) & "، "
Case 2
name(index) = namesMap(unitValue) & ("ان") & "، "
Case Else
name(index) = PluralNames(namesMap(n), unitValue) & "، "
End Select
ElseIf n < 3 Then
If Female AndAlso n = 2 AndAlso index = 0 Then
name(index) = TwoFemales
Else
name(index) = namesMap(n)
End If
Else
name(index) = If(Female AndAlso index < 3, namesMap(n).Substring(0, namesMap(n).Length - 1), namesMap(n))
End If
Case 10
Dim tmp As String = name(index - 1)
If n = 1 Then
If tmp = One Then
tmp = If(Female AndAlso index < 3, Ehda, Ahad)
ElseIf tmp = Two OrElse tmp = TwoFemales Then
tmp = If(Female AndAlso index < 3, Ethnta, Ethna)
End If
End If
If unitValue > 1 AndAlso index + 1 = len Then
If n = 1 AndAlso tmp = Zero Then
name(index) = PluralNames(Ten, unitValue) & "، "
ElseIf n = 1 Then
name(index) = Ten2 & " " & namesMap(unitValue) & "، "
Else
name(index) = namesMap(n * 10) & " " & namesMap(unitValue) & "، "
End If
Else
name(index) = namesMap(n * 10)
If name(index - 1) = Zero Then
If n = 1 AndAlso Female AndAlso index < 3 Then name(index) = Ten2
Else
If n = 1 AndAlso Not (Female AndAlso index < 3) Then name(index) = Ten2
End If
End If
If n <> 0 Then
name(index - 1) = name(index)
name(index) = tmp
End If
Case 100
Dim s1 As String
If n > 2 Then
s1 = namesMap(n)
s1 = s1.Substring(0, s1.Length - (If(n = 8, 2, 1))) + Hundred
Else
s1 = If(n = 2, TwoHundreds, namesMap(n * 100))
End If
If unitValue > 1 AndAlso name(index - 2) <> Zero Then
Dim X = If(name(index - 2) = Ten2, Ten, name(index - 2))
For Each Elm In namesMap
Dim val = Elm.Key
If namesMap(val) = X Then
If val > 2 AndAlso val < 10 OrElse val = 10 AndAlso name(index - 1) = Zero Then
name(index - 2) = PluralNames(name(index - 2), unitValue) & "، "
ElseIf s1 = Zero AndAlso name(index - 1) = Zero Then
If val = 1 Then
name(index - 2) = namesMap(unitValue) & "، "
ElseIf val = 2 Then
name(index - 2) = namesMap(unitValue) & "ان، "
Else
name(index - 2) = name(index - 2) & " " & namesMap(unitValue) & "، "
End If
Else
name(index - 2) = name(index - 2) & " " & namesMap(unitValue) & "، "
End If
Exit For
End If
Next
ElseIf unitValue > 1 AndAlso n <> 0 Then
If s1 = TwoHundreds Then s1 = s1.TrimEnd("ن")
s1 &= " " & namesMap(unitValue) & "،"
End If
name(index) = s1
End Select
index += 1
Loop
Dim s As String = ""
For c As Long = 0 To len - 1
If name(c) = Zero Then Continue For
If Female AndAlso c = 0 AndAlso name(c) = One Then name(c) = OneFemale
name(c) = name(c).Trim()
If s <> "" AndAlso Not ((s.StartsWith(Ten2 & " ") OrElse s.StartsWith(Ten)) AndAlso (Not name(c - 1) = Zero)) Then
If c > 0 Then
Dim X = name(c).Split(" ")
If X.Length > 0 Then
Select Case X(0)
Case Ten2, Twenty, Thirty, Fourty, Fifty, Sixty, Seventy, Eighty, Ninety
name(c) &= "ا"
End Select
End If
End If
s = name(c) & " و" & s
Else
s = name(c) & " " & s
End If
Next
s = "(" & s.Trim.Trim("،").Replace("،ا ", "ا، ") & ")"
If SingleName <> "" AndAlso PluralName <> "" Then
Dim N As Long
Dim X = a.ToString
If X.Length < 2 Then
N = a
Else
N = X.Substring(X.Length - 2, 2)
End If
If N = 0 Then
If a > 0 Then
If s.EndsWith("ان" & ")") Then s = s.TrimEnd(")").TrimEnd("ن") & ")"
s &= " " & SingleName
End If
ElseIf N < 11 Then
Select Case name(0)
Case Zero
Case One, OneFemale
If a = 1 Then
s = SingleName & " " & name(0)
Else
s &= " من ال" & PluralName
End If
Case Two, TwoFemales
If a = 2 Then
SingleName = SingleName.Replace("ة", "ت")
s = SingleName & "ان " & name(0)
Else
s &= " من ال" & PluralName
End If
Case Else
s &= " " & PluralName
End Select
Else
s &= " " & SingleName & If(SingleName.EndsWith("ة"), "", "ا")
End If
End If
Return If(s = "", Zero, (If(negative, "سالب " & s, s)).Trim())
End Function
Private Shared Function PluralNames(Word As String, unitValue As Long) As String
If unitValue = 1000 Then
Return Word & " " & Thousands
ElseIf unitValue = 10 ^ 6 Then
Return Word & " " & Millions
ElseIf unitValue = 10 ^ 9 Then
Return Word & " " & Pillions
ElseIf unitValue = 10 ^ 12 Then
Return Word & " " & Trillions
ElseIf unitValue = 10 ^ 15 Then
Return Word & " " & Quadrillions
Else
Return Word & " " & Quintillions
End If
End Function
Public Shared Function Convert(a As Decimal, Optional Female As Boolean = False, Optional SingleName As String = "", Optional PluralName As String = "") As String
If Fix(a) > Long.MaxValue Then Return "هذا العدد أكبر من القيمة العظمى التي يمكن تحويلها"
Dim array() As String = a.ToString.Split(".")
Dim i As Long = array(0)
Dim f As Long = If(array.Length = 2, array(1), 0)
Dim fractSize As Long = If(f > 0, array(1).Length, 0)
Dim integralPart As String = If(i <> 0 OrElse f = 0, Parse(i, Female, SingleName, PluralName), "")
Dim fractionalPart As String = If(f > 0, Parse(f, False, "", "").TrimEnd(")") & " من " & Parse(Math.Pow(10, fractSize), False, "", "").TrimStart("("), "")
Return integralPart & (If(f * i <> 0, " و ", "")) & fractionalPart
End Function
End Class
VB.NET- المراقبين
- تاريخ التسجيل : 18/02/2011
المساهمات : 121
النقاط : 189
التقيم : 6
الدولة :
الجنس :
رد: تحويل الأعداد إلى الصيغة الحرفية (التفقيط)
استخدام فئة التفقيط
في الموضوع السابق، وضعت لكم كود الفئة NumericToLiteral التي تقوم بتحويل الأعداد من الصيغة الرقمية إلى الصيغة الحرفية.. الكود موجود أيضا داخل ملف المشروع المرفق بهذا الموضوع، ويمكنكم تحميله من هذا الرابط:
[ندعوك للتسجيل في المنتدى أو التعريف بنفسك لمعاينة هذا الرابط]
نريد الآن معرفة كيفية التعامل مع الفئة NumericToLiteral.
هذه الفئة تمتلك وسيلة واحدة مشتركة Shared يمكن استدعاؤها من اسم الفئة مباشرة، وهي الوسيلة Convert.. والمثال التالي يريك كيف تحول الرقم 225 إلى تمثيله النصي:
- الكود:
Dim LiteralNo = NumericToLiteral.Convert(225)
MsgBox(LiteralNo)
(مئتان وخمسة وعشرون)
ملاحظات:
1- أقصى عدد تتعامل معه هذه الفئة هو 9,223,372,036,854,775,807.. والتمثيل النصي له هو:
(تسعة كوينتيليونات، ومئتان وثلاثة وعشرون كدريليونا، وثلاثمئة واثنان وسبعون تريليونا، وستة وثلاثون مليارا، وثمانمئة وأربعة وخمسون مليونا، وسبعمئة وخمسة وسبعون ألفا، وثمانمئة وسبعة)
حيث إن:
الكوينتيليون = 1000 كدريليون
الكدريليون = 1000 تريليون
تريليون = 1000 مليار
المليار (البليون) = 1000 مليون
وتتعامل هذه الفئة أيضا مع الكسور ومع الأعداد السالبة.. على سبيل المثال، تقول هذه الفئة بتحويل العدد (- 1100.349) إلى:
سالب (ألف، ومئة) و (ثلاثمئة وتسعة وأربعون من ألف)
2- هذه الفئة تكتب التمثيل النصي بين قوسين، لأنه أحيانا يكون طويلا جدا.. كما أن القوسين يجعلان الأمور أوضح عند وضع تمييز بعد العدد.. فمثلا: لو حولت الرقم 273673690 فستحصل على التمثيل الرقمي التالي:
(مئتان وثلاثة وسبعون مليونا، وستمئة وثلاثة وسبعون ألفا، وستمئة وتسعون)
لكن إذا كان القوسان يزعجانك، فيمكنك التخلص منها كالتالي:
- الكود:
LiteralNo = LiteralNo.Replace("(", ""). Replace (")", "")
3- التمثيل النصي للرقم يفترض أن تمييز العدد مذكرا.. لكنك تستطيع تغيير هذا، فالوسيلةConvert لها معامل ثان اختياري، لو أرسلت إليه القيمة True فسيتم اعتبار التمييز مؤنثا، وصياغة العدد على أساس ذلك.. والمثال التالي يوضح الفارق بين تمثيل العدد 15 كمذكر وكمؤنث:
- الكود:
Dim LiteralNo = NumericToLiteral.Convert(15)
MsgBox(LiteralNo)
LiteralNo = NumericToLiteral.Convert(15, True)
MsgBox(LiteralNo)
ستعرض الرسالة الأولى:
(خمسة عشر)
ستعرض الرسالة الثانية:
(خمس عشرة)
4- يمكنك أن ترسل للوسيلة Convert أيضا التمييز الذي تريد استخدامه.. هذا أفضل من أن تحاول كتابته بنفسك، لأن هناك حالا يكون فيها التمييز مفردا، وأخرى يكون فيها جمعا، وحالات يكون فيها منصوبا، وأخرى مجرورا.. لو أرسلته لهذه الوسيلة فستكتبه لك في الصيغة الملائمة للعدد.. ونظرا لأن هذه الفئة لا تتضمن معجما ولا محللا صرفيا، فهي تحتاج منك لذكر التمييز في صيغتي المفرد والجمع، بإرسالهما إلى المعاملين الاختياريين الثالث والرابع على التوالي.. انظر الأمثلة التالية:
- الكود:
Dim LiteralNo = NumericToLiteral.Convert(150, False, "جنيه", "جنيهات")
MsgBox(LiteralNo)
LiteralNo = NumericToLiteral.Convert(105, False, "جنيه", "جنيهات")
MsgBox(LiteralNo)
LiteralNo = NumericToLiteral.Convert(100, False, "جنيه", "جنيهات")
MsgBox(LiteralNo)
(مئة وخمسون) جنيها
(مئة وخمس) جنيهات
(مئة) جنيه
5- إذا أردت إضافة التعبير "فقط لا غير" المستخدم عند تفقيط النقود في الإيصالات، فأضفه في نهاية التمثيل النصي كالتالي:
- الكود:
LiteralNo &= " فقط لا غير"
يمكنكم تحميل هذا المشروع من هذا الرابط:
[ندعوك للتسجيل في المنتدى أو التعريف بنفسك لمعاينة هذا الرابط]
في هذا المشروع، يمكنكم أن تجربوا ما يلي:
تمييز مذكر: "جنيه" و "جنيهات":
العدد | التمثيل النصي |
1 | جنيه واحد |
2 | جنيهان اثنان |
3 | (ثلاثة) جنيهات |
11 | (أحد عشر) جنيها |
99 | (تسعة وتسعون) جنيها |
101 | (مئة وواحد) من الجنيهات |
102 | (مئة واثنان) من الجنيهات |
110 | (مئة وعشرة) جنيهات |
187 | (مئة وسبعة وثمانون) جنيها |
200 | (مئتا) جنيه |
212 | (مئتان واثنا عشر) جنيها |
1,200 | (ألف، ومئتا) جنيه |
2,370 | (ألفان، وثلاثمئة وسبعون) جنيها |
1,001,100 | (مليون، وألف، ومئة) جنيه |
976,530,856 | (تسعمئة وستة وسبعون مليونا، وخمسمئة وثلاثون ألفا، وثمانمئة وستة وخمسون) جنيها |
2,000,000,000 | (مليارا) جنيه |
2,030,500,006 | (ملياران، وثلاثون مليونا، وخمسمئة ألف، وستة) جنيهات |
العدد | التمثيل النصي |
1 | امرأة واحدة |
2 | امرأتان اثنتان |
3 | (ثلاث) نساء |
11 | (إحدى عشرة) امرأة |
99 | (تسع وتسعون) امرأة |
101 | (مئة وواحدة) من النساء |
102 | (مئة واثنتان) من النساء |
110 | (مئة وعشر) نساء |
187 | (مئة وسبع وثمانون) امرأة |
200 | (مئتا) امرأة |
212 | (مئتان واثنتا عشرة) امرأة |
1,200 | (ألف، ومئتا) امرأة |
2,370 | (ألفان، وثلاثمئة وسبعون) امرأة |
1,001,100 | (مليون، وألف، ومئة) امرأة |
976,530,856 | (تسعمئة وستة وسبعون مليونا، وخمسمئة وثلاثون ألفا، وثمانمئة وست وخمسون) امرأة |
2,000,000,000 | (مليارا) امرأة |
2,030,500,006 | (ملياران، وثلاثون مليونا، وخمسمئة ألف، وست) نساء |
VB.NET- المراقبين
- تاريخ التسجيل : 18/02/2011
المساهمات : 121
النقاط : 189
التقيم : 6
الدولة :
الجنس :
رد: تحويل الأعداد إلى الصيغة الحرفية (التفقيط)
بارك الله فيك أخى vb ونتمنى أن تدعو م /محمد الى المشاركة معنا فى المنتدى
ـــــــــــــــــــ التوقيع ــــــــــــــــــــ
NEXT- الادارة
- تاريخ التسجيل : 18/02/2011
المساهمات : 446
النقاط : 200660
التقيم : 28
الدولة :
الجنس :
رد: تحويل الأعداد إلى الصيغة الحرفية (التفقيط)
كيف ندرج العملة الثانوية مثل السنتيم بعد الفاصلةNEXT كتب:بارك الله فيك أخى vb ونتمنى أن تدعو م /محمد الى المشاركة معنا فى المنتدى
paveldida- .
- تاريخ التسجيل : 03/03/2020
المساهمات : 1
النقاط : 1
التقيم : 0
الدولة :
الجنس :
العريقي١- ..
- تاريخ التسجيل : 21/05/2021
المساهمات : 12
النقاط : 22
التقيم : 0
الدولة :
الجنس :
| |
صفحة 1 من اصل 1
صلاحيات هذا المنتدى:
لاتستطيع الرد على المواضيع في هذا المنتدى
الأحد مارس 17, 2024 1:52 pm من طرف رانيا حماد
» افضل شركة نقل عفش بالرياض نقل باكستاني 40% خصم | موقع الانوار
الأحد مارس 17, 2024 1:25 pm من طرف رانيا حماد
» افضل معلم جبس بالرياض تركيب جبس بورد بالرياض 20% خصم اتصل الآن
الأحد مارس 17, 2024 1:09 pm من طرف رانيا حماد
» شراء اثاث مستعمل بالكويت بخصم 30%
الأحد مارس 17, 2024 12:54 pm من طرف رانيا حماد
» افضل فني كهربائي منازل بالرياض جودة 100% | اتصل الآن
الأحد مارس 17, 2024 12:36 pm من طرف رانيا حماد
» أفضل فني سباك بالرياض ممتاز بالرياض | اتصل الآن
الأحد مارس 17, 2024 12:25 pm من طرف رانيا حماد
» افضل شركة تنظيف اثاث بالرياض تنظيف كنب واجهات حجر بخصم 40%
الأحد مارس 17, 2024 11:52 am من طرف رانيا حماد
» افضل شركة تنظيف فلل بالرياض | الانوار
الأحد مارس 17, 2024 11:22 am من طرف رانيا حماد
» افضل شركة تنظيف واجهات زجاج بالرياض 30% خصم
الأحد مارس 17, 2024 10:38 am من طرف رانيا حماد
» افضل شركة نقل عفش بالكويت بخصم 20%
الخميس مارس 14, 2024 1:36 pm من طرف رانيا حماد