send
Grupo de Telegram
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
  • 1758 Vistas

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

Conectado Flamer

  • *
  • Underc0der
  • Mensajes: 17
  • 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: You are not allowed to view links. You are not allowed to view links. Register or Login or You are not allowed to view links. Register or Login

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 »

You are not allowed to view links. You are not allowed to view links. Register or Login or You are not allowed to view links. Register or Login


 

¿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: 1309
Último mensaje Diciembre 25, 2016, 12:17:55 am
por Flamer