Código de Visual Basic - Multiplicaciones de números grandes

Requerimientos

Visual Basic for DOS, QuickBASIC, QBASIC, QB64

0.1b

Publicado el 5 de Abril del 2018gráfica de visualizaciones de la versión: 0.1b
1.656 visualizaciones desde el 5 de Abril del 2018
estrellaestrellaestrellaestrellaestrella
estrellaestrellaestrellaestrella
estrellaestrellaestrella
estrellaestrella
estrella

Es una versión beta (apenas en esquema básico de diseño) para funciones matemáticas con números de formato largo.
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
' Multiplicaci¢n de n£meros grandes
OPTION EXPLICIT
 
' Funciones
DECLARE FUNCTION ValidaNumero (Numero AS STRING) AS STRING
DECLARE FUNCTION MultiLng (Multiplicando AS STRING, Multiplicador AS STRING) AS STRING
DECLARE FUNCTION RemCeros (Valor AS STRING, Lado AS INTEGER) AS STRING
DECLARE FUNCTION SumaLng (Sumar() AS STRING) AS STRING
 
' Var
DIM N1 AS STRING, N2 AS STRING, P AS STRING
DIM SoN AS STRING
 
CLS
DO
  INPUT "¨Cu l es el multiplicando"; N1
  INPUT "¨Cu l es el multiplicador"; N2
  N1 = ValidaNumero(N1)
  N2 = ValidaNumero(N2)
  IF N1 <> "" AND N2 <> "" THEN
    P = MultiLng(N1, N2)
    PRINT "El producto es: "; P
  ELSE
    PRINT "Teclee s¢lo n£meros. No se admiten comas o caracteres distintos a n£meros."
  END IF
  PRINT
  INPUT "¨Otra vez (S/N)"; SoN
LOOP UNTIL UCASE$(SoN) = "N"
END
 
FUNCTION MultiLng (Multiplicando AS STRING, Multiplicador AS STRING) AS STRING
  ' Var
  DIM M1 AS INTEGER
  DIM M2 AS INTEGER
  DIM R AS INTEGER
  DIM Ll AS INTEGER
  DIM P AS STRING
  DIM C1 AS INTEGER
  DIM C2 AS INTEGER
  DIM i AS INTEGER
  DIM x AS INTEGER
  DIM cc AS INTEGER
  DIM S1 AS INTEGER
  DIM S2 AS INTEGER
  DIM D1 AS INTEGER
  DIM D2 AS INTEGER
  DIM DP AS INTEGER
  DIM N() AS STRING
  DIM C AS STRING
  CONST Punto = "."
  CONST Cero = "0"
  CONST Guion = "-"
 
  ' Iniciaci¢n para respetar la ley de los signos
  S1 = LEFT$(Multiplicando, 1) = Guion
  S2 = LEFT$(Multiplicador, 1) = Guion
  IF S1 THEN Multiplicando = MID$(Multiplicando, 2)
  IF S2 THEN Multiplicador = MID$(Multiplicador, 2)
 
  ' Localizaci¢n del punto decimal
  D1 = INSTR(Multiplicando, Punto)
  D2 = INSTR(Multiplicador, Punto)
 
  ' Valores iniciales
  C1 = LEN(Multiplicando)
  C2 = LEN(Multiplicador)
  cc = 0
 
  ' Si hay punto decimal, lo quita
  IF D1 > 0 THEN
    Multiplicando = LEFT$(Multiplicando, D1 - 1) + MID$(Multiplicando, D1 + 1)
    D1 = C1 - D1
  END IF
  IF D2 > 0 THEN
    Multiplicador = LEFT$(Multiplicador, D2 - 1) + MID$(Multiplicador, D2 + 1)
    D2 = C2 - D2
  END IF
 
  IF D1 > D2 THEN
    Multiplicador = Multiplicador + STRING$(D1 - D2, Cero)
    DP = D1 * 2
  ELSEIF D2 > D1 THEN
    Multiplicando = Multiplicando + STRING$(D2 - D1, Cero)
    DP = D2 * 2
  ELSE
    DP = D1 * 2
  END IF
 
  ' Restablece las longitudes
  C1 = LEN(Multiplicando)
  C2 = LEN(Multiplicador)
  REDIM N(1 TO C2) AS STRING
 
  ' Obtiene los n£meros de la multiplicaci¢n
  FOR i = C2 TO 1 STEP -1  ' Multiplicador
    N(i) = STRING$(cc, Cero)  ' Cu ntos ceros agrega
    M2 = VAL(MID$(Multiplicador, i, 1))
    Ll = 0
    cc = cc + 1
    FOR x = C1 TO 1 STEP -1
      M1 = VAL(MID$(Multiplicando, x, 1))
      R = M1 * M2
      R = R + Ll
      N(i) = LTRIM$(STR$(R MOD 10)) + N(i)
      Ll = FIX(R / 10)
    NEXT x
    IF Ll > 0 THEN
      N(i) = LTRIM$(STR$(Ll)) + N(i)
    END IF
  NEXT i
 
  P = SumaLng(N())
 
  ' Punto decimal
  IF DP > 0 THEN
    C1 = LEN(P)
    IF DP <= C1 THEN
      P = LEFT$(P, C1 - DP) + Punto + RIGHT$(P, DP)
    ELSE
      P = Punto + STRING$(DP - C1, Cero) + RIGHT$(P, DP)
    END IF
    PRINT P
    P = RemCeros(P, 1)
  ELSE
    P = RemCeros(P, 2)
  END IF
 
  ' Ley de los signos
  IF S1 <> S2 THEN
    P = Guion + P
  END IF
 
  MultiLng = P
END FUNCTION
 
FUNCTION RemCeros (Valor AS STRING, Lado AS INTEGER) AS STRING
  ' Var
  DIM C AS STRING * 1
  DIM PD AS INTEGER
  CONST Punto = "."
  CONST Cero = "0"
 
  ' Los ceros a la derecha primero
  IF Lado = 1 OR Lado = 0 THEN ' Derecha o ambos
    PD = (INSTR(Valor, Punto) > 0)
    IF PD THEN
      DO
        C = RIGHT$(Valor, 1)
        IF C = Cero OR C = Punto THEN
          Valor = LEFT$(Valor, LEN(Valor) - 1)
        END IF
      LOOP UNTIL C <> Cero OR C = Punto
      C = ""
    END IF
  END IF
 
  ' Ahora, los ceros a la izquierda
  IF Lado = 2 OR Lado = 0 THEN  ' S¢lo izquierda
    DO
      C = LEFT$(Valor, 1)
      IF C = Cero THEN
        Valor = MID$(Valor, 2)
      END IF
    LOOP UNTIL C <> Cero
  END IF
 
  ' Verifica que lo primero que aparezca no sea un punto
  C = LEFT$(Valor, 1)
  IF C = Punto THEN
    Valor = "0" + Valor
  END IF
 
  RemCeros = Valor
END FUNCTION
 
