DECLARE SUB modificar () DECLARE SUB eliminar () DECLARE SUB vaciar () DECLARE SUB listado () DECLARE SUB lista () DECLARE SUB lista1 () DECLARE SUB lista2 () DECLARE SUB lista3 () DECLARE SUB lista4 () DECLARE SUB registrar () DECLARE SUB buscar () DECLARE SUB imprimir () DECLARE SUB cuadro () DECLARE FUNCTION numregistros! () DECLARE FUNCTION menu! () TYPE Video codigo AS STRING * 5 nombre AS STRING * 20 categoria AS STRING * 10 estudio AS STRING * 10 runtime AS STRING * 9 precio AS STRING * 7 END TYPE DIM SHARED A$, numreg DIM SHARED mivid AS Video CLOSE A$ = "videos.txt" CLS numreg = numregistros sw = 1 DO WHILE (sw = 1) ELECCION = menu SELECT CASE ELECCION CASE 1 BEEP registrar 'llamada al sub que registra un producto CASE 2 BEEP eliminar 'llamada al sub que elimina un videoo CASE 3 BEEP modificar 'llamada al sub que modifica un registro CASE 4 BEEP lista 'llamada al sub que lista los videos CASE 5 BEEP vaciar 'llamada al menu que vacia el archivo de productos CASE 6 BEEP buscar CASE 7 imprimir 'llamada al sub imprimir CASE 8 CLS SCREEN 12 LOCATE 12, 25 COLOR 4 PRINT "VIDEOTECA BERLITZ AGRADECE SU PREFERENCIA" CANCION$ = "L4CEG" PLAY CANCION$ sw = 0 END END SELECT LOOP END SUB buscar CLS CLOSE OPEN a$ FOR RANDOM AS #1 LEN =LEN (mivid) Aqui: CLS PRINT: INPUT "Ingrese el numero de registro que desea buscar: ", x REG = 6 DO WHILE x <= numreg GET #1, x, mivid CALL cuadro LOCATE REG, 3: PRINT mivid.codigo; " "; mivid.nombre; " "; mivid.categoria; " "; mivid.estudio; " "; mivid.runtime; " "; mivid.precio LOCATE (REG+2), 3: INPUT "Si desea seguir buscando presione B, sino, cualquier tecla para continuar: ", opcion$ IF UCASE$(opcion$) = "B" THEN GOTO Aqui ELSE GOTO SEguir END IF LOOP Seguir: CLOSE #1 END SUB SUB cuadro CLS SCREEN 12 COLOR 3 hor$ = STRING$(77, 205) hor1$ = STRING$(79, 205) esqsupiz$ = CHR$(201) esqsupder$ = CHR$(187) esqinfiz$ = CHR$(200) esqinfder$ = CHR$(188) REM dibujo de las lineas horizontales LOCATE 1, 1 PRINT esqsupiz$; hor$; esqsupder$ LOCATE 28, 1: PRINT esqinfiz$; hor$; esqinfder$ LOCATE 3, 1: PRINT hor1$ REM dibujo de las lineas verticales REG = 2 DO WHILE REG <= 27 LOCATE REG, 1: PRINT CHR$(186) LOCATE REG, 79: PRINT CHR$(186) REG = REG + 1 LOOP LOCATE 10, 1: PRINT CHR$(186) LOCATE 10, 79: PRINT CHR$(186) LOCATE 2, 33: PRINT "LISTA DE VIDEOS" LOCATE 4, 3 PRINT "Codigo Titulo Categoria Estudio Duracion Precio" END SUB SUB eliminar DIM Eliminado AS Video CLS lista1 PRINT REG = numreg + 6 LOCATE REG, 3: LINE INPUT "Ingrese el codigo del video que desea eliminar: "; Eliminado.codigo CLS CLOSE OPEN A$ FOR RANDOM AS #1 LEN = LEN(mivid) OPEN "novale.txt" FOR RANDOM AS #2 LEN = LEN(mivid) x = 1 y = 1 FOR x = 1 TO numreg GET #1, x, mivid IF mivid.codigo <> Eliminado.codigo THEN PUT #2, y, mivid y = y + 1 END IF NEXT CLOSE #1 CLOSE #2 KILL A$ NAME "novale.txt" AS A$ numreg = y - 1 END SUB SUB lista CLS CLOSE LOCATE 10, 32: PRINT "Opciones de lista" LOCATE 11, 32: PRINT "-----------------" LOCATE 13, 10: PRINT "1.-Lista por orden de registro" LOCATE 15, 10: PRINT "2.-Lista por titulo" LOCATE 17, 10: PRINT "3.-Lista por categoria" LOCATE 19, 10: PRINT "4.- Lista por estudio" LOCATE 21, 32: INPUT "Elija la opcion: ", N SELECT CASE (N) CASE 1 lista1 REG = numreg + 7 PRINT LOCATE REG, 3: INPUT "Presione Enter para seguir", cualquiercosa$ CASE 2 lista2 REG = numreg + 7 PRINT LOCATE REG, 3: LINE INPUT "Presione Enter para seguir", cualquiercosa$ CASE 3 lista3 REG = numreg + 7 PRINT LOCATE REG, 3: LINE INPUT "Presione Enter para seguir", cualquiercosa$ CASE 4 lista4 REG = numreg + 7 PRINT LOCATE REG, 3: LINE INPUT "Presione Enter para seguir", cualquiercosa$ END SELECT END SUB SUB lista1 CLS CLOSE CALL cuadro SCREEN 12 COLOR 11 OPEN A$ FOR RANDOM AS #1 LEN = LEN(mivid) x = 1 REG = 6 DO WHILE NOT EOF(1) GET #1, x, mivid LOCATE REG, 3: PRINT mivid.codigo; " "; mivid.nombre; " "; mivid.categoria; " "; mivid.estudio; " "; mivid.runtime;" "; mivid.precio x = x + 1 REG = REG + 1 LOOP CLOSE #1 END SUB SUB lista2 CLS CLOSE N = numreg OPEN A$ FOR RANDOM AS #1 LEN = LEN(mivid) x = 1 DIM codigo$(N), nombre$(N), categoria$(N), estudio$(N), runtime$(N), year$(N), precio$(N) DO WHILE x <= N GET #1, x, mivid codigo$(x) = mivid.codigo nombre$(x) = mivid.nombre categoria$(x) = mivid.categoria estudio$(x) = mivid.estudio runtime$(x) = mivid.runtime precio$(x) = mivid.precio x = x + 1 LOOP FOR i = 1 TO N - 1 FOR j = 1 TO N - 1 IF nombre$(j) > nombre$(j + 1) THEN SWAP nombre$(j), nombre$(j + 1) SWAP codigo$(j), codigo$(j + 1) SWAP categoria$(j), categoria$(j + 1) SWAP estudio$(j), estudio$(j + 1) SWAP runtime$(j), runtime$(j + 1) SWAP precio$(j), precio$(j + 1) END IF NEXT NEXT CALL cuadro SCREEN 12 COLOR 11 REG = 6 FOR j = 1 TO N LOCATE REG, 3: PRINT codigo$(j); " "; nombre$(j); " ";categoria$(j); " ";estudio$(j); " "; runtime$(j); " "precio$(j) REG = REG + 1 NEXT CLOSE #1 END SUB SUB lista3 CLS CLOSE N = numreg OPEN A$ FOR RANDOM AS #1 LEN = LEN(mivid) x = 1 DIM codigo$(N), nombre$(N), categoria$(N), estudio$(N), runtime$(N), precio$(N) DO WHILE x <= N GET #1, x, mivid codigo$(x) = mivid.codigo nombre$(x) = mivid.nombre categoria$(x) = mivid.categoria estudio$(x) = mivid.estudio runtime$(x) = mivid.runtime precio$(x) = mivid.precio x = x + 1 LOOP FOR i = 1 TO N - 1 FOR j = 1 TO N - 1 IF categoria$(j) > categoria$(j + 1) THEN SWAP categoria$(j), categoria$(j + 1) SWAP codigo$(j), codigo$(j + 1) SWAP nombre$(j), nombre$(j + 1) SWAP estudio$(j), estudio$(j + 1) SWAP runtime$(j), runtime$(j + 1) SWAP precio$(j), precio$(j + 1) END IF NEXT NEXT CALL cuadro SCREEN 12 COLOR 11 REG = 6 FOR j = 1 TO N LOCATE REG, 3: PRINT codigo$(j); " "; nombre$(j); " "; categoria$(j); " "; estudio$(j); " "; runtime$(j); " "; precio$(j) REG = REG + 1 NEXT CLOSE #1 END SUB SUB lista4 CLS CLOSE N = numreg OPEN A$ FOR RANDOM AS #1 LEN = LEN(mivid) x = 1 DIM codigo$(N), nombre$(N), categoria$(N), estudio$(N), runtime$(N), precio$(N) DO WHILE x <= N GET #1, x, mivid codigo$(x) = mivid.codigo nombre$(x) = mivid.nombre categoria$(x) = mivid.categoria estudio$(x) = mivid.estudio runtime$(x) = mivid.runtime precio$(x) = mivid.precio x = x + 1 LOOP FOR i = 1 TO N - 1 FOR j = 1 TO N - 1 IF estudio$(j) > estudio$(j + 1) THEN SWAP estudio$(j), estudio$(j + 1) SWAP codigo$(j), codigo$(j + 1) SWAP nombre$(j), nombre$(j + 1) SWAP categoria$(j), categoria$(j + 1) SWAP runtime$(j), runtime$(j + 1) SWAP precio$(j), precio$(j + 1) END IF NEXT NEXT CALL cuadro SCREEN 12 COLOR 11 REG = 6 FOR j = 1 TO N LOCATE REG, 3: PRINT codigo$(j); " "; nombre$(j); " "; categoria$(j); " "; estudio$(j); " "; runtime$(j); " "; precio$(j) REG = REG + 1 NEXT CLOSE #1 END SUB FUNCTION menu CLS SCREEN 12 LINE (150, 4)-(500, 400), 12, B PAINT (200, 5), 4, 12 LINE (150, 70)-(500, 70), 12 f$ = DATE$ h$ = TIME$ LOCATE 2, 20: PRINT f$ LOCATE 3, 20: PRINT h$ LOCATE 3, 51: PRINT "Num reg:"; numreg LOCATE 4, 33: PRINT "Videoteca BERLITZ" LOCATE 6, 33: PRINT "Menu de Opciones" LOCATE 8, 25: PRINT "1.- Registrar un video" LOCATE 10, 25: PRINT "2.- Eliminar un video" LOCATE 12, 25: PRINT "3.- Modificar un video" LOCATE 14, 25: PRINT "4.- Ver lista de videos" LOCATE 16, 25: PRINT "5.- Eliminar archivo" LOCATE 18, 25: PRINT "6.- Buscar registro" LOCATE 20, 25: PRINT "7.- Imprimir lista" LOCATE 22, 25: PRINT "8.- Salir" LOCATE 24, 25: LINE INPUT "Ingrese su opcion: "; opc$ menu = VAL(opc$) END FUNCTION SUB modificar CLS CLOSE Modificando: CALL lista1 REG = numreg + 7 LOCATE REG, 3: INPUT "Ingrese el numero de registro que desea modificar: ", a OPEN A$ FOR RANDOM AS #1 LEN = LEN(mivid) DO WHILE a <= numreg GET #1, a, mivid LOCATE (REG+2), 3: PRINT "Ingrese los datos del nuevo registro" LOCATE (REG+3), 3: INPUT "Codigo: ", mivid.codigo LOCATE (REG+4), 3: INPUT "Titulo: ", mivid.nombre LOCATE (REG+5), 3: INPUT "Categoria: ", mivid.categoria LOCATE (REG+6), 3: INPUT "Estudio donde se grabo: ", mivid.estudio LOCATE (REG+7), 3: INPUT "Duracion en minutos: ", mivid.runtime LOCATE (REG+8), 3: INPUT "Precio: ", mivid.precio mivid.nombre = UCASE$(mivid.nombre) mivid.categoria = UCASE$(mivid.categoria) mivid.estudio = UCASE$(mivid.estudio) PUT #1, a, mivid CLOSE #1 LOCATE (REG+11), 3: INPUT "Si desea continuar modificando digite M, sino, cualquiera tecla: ", modi$ IF UCASE$(modi$) <> "M" THEN GOTO Continuar ELSE CLS GOTO Modificando END IF numreg = numreg - 1 LOOP Continuar: END SUB FUNCTION numregistros OPEN A$ FOR RANDOM AS #1 LEN = LEN(mivid) x = 0 DO WHILE NOT EOF(1) x = x + 1 GET #1, x, mivid LOOP numregistros = x - 1 END FUNCTION SUB registrar swreg = 1 CLOSE OPEN A$ FOR RANDOM AS #1 LEN = LEN(mivid) DO WHILE (swreg = 1) CLS PRINT "Ingrese los datos de un nuevo video" PRINT "--------------------------------------" PRINT INPUT "Codigo: ", mivid.codigo INPUT "Titulo: ", mivid.nombre INPUT "Categoria: ", mivid.categoria INPUT "Estudio donde se grabo: ", mivid.estudio INPUT "Duracion en minutos: ", mivid.runtime INPUT "Precio: ", mivid.precio numreg = numreg + 1 mivid.nombre = UCASE$(mivid.nombre) mivid.categoria = UCASE$(mivid.categoria) mivid.estudio = UCASE$(mivid.estudio) PUT #1, numreg, mivid INPUT "Desea continuar ingresando [(S/N)]", desea$ IF UCASE$(desea$) <> "S" THEN swreg = 0 END IF LOOP CLOSE #1 END SUB SUB vaciar CLOSE CLS opcion$ = "Desea dejar en blanco el archivo " + A$ PRINT opcion$; " [S/N] "; LINE INPUT desea$ IF UCASE$(desea$) = "S" THEN KILL A$ OPEN A$ FOR RANDOM AS #1 LEN = LEN(mivid) CLOSE numreg = numregistros END IF END SUB SUB imprimir CLOSE 'cierra todo archivo previo OPEN "imprimir.txt" FOR OUTPUT AS #1 LEN = LEN(Mivid) format$ = " " PRINT "Codigo Titulo Categoria Estudio Duracion Precio" PRINT "-----------------------------------------------------------------" x = 1 FOR x = 1 to numreg GET #1, x, Mivid PRINT #1, " "; mivid.codigo; " "; mivid.nombre; " "; mivid.categoria; " "; mivid.estudio; " "; mivid.runtime;" "; mivid.precio x = x + 1 NEXT CLOSE #1 END SUB