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