Ejercicios en BASIC

[¤ Nerviozzo ¤]

Ejercicio 10:

Código [Seleccionar] Expandir

CLS
DIM NOM$(10)
DIM EDAD(10)
FOR I=1 TO 10
INPUT "Introduce un nombre y su edad: ",NOMBRE$,EDADES
NOM$(I)=NOMBRE$
EDAD(I)=EDADES
NEXT I
FOR I=1 TO 9
IF EDAD(I)>=18 THEN
IF NOM$(I)>NOM$(I+1) THEN
AUX$=NOM$(I)
NOM$(I)=NOM$(I+1)
NOM$(I+1)=AUX$
AUX=EDAD(I)
EDAD(I)=EDAD(I+1)
EDAD(I+1)=AUX
I=1
END IF
END IF
NEXT I
FOR I=1 TO 10
PRINT NOM$(I) " TIENE " EDAD(I) " AÑOS. "
NEXT I

PAZ

[¤ Nerviozzo ¤]

Ejercicio 11:

Código [Seleccionar] Expandir

CLS
DATA Luis,8,9,Manuel,10,7,Juan,5,4,Rocio,3,4,Carlos,6,9
DIM MATRIZ$(5,3)
FOR I=1 TO 5
READ NOM$,N1$,N2$
MATRIZ$(I,1)=NOM$
MATRIZ$(I,2)=N1$
MATRIZ$(I,3)=N2$
NEXT I
PRINT "1 - Visualizar, ordenado por nombre de alumno la nota media."
PRINT "2 - Visualizar los alumnos aprobados, ordenados por la nota media."
PRINT "3 - Introducir un nombre e informar de las notas del alumno."
PRINT "4 - Salir."
INPUT "Elija una opcion: ",OPC

SELECT CASE OPC

CASE 1
CLS
FOR I=0 TO 4
IF MATRIZ$(I,1)>MATRIZ$(I+1,1) THEN
AUX$=MATRIZ$(I,1)
      MATRIZ$(I,1)=MATRIZ$(I+1,1)
      MATRIZ$(I+1,1)=AUX$
AUX$=MATRIZ$(I,2)
MATRIZ$(I,2)=MATRIZ$(I+1,2)
MATRIZ$(I+1,2)=AUX$
AUX$=MATRIZ$(I,3)
MATRIZ$(I,3)=MATRIZ$(I+1,3)
MATRIZ$(I+1,3)=AUX$
I=0
END IF
NEXT I
FOR I=1 TO 5
MEDIA=VAL(MATRIZ$(I,2))+VAL(MATRIZ$(I,3))
MEDIA=MEDIA/2
PRINT "El alumno " MATRIZ$(I,1) " tiene una media de" MEDIA
NEXT I

CASE 2
CLS
FOR I=1 TO 5
MEDIA=VAL(MATRIZ$(I,2))+VAL(MATRIZ$(I,3))
MEDIA=MEDIA/2
IF MEDIA>=5 THEN PRINT "El alumno " MATRIZ$(I,1) " est  aprobado con un" MEDIA "de media."
NEXT I

CASE 3
CLS
INPUT "Introduce el nombre del alumno: ",ALUM$
FOR I=1 TO 5
IF UCASE$(MATRIZ$(I,1))=UCASE$(ALUM$) THEN
MEDIA=VAL(MATRIZ$(I,2))+VAL(MATRIZ$(I,3))
MEDIA=MEDIA/2
PRINT "El alumno " MATRIZ$(I,1) " ha sacado un " MATRIZ$(I,2) " y un " MATRIZ$(I,3)". Nota media:" MEDIA
      END IF
NEXT I

CASE 4
CLS
PRINT "Hasta pronto"

CASE ELSE
CLS
PRINT "Opcion desconocida"

END SELECT

PAZ

[¤ Nerviozzo ¤]

Ejercicio 12:

Código [Seleccionar] Expandir

