المشاركات : 82
المواضيع 5
الإنتساب : Nov 2012
السمعة :
2
الشكر: 0
تم شكره 26 مرات في 7 مشاركات
السلام عليكم ،،
كيفكم ،، اليوم بس عندي مشاركه بسيطه ،، كنت ابحث و لقيت باحد المنتديات تقفيط الارقام و لكن كان باصدار فيجول بيسك 6 :o
قمت بتعديل ما يلزم فيه و انزاله كموضوع لباقي الاخوه لاجل الكل يستفيد ،،
رابط ملفات البرنامج ،، يعمل فيجول 2005 ،، ::
http://www.mediafire.com/?7o5usfv74u4crpp
المشاركات : 749
المواضيع 17
الإنتساب : Sep 2013
السمعة :
54
الشكر: 521
تم شكره 619 مرات في 232 مشاركات
جزاك الله خيرا
ويعطيك العافية
المشاركات : 17
المواضيع 2
الإنتساب : Sep 2012
السمعة :
0
الشكر: 0
تم شكره 11 مرات في 4 مشاركات
وجدت أخطاء في الكود تم تحسينها جذريا
المشاركات : 17
المواضيع 2
الإنتساب : Sep 2012
السمعة :
0
الشكر: 0
تم شكره 11 مرات في 4 مشاركات
هذه هي الدالة
إقتباس : 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 = Format(TheNo, "000000000000.00")
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 = 0
Dim ReMark As String
If TheNo > 999999999999.99 Then Exit Function
If TheNo = 0 Then
NoToTxt = "صفر"
Exit Function
End If
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) = "تسعة"
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
و هذه طريقة التنفيذ
إقتباس : If Me.TextBox1.Text = "" Then Exit Sub
If TextBox1.Text.Contains(".") = True Then
Dim number() As String = Split(TextBox1.Text, ".")
N = Int(number(0))
p = Val(Mid(number(1), 1, 2))
Else
p = 0
N = Int(TextBox1.Text)
End If
If (p) > 0 Then
TextBox2.Text = NoToTxt(N, "ريـال", "") & " و " & NoToTxt(p, "هللة", "")
Else
TextBox2.Text = NoToTxt(N, "ريـال", "")
End If
المشاركات : 1,817
المواضيع 141
الإنتساب : Sep 2013
السمعة :
112
الشكر: 7278
تم شكره 3459 مرات في 585 مشاركات
26-02-13, 10:56 PM
(آخر تعديل لهذه المشاركة : 06-11-14, 05:25 PM {2} بواسطة abulayth.)
السلام عليكم
بارك الله فيك
بالتوفيق ان شاءالله
المشاركات : 71
المواضيع 0
الإنتساب : May 2013
السمعة :
0
الشكر: 0
تم شكره 7 مرات في 7 مشاركات
المشاركات : 118
المواضيع 26
الإنتساب : Jul 2014
السمعة :
15
الشكر: 26
تم شكره 180 مرات في 44 مشاركات
المشاركات : 12
المواضيع 0
الإنتساب : Sep 2013
السمعة :
0
الشكر: 51
تم شكره 52 مرات في 2 مشاركات
|