Subtraction limitless - Printable Version +- Qbasicnews.com (http://qbasicnews.com/newforum) +-- Forum: QBasic (http://qbasicnews.com/newforum/forum-4.html) +--- Forum: QB Projects (http://qbasicnews.com/newforum/forum-12.html) +--- Thread: Subtraction limitless (/thread-10131.html) |
Subtraction limitless - lrcvs - 06-11-2008 DECLARE SUB a.inicio (lta$, ltb$) DECLARE SUB b.almacen (cad$, n$) DECLARE SUB c.pizarra () DECLARE SUB d.encabezados (lta$, ltb$) DECLARE SUB e.resta () DECLARE FUNCTION f.invcad$ (cad$) 'READ THIS FIRST 'This program only makes a subtraction limitless. 'This result is in a called file " R". 'In order to see it, to use a text visualizer. 'If solution < 75 digit. then display in the screen 'if solution > 75 digit. then use a text visualizer. CALL a.inicio(lta$, ltb$) CALL b.almacen(lta$, "a") CALL b.almacen(ltb$, "b") CALL c.pizarra CALL d.encabezados(lta$, ltb$) CALL e.resta SUB a.inicio (lta$, ltb$) 'En este procedimiento, creamos la resta >> In this procedure, make the subtraction 'Variables: 'mi = num, numero de elementos del minuendo >> Number of elements of minuend 'su = num, numero de elementos del sustraendo >> Number of elements of subtrahend 'a$,b$ = tex, cadena temporal >> chain temp 'lta$ = text, minuendo >> minuend 'ltb$ = text, sustraendo >> subtrahend DO 1 : CLS 'Number of elements of minuend INPUT "Numero de elementos del minuendo "; mi IF mi = 0 THEN GOTO 1 'Number of elements of subtrahend INPUT "Numero de elementos del sustraendo "; su IF su = 0 THEN GOTO 1 IF mi < su THEN BEEP: GOTO 1 LOOP UNTIL mi >= su CLS DO 'Aqui iniciamos las variables >> Init the variables a$ = "" b$ = "" lta$ = "" ltb$ = "" 'Aqui creamos el minuendo >> Create the minuend FOR n = 1 TO mi RANDOMIZE TIMER a$ = a$ + LTRIM$(STR$(INT(RND * 9))) NEXT n 'Aqui creamos el sustraendo >> Create the subtrahend FOR n = 1 TO su RANDOMIZE TIMER b$ = b$ + LTRIM$(STR$(INT(RND * 9))) NEXT n LOOP UNTIL VAL(a$) > VAL(b$) 'Aqui calculamos las longitudes >> Calculate the lengths la = LEN(a$) lb = LEN(b$) 'Aqui creamos la cadena patron >> Create the chain pattern lta$ = STRING$(la, " ") ltb$ = lta$ 'Aqui insertamos los valores en las cadenas patron >> Insert values in chains pattern MID$(lta$, (la + 1) - la) = a$ MID$(ltb$, (la + 1) - lb) = b$ a$ = "" b$ = "" END SUB SUB b.almacen (cad$, n$) 'aqui guardamos los datos en un fichero >> Here save the data in a file OPEN "o", #1, n$ FOR m = LEN(cad$) TO 1 STEP -1 WRITE #1, MID$(cad$, m, 1) NEXT m CLOSE (1) END SUB SUB c.pizarra 'Iniciamos la pizarra >> Init the blackboard OPEN "a", #3, "r" WRITE #3, "" CLOSE (3) KILL "r" END SUB SUB d.encabezados (lta$, ltb$) 'Aqui escribimos los datos en el fichero final >> Write data in the end file 'Escribimos el minuendo y el sustraendo >> Write the minuend and subtrahend OPEN "a", #3, "r" WRITE #3, lta$ WRITE #3, ltb$ CLOSE (3) END SUB SUB e.resta 'Aqui hacemos la resta >> Make the subtraction 'Variables 'acum = num, acumulador de decimales >> accumulator decimals 'l = num, acumulador para saber la longitud del minuendo >> accumulator to know the length of minuend 'ca,cb = num, acumuladores de posicion de fichero >> accumulators position file 'a,b = num, valores parciales de a$ y b$ >> values partials of a$ and b$ 'r$ = tex, acumulador de resultado >> accumulator result CLS acum = 0 l = 0 R$ = "" 'Aqui calculamos la longitud del minuendo >> Calculate the length of minuend 'para saber cuantas restas tenemos que hacer >> to know how many subtractions we must do OPEN "i", #1, "a" DO INPUT #1, a$ l = l + 1 LOOP WHILE EOF(1) <> -1 CLOSE (1) ca = 0 cb = 0 FOR n = 1 TO l LOCATE 1, 1: PRINT "Position = "; n OPEN "i", #1, "a" DO INPUT #1, a$ ca = ca + 1 a = VAL(a$) LOOP UNTIL ca = n CLOSE (1) ca = 0 OPEN "i", #2, "b" DO INPUT #2, b$ cb = cb + 1 b = VAL(b$) LOOP UNTIL cb = n CLOSE (2) cb = 0 b = b + acu acu = 0 IF a > b THEN R$ = R$ + LTRIM$(STR$(a - b)) IF a = b THEN R$ = R$ + "0" IF a < b THEN a = a + 10: acu = VAL(LEFT$(LTRIM$(STR$(a)), 1)): R$ = R$ + (LTRIM$(STR$(a - b))) NEXT n OPEN "a", #3, "r" WRITE #3, f.invcad$(R$) CLOSE (3) BEEP CLS IF LEN(R$) > 75 THEN GOTO 30 IF LEN(R$) < 75 THEN GOTO 5 5 : CLS ink = 0 OPEN "i", #3, "r" 10 : IF EOF(3) THEN GOTO 20 INPUT #3, R$ ink = ink + 1 IF ink = 1 THEN COLOR 7: PRINT R$ IF ink = 2 THEN COLOR 7: PRINT R$ IF ink = 3 THEN COLOR 10: PRINT R$ GOTO 10 20 : CLOSE (3) COLOR 7 GOTO 40 30 : PRINT "End, view the file R " 40 : END SUB FUNCTION f.invcad$ (cad$) 'aqui invertimos una cadena de texto >> here we invest a string 'variables 'lcad : num, longitud cadena entrante >> length chain incoming 'cadtem$ : tex, acumulador cadena temporal >> accumulator temporary chain lcad = LEN(cad$) cadtem$ = "" FOR cad = lcad TO 1 STEP -1 cadtem$ = cadtem$ + MID$(cad$, cad, 1) NEXT cad f.invcad$ = cadtem$ cadtemp$ = "" END FUNCTION Re: Subtraction limitless - LPG - 06-11-2008 I don't know much about libraries. In the run menu of QB4.5 there is a button saying make library. I think it makes a library so you can load it into another program and use all of its subs. that would be useful as you could put these programs into subs and build a library. Please post if I have the wrong idea about librarys. Re: Subtraction limitless - LPG - 06-11-2008 Also. why do you use write for files and print for the screen when print works for files aswell. Re: Subtraction limitless - lrcvs - 06-11-2008 Hi, LPG: I regret to tell you not to make libraries in QB 4.5. For the programming is like a game, I enjoy doing simple programs. This program is easily adaptable to any application, do what you want, use it as best as possible. Greetings from Spain. Re: Subtraction limitless - lrcvs - 06-12-2008 Hi, LPG Using "Write" in files and "Print" on the screen, simply by inertia of dat files. My basic level is low for what your make here. I need to learn more about Basic. Greetings from Spain |