First commit ~0,10

This commit is contained in:
2021-09-03 17:42:07 +02:00
commit 474d98379e
57 changed files with 16968 additions and 0 deletions

548
BAS/BD.BAS Normal file
View File

@ -0,0 +1,548 @@
REM Versi<73>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 "<22>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 "<22>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 <<3C><> para editar ficha "
GOSUB mirp
GOSUB empi
LOCATE 12, 34: PRINT "<22>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 <<3C><> 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 "<22>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<63>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 <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>Ŀ";
LPRINT "<22><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><>";
LPRINT "<22> <20><>";
LPRINT "<22> Nombre: " + nom$ + " Apellidos: " + ape$ + " <20><>";
LPRINT "<22> <20><>";
LPRINT "<22> Calle: " + cal$ + " N<>: " + num$ + " Piso: " + pis$ + " Letra: " + let$ + " <20><>";
LPRINT "<22> <20><>";
LPRINT "<22> Localidad: " + loc$ + " Provincia: " + pro$ + " C.P: " + cod$ + " <20><>";
LPRINT "<22> <20><>";
LPRINT "<22> Tel<65>fono: " + tel$ + " <20><>";
LPRINT "<22> <20><>";
LPRINT "<22> Ordenador, CPU: " + cpu$ + " RAM: " + ram$ + " TG: " + tg$ + " HD: " + hd$ + " <20><>";
LPRINT "<22><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>ٱ";
LPRINT " <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>";
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<6F> David Guill<6C>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 "<22><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD> <20><> Base de Datos <20><> ";
PRINT "<22> Introducir <20> <20> <20> <20><> <20><> v<> 1.0 <20><> ";
PRINT "<22> <20> <20> <20> <20><> <20><> <20><> ";
PRINT "<22> Editar / Modificar <20> <20> <20> <20> <20><> F1 Help <20><> ";
PRINT "<22> <20> <20> <20> <20> <20><> <20><> F2 Imprimir <20><> ";
PRINT "<22> Buscar <20> <20> <20> <20> <20><> ܳ<> F3 Exit to DOS <20><><EFBFBD> ";
PRINT "<22> <20> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD> <20><> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>";
PRINT "<22> Eliminar <20> <20><><EFBFBD><EFBFBD>on<6F>line۰<65>lf۰<66><DBB0><EFBFBD><EFBFBD><EFBFBD><EFBFBD>";
PRINT "<22> <20> Jos<6F> David Guill<6C>n '93 <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>";
PRINT "<22> - Creditos - <20> "
PRINT "<22><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>Ŀ";
PRINT "<22><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><>";
PRINT "<22> <20><>"
PRINT "<22> <20><>"
PRINT "<22> <20><>"
PRINT "<22> <20><>"
PRINT "<22> <20><>"
PRINT "<22> <20><>"
PRINT "<22> <20><>"
PRINT "<22> <20><>"
PRINT "<22> <20><>"
PRINT "<22> <20><>"
PRINT "<22><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>ٱ";
PRINT " <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>";
RETURN
menu2:
LOCATE 11, 1
PRINT "<22><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>Ŀ";
PRINT "<22><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> N<> de Ficha: <20><>";
PRINT "<22> <20><>"
PRINT "<22> Nombre: Apellidos: <20><>"
PRINT "<22> <20><>"
PRINT "<22> Calle: N<>: Piso: Letra: <20><>"
PRINT "<22> <20><>"
PRINT "<22> Localidad: Provincia: C.P: <20><>"
PRINT "<22> <20><>"
PRINT "<22> Tel<65>fono: <20><>"
PRINT "<22> <20><>"
PRINT "<22> Ordenador, CPU: RAM: TG: HD: <20><>"
PRINT "<22><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>ٱ";
PRINT " <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>";
RETURN
cargachar:
lec$(1) = "<22> INTRODUCIR "
lec$(2) = "<22> EDITAR / MODIFICAR "
lec$(3) = "<22> BUSCAR "
lec$(4) = "<22> ELIMINAR "
lec$(5) = "<22> - 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 "<22>"
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 "<22> ": 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 "<22>" 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)) = "<22>" 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<65>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