CLS
DIM V(10)
RANDOMIZE TIMER
FOR I=1 TO 10
V(I)=INT(RND*100)
NEXT I
FOR I=1 TO 9
IF V(I)>V(I+1) THEN
AUX=V(I)
V(I)=V(I+1)
V(I+1)=AUX
I=0
END IF
NEXT I
FOR I=1 TO 10
PRINT V(I)
NEXT I

PAZ

[¤ Nerviozzo ¤]

Ejercicio 13:

Una manera "fácil" y con fichero secuencial:

Código [Seleccionar] Expandir

cls
print "1 - Crear el archivo de almacen"
print
print "2 - Consultar un art¡culo"
print
input "Elige una opci¢n: ",op
select case op

case 1
open "o",1,"almacen.dat"
do
  do
    cls
    input "Introduce el c¢digo de art¡culo: ",COD$
    input "Introduce el nombre del art¡culo: ",ART$
    input "Introduce la cantidad de art¡culos que hay: ",CAN$
    input "Introduce el coste del art¡culo sin IVA: ",PVP$
    print
    input "¨Es correcto? (S/N) ",op$
    loop until ucase$(op$)="S"
write #1,COD$,ART$,CAN$,PVP$
input "¨Desea introducir otro? (S/N) ",op$
loop until ucase$(op$)="N"
close 1

case 2
cls
sw=0
open "i",1,"almacen.dat"
  do
input "Introduce un codigo de art¡culo: ",codus$
if len(codus$)>7 then print "C¢digo incorrecto (Debe de tener 7 caracteres ¢ menos)."
while not EOF(1)
input #1,COD$,ART$,CAN$,PVP$
if codus$=COD$ then
   pvpi=val(PVP$)/100*16
   print "El c¢digo " COD$ " pertenece al art¡culo " ART$ " que cuesta" pvpi "pesetas (IVA incluido)"
   sw=1
end if
wend
if sw=0 then print "Codigo inexistente"
input "¿Desea buscar otro? (S/N) ",op$
loop until ucase$(op$)="N"
end select

y una manera un poco más "sofisticada" y con fichero relativo xD

Código [Seleccionar] Expandir

SCREEN 9
OPEN "R",1,"ARTICULO.DAT",37
FIELD #1,7 AS COD$,20 AS ART$,4 AS CAN$,6 AS PVP$

DO
CLS
COLOR 15,7
LINE (10,5)-(630,344),8,B
LINE (100,100)-(250,150),8,B
LINE (101,149)-(101,101),15
LINE (101,101)-(249,101),15
LOCATE 10,20:COLOR 4:?"A";:COLOR 15:?"LTAS"
LINE (300,100)-(450,150),8,B
LINE (301,149)-(301,101),15
LINE (301,101)-(449,101),15
LOCATE 10,42:COLOR 4:?"C";:COLOR 15:?"ONSULTAS"
LINE (200,200)-(350,250),8,B
LINE (201,249)-(201,201),15
LINE (201,201)-(349,201),15
LOCATE 17,33:COLOR 4:?"S";:COLOR 15:?"ALIR"
COLOR 1
LOCATE 23,20:?"* PULSA LAS LETRAS EN ROJO PARA ENTRAR *"
DO
  LINE (535,12)-(615,30),8,B
  LINE (536,29)-(614,29),15
  LINE (614,29)-(614,13),15
  WHILE NOT INSTAT
     COLOR 14
     LOCATE 2,69:?TIME$
  WEND
  A$=UCASE$(INPUT$(1))