FUNCTION SumaLng (Sumar() AS STRING) AS STRING
  ' Var
  DIM S AS STRING
  DIM C AS STRING * 1
  DIM i AS INTEGER
  DIM x AS INTEGER
  DIM R AS INTEGER
  DIM Ll AS INTEGER
  DIM Li AS INTEGER
  DIM Ls AS INTEGER
  DIM Lc AS INTEGER
  DIM PD AS INTEGER
  CONST Punto = "."
  CONST Cero = "0"
 
 
  ' Valores iniciales
  Ll = 0
  Li = LBOUND(Sumar)
  Ls = UBOUND(Sumar)
 
  ' Encuentra si hay puntos decimales
  FOR i = Li TO Ls
    x = INSTR(Sumar(i), Punto)
    IF x > 0 THEN
      x = x - LEN(Sumar(i))
      IF x > PD THEN
        PD = x
      END IF
    END IF
  NEXT i
 
  IF PD > 0 THEN ' S¡ hay punto decimal
    FOR i = Li TO Ls
      x = INSTR(Sumar(i), Punto)
      IF x = 0 THEN
        Sumar(i) = Sumar(i) + Punto + STRING$(PD, Cero)
      ELSE
        Sumar(i) = Sumar(i) + STRING$(PD - LEN(Sumar(i)), Cero)
      END IF
    NEXT i
  END IF
 
  ' Ahora, ajusta la longitud de los n£meros obtenidos
  FOR i = Li TO Ls
    IF LEN(Sumar(i)) > Ll THEN
      Ll = LEN(Sumar(i))
    END IF
  NEXT i
 
  FOR i = Li TO Ls
    Sumar(i) = STRING$(Ll - LEN(Sumar(i)), Cero) + Sumar(i)
  NEXT i
 
  ' Ahora, suma los n£meros obtenidos
  Lc = Ll
  Ll = 0
  S = ""
  FOR x = Lc TO 1 STEP -1
    R = 0
    FOR i = Li TO Ls
      C = MID$(Sumar(i), x, 1)
      IF C <> Punto THEN
        R = R + VAL(C)
      END IF
    NEXT i
    IF C = Punto THEN
      S = C + S
    ELSE
      R = R + Ll
      S = LTRIM$(STR$(R MOD 10)) + S
      Ll = FIX(R / 10)
    END IF
  NEXT x
 
  IF Ll > 0 THEN
    S = LTRIM$(STR$(Ll)) + S
  END IF
 
  IF PD THEN
    S = RemCeros(S, 0)
  END IF
 
  SumaLng = S
 
END FUNCTION
 
FUNCTION ValidaNumero (Numero AS STRING) AS STRING
  DIM l AS LONG
  DIM lo AS LONG
  DIM Ok AS INTEGER
  DIM P AS INTEGER
  DIM C AS STRING
  DIM S AS INTEGER
 
  Numero = LTRIM$(RTRIM$(Numero))
  lo = LEN(Numero)
  Ok = -1
 
  FOR l = 1 TO lo
    C = MID$(Numero, l, 1)
    IF ASC(C) < 48 OR ASC(C) > 57 THEN
      IF C <> "." THEN
        IF C <> "-" THEN
          Ok = 0
          EXIT FOR
        ELSE
          IF NOT S THEN  ' ¨Ya se hab¡a contabilizado un gui¢n?
            S = -1
          ELSE
            Ok = 0
            EXIT FOR
          END IF
        END IF
      ELSE
        IF NOT P THEN  ' ¨Ya se hab¡a contabilizado un punto?
          P = -1
        ELSE
          Ok = 0
          EXIT FOR
        END IF
      END IF
    END IF
  NEXT l
 
  ' Si es n£mero, devuelva el n£mero
  ' si no lo es, devuelva una cadena vac¡a
  IF Ok THEN
    ValidaNumero = Numero
  ELSE
    ValidaNumero = ""
  END IF
END FUNCTION



Comentarios sobre la versión: 0.1b (0)


No hay comentarios
 

Comentar la versión: 0.1b

Nombre
Correo (no se visualiza en la web)
Valoración
Comentarios...
CerrarCerrar
CerrarCerrar
Cerrar

Tienes que ser un usuario registrado para poder insertar imágenes, archivos y/o videos.

Puedes registrarte o validarte desde aquí.

Codigo
Negrita
Subrayado
Tachado
Cursiva
Insertar enlace
Imagen externa
Emoticon
Tabular
Centrar
Titulo
Linea
Disminuir
Aumentar
Vista preliminar
sonreir
dientes
lengua
guiño
enfadado
confundido
llorar
avergonzado
sorprendido
triste
sol
estrella
jarra
camara
taza de cafe
email
beso
bombilla
amor
mal
bien
Es necesario revisar y aceptar las políticas de privacidad

http://lwp-l.com/s4530