Visual Basic - Multiplication limitless Version #2

Life is soft - evento anual de software empresarial
   
Vista:

Multiplication limitless Version #2

Publicado por LRCVS (4 intervenciones) el 08/01/2010 22:46:12
THE PROGRAM IS RIGHT NOW. OK!!!

Program:

Multiplication limitless Version #2

LRCVS 01.01.2010

Spain

'..................................

CLS
FORM1.PRINT "WAIT"
T1 = TIMER
'NUMBER OF DIGITS OF MULTIPLY AND MULTIPLIER WITHOUT LIMIT.
NA = 1000
NB = 100

'......................................................
'HERE DELETE FILES
OPEN "X" + ".MLT" FOR BINARY AS #1
CLOSE (1)
KILL "*.MLT"

'......................................................
'DO MULTIPLY >>> A AND DO MULTIPLIER >>> B
FOR N = 1 TO 2
IF N = 1 THEN F$ = "A" + ".MLT": NN = NA
IF N = 2 THEN F$ = "B" + ".MLT": NN = NB
OPEN F$ FOR BINARY AS #1
FOR N2 = 1 TO NN
RANDOMIZE TIMER
X$ = LTRIM$(STR$(INT(RND * 10)))
SEEK #1, N2: PUT #1, N2, X$
NEXT N2
SEEK #1, N2
CLOSE (1)
NEXT N

'.....................................................
'HERE DO THE PARTIAL MULTIPLICATIONS
FOR K = 0 TO 9
XX$ = "": NUM$ = "": Z$ = "": ACU = 0: GG = NA
C$ = LTRIM$(STR$(K))
OPEN C$ + ".MLT" FOR BINARY AS #2
OPEN "A" + ".MLT" FOR BINARY AS #1
FOR N = 1 TO NA
SEEK #1, GG: GET #1, GG, X$
NUM$ = X$
Z$ = LTRIM$(STR$(ACU + (VAL(X$) * VAL(C$))))
L = LEN(Z$)
ACU = 0
IF L = 1 THEN NUM$ = Z$: PUT #2, N, NUM$
IF L > 1 THEN ACU = VAL(LEFT$(Z$, LEN(Z$) - 1)): NUM$ = RIGHT$(Z$, 1): PUT #2, N, NUM$
SEEK #2, N: PUT #2, N, NUM$
XX$ = XX$ + NUM$
GG = GG - 1
NEXT N
IF L > 1 THEN ACU = VAL(LEFT$(Z$, LEN(Z$) - 1)): NUM$ = LTRIM$(STR$(ACU)): XX$ = XX$ + NUM$: PUT #2, N, NUM$
CLOSE (1)
CLOSE (2)
NEXT K

'......................................................
'HERE WE CREATE THE PARTIAL SOLUTION >>> D
ACU = 0
LT5 = 1
LT6 = LT5
'AQUI BUSCAMOS LOS ELEMENTOS DE B
OPEN "B" + ".MLT" FOR BINARY AS #1
OPEN "D" + ".MLT" FOR BINARY AS #3
FOR JB = NB TO 1 STEP -1
SEEK #1, JB
GET #1, JB, X$

OPEN X$ + ".MLT" FOR BINARY AS #2: LF = LOF(2): CLOSE (2)

OPEN X$ + ".MLT" FOR BINARY AS #2
FOR KB = 1 TO LF
SEEK #2, KB
GET #2, , NUM$
SEEK #3, LT5
GET #3, LT5, PR$
T$ = ""
T$ = LTRIM$(STR$(ACU + VAL(NUM$) + VAL(PR$)))
PR$ = RIGHT$(T$, 1)
ACU = 0
IF LEN(T$) > 1 THEN ACU = LEFT$(T$, LEN(T$) - 1)
SEEK #3, LT5: PUT #3, LT5, PR$
LT5 = LT5 + 1
NEXT KB
IF ACU <> 0 THEN PR$ = LTRIM$(STR$(ACU)): PUT #3, LT5, PR$
CLOSE (2)
LT6 = LT6 + 1
LT5 = LT6
ACU = 0
NEXT JB
CLOSE (3)
CLOSE (1)

OPEN "D" + ".MLT" FOR BINARY AS #3: LD = LOF(3): CLOSE (3)
ER = 1
OPEN "D" + ".MLT" FOR BINARY AS #3
OPEN "R" + ".MLT" FOR BINARY AS #4
FOR N = LD TO 1 STEP -1
SEEK #3, N: GET #3, N, PR$
SEEK #4, ER: PUT #4, ER, PR$
ER = ER + 1
NEXT N
CLOSE (4)
CLOSE (3)

'HERE ELIMINATE PARTIAL PRODUCTS
KILL "D.MLT"
FOR N = 0 TO 9
C$ = LTRIM$(STR$(N))
KILL C$ + ".MLT"
NEXT N
T2 = TIMER
FORM1.PRINT "END"
FORM1.PRINT
FORM1.PRINT T2 - T1; "SEG"
FORM1.PRINT "SOLUTION IN THE FILE: R.MLT "
Valora esta pregunta
Me gusta: Está pregunta es útil y esta claraNo me gusta: Está pregunta no esta clara o no es útil
0
Responder