طريقة التفقيط لعملة دينار كويتى وقرائة 3 ارقام بعد العلامة - ahmedramzyaish - 14-11-19
استخدم الكود الاتى للتفقيط ولكن الدينار يتطلب 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
RE: طريقة التفقيط لعملة دينار كويتى وقرائة 3 ارقام بعد العلامة - smalw - 14-11-19
اتوقع المطلوب
تحويل العمله الى نص مكتوب
RE: طريقة التفقيط لعملة دينار كويتى وقرائة 3 ارقام بعد العلامة - ahmedramzyaish - 15-11-19
(14-11-19, 12:50 AM)smalw كتب : اتوقع المطلوب
تحويل العمله الى نص مكتوب
اشكرك الكود يعمل ولكن فى مشكلة عندما يكون الرقم يبدا بألفين مثلا 2190.709
تكتب ألاف مائة وتسعون
اما ياقى الاعداد تمام
هل لها حل
RE: طريقة التفقيط لعملة دينار كويتى وقرائة 3 ارقام بعد العلامة - معاند الحظ - 15-11-19
استخدم الكود التالي ولا تنسى تعدل اسماء الارقام الى العربية في الكود
كود :
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/33282/Simple-Class-to-Convert-Numbers-into-Text
RE: طريقة التفقيط لعملة دينار كويتى وقرائة 3 ارقام بعد العلامة - 3booody - 15-11-19
السلام عليكم ورحمة الله وبركاته
أخي كودك ربما يكون معقد قليلآ والي فهمتو منك تريد تحول من رقم الى رقم كتابة ,, بصراحة كنت ناوي اعطيك فكرة اسهل وبدون تعقيد لكن وجدت الامر ممتع واكملت لك كود الى حد 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)
سوف يعطيك النتيجة ان شاء الله
|