LOOP UNTIL A$="A" OR A$="C" OR A$="S"
SELECT CASE A$

    CASE "A"
       LOCATE 10,20:COLOR 15:?"A";:COLOR 4:?"LTAS"
       LINE (101,149)-(101,101),8
       LINE (101,101)-(249,101),8
       LINE (101,149)-(249,149),15
       LINE (249,101)-(249,149),15
       DELAY 0.5
       LINE (101,149)-(101,101),15
       LINE (101,101)-(249,101),15
       LINE (101,149)-(249,149),7
       LINE (249,101)-(249,149),7
       LOCATE 10,20:COLOR 4:?"A";:COLOR 15:?"LTAS"
       DO
        DO
         CLS
         COLOR 15,7
         LINE (10,5)-(630,344),8,B
         COLOR 1
         CALL LIBRE
         SW=0
         FOR I=1 TO LOF(1)/37
             GET #1,I
             IF VAL(PVP$)=0 THEN
                CO$=STR$(I)
                SW=1
                EXIT FOR
             END IF
         NEXT I
         IF SW=0 THEN
            CO$=STR$((LOF(1)/37)+1)
         END IF
         COLOR 4
         LOCATE 10,30:?CO$
         COLOR 14
         AR$=FNINTRO$(20,12,27)
         CA$=FNINTRON$(4,14,27)
         PV$=FNINTRON$(6,16,27)
         LOCATE 19,20:?"¨SON CORRECTOS LOS DATOS? (S/N)"
         DO
          COR$=UCASE$(INPUT$(1))
         LOOP UNTIL COR$="S" OR COR$="N"
        LOOP UNTIL COR$="S"
        LSET COD$=CO$
        LSET ART$=AR$
        LSET CAN$=CA$
        LSET PVP$=PV$
        PUT #1,VAL(CO$)
        LOCATE 19,20:?SPACE$(35)
        LOCATE 19,20:?"¨DESEA INTRODUCIR OTRO? (S/N)"
        DO
         OTRO$=UCASE$(INPUT$(1))
        LOOP UNTIL OTRO$="S" OR OTRO$="N"
       LOOP UNTIL OTRO$="N"

    CASE "C"
       LOCATE 10,42:COLOR 15:?"C";:COLOR 4:?"ONSULTAS"
       LINE (301,149)-(301,101),8
       LINE (301,101)-(449,101),8
       LINE (301,149)-(449,149),15
       LINE (449,101)-(449,149),15
       DELAY 0.5
       LINE (301,149)-(301,101),15
       LINE (301,101)-(449,101),15
       LINE (301,149)-(449,149),7
       LINE (449,101)-(449,149),7
       LOCATE 10,42:COLOR 4:?"C";:COLOR 15:?"ONSULTAS"
       DO
        CLS
        CALL LIBRE
        COLOR 14
        LOCATE 10,28:?"    "
        CO$=FNINTRON$(7,10,27)
        IF VAL(CO$)<=LOF(1)/37 THEN
   GET #1,VAL(CO$)
   IF VAL(PVP$)>0 THEN
              COLOR 14
              LOCATE 12,28:?ART$
              LOCATE 14,28:?CAN$
              LOCATE 16,28:?VAL(PVP$)*1.16
           ELSE
              COLOR 4
              LOCATE 18,25:?"REGISTRO DADO DE BAJA"
           END IF             
        ELSE     
           COLOR 4
           LOCATE 18,25:?"SOBREPASA CODIGO"           
        END IF
        COLOR 15
        LOCATE 20,25:?"¨DESEA REALIZAR OTRA CONSULTA?(S/N)"
        DO
         AA$=UCASE$(INPUT$(1))
        LOOP UNTIL AA$="S" OR AA$="N"
       LOOP UNTIL AA$="N"

    CASE "S"
       LOCATE 17,33:COLOR 15:?"S";:COLOR 4:?"ALIR"
       LINE (201,249)-(201,201),8
       LINE (201,201)-(349,201),8
       LINE (201,249)-(349,249),15
       LINE (349,249)-(349,201),15
       DELAY 0.5
       LINE (201,249)-(201,201),15
       LINE (201,201)-(349,201),15
       LINE (201,249)-(349,249),7
       LINE (349,249)-(349,201),7
       LOCATE 17,33:COLOR 4:?"S";:COLOR 15:?"ALIR"
       DELAY 0.5
       CLS

