ahora vengo con otro código una calculadora en Vbscript de numeros grandes
la idea me surgio al ver esta pagina:
http://www.elguille.info/NET/dotnet/operarConNumerosGrandes1.htmpero en algunas operaciones observe que no daba el resultado correcto así que hice la mía mejor
Nota: si ponen muy grandes tardara en hacer la operación
Aquí el code
Option Explicit
Dim num1, num2, n, m, x, op, r,v
num2 = inputbox("Introduce El Primer Numero")'"123654789"
num1 = inputbox("Introduce Segundo Numero")'"147852369"
ReDim n(Len(num1)), m(Len(num2))
For x = 1 To Len(num1)
n(x) = CInt(Mid(num1, x, 1))
Next
For x = 1 To Len(num2)
m(x) = CInt(Mid(num2, x, 1))
Next
op = InputBox("1- Sumar" & vbCrLf & "2- Restar" & vbCrLf & "3- Multiplicar" & vbCrLf & "4- Dividir")
Select Case op
Case "1"
r = sumar(n, m)
Case "2"
r = RestaroDividir(n, m, op)
Case "3"
v = mmi(num1,num2)
if v = "+" then
r = multiplicar(n,m)
elseif v = "-" then
r = multiplicar(m, n)
else
r = multiplicar(n, m)
end if
Case "4"
r = RestaroDividir(n, m, op)
End Select
MsgBox r
r = Replace(r, " ", "")
Function Dividir(n, m)
On Error Resume Next
Dim num1, num2, pf, d, x, s, j, r, mk
num1 = Replace(Join(n), " ", "")
num2 = Replace(Join(m), " ", "")
pf = UBound(m)
d = Mid(num1, 1, pf)
While pf <= UBound(n) 'pf
Select Case mmi(d, num2)
Case "+"
x = "0"
s = "0"
ReDim md(Len(d))
For j = 1 To Len(d)
md(j) = Mid(d, j, 1)
Next
While mmi(s, d) = "-"
x = CStr(CDbl(x) + 1)
ReDim mx(Len(x))
ReDim ms(Len(num2))
For j = 1 To Len(num2)
ms(j) = Mid(num2, j, 1)
Next
For j = 1 To Len(x)
mx(j) = Mid(x, j, 1)
Next
s = Replace(multiplicar(ms, mx), " ", "")
Wend
If mmi(s, d) <> "1" Then
x = CStr(CDbl(x) - 1)
End If
ReDim mx(Len(x))
For j = 1 To Len(x)
mx(j) = Mid(x, j, 1)
Next
mk = Split(multiplicar(mx, m), " ")
d = Replace(RestaroDividir(mk, md, "2"), " ", "")
While Mid(d, 1, 1) = "0"
d = Mid(d, 2, Len(d))
Wend
r = r & x
pf = pf + 1
d = d & n(pf)
Case "-"
r = r & "0"
pf = pf + 1
d = d & n(pf)
Case "1"
r = r & "1"
pf = pf + 1
d = n(pf)
End Select
Wend
While Mid(r, 1, 1) = "0"
r = Mid(r, 2, Len(r))
Wend
Dividir = "Caben:-" & r & "----Sobran:-" & d
End Function
Function mmi(num1, num2)
Dim x, r
While Mid(num1, 1, 1) = "0"
num1 = Mid(num1, 2, Len(num1))
Wend
While Mid(num2, 1, 1) = "0"
num2 = Mid(num2, 2, Len(num2))
Wend
If Len(num1) > Len(num2) Then
r = "+"
ElseIf Len(num1) = Len(num2) Then
For x = 1 To Len(num1)
If CInt(Mid(num1, x, 1)) > CInt(Mid(num2, x, 1)) Then
r = "+"
Exit For
ElseIf CInt(Mid(num1, x, 1)) < CInt(Mid(num2, x, 1)) Then
r = "-"
Exit For
End If
Next
Else
r = "-"
End If
If (x - 1) = Len(num1) Then
mmi = "1"
Else
mmi = r
End If
End Function
'-------------------------------------------------------------------------------------------------------------'
Function RestaroDividir(n, m, op)
Dim lm, ln, r, x
ln = UBound(n)
lm = UBound(m)
If ln > lm Then
r = rd(n, m, op)
ElseIf ln < lm Then
r = rd(m, n, op)
Else
For x = 1 To UBound(n)
If n(x) > m(x) Then
r = rd(n, m, op)
Exit For
ElseIf n(x) < m(x) Then
r = rd(m, n, op)
Exit For
End If
Next
End If
If r = "" Then
If op = "2" Then
RestaroDividir = "0"
Else
RestaroDividir = "1"
End If
Else
RestaroDividir = r
End If
End Function
Function rd(n, m, op)
Dim ln, lm, r
If op = "2" Then
ln = UBound(n)
lm = UBound(m)
r = Restar(ln, lm, n, m)
Else
r = Dividir(n, m)
End If
rd = r
End Function
'-------------------------------------------Funcion Multiplica---------------------------------------------------'
Function multiplicar(n, m)
Dim x, y, r, c, s
ReDim a(UBound(m))
For x = UBound(a) To 1 Step -1
r = Join(n)
s = Split(r, " ")
For y = 2 To CInt(m(x))
r = sumar(n, s)
s = Split(r, " ")
Next
a(x) = r & c
c = c & " 0"
Next
s = Split(a(1), " ")
For x = 2 To UBound(a)
c = Split(a(x), " ")
r = sumar(s, c)
s = Split(r, " ")
Next
multiplicar = r
End Function
'---------------------------------------------Funcion Restar-------------------------------------------------------'
Function Restar(ln, lm, n, m)
Dim x, r, a
For x = ln To 1 Step -1
If lm > 0 Then
If CInt(n(x)) >= CInt(m(lm)) Then
r = CStr(n(x) - m(lm)) & " " & r
Else
r = CStr(n(x) - m(lm) + 10) & " " & r
For a = x - 1 To 1 Step -1
If n(a) = 0 Then
n(a) = 9
Else
n(a) = n(a) - 1
Exit For
End If
Next
End If
Else
r = CStr(n(x)) & " " & r
End If
lm = lm - 1
Next
While Mid(r, 1, 1) = "0"
r = Mid(r, 2, Len(r))
Wend
Restar = Trim(r)
End Function
'-----------------------------------------Funcion Sumar--------------------------------------------------------------------'
Function sumar(n, m)
Dim lm, ln, r
ln = UBound(n)
lm = UBound(m)
If ln >= lm Then
r = s(ln, lm, n, m)
Else
r = s(lm, ln, m, n)
End If
sumar = r
End Function
Function s(ln, lm, n, m)
Dim a, b, x, r
a = 0
For x = ln To 1 Step -1
If lm > 0 Then
a = CInt(n(x)) + CInt(m(lm)) + a
If a > 9 Then
b = CStr(a)
r = Mid(b, 2, 1) & " " & r
a = CInt(Mid(b, 1, 1))
Else
r = CStr(a) & " " & r
a = 0
End If
Else
a = CInt(n(x)) + a
If a > 9 Then
b = CStr(a)
r = Mid(b, 2, 1) & " " & r
a = CInt(Mid(b, 1, 1))
Else
r = CStr(a) & " " & r
a = 0
End If
End If
lm = lm - 1
Next
If a > 0 Then
r = CStr(a) & " " & r
End If
s = " " & Trim(r)
End Function
Saludos Flamer y me dicen si tiene errores para corregirlos
Mostrar Mensajes
