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

الشاطر اللي يطلع الخلل...كود صغيرووووووون

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

سلام شباب...رجعت ام الاسئله....عندي برنامج صغيرن وبسيط...

الزبده مالته انه اذا دخلنا رقم بالارقام...يطبع لنا رقم بالحروف...

يعني اذا كان هذا اللي دخلناه 52...يطلع لنا جدي..fifty two...

المشكله ان في بعض الارقام تطلع غلط...مثل 55...46....وبعدين ما عرفت اواصل للمئات...كله يطلع لي اخطاء...

بس اذا في احد يتلطف ويساعدني ويشوف وين الخلل اللي في البرنامج ويكمل لي الجزء الناقص...

مشكووووووووووووورن شباب مقدما...واللي يسوي لي البرنامج الله يعطيه العافيه يجازيه خير...

شيطووووووووووووونه...

هذا هو الكود...

Dim units(10) As String

Dim teens(10) As String

Dim tens(10) As String

Dim fullword As String

Dim x, y, z As Integer

Private Sub Command1_Click()

Text1.Text = ""

Label2.Caption = ""

End Sub

Private Sub Command2_Click()

x = Val(Text1)

If x < 10 Then

y = x

fullword = units(x)

Else

If x > 10 And x < 20 Then

y = x - 10

fullword = teens(y)

Else

If x Mod 10 = 0 Then

y = x / 10

fullword = tens(y)

Else

y = x / 10

z = x Mod 10

If x > 20 And x < 40 Then

fullword = tens(y) & " " & units(z)

Else

fullword = tens(y - 1) & " " & units(z)

End If

End If

End If

End If

Label2.Caption = fullword

End Sub

Private Sub Command3_Click()

End

End Sub

Private Sub Form_Load()

units(0) = ""

units(1) = "One"

units(2) = "Two"

units(3) = "Three"

units(4) = "Four"

units(5) = "Five"

units(6) = "Six"

units(7) = "Seven"

units(8) = "Eight"

units(9) = "Nine"

tens(0) = ""

tens(1) = "Ten"

tens(2) = "Twenty"

tens(3) = "Thirty"

tens(4) = "Fourty"

tens(5) = "Fifty"

tens(6) = "Sixty"

tens(7) = "Seventy"

tens(8) = "Eighty"

tens(9) = "Ninty"

teens(0) = ""

teens(1) = "Eleven"

teens(2) = "Twelve"

teens(3) = "Thirteen"

teens(4) = "Fourteen"

teens(5) = "Fifteen"

teens(6) = "Sixteen"

teens(7) = "Seventeen"

teens(8) = "Eighteen"

teens(9) = "Ninteen"

End Sub

#2

ليس هذا هو الخطأ الذي تقصدين لكنه خطأ ينبغي تصحيحه ، لم أجرب الكود حتى الآن

	Dim x, y, z As Integer

والصحيح

Dim x As Integer, y As Integer, z As Integer
#3

هلا اخوي...مشكور وما قصرت...على الاقل عطيتني وجه غير عن 20 شخص اللي دخلو...

بس يا اخوي انا جربت اللي قلته لي بس هم ما اشتغل...

مشكور اخوي مره ثانيه والله يطول بعمرك...(f)

شيطونه

