أريد النتائج فى صورة بسط ومقام

طبعآ هذا الكود الذى ذكرته لكم مجرد مثال بسيط ضربته لكم

ولكن الأكواد كثيرة وقد توجد داخل أى كود متغيرات أخرى وأوامر وعمليات حسابية أخرى كثيرة تصل بنا فى النهاية الى أن y تساوى مثلآ 4/9

أريد أن يطبعها هكذا 4/9 ولا يطبعها 0.444444444

وقد تصل بنا الأوامر والعمليات الحسابية الأخرى داخل أى كود آخر فى النهاية الى أن y تساوى مثلآ 17/3

أريد أن يطبعها هكذا 17/3 ولا يطبعها 5.66666666

وقد تصل بنا الأوامر والعمليات الحسابية الأخرى داخل أى كود آخر فى النهاية الى أن y تساوى مثلآ 150/7

أريد أن يطبعها هكذا 150/7 ولا يطبعها 21.42857143

وهكذا

ولكم ألف شكر

حمل البرنامج من المرفق

وانشاء اللله يعجبك

مرر له مثلا 0.444444 الناتج 4/9

او مثلا 4.66666 الناتج 14/3

او اي عدد

Decimal_to205873462007.zip

بارك الله فيك

ولك ألف شكر

ولكن ألا توجد dim معين أو function أوأى أمر فى لغة الbasic نفسها تقوم بهذه العملية

كتابة أى متغير كسرى فى صورة كسراعتيادى(بسط ومقام)

ولكم ألف شكر

اسلام الكبابى كتب:

ولكن ألا توجد dim معين أو function أوأى أمر فى لغة الbasic نفسها تقوم بهذه العملية

كتابة أى متغير كسرى فى صورة كسراعتيادى(بسط ومقام)

ولكم ألف شكر

لايوجد يااخي

واذا انت استصعبت البرنامج وتبغاه على شكل دالة بحيث تمرر لها الكسر وتعيد لك الكسر الاعتيادي

Public Function GetR(x As Double) As String
'Sub para converter decimal em fraccionario
Dim pnum As Long
Dim pden As Long
Dim pp As Double
Dim erro As Double
Dim parasomar As Double
Dim d(250)
Dim aaa As String
Dim inteiro As String
Dim parteint As Double
envio = x
'Calcular quociente para conferir no final
sinal = -1
If envio < 0 Then
pp = sinal * Val(envio)
Else
pp = Val(envio)
End If


'Definir valor maximo a atingir no numerador (recomendavel 9999)
n = 9999
eureka$ = ""
inteiro = Str(pp)
If pp < 1 Then
   parteint = 0
   GoTo toni1
End If
For I = 1 To Len(inteiro)
If Asc(Mid(inteiro, I, I + 1)) = 46 Then
   I = I + 1
   GoTo toni2
End If
Next I
toni2:
parteint = Val(Left(inteiro, I - 1))
toni1:
pp = Val(inteiro) - parteint

If pp = 0 Then
    If Val(envio) > 0 Then
        eureka$ = Str(parteint)
    ElseIf Val(envio) < 0 Then
        eureka$ = "-" + Str(parteint)
    ElseIf Val(envio) = 0 Then
        eureka$ = Str(envio)
    End If
Exit Function

End If



'Ultrapassar o problema das dízimas infinitas (0.0129999..)
xx = Str(pp)

If Len(xx) - 2 >= 3 Then
    aaa = Mid(xx, Len(xx), 1)
    bbb = Mid(xx, Len(xx) - 1, 1)
    ccc = Mid(xx, Len(xx) - 2, 1)

       If aaa = bbb And bbb = ccc And Val(aaa) >= 5 Then
            parasomar = 10 ^ (-Len(xx) + 2)
            pp = pp + parasomar

        End If
End If


'Definir erro inicial=parte decimal

erro = pp
'Parte inteira do decimal como numerador inicial para calculo
pnum = Int(pp)

'Fixar denominador inicial unitario
pden = 1

'Ciclo ate numerador atingir o valor maximo definido (precisao)

While pnum <= n
        If Abs((pnum / pden) - pp) < erro Then
            erro = Abs((pnum / pden) - pp)
            numfinal = pnum
            denfinal = pden
            If Abs(erro) < 0.0000001 Then GoTo reduzir
        End If
    pden = pden + 1
    pnum = CInt(pden * pp)
Wend

reduzir:

'Reduzir a fraccao obtida (numfinal/denfinal)

m = 0
    If numfinal = 0 Then
        eureka$ = Str(envio)
        Exit Function
    End If
pp = numfinal
limite = Int(Sqr(pp))
For kapa = 1 To limite
    If pp Mod kapa = 0 Then
        m = m + 1
        d(m) = kapa
    End If
Next kapa
If Int(pp / d(m)) = d(m) Then
    n = 2 * m - 1
    For kapa = 1 To m - 1
        d(m + kapa) = Int(pp / d(m - kapa))
    Next kapa
Else
    n = 2 * m
    For kapa = 1 To m
        d(m + kapa) = Int(pp / d(m - kapa + 1))
    Next kapa
End If

'Calcular maximo divisor comum
For x = 1 To n
    res = denfinal Mod d(x)
    If res = 0 Then
        mdc = d(x)
    End If
Next x

numfinal = parteint * (denfinal / mdc) + (numfinal / mdc)

'Reenviar resultado
If envio > 0 Then
eureka$ = Str$(numfinal / mdc) + "/" + Str$(denfinal / mdc)
Else
eureka$ = "-" + Str$(numfinal / mdc) + "/" + Str$(denfinal / mdc)
End If

'Impedir denominador unitário
aaa = Str$(denfinal / mdc)
If Val(aaa) = 1 Then
    eureka$ = Left$(eureka$, Len(eureka$) - 3)
End If
GetR = eureka$


End Function

والاستدعاء بيكون كالتالي

Dim n as String
n= GetR(0.444444)

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

أنا عامل أكثر من برنامج لهذا الغرض

ولكنى أسأل عن دالة فى لغة الbasic نفسها تقوم بهذه العملية

مثل دالة الRound مثلآ التى تقوم بعملية التقريب مباشرة دون أن نكتب له أى كود

ولكم ألف شك

لا يوجد

اسلام الكبابى كتب:

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

أنا عامل أكثر من برنامج لهذا الغرض

ولكنى أسأل عن دالة فى لغة الbasic نفسها تقوم بهذه العملية

مثل دالة الRound مثلآ التى تقوم بعملية التقريب مباشرة دون أن نكتب له أى كود

ولكم ألف شك

اخي اسلام لو قرأت اخر رد لي كان مكتوب فيه

اقتباس

لايوجد يااخي