الفريق العربي للبرمجةأرشيف المنتديات · 2000 – 2023
نسخة أرشيفية للقراءة فقط — التسجيل والمشاركة مغلقان، والمحتوى محفوظ كما كان.

اريد كود للتفقيط

مغلق
بدأه رنين في 9 أغسطس 2004 · 6 رد · 2,018 مشاهدة · في لغة Ms Visual Basic 6 وما قبلها من إصدارات
مشاركة: واتساب X فيسبوك تيليجرام
#1 صاحب الموضوع

عندي مشكلة كبيرة بالنسبة ليا ولكن عارف انكم قادرين عليها وهي كالتالي :

عندي TEXT اريد اكتب فيه رقم وبمجر كتابة الرقم والضعط على زر انتر يظهر التفقيط كتابة مثال :

اكتب في TEXT مبلغ 1500 يظهر في LABEAL الف وخمسمائة ريال فقط لاغير

اريد الحل يا شباب عندي مشروع تخرج وورطان ومنى عارف ايش اسوى ياريت ترسلو ليا الكود ويكون التفقيط باللغة العربية

#2

السلام عليكم

هذا البرنامج المطلوب ولكن يحتاج الى تعديل كثير تحتاج فيه الى 2 تكستبوكس وزر

Dim l As Integer, s(4) As String, k1, k2, k3, k4
Public Function sam(k1, k2, k3, k4)
If k1 = 1 Then s(0) = " æÇÍÏ "
If k1 = 2 Then s(0) = " ÇËäíä "
If k1 = 3 Then s(0) = " ËáÇËÉ "
If k1 = 4 Then s(0) = " ÇÑÈÚÉ "
If k1 = 5 Then s(0) = " ÎãÓÉ "
If k1 = 6 Then s(0) = " ÓÊÉ "
If k1 = 7 Then s(0) = " ÓÈÚÉ "
If k1 = 8 Then s(0) = " ËãÇäíÉ "
If k1 = 9 Then s(0) = " ÊÓÚÉ "

'If k2 = 1 Then s(1) = ""
If k2 = 2 Then s(1) = " ÚÔÑæä"
If k2 = 3 Then s(1) = " 臂辊"
If k2 = 4 Then s(1) = " ÇÑÈÚæä"
If k2 = 5 Then s(1) = " ÎãÓæä"
If k2 = 6 Then s(1) = " ÓÊæä"
If k2 = 7 Then s(1) = " ÓÈÚæä"
If k2 = 8 Then s(1) = " ËãÇäæä"
If k2 = 9 Then s(1) = " ÊÓÚæä"

If k3 = 1 Then s(2) = " ãÆÉ"
If k3 = 2 Then s(2) = " ãÆÊÇä"
If k3 = 3 Then s(2) = " ËáÇË ãÆÉ"
If k3 = 4 Then s(2) = " ÇÑÈÚ ãÆÉ"
If k3 = 5 Then s(2) = " ÎãÓ ãÆÉ"
If k3 = 6 Then s(2) = " ÓÊ ãÆÉ"
If k3 = 7 Then s(2) = " ÓÈÚ ãÆÉ"
If k3 = 8 Then s(2) = " ËãÇä ãÆÉ"
If k3 = 9 Then s(2) = " ÊÓÚ ãÆÉ"

If k4 = 1 Then s(3) = " ÇáÝ "
If k4 = 2 Then s(3) = " ÇáÝíä "
If k4 = 3 Then s(3) = " ËáÇËÉ ÇáÇÝ "
If k4 = 4 Then s(3) = " ÇÑÈÚÉ ÇáÇÝ "
If k4 = 5 Then s(3) = " ÎãÓÉ ÇáÇÝ "
If k4 = 6 Then s(3) = " ÓÊÉ ÇáÇÝ "
If k4 = 7 Then s(3) = " ÓÈÚÉ ÇáÇÝ "
If k4 = 8 Then s(3) = " ËãÇäíÉ ÇáÇÝ "
If k4 = 9 Then s(3) = " ÊÓÚÉ ÇáÇÝ "

End Function
Private Sub Command1_Click()
l = Len(Text1.Text)
If IsNumeric(Text1.Text) = False Then
MsgBox "Enter number"
GoTo l1
End If
If l > 4 Then
MsgBox "Enter maximum 4 digits "
GoTo l1
End If
Text2.Text = ""
If l = 4 Then m = sam(Right(Text1.Text, 1), Mid(Text1.Text, 3, 1), Mid(Text1.Text, 2, 1), Left(Text1.Text, 1))
If l = 3 Then
Text1.Text = "0" & Text1.Text
m = sam(Right(Text1.Text, 1), Mid(Text1.Text, 3, 1), Mid(Text1.Text, 2, 1), Left(Text1.Text, 1))
End If
If l = 2 Then
Text1.Text = "00" & Text1.Text
m = sam(Right(Text1.Text, 1), Mid(Text1.Text, 3, 1), Mid(Text1.Text, 2, 1), Left(Text1.Text, 1))
End If
If l = 1 Then
Text1.Text = "000" & Text1.Text
m = sam(Right(Text1.Text, 1), Mid(Text1.Text, 3, 1), Mid(Text1.Text, 2, 1), Left(Text1.Text, 1))
End If
Text2.Text = s(3) & " æ " & s(2) & " æ " & s(0) & " æ " & s(1)
l1: '
End Sub

من قال لا إله إلا الله صادقا دخل الجنة

