دالة اختصار الكسر الاعتيادى

السلام عليكم...

لا أعرف أن في VB6 مثل تلك الدالة.

اكتب كود الإجراء التالي في Module (أو في القسم العام لـ Form حيث يمكنك جعله Private بدل Public):

Public Sub ReduceFraction(ByVal Number1 As Long, ByVal Number2 As Long, ByRef Result1 As Variant, ByRef Result2 As Variant)
    Dim MaxDivider As Long
    Dim ADivider As Long
    Dim SmallerNumber As Long

    Result1 = Null
    Result2 = Null

    If Number1 = 0 Then
        Result1 = 0
        'Result2 = 0
    ElseIf Number2 = 0 Then
        Err.Raise vbObjectError + 1001, App.EXEName, "القسمة على صفر"
    ElseIf Number2 = Number1 Then
        Result1 = 1
        Result2 = 1
    ElseIf Number2 < Number1 Then
        If (Number1 Mod Number2) = 0 Then
            Result1 = Number1 \ Number2
            Result2 = 1
        Else
            SmallerNumber = Number2
        End If
    Else
        If (Number2 Mod Number1) = 0 Then
            Result1 = 1
            Result2 = Number2 \ Number1
        Else
            SmallerNumber = Number1
        End If
    End If

    If IsNull(Result1) Then
        If (SmallerNumber Mod 2) = 0 Then
            MaxDivider = SmallerNumber \ 2
        Else
            MaxDivider = (SmallerNumber - 1) \ 2
        End If

        Result1 = Number1
        Result2 = Number2
        For ADivider = MaxDivider To 2 Step -1
            If ((Number1 Mod ADivider) = 0) And ((Number2 Mod ADivider) = 0) Then
                Result1 = Number1 \ ADivider
                Result2 = Number2 \ ADivider
                Exit For
            End If
        Next ADivider
    End If
End Sub

* بارامترات الإجراء:

Number1: العدد الأول، و هو بسط الكسر (العدد العلوي أو المقسوم).

Number2: العدد الثاني، و هو مقام الكسر (العدد السفلي أو القاسم).

Result1: بسط الكسر الناتج من عملية الاختصار.

Result2: مقام الكسر الناتج من عملية الاختصار.

== لاحظ أن البارامترين Result1 و Result2 يمرران بالمرجع (ByRef) أي أنه يجب تمرير متغيرين من النوع Variant.

* لاحظ أنه في الإجراء توجد عدة حالات، منها حالتان خاصتان هما:

*** إذا كان البسط صفراً فإن قيمة الكسر ستكون صفراً، و عليه فإن الإجراء يعيد 0 (صفراً) في Result1 و Null في Result2.

*** إذا كان المقام صفراً فإن قيمة الكسر غير معرفة (أو ما لا نهاية) و عليه فإن الإجراء يعمل على إنتاج خطأ "القسمة على صفر".

=== لتجربة الإجراء:

* نضع على الـ Form أربع خانات نص، و لنفرض أن أسماءها هي Text1 (بسط الكسر) و Text2 (مقام الكسر) و Text3 (بسط الكسر المختصر) و Text4 (مقام الكسر المختصر).

* نضع زراً (Command) و نكتب به الكود التالي:

Private Sub Command1_Click()
    Dim Number1 As Long
    Dim Number2 As Long
    Dim Number3 As Variant
    Dim Number4 As Variant

    Number1 = CLng(Text1.Text)
    Number2 = CLng(Text2.Text)

    ReduceFraction Number1, Number2, Number3, Number4

    If IsNull(Number3) Then
        Text3.Text = ""
    Else
        Text3.Text = CStr(Number3)
    End If

    If IsNull(Number4) Then
        Text4.Text = ""
    Else
        Text4.Text = CStr(Number4)
    End If
End Sub

نرجو الاستفادة و السلام.

جزاك الله خيرآ

ولدى أكواد عديدة لهذا الغرض وغيره

ولكنى أسأل عن دالة فى لغة الvb

ولكم ألف شكر

هذا أحد أكوادى لهذا الغرض

حتى لا تظن أنى آخذ المعلومة ثم أدعى معرفتها

Dim A1 As Single, A2 As Single
Dim AA1 As Single, AA2 As Single
Dim Namel As Integer, AMEL(22) As Integer


Private Sub Command1_Click()
    Cls
    A1 = Text1.Text
    A2 = Text2.Text
   AA1 = A1: AA2 = A2
   Namel = 0
   For I = 2 To AA1 / 2 + 1
50  Xdevid = AA1 / I
   If Xdevid <> Int(Xdevid) Then GoTo 60
   Namel = Namel + 1: AMEL(Namel) = I
   If Xdevid = 1 Then GoTo 100 Else AA1 = Xdevid: GoTo 50
60  Next I
100  For I = 1 To Namel
  Xdevid = AA2 / AMEL(I)
   If Xdevid = Int(Xdevid) Then AA2 = Xdevid
  Next I
 AA1 = A1 * AA2 / A2
  Text3.Text = AA1
  Text4.Text = AA2
End Sub