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

549 lines
17 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.

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 "³ Telfono: " + 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 Guilln "
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 Guilln '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 "³ Telfono: ³±"
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