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