bas/BAS/CATALOG2.BAS
2021-09-03 17:42:07 +02:00

913 lines
25 KiB
QBasic
Raw Blame History

This file contains ambiguous Unicode characters

This file contains Unicode characters that might be confused with other characters. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

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 Guilln 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 Guilln "
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 Guilln '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