:(

#4

هذا هو التصحيح (في الجزء الخطأ فقط)

'if number MOD 10 = 1 ; as in 21,22,23....

'rounding is happening here...

'to avoid rounding use FIX function

y = Fix(x / 10)

z = x Mod 10

If x > 20 And x < 40 Then

fullword = tens(y) & " " & units(z)

Else

'change 'y - 1' to 'y' only

fullword = tens(y) & " " & units(z)

End If

End If

#5
'************ Code Start **********
'This code was originally written by Joe Foster.
'It is not to be altered or distributed,
'except as part of an application.
'You are free to use it in any application,
'provided the copyright notice is left unchanged.
'
'Code Courtesy of
'Joe Foster
'
' Convert a currency value into an (American) English string
Function English (ByVal N As Currency) As String
    Const Thousand = 1000@
    Const Million = Thousand * Thousand
    Const Billion = Thousand * Million
    Const Trillion = Thousand * Billion

    If (N = 0@) Then English = "zero": Exit Function

    Dim Buf As String: If (N < 0@) Then Buf = "negative " Else Buf = ""
    Dim Frac As Currency: Frac = Abs(N - Fix(N))
    If (N < 0@ Or Frac <> 0@) Then N = Abs(Fix(N))
    Dim AtLeastOne As Integer: AtLeastOne = N >= 1

    If (N >= Trillion) Then
        Debug.Print N
        Buf = Buf & EnglishDigitGroup(Int(N / Trillion)) & " trillion"
        N = N - Int(N / Trillion) * Trillion ' Mod overflows
        If (N >= 1@) Then Buf = Buf & " "
    End If

    If (N >= Billion) Then
        Debug.Print N
        Buf = Buf & EnglishDigitGroup(Int(N / Billion)) & " billion"
        N = N - Int(N / Billion) * Billion ' Mod still overflows
        If (N >= 1@) Then Buf = Buf & " "
    End If

    If (N >= Million) Then
        Debug.Print N
        Buf = Buf & EnglishDigitGroup(N  Million) & " million"
        N = N Mod Million
        If (N >= 1@) Then Buf = Buf & " "
    End If

    If (N >= Thousand) Then
        Debug.Print N
        Buf = Buf & EnglishDigitGroup(N  Thousand) & " thousand"
        N = N Mod Thousand
        If (N >= 1@) Then Buf = Buf & " "
    End If

    If (N >= 1@) Then
        Debug.Print N
        Buf = Buf & EnglishDigitGroup(N)
    End If

    If (Frac = 0@) Then
        Buf = Buf & " exactly"
    ElseIf (Int(Frac * 100@) = Frac * 100@) Then
        If AtLeastOne Then Buf = Buf & " and "
        Buf = Buf & Format$(Frac * 100@, "00") & "/100"
    Else
        If AtLeastOne Then Buf = Buf & " and "
        Buf = Buf & Format$(Frac * 10000@, "0000") & "/10000"
    End If

    English = Buf
End Function

' Support function to be used only by English()
Private Function EnglishDigitGroup (ByVal N As Integer) As String
    Const Hundred = " hundred"
    Const One = "one"
    Const Two = "two"
    Const Three = "three"
    Const Four = "four"
    Const Five = "five"
    Const Six = "six"
    Const Seven = "seven"
    Const Eight = "eight"
    Const Nine = "nine"
    Dim Buf As String: Buf = ""
    Dim Flag As Integer: Flag = False

    'Do hundreds
    Select Case (N  100)
    Case 0: Buf = "":  Flag = False
    Case 1: Buf = One & Hundred: Flag = True
    Case 2: Buf = Two & Hundred: Flag = True
    Case 3: Buf = Three & Hundred: Flag = True
    Case 4: Buf = Four & Hundred: Flag = True
    Case 5: Buf = Five & Hundred: Flag = True
    Case 6: Buf = Six & Hundred: Flag = True
    Case 7: Buf = Seven & Hundred: Flag = True
    Case 8: Buf = Eight & Hundred: Flag = True
    Case 9: Buf = Nine & Hundred: Flag = True
    End Select

    If (Flag <> False) Then N = N Mod 100
    If (N > 0) Then
        If (Flag <> False) Then Buf = Buf & " "
    Else
        EnglishDigitGroup = Buf
        Exit Function
    End If

    'Do tens (except teens)
    Select Case (N  10)
    Case 0, 1: Flag = False
    Case 2: Buf = Buf & "twenty": Flag = True
    Case 3: Buf = Buf & "thirty": Flag = True
    Case 4: Buf = Buf & "forty": Flag = True
    Case 5: Buf = Buf & "fifty": Flag = True
    Case 6: Buf = Buf & "sixty": Flag = True
    Case 7: Buf = Buf & "seventy": Flag = True
    Case 8: Buf = Buf & "eighty": Flag = True
    Case 9: Buf = Buf & "ninety": Flag = True
    End Select

    If (Flag <> False) Then N = N Mod 10
    If (N > 0) Then
        If (Flag <> False) Then Buf = Buf & "-"
    Else
        EnglishDigitGroup = Buf
        Exit Function
    End If

    'Do ones and teens
    Select Case (N)
    Case 0: ' do nothing
    Case 1: Buf = Buf & One
    Case 2: Buf = Buf & Two
    Case 3: Buf = Buf & Three
    Case 4: Buf = Buf & Four
    Case 5: Buf = Buf & Five
    Case 6: Buf = Buf & Six
    Case 7: Buf = Buf & Seven
    Case 8: Buf = Buf & Eight
    Case 9: Buf = Buf & Nine
    Case 10: Buf = Buf & "ten"
    Case 11: Buf = Buf & "eleven"
    Case 12: Buf = Buf & "twelve"
    Case 13: Buf = Buf & "thirteen"
    Case 14: Buf = Buf & "fourteen"
    Case 15: Buf = Buf & "fifteen"
    Case 16: Buf = Buf & "sixteen"
    Case 17: Buf = Buf & "seventeen"
    Case 18: Buf = Buf & "eighteen"
    Case 19: Buf = Buf & "nineteen"
    End Select

    EnglishDigitGroup = Buf
End Function
'************ Code End **********
#6

هذا ملف به 12 دالة تفقيط

للحصول علي الكود بعد فتح ملف الاكسيل

ALT+F11

http://www.arabteam2000.com/vb/showthread....=&threadid=9776

#7

الخطأ واضح وضوح الشمس ...

الخطأ أنك قمت بمحاولة برمجة الكود بنفسك ، لأن دالة التفقيط متوفرة بالانجليزي وبالعربي مجاناً !!!

اذا كان هناك مشكلة في إيجادها docesam@yahoo.com

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

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

عدد الزوار حالياً

المتواجدون خلال آخر دقيقتين · يتحدّث كل ٣٠ ثانية

—الإجمالي—أعضاء مسجّلون—زوار بدون تسجيل

جارٍ التحقق من المتواجدين…