First commit ~0,10
This commit is contained in:
548
BAS/BD.BAS
Normal file
548
BAS/BD.BAS
Normal 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
|
||||
|
||||
|
Reference in New Issue
Block a user