comment
IRC Chat
play_arrow
Este sitio utiliza cookies propias y de terceros. Si continúa navegando consideramos que acepta el uso de cookies. OK Más Información.

[Aporte] Super Calculadora

  • 0 Respuestas
  • 1967 Vistas

0 Usuarios y 1 Visitante están viendo este tema.

Desconectado Flamer

  • *
  • Underc0der
  • Mensajes: 23
  • Actividad:
    0%
  • Reputación 1
    • Ver Perfil
    • http://elblogdeflamer.blogspot.mx/
« en: Diciembre 31, 2016, 04:45:48 pm »
Ahora vengo con otro código una calculadora en Vbscript de numeros grandes
la idea me surgio al ver esta pagina: No tienes permisos para ver links. Registrate o Entra con tu cuenta

Pero 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

Código
Código: Visual Basic
  1. Option Explicit
  2.  
  3. Dim num1, num2, n, m, x, op, r,v
  4.  
  5. num2 = inputbox("Introduce El Primer Numero")'"123654789"
  6. num1 = inputbox("Introduce Segundo Numero")'"147852369"
  7.  
  8. ReDim n(Len(num1)), m(Len(num2))
  9.  
  10. For x = 1 To Len(num1)
  11.    n(x) = CInt(Mid(num1, x, 1))
  12. Next
  13.  
  14. For x = 1 To Len(num2)
  15.    m(x) = CInt(Mid(num2, x, 1))
  16. Next
  17.  
  18. op = InputBox("1- Sumar" & vbCrLf & "2- Restar" & vbCrLf & "3- Multiplicar" & vbCrLf & "4- Dividir")
  19.  
  20. Select Case op
  21.    Case "1"
  22.       r = sumar(n, m)
  23.    Case "2"
  24.       r = RestaroDividir(n, m, op)
  25.    Case "3"
  26.       v = mmi(num1,num2)
  27.       if v = "+" then
  28.              r = multiplicar(n,m)
  29.           elseif v = "-" then
  30.          r = multiplicar(m, n)
  31.       else
  32.              r = multiplicar(n, m)
  33.           end if      
  34.    Case "4"
  35.       r = RestaroDividir(n, m, op)
  36. End Select
  37. MsgBox r
  38. r = Replace(r, " ", "")
  39.  
  40. Function Dividir(n, m)
  41. On Error Resume Next
  42.    Dim num1, num2, pf, d, x, s, j, r, mk
  43.  
  44.    num1 = Replace(Join(n), " ", "")
  45.    num2 = Replace(Join(m), " ", "")
  46.  
  47.    pf = UBound(m)
  48.  
  49.    d = Mid(num1, 1, pf)
  50.  
  51.    While pf <= UBound(n)  'pf
  52.  
  53.       Select Case mmi(d, num2)
  54.          Case "+"
  55.             x = "0"
  56.             s = "0"
  57.             ReDim md(Len(d))
  58.             For j = 1 To Len(d)
  59.                md(j) = Mid(d, j, 1)
  60.             Next
  61.             While mmi(s, d) = "-"
  62.                x = CStr(CDbl(x) + 1)
  63.  
  64.                ReDim mx(Len(x))
  65.                ReDim ms(Len(num2))
  66.  
  67.                For j = 1 To Len(num2)
  68.                   ms(j) = Mid(num2, j, 1)
  69.                Next
  70.  
  71.                For j = 1 To Len(x)
  72.                   mx(j) = Mid(x, j, 1)
  73.                Next
  74.                s = Replace(multiplicar(ms, mx), " ", "")
  75.             Wend
  76.             If mmi(s, d) <> "1" Then
  77.                 x = CStr(CDbl(x) - 1)
  78.             End If
  79.  
  80.                ReDim mx(Len(x))
  81.  
  82.                For j = 1 To Len(x)
  83.                   mx(j) = Mid(x, j, 1)
  84.                Next
  85.  
  86.                mk = Split(multiplicar(mx, m), " ")
  87.  
  88.                d = Replace(RestaroDividir(mk, md, "2"), " ", "")
  89.                While Mid(d, 1, 1) = "0"
  90.                   d = Mid(d, 2, Len(d))
  91.                Wend
  92.  
  93.                r = r & x
  94.  
  95.               pf = pf + 1
  96.               d = d & n(pf)
  97.  
  98.          Case "-"
  99.             r = r & "0"
  100.             pf = pf + 1
  101.             d = d & n(pf)
  102.          Case "1"
  103.             r = r & "1"
  104.             pf = pf + 1
  105.             d = n(pf)
  106.       End Select
  107.    Wend
  108.    While Mid(r, 1, 1) = "0"
  109.       r = Mid(r, 2, Len(r))
  110.    Wend
  111.    Dividir = "Caben:-" & r & "----Sobran:-" & d
  112. End Function
  113.  
  114. Function mmi(num1, num2)
  115.    Dim x, r
  116.  
  117.    While Mid(num1, 1, 1) = "0"
  118.       num1 = Mid(num1, 2, Len(num1))
  119.    Wend
  120.    While Mid(num2, 1, 1) = "0"
  121.       num2 = Mid(num2, 2, Len(num2))
  122.    Wend
  123.  
  124.    If Len(num1) > Len(num2) Then
  125.       r = "+"
  126.    ElseIf Len(num1) = Len(num2) Then
  127.       For x = 1 To Len(num1)
  128.          If CInt(Mid(num1, x, 1)) > CInt(Mid(num2, x, 1)) Then
  129.             r = "+"
  130.             Exit For
  131.          ElseIf CInt(Mid(num1, x, 1)) < CInt(Mid(num2, x, 1)) Then
  132.             r = "-"
  133.             Exit For
  134.          End If
  135.       Next
  136.    Else
  137.       r = "-"
  138.    End If
  139.  
  140.    If (x - 1) = Len(num1) Then
  141.       mmi = "1"
  142.    Else
  143.       mmi = r
  144.    End If
  145. End Function
  146. '-------------------------------------------------------------------------------------------------------------'
  147. Function RestaroDividir(n, m, op)
  148.    Dim lm, ln, r, x
  149.  
  150.    ln = UBound(n)
  151.    lm = UBound(m)
  152.  
  153.    If ln > lm Then
  154.       r = rd(n, m, op)
  155.    ElseIf ln < lm Then
  156.       r = rd(m, n, op)
  157.    Else
  158.       For x = 1 To UBound(n)
  159.          If n(x) > m(x) Then
  160.              r = rd(n, m, op)
  161.              Exit For
  162.          ElseIf n(x) < m(x) Then
  163.              r = rd(m, n, op)
  164.              Exit For
  165.          End If
  166.       Next
  167.    End If
  168.  
  169.    If r = "" Then
  170.       If op = "2" Then
  171.          RestaroDividir = "0"
  172.       Else
  173.          RestaroDividir = "1"
  174.       End If
  175.    Else
  176.       RestaroDividir = r
  177.    End If
  178. End Function
  179.  
  180. Function rd(n, m, op)
  181.    Dim ln, lm, r
  182.  
  183.    If op = "2" Then
  184.       ln = UBound(n)
  185.       lm = UBound(m)
  186.       r = Restar(ln, lm, n, m)
  187.    Else
  188.       r = Dividir(n, m)
  189.    End If
  190.    rd = r
  191. End Function
  192. '-------------------------------------------Funcion Multiplica---------------------------------------------------'
  193. Function multiplicar(n, m)
  194.    Dim x, y, r, c, s
  195.  
  196.    ReDim a(UBound(m))
  197.  
  198.    For x = UBound(a) To 1 Step -1
  199.       r = Join(n)
  200.       s = Split(r, " ")
  201.       For y = 2 To CInt(m(x))
  202.          r = sumar(n, s)
  203.          s = Split(r, " ")
  204.       Next
  205.       a(x) = r & c
  206.       c = c & " 0"
  207.    Next
  208.  
  209.    s = Split(a(1), " ")
  210.  
  211.    For x = 2 To UBound(a)
  212.       c = Split(a(x), " ")
  213.       r = sumar(s, c)
  214.       s = Split(r, " ")
  215.    Next
  216.    multiplicar = r
  217. End Function
  218. '---------------------------------------------Funcion Restar-------------------------------------------------------'
  219. Function Restar(ln, lm, n, m)
  220.    Dim x, r, a
  221.  
  222.    For x = ln To 1 Step -1
  223.       If lm > 0 Then
  224.          If CInt(n(x)) >= CInt(m(lm)) Then
  225.             r = CStr(n(x) - m(lm)) & " " & r
  226.          Else
  227.             r = CStr(n(x) - m(lm) + 10) & " " & r
  228.             For a = x - 1 To 1 Step -1
  229.                If n(a) = 0 Then
  230.                   n(a) = 9
  231.                Else
  232.                   n(a) = n(a) - 1
  233.                   Exit For
  234.                End If
  235.             Next
  236.          End If
  237.       Else
  238.          r = CStr(n(x)) & " " & r
  239.       End If
  240.       lm = lm - 1
  241.    Next
  242.    While Mid(r, 1, 1) = "0"
  243.          r = Mid(r, 2, Len(r))
  244.    Wend
  245.    Restar = Trim(r)
  246. End Function
  247. '-----------------------------------------Funcion Sumar--------------------------------------------------------------------'
  248. Function sumar(n, m)
  249.    Dim lm, ln, r
  250.  
  251.    ln = UBound(n)
  252.    lm = UBound(m)
  253.  
  254.    If ln >= lm Then
  255.       r = s(ln, lm, n, m)
  256.    Else
  257.       r = s(lm, ln, m, n)
  258.    End If
  259.    sumar = r
  260. End Function
  261.  
  262. Function s(ln, lm, n, m)
  263.    Dim a, b, x, r
  264.    a = 0
  265.    For x = ln To 1 Step -1
  266.       If lm > 0 Then
  267.          a = CInt(n(x)) + CInt(m(lm)) + a
  268.          If a > 9 Then
  269.             b = CStr(a)
  270.             r = Mid(b, 2, 1) & " " & r
  271.             a = CInt(Mid(b, 1, 1))
  272.          Else
  273.             r = CStr(a) & " " & r
  274.             a = 0
  275.          End If
  276.       Else
  277.          a = CInt(n(x)) + a
  278.          If a > 9 Then
  279.             b = CStr(a)
  280.             r = Mid(b, 2, 1) & " " & r
  281.             a = CInt(Mid(b, 1, 1))
  282.          Else
  283.             r = CStr(a) & " " & r
  284.             a = 0
  285.          End If
  286.       End If
  287.       lm = lm - 1
  288.    Next
  289.    If a > 0 Then
  290.       r = CStr(a) & " " & r
  291.    End If
  292.    s = " " & Trim(r)
  293. End Function

 


Saludos Flamer y me dicen si tiene errores para corregirlos
« Última modificación: Enero 02, 2017, 09:18:25 pm por Stiuvert »
Mi Canal De Youtube


No tienes permisos para ver links. Registrate o Entra con tu cuenta


 

¿Te gustó el post? COMPARTILO!



[Aporte] Obtener Nombre De Usuario y Contraseña De Facebook Con Un Simple script

Iniciado por Flamer

Respuestas: 0
Vistas: 1468
Último mensaje Diciembre 25, 2016, 12:17:55 am
por Flamer