موقعي للتعارف و تبادل الأخبار http://www.xybond.com

#3

السلام عليكم

حقيقة لا ادري ما حدث

البرنامج المرفق اعلاه كان يعمل في جهازي و لكن بعد ان ارفقته في المنتدى و حاولت استعماله من المنتدى لاحظت ان الجزء المكتوب باللغة العربية قد تحول الى حروف انجليزية عشوائية فبدل ان اكتب الحرف (و) كتب aelig

و لا ادري ان كانت المشكة من نوع الخط ام من الجهاز اعتذر لك ( رنين) :(

من قال لا إله إلا الله صادقا دخل الجنة

موقعي للتعارف و تبادل الأخبار http://www.xybond.com

#4

فعلا الكود لا يعمل لذا امل منكم الرد في اسرع وقت ممكن

ارجو المساعدة كود التفقيط يا شباب عاجل جداً

#5

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

' دالة التفقيط الآلي
' برمجة محمد مهند عبادي 2003
Function words(D As Double, Optional F1 As String = "واحدة", _
Optional F2 As String, Optional F3 As String, Optional D1 As String = "جزء", _
Optional D2 As String, Optional D3 As String) As String
Dim P, P1, P2, P3, P4, w, w1, w2, w3, N, N1 As String
If IsNull(D) Or D = 0 Then
    words = ""
    Exit Function
End If
If F2 = "" Then F2 = F1
If F3 = "" Then F3 = F1
If D2 = "" Then D2 = D1
If D3 = "" Then D3 = D1
P = swords(Int((D - Int(D)) * 100), D1, D2, D3)
N = Format(Str(D), "000000000000")
P1 = swords(Mid(N, 10, 3), F1, F2, F3)
P2 = swords(Mid(N, 7, 3), "ألف", "ألفان", "آلاف")
P3 = swords(Mid(N, 4, 3), "مليون", "مليونان", "ملايين")
P4 = swords(Mid(N, 1, 3), "مليار", "ملياران", "مليارات")

If P4 = "" Or P1 + P2 + P3 = "" Then w3 = "" Else w3 = " و "
If P3 = "" Or P1 + P2 = "" Then w2 = "" Else w2 = " و "
If P2 = "" Or P1 = "" Then w1 = "" Else w1 = " و "
If P1 = "" Then P1 = " " + F1
If P = "" Then w = "" Else w = " و "
words = "فقط " + P4 + w3 + P3 + w2 + P2 + w1 + P1 + w + P + " لاغير"
End Function
Function swords(N, U1, U2, U3 As String) As String
 Dim S(1 To 3), w1, w2, F, A(2, 9) As String
 A(0, 0) = ""
 A(0, 1) = "واحد"
 A(0, 2) = "إثنان"
 A(0, 3) = "ثلاثة"
 A(0, 4) = "أربعة"
 A(0, 5) = "خمسة"
 A(0, 6) = "ستة"
 A(0, 7) = "سبعة"
 A(0, 8) = "ثمانية"
 A(0, 9) = "تسعة"
 A(1, 0) = ""
 A(1, 1) = "عشر"
 A(1, 2) = "عشرون"
 A(1, 3) = "ثلاثون"
 A(1, 4) = "أربعون"
 A(1, 5) = "خمسون"
 A(1, 6) = "ستون"
 A(1, 7) = "سبعون"
 A(1, 8) = "ثمانون"
 A(1, 9) = "تسعون"
 A(2, 0) = ""
 A(2, 1) = "مائة"
 A(2, 2) = "مائتان"
 A(2, 3) = "ثلاثمائة"
 A(2, 4) = "أربعمائة"
 A(2, 5) = "خمسمائة"
 A(2, 6) = "ستمائة"
 A(2, 7) = "سبعمائة"
 A(2, 8) = "ثمانمائة"
 A(2, 9) = "تسعمائة"
 Select Case Val(N)
    Case 1
        swords = U1
        Exit Function
    Case 2
        swords = U2
        Exit Function
    Case 0
        swords = ""
        Exit Function
 End Select
 N = Format(N, "000")
 S(1) = Val(Mid(N, 3, 1))
 S(2) = Val(Mid(N, 2, 1))
 S(3) = Val(Mid(N, 1, 1))
 If S(2) = 0 Or S(1) = 0 Then w2 = "" Else w2 = " و "
 If S(3) = 0 Or Val(Mid(N, 2, 2)) = 0 Then w1 = "" Else w1 = " و "
 If S(2) = 1 Then
    A(0, 1) = "أحد "
    A(0, 2) = "إثنا "
    w2 = " "
 End If
 Select Case Val(Mid(N, 2, 2))
    Case 0
        A(2, 2) = "مائتا "
        F = U1
    Case 3 To 10
        F = U3
    Case 1, 2, Is > 10
        F = U1
 End Select
 swords = A(2, S(3)) + w1 + A(0, S(1)) + w2 + A(1, S(2)) + " " + F
End Function
#6

طيب

تم تعديل هذه المشاركة بواسطة vb666 في 16 أغسطس 2004 في 10:35

#7

أرفق لك ملف اكسل يحوي شيفرة تفقيط

اضغط Alt+F11 لعرض الشيفرة

هو كان للريال لكنني حولته لليرة

الريال مذكر و الليرة مؤنث :-)

Nums.zip

تم تعديل هذه المشاركة بواسطة vb666 في 16 أغسطس 2004 في 10:36

هذا الموضوع مغلق.

مواضيع مشابهة