anun1

Super Calculadora







Proyecto: Super Calculadora

Autor: Flamer

Lenguaje: VBscript

Referencias: http://www.elguille.info/NET/dotnet/operarConNumerosGrandes1.htm

Descripción: Super calculadora en VBscript pronto la traeré en la versión  .Net,la idea me surgió al ver la pagina del guille,pero al calar la calculadora me di cuenta que en algunas operaciones el resultado que arrojaba era erróneo así que hice mejor la mía

Aquí el código:


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 si tiene errores me avisan para repararlos

No hay comentarios.:

Publicar un comentario