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

211 lines
5.6 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.

'Generador de un reloj digital en pantalla'
DEFINT A-Z
DIM SHARED P(6), A, veces
DIM OldX1(130), OldY1(130), OldX2(130), OldY2(130), OldX3(130), OldY3(130), OldX4(130), OldY4(130), OldX5(130), OldY5(130), OldTipo(100), OldX6(100), OldY6(100), Pt(16)
RANDOMIZE TIMER
X(1) = 400: Y(1) = 175
X(2) = 400: Y(2) = 175
X(3) = 400: Y(3) = 175
X(4) = 400: Y(4) = 175
X(5) = 400: Y(5) = 175
X(6) = 400: Y(5) = 175
Pt(1) = 1
Pt(2) = 1
Pt(3) = 1
Pt(4) = 1
Pt(5) = 1
Pt(6) = 1
mir$ = "Lineas ( Jos David Guilln 15/04/94 )"
IF MID$(mir$, 13, 1) <> "" THEN PRINT " Programa modificado 1": GOTO errormo
IF MID$(mir$, 26, 1) <> "" THEN PRINT " Programa modificado 2": GOTO errormo
P(1) = 0
P(2) = 80
P(3) = 200
P(4) = 280
P(5) = 400
P(6) = 440
P(1) = 0
P(2) = 75
P(3) = 195
P(4) = 275
P(5) = 395
P(6) = 435
SCREEN 9
'***************************************************
'* GRAFICO LINEAL **********************************
'***************************************************
Coor = 1
DO
salida = 0
'IF Pt(4) = 1 THEN M(4) = INT(RND * 8) + 1
IF Pt(3) = 1 THEN M(3) = INT(RND * 8) + 1
IF Pt(2) = 1 THEN M(2) = INT(RND * 8) + 1
IF Pt(5) = 1 THEN M(5) = INT(RND * 8) + 1
IF Pt(6) = 1 THEN M(5) = INT(RND * 8) + 1
IF Pt(1) = 1 THEN M(1) = INT(RND * 8) + 1
Pt(1) = 0
Pt(2) = 0
Pt(3) = 0
Pt(4) = 0
Pt(5) = 0
Pt(6) = 0
qwert = qwert + 1
IF qwert = 7 THEN qwert = 1
IF Cont = 1 THEN M(6) = INT(RND * 7) + 1: M(6) = M(qwert)
DO
Vez = Vez + 1
Vz = Vz + 1
IF Vz >= 30 THEN Vz = 1
IF Vez >= 30 THEN Vez = 1
FOR Coor = 1 TO 6
SELECT CASE M(Coor)
CASE 1: IF Coor <> 6 THEN X(Coor) = X(Coor) - 1: Y(Coor) = Y(Coor) - 1 ELSE X(Coor) = X(Coor) - 1: Y(Coor) = Y(Coor) - 1
CASE 2: IF Coor <> 6 THEN Y(Coor) = Y(Coor) - 1 ELSE Y(Coor) = Y(Coor) - 1
CASE 3: IF Coor <> 6 THEN X(Coor) = X(Coor) + 1: Y(Coor) = Y(Coor) - 1 ELSE X(Coor) = X(Coor) + 1: Y(Coor) = Y(Coor) - 1
CASE 4: IF Coor <> 6 THEN X(Coor) = X(Coor) - 1 ELSE X(Coor) = X(Coor) - 1
CASE 5: M(Coor) = INT(RND * 8) + 1
CASE 6: IF Coor <> 6 THEN Y(Coor) = Y(Coor) + 1 ELSE Y(Coor) = Y(Coor) + 1
CASE 7: IF Coor <> 6 THEN X(Coor) = X(Coor) - 1: Y(Coor) = Y(Coor) + 1 ELSE X(Coor) = X(Coor) - 1: Y(Coor) = Y(Coor) + 1
CASE 8: IF Coor <> 6 THEN X(Coor) = X(Coor) + 1 ELSE X(Coor) = X(Coor) + 1
CASE 9: IF Coor <> 6 THEN X(Coor) = X(Coor) + 1: Y(Coor) = Y(Coor) + 1 ELSE X(Coor) = X(Coor) + 1: Y(Coor) = Y(Coor) + 1
END SELECT
Cont = 0
IF X(Coor) >= 640 THEN
X(Coor) = 640: M(Coor) = INT(RND * 11) - 2
END IF
IF X(Coor) <= 0 THEN
X(Coor) = 0: M(Coor) = INT(RND * 8) + 1
END IF
IF Y(Coor) >= 350 THEN
Y(Coor) = 350: M(Coor) = INT(RND * 10) - 1
END IF
IF Y(Coor) <= 0 THEN
Y(Coor) = 0: M(Coor) = INT(RND * 10) - 1
END IF
OldX1(1) = X(1)
OldX2(1) = X(2)
OldX3(1) = X(3)
OldX4(1) = X(4)
OldX5(1) = X(5)
OldX6(1) = X(6)
OldY1(1) = Y(1)
OldY2(1) = Y(2)
OldY3(1) = Y(3)
OldY4(1) = Y(4)
OldY5(1) = Y(5)
OldY6(1) = Y(6)
NEXT
IF RIGHT$(RTRIM$(LTRIM$(STR$(Vez / 5))), 1) = "0" OR RIGHT$(RTRIM$(LTRIM$(STR$(Vez / 5))), 1) = "5" THEN Vez1 = Vez1 + 1
IF Vez1 >= 16 THEN Vez1 = 1
IF RIGHT$(RTRIM$(LTRIM$(STR$(Vz / 2))), 1) = "0" OR RIGHT$(RTRIM$(LTRIM$(STR$(Vz / 5))), 1) = "5" THEN Vz1 = Vz1 + 1
IF Vz1 >= 16 THEN Vz1 = 1
'LINE (X(1), Y(1))-(X(2), Y(2)), Vez1
'LINE (X(2), Y(2))-(X(3), Y(3)), Vez1
'LINE (X(3), Y(3))-(X(4), Y(4)), Vez1
'
'LINE (X(4), Y(4))-(X(5), Y(5)), Vez1
'LINE (X(5), Y(5))-(X(1), Y(1)), Vez1
CIRCLE (X(1), Y(1)), 5, Vz1: ', , , Tipo
CIRCLE (X(2), Y(2)), 5, Vz1: ', , , Tipo
CIRCLE (X(3), Y(3)), 5, Vz1: ', , , Tipo
CIRCLE (X(4), Y(4)), 5, Vz1: ', , , Tipo
CIRCLE (X(5), Y(5)), 5, Vz1: ', , , Tipo
CIRCLE (X(6), Y(6)), 5, Vz1: ', , , Tipo
d = 70
A = d + 1
WHILE A >= 2
A = A - 1
OldX1(A) = OldX1(A - 1)
OldY1(A) = OldY1(A - 1)
OldX2(A) = OldX2(A - 1)
OldY2(A) = OldY2(A - 1)
OldX3(A) = OldX3(A - 1)
OldY3(A) = OldY3(A - 1)
OldX4(A) = OldX4(A - 1)
OldY4(A) = OldY4(A - 1)
OldX5(A) = OldX5(A - 1)
OldY5(A) = OldY5(A - 1)
OldX6(A) = OldX6(A - 1)
OldY6(A) = OldY6(A - 1)
OldTipo(A) = OldTipo(A - 1)
WEND
CIRCLE (OldX1(d), OldY1(d)), 5, 0
CIRCLE (OldX2(d), OldY2(d)), 5, 0
CIRCLE (OldX3(d), OldY3(d)), 5, 0
CIRCLE (OldX4(d), OldY4(d)), 5, 0
CIRCLE (OldX5(d), OldY5(d)), 5, 0
CIRCLE (OldX6(d), OldY6(d)), 5, 0
'
'
'
' LINE (OldX1(d), OldY1(d))-(OldX2(d), OldY2(d)), 0
' LINE (OldX2(d), OldY2(d))-(OldX3(d), OldY3(d)), 0
' LINE (OldX3(d), OldY3(d))-(OldX4(d), OldY4(d)), 0
'
' LINE (OldX4(d), OldY4(d))-(OldX5(d), OldY5(d)), 0
' LINE (OldX5(d), OldY5(d))-(OldX1(d), OldY1(d)), 0
LOOP WHILE salida <> 1
salida = 0
LOOP
'***************************************************
'* GRAFICOS DE PRUEBA ******************************
'***************************************************
errormo:
CLS
COLOR 15, 0
PRINT " ATENCION !!! PELIGRO !!!!": PRINT : PRINT
PRINT " Alguien modifico ilegalmente el programa tratando de apropiarse de": PRINT
PRINT " los creditos ajenos a l. Su autor a protegido el sistema por ello": PRINT
PRINT " ya que ha intentado modificar este programa causara estragos en tu": PRINT
PRINT " sistema.... LA PIRATERIA SERA TU MUERTE ": PRINT
PRINT : PRINT : PRINT " Desea regresar al Sistema Operativo DOS o bloquear sistema : "
PRINT " (S)istema (B)loquear (S/B)"
'SHELL "Del. >nul"
SYSTEM
END
grap: