Foro de elhacker.net

cls
input "Introduce un nombre: ",nom$
for car=LEN(nom$) to 0 step -1
print LEFT$(nom$,car)
next car

cls
input "Introduce un nombre: ",nom$
car=LEN(nom$)
while car>0
print LEFT$(nom$,car)
car=car-1
wend

cls
input "Introduce 3 n£meros: ",A,B,C
if A > B and A > C then print A "es el mayor"
if A < B and A < C then print A "es el menor"
if B > A and B > C then print B "es el mayor"
if B < A and B < C then print B "es el menor"
if C > A and C > B then print C "es el mayor"
if C < A and C < B then print C "es el menor"

cls
input "Introduce los tres lados del triangulo: ",A,B,C
if A = B and A = C then print "El triangulo es equilatero"
if A <> B and A <> C and B <> C then print "El triangulo es escaleno"
if A = B and A <> C or A = C and A <> B or B = A and B <> C or C = A and C <> B or C = B and C <> A then
print "El triangulo es isosceles"
end if

cls
input "Introduce 4 n£meros: ",A,B,C,D
Suma = A + C
Produ = B * D
print "La suma del primero y el tercero es" Suma
print "El producto del segundo y el cuarto es" Produ

cls
for I=199 to 0 step -2
print I
suma = suma + i
next i
print "La suma es" suma

CLS
INPUT "Ingrese una palabra: ", pal$
FOR I = 1 TO LEN(pal$)
IF MID$(pal$, I, 1) = "a" OR MID$(pal$, I, 1) = "A" OR MID$(pal$, I, 1) = "e" OR MID$(pal$, I, 1) = "E" OR MID$(pal$, I, 1) = "i" OR MID$(pal$, I, 1) = "I" OR MID$(pal$, I, 1) = "o" OR MID$(pal$, I, 1) = "O" OR MID$(pal$, I, 1) = "u" OR MID$(pal$, I, 1) = "U" THEN
cont = cont + 1
palcom$=palcom$+MID$(pal$, I, 1)
END IF
NEXT I
print palcom$
PRINT "el total de vocales en esta palabra es :", cont

cls
input "Introduce un numero: ",A
for B=1 to 10
P=B*A
print A "*" B "=" P
next B

CLS
DATA JUAN,PEPE,LUIS,JOSE,JUAN,LUIS,ISMAEL,JUAN,RUBEN,CARLOS
INPUT "Introduce un nombre: ", NOM$
FOR I=1 TO 10
READ N$
IF UCASE$(NOM$) = N$ THEN
CONT=CONT+1
END IF
NEXT I
PRINT NOM$ " aparece" CONT "veces en la instruccion DATA."

cls
randomize timer
for A=1 to 6
C=INT(RND*49-1+1)+1
B$=B$+STR$(C)
next A
print B$

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

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

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

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

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