END SELECT
LOOP UNTIL A$="S"
CLOSE
END

DEF FNINTRO$(CANT,FIL,COLU)

CONTADOR=0
COLOR 14
C$=""
B$="ABCDEFGHIJKLMNÑOPQRSTUVWXYZ\.:() "
COLU=COLU+1
A$=""
BANDE=0
WHILE CONTADOR <> CANT AND A$ <> CHR$(13)
WHILE NOT INSTAT
   LOCATE FIL,COLU+1:?"_"
   DELAY 0.2
   LOCATE FIL,COLU+1:?" "
   DELAY 0.2
WEND
A$=UCASE$(INPUT$(1))
IF CHR$(8) = A$ AND BANDE > 0 THEN
    LOCATE FIL,COLU:?" "
    LON=LEN(C$)-1
    IF LON>=0 THEN
       C$=LEFT$(C$,LON)
       AC$=LEFT$(C$,COLU-1)
       COLU=COLU-1
       CONTADOR=CONTADOR-1
    END IF
ELSE
    X=INSTR(B$,A$)
    IF (X>0 AND CHR$(13)<>A$) AND CHR$(27) <> A$ THEN
       COLU=COLU+1
       IF CHR$(8) <> A$ THEN
          BANDE=1
          LOCATE FIL,COLU:?A$;
          C$=C$+A$
          CONTADOR=CONTADOR+1
       END IF
    END IF
END IF
WEND
IF CANT=CONTADOR THEN
    A$=INPUT$(1)
END IF
FNINTRO$=C$
END DEF


DEF FNINTRON$(CANT,FIL,COLU)
CONTADOR=0
COLOR 14
C$=""
B$="0123456789"
COLU=COLU+1
A$=""
BANDE=0
WHILE CONTADOR <> CANT AND A$ <> CHR$(13)
WHILE NOT INSTAT
   LOCATE FIL,COLU+1:?"_"
   DELAY 0.2
   LOCATE FIL,COLU+1:?" "
   DELAY 0.2
WEND
A$=INPUT$(1)
IF CHR$(8) = A$ AND BANDE > 0 THEN
    LOCATE FIL,(COLU):?" "
    LON=LEN(C$)-1
    IF LON>=0 THEN
       C$=LEFT$(C$,LON)
       C$=LEFT$(C$,COLU-1)
       COLU=COLU-1
       CONTADOR=CONTADOR-1
    END IF
ELSE
    X=INSTR(B$,A$)
    IF (X>0 AND CHR$(13)<>A$) AND CHR$(27) <> A$ THEN
       COLU=COLU+1
       IF CHR$(8) <> A$ THEN
          BANDE=1
          LOCATE FIL,COLU:?A$
          C$=C$+A$
          CONTADOR=CONTADOR+1
       END IF
    END IF
END IF
IF CANT=CONTADOR THEN
    A$=INPUT$(1)
END IF
WEND
FNINTRON$=C$
END DEF

SUB LIBRE:
    LINE (210,122)-(315,143),8,B
    COLOR 1
    LOCATE 10,10:?"CODIGO .....   ";
    LINE (211,123)-(314,123),15
    LINE (314,123)-(314,142),15
    COLOR 1
    LOCATE 12,10:?"ARTICULO ...  ";
    LINE (210,150)-(390,171),8,B
    LINE (211,151)-(389,151),15
    LINE (389,151)-(389,170),15
    LOCATE 14,10:?"CANTIDAD ...";
    LINE (210,178)-(315,199),8,B
    LINE (211,179)-(314,179),15
    LINE (314,179)-(314,198),15
    LOCATE 16,10:?"PRECIO .....";
    LINE (210,206)-(315,227),8,B
    LINE (211,207)-(314,207),15
    LINE (314,207)-(314,226),15
END SUB

PAZ