تقييم الموضوع :
  • 0 أصوات - بمعدل 0
  • 1
  • 2
  • 3
  • 4
  • 5
الحلقة السادسة من السلسلة 167 (المبلغ كتابتا)
#1
كاتب الموضوع : FlyToAbd

لاحظت بعض الاخوة المبرمجين اللي يعمل برنامج ويحتاج فيه كتابة المبلغ يعمل حلول غير منطقية بالرغم من ان كتابة المبلغ يجب أن يستنتج منطقيا من قيمة المبلغ نفسه
لقد احتجت لهذا الموضوع منذ فترة طويلة وعملت دالة تحل المشكلة وبقيت استخدم هذه الدالة

ينقسم الكود الى ثلاث اقسام
الجزء الاول نحفظ مسميات وحدة العملة في متغيرات ليتمكن المبرمج من تغييرها اذا كان برنامجه يستخدم اكثر من عملة

كود :
Module Module1
Dim CuryName As String = "دينار"
Dim CurySubName As String = "درهم"
Dim CuryNameSingle As String = CuryName & "اً"
Dim CurySubNameSingle As String = CurySubName & "اً"
Dim CuryNameDouble As String = CuryName & "ان"
Dim CurySubNameDouble As String = CurySubName & "ان"
Dim CuryNameMulti As String = "دنانير"
Dim CurySubNameMulti As String = CurySubName & "دراهم"
CuryName نضع فيه اسم العملة
CurySubName نضع فيه اسم العملة المتفرعة والتي تكون بالالف
CuryNameSingle والمتغير CurySubNameSingle يضيف حرف الف معه تنوين لاغراض القواعد
والمتغيران التي بعدها تضيف الف ونون لايجاد المثنى للكلمتين
والمتغيران التي بعدها لكتابة الجمع للكلمتين
واذا كانت عملتك مختلفة فعليك تغيير الكلمات "دينار" ، "درهم" ، "دنانير" ، "دراهم" من المتغيرات فقط

فكرة الدالة انها تقسم الارقام الى ثلاث مراتب ثلاث مراتب وكل ثلاث مراتب سوف تقرأ بنفس الطريقة والذي يختلف فقط هو الوحدة سوف اختار رقما ينبهك الى الفكرة
527,527,527.527
سيقرأ هذا الرقم كالاتي
خمسمائة وسبع وعشرون مليوناً
وخمسمائة وسبع وعشرون ألفاً
وخمسمائة وسبع وعشرون ديناراً
وخمسمائة وسبع وعشرون درهماً

بالرغم من أن الكثير من الانظمة المالية تكتب 527 فلساً هكذا (وقد اعتمدته)

وعليه توجد دالة رئيسية تقسم الارقام وتستدعي دالة فرعية تقرأ رقم من ثلاث مرات وتضيف عليه الوحدة
الدالة الرئيسية

كود :
Public Function ToWords(ByVal Num As Double) As String
Dim SubNum(3) As Integer
Dim Wrd(3) As String
Dim Words As String
Dim Nm As String
If (Not IsNumeric(Num)) OrElse Num > 999999999.999 Then
Return Num
Else
Nm = Format(Num, "000,000,000.000")
SubNum(3) = Val(Mid(Nm, 1, 3))
SubNum(2) = Val(Mid(Nm, 5, 3))
SubNum(1) = Val(Mid(Nm, 9, 3))
SubNum(0) = Val(Mid(Nm, 13, 3))
For i As Integer = 3 To 0 Step -1
Wrd(i) = SubWriteNumber(SubNum(i), i)
Next
If Wrd(3) <> "" Then
If Wrd(2) = "" Then
If Wrd(1) = "" Then
If Wrd(0) = "" Then
Wrd(3) &= CuryNameSingle & " "
Else
Wrd(3) &= CuryNameSingle & " و "
End If
Else
Wrd(3) &= " و"
End If
Else
Wrd(3) &= " و"
End If
End If
If Wrd(2) <> "" Then
If Wrd(1) = "" Then
If Wrd(0) = "" Then
Wrd(2) &= CuryNameSingle & " "
Else
Wrd(2) &= CuryNameSingle & " و "
End If
Else
Wrd(2) &= " و"
End If
End If
If Wrd(1) <> "" Then
If Wrd(0) <> "" Then
Wrd(1) &= " و"
End If
End If
Words = Wrd(3) & Wrd(2) & Wrd(1) & " " & SubNum(0) & CurySubNameSingle
Return Words
End If
End Function
الدالة الفرعية

كود :
Private Function SubWriteNumber(ByVal Num As Single, ByVal Unit As Byte) As String
Dim Wrt(14, 3) As String
Dim Words As String = ""
Dim Dgt(2) As Byte
Dim Nm As String
Unit = Unit + 11
Wrt(0, 1) = "" : Wrt(0, 2) = "" : Wrt(0, 3) = ""
Wrt(1, 1) = "واحد" : Wrt(1, 2) = "عَشَرَ" : Wrt(1, 3) = "مائة"
Wrt(2, 1) = "إثنان" : Wrt(2, 2) = "عُشرون" : Wrt(2, 3) = "مائتان"
Wrt(3, 1) = "ثلاثة" : Wrt(3, 2) = "ثلاثون" : Wrt(3, 3) = "ثلاثمائة"
Wrt(4, 1) = "أربعة" : Wrt(4, 2) = "أربعون" : Wrt(4, 3) = "أربعمائة"
Wrt(5, 1) = "خمسة" : Wrt(5, 2) = "خمسون" : Wrt(5, 3) = "خمسمائة"
Wrt(6, 1) = "ستة" : Wrt(6, 2) = "ستون" : Wrt(6, 3) = "ستمائة"
Wrt(7, 1) = "سبعة" : Wrt(7, 2) = "سبعون" : Wrt(7, 3) = "سبعمائة"
Wrt(8, 1) = "ثمانية" : Wrt(8, 2) = "ثمانون" : Wrt(8, 3) = "ثمانمائة"
Wrt(9, 1) = "تسعة" : Wrt(9, 2) = "تسعون" : Wrt(9, 3) = "تسعمائة"
Wrt(10, 1) = "أحَدَ" : Wrt(10, 2) = "إثنا" : Wrt(10, 3) = "عشرة"
Wrt(11, 1) = CurySubNameSingle : Wrt(11, 2) = CurySubNameDouble : Wrt(11, 3) = CurySubNameMulti
Wrt(12, 1) = CuryNameSingle : Wrt(12, 2) = CuryNameDouble : Wrt(12, 3) = CuryNameMulti
Wrt(13, 1) = "ألفاً" : Wrt(13, 2) = "ألفان" : Wrt(13, 3) = "آلاف"
Wrt(14, 1) = "مليوناً" : Wrt(14, 2) = "مليونان" : Wrt(14, 3) = "ملايين"
Nm = Format(Num, "000")
Dgt(0) = Val(Mid(Nm, 3, 1))
Dgt(1) = Val(Mid(Nm, 2, 1))
Dgt(2) = Val(Mid(Nm, 1, 1))
Select Case Dgt(2)
Case 0
Select Case Dgt(1)
Case 0
Select Case Dgt(0)
Case 0
Words = ""
Case 1, 2
Words = Wrt(Unit, Dgt(0))
Case Is > 2
Words = Wrt(Dgt(0), 1) & " " & Wrt(Unit, 3)
End Select
Case 1
Select Case Dgt(0)
Case 0
Words = Wrt(10, 3) & " " & Wrt(Unit, 3)
Case 1, 2
Words = Wrt(10, Dgt(0)) & " " & Wrt(1, 2) & " " & Wrt(Unit, 1)
Case Is > 2
Words = Wrt(Dgt(0), 1) & " " & Wrt(1, 2) & " " & Wrt(Unit, 1)
End Select
Case Is > 1
Select Case Dgt(0)
Case 0
Words = Wrt(Dgt(1), 2) & " " & Wrt(Unit, 1)
Case Is > 0
Words = Wrt(Dgt(0), 1) & " و" & Wrt(Dgt(1), 2) & " " & Wrt(Unit, 1)
End Select
End Select
Case Is > 0
Select Case Dgt(1)
Case 0
Select Case Dgt(0)
Case 0
Words = Wrt(Dgt(2), 3) & " " & Wrt(Unit, 1)
Case 1, 2
Words = Wrt(Dgt(2), 3) & " و" & Wrt(Dgt(0), 1) & " " & Wrt(Unit, 1)
Case Is > 2
Words = Wrt(Dgt(2), 3) & " و" & Wrt(Dgt(0), 1) & " " & Wrt(Unit, 3)
End Select
Case 1
Select Case Dgt(0)
Case 0
Words = Wrt(Dgt(2), 3) & " و" & Wrt(10, 3) & " " & Wrt(Unit, 3)
Case 1, 2
Words = Wrt(Dgt(2), 3) & " و" & Wrt(10, Dgt(0)) & " " & Wrt(1, 2) & " " & Wrt(Unit, 1)
Case Is > 2
Words = Wrt(Dgt(2), 3) & " و" & Wrt(Dgt(0), 1) & " " & Wrt(1, 2) & " " & Wrt(Unit, 1)
End Select
Case Is > 1
Select Case Dgt(0)
Case 0
Words = Wrt(Dgt(2), 3) & " و" & Wrt(Dgt(1), 2) & " " & Wrt(Unit, 1)
Case Is > 0
Words = Wrt(Dgt(2), 3) & " و" & Wrt(Dgt(0), 1) & " و" & Wrt(Dgt(1), 2) & " " & Wrt(Unit, 1)
End Select
End Select
End Select
Return Words
End Function
End Module
ولتجربة الدالة عليك بالاتي
نضيف الادوات التالية الى النموذج
Label1
Button1
NumericUpDown1
[SIZE=2]عدل الخاصية Maximum الى 999999999.999
عدل الخاصية DecimalPlaces الى 3
ونضيف الكود التالي الى النموذج
[/SIZE]
كود :
Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
Label1.Text = ToWords(NumericUpDown1.Value)
End Sub
اكتب الرقم المناسب واضغط على الزر
الرد }}}}
تم الشكر بواسطة:


المواضيع المحتمل أن تكون متشابهة .
الموضوع : الكاتب الردود : المشاهدات : آخر رد
  برامج 167 للبرمجة الحلقة الاولى RaggiTech 0 256 03-10-12, 01:38 AM
آخر رد: RaggiTech
  الحلقة صفر من السلسلة 167 للبرمجة RaggiTech 0 408 02-10-12, 04:32 PM
آخر رد: RaggiTech
  الحلقة العاشرة من السلسلة 167 - اضافة المخطط (Chart) الى التقرير RaggiTech 0 471 02-10-12, 04:31 PM
آخر رد: RaggiTech
  الحلقة السابعة من السلسلة 167- استخراج جميع معلومات الجهاز RaggiTech 4 641 02-10-12, 04:28 PM
آخر رد: RaggiTech
  الحلقة الرابعة من السلسلة 167 - حل مشكلة Socket مع مثال شات RaggiTech 0 484 02-10-12, 04:24 PM
آخر رد: RaggiTech
  الحلقة الخامسة من السلسلة 167 كود برنامج مسنجر كامل على الشبكة المحلية RaggiTech 0 399 02-10-12, 04:18 PM
آخر رد: RaggiTech
  الحلقة الثامنة من السلسلة 167- دارسة في الألوان RaggiTech 0 363 02-10-12, 04:17 PM
آخر رد: RaggiTech
  الحلقة التاسعة من السلسلة 167 حفظ الصور في تطبيق قواعد بيانات RaggiTech 0 721 02-10-12, 04:15 PM
آخر رد: RaggiTech
  الحلقة 2 من السلسلة 167 RaggiTech 7 610 02-10-12, 04:11 PM
آخر رد: RaggiTech

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


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