C/bas
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity
bas/BAS/HORA2.BAS
jdg 474d98379e First commit ~0,10
2021-09-03 17:42:07 +02:00

463 lines
10 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
DECLARE SUB PonNum (Digito$, Posicion)
DIM SHARED P(6), A
DIM OldX1(30), OldY1(30), OldX2(30), OldY2(30), OldX3(30), OldY3(30), OldX4(30), OldY4(30), OldX5(30), OldY5(30), OldTipo(100), OldX6(100), OldY6(100)
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
mir$ = "Reloj ( Jos‚ David Guill‚n 15/02/93 )"
IF MID$(mir$, 13, 1) <> "‚" THEN PRINT " Programa modificado 1": SYSTEM
IF MID$(mir$, 26, 1) <> "‚" THEN PRINT " Programa modificado 2": SYSTEM
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
Hora$ = LEFT$(TIME$, 2)
Min$ = MID$(TIME$, 4, 2)
Hora1$ = LEFT$(Hora$, 1)
A = 1
PonNum Hora1$, 1
Hora2$ = MID$(Hora$, 2, 1)
A = 2
PonNum Hora2$, 2
LINE (170, 20)-(180, 30), 12, BF
LINE (170, 60)-(180, 70), 12, BF
Min1$ = LEFT$(Min$, 1)
A = 3
PonNum Min1$, 3
Min2$ = MID$(Min$, 2, 1)
A = 4
PonNum Min2$, 4
LINE (370, 50)-(380, 60), 12, BF
LINE (370, 80)-(380, 90), 12, BF
DO
Hora$ = LEFT$(TIME$, 2)
Min$ = MID$(TIME$, 4, 2)
IF INKEY$ <> "" THEN SCREEN 0: PRINT mir$: SYSTEM
IF OldHor2$ <> LEFT$(Hora$, 1) THEN
Hora1$ = LEFT$(Hora$, 1)
A = 1
PonNum Hora1$, 1
END IF
OldHor2$ = LEFT$(Hora$, 1)
IF OldHor1$ <> MID$(Hora$, 2, 1) THEN
Hora2$ = MID$(Hora$, 2, 1)
A = 2
PonNum Hora2$, 2
END IF
OldHor1$ = MID$(Hora$, 2, 1)
IF OldMin2$ <> LEFT$(Min$, 1) THEN
Min1$ = LEFT$(Min$, 1)
A = 3
PonNum Min1$, 3
END IF
OldMin2$ = LEFT$(Min$, 1)
IF OldMin1$ <> MID$(Min$, 2, 1) THEN
Min2$ = MID$(Min$, 2, 1)
A = 4
PonNum Min2$, 4
END IF
OldMin1$ = MID$(Min$, 2, 1)
IF INKEY$ <> "" THEN SCREEN 0: PRINT mir$: SYSTEM
seg$ = MID$(TIME$, 7, 1)
A = 5
PonNum seg$, 5
seg$ = MID$(TIME$, 8, 1)
A = 6
PonNum seg$, 6
'***************************************************
'* GRAFICO LINEAL **********************************
'***************************************************
M(4) = INT(RND * 8) + 1
M(3) = INT(RND * 8) + 1
M(2) = INT(RND * 8) + 1
M(5) = INT(RND * 8) + 1
M(1) = INT(RND * 8) + 1
M(6) = INT(RND * 8) + 1
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) - 3: Y(Coor) = Y(Coor) - 3 ELSE X(Coor) = X(Coor) - 2: Y(Coor) = Y(Coor) - 2
CASE 2: IF Coor <> 6 THEN Y(Coor) = Y(Coor) - 3 ELSE Y(Coor) = Y(Coor) - 2
CASE 3: IF Coor <> 6 THEN X(Coor) = X(Coor) + 3: Y(Coor) = Y(Coor) - 3 ELSE X(Coor) = X(Coor) + 2: Y(Coor) = Y(Coor) - 2
CASE 4: IF Coor <> 6 THEN X(Coor) = X(Coor) - 3 ELSE X(Coor) = X(Coor) - 2
CASE 5: 'Pause
CASE 6: IF Coor <> 6 THEN Y(Coor) = Y(Coor) + 3 ELSE Y(Coor) = Y(Coor) + 2
CASE 7: IF Coor <> 6 THEN X(Coor) = X(Coor) - 3: Y(Coor) = Y(Coor) + 3 ELSE X(Coor) = X(Coor) - 2: Y(Coor) = Y(Coor) + 2
CASE 8: IF Coor <> 6 THEN X(Coor) = X(Coor) + 3 ELSE X(Coor) = X(Coor) + 2
CASE 9: IF Coor <> 6 THEN X(Coor) = X(Coor) + 3: Y(Coor) = Y(Coor) + 3 ELSE X(Coor) = X(Coor) + 2: Y(Coor) = Y(Coor) + 2
END SELECT
IF Coor = 6 THEN
IF X(6) >= 640 THEN X(6) = 640: Salida = 1
IF X(6) <= 0 THEN X(6) = 0: Salida = 1
IF Y(6) <= 150 THEN Y(6) = 150: Salida = 1
IF Y(6) >= 350 THEN Y(6) = 350: Salida = 1
ELSE
IF X(Coor) >= 640 THEN X(Coor) = 640: Salida = 1
IF X(Coor) <= 480 AND Y(Coor) < 250 THEN
X(Coor) = 650: Salida = 1
ELSE
IF X(Coor) <= 0 THEN X(Coor) = 480: Salida = 1
END IF
IF Y(Coor) >= 350 AND X(Corr) <= 400 THEN Y(Coor) = 350: Salida = 1
IF Y(Coor) >= 350 THEN Y(Coor) = 0: Salida = 1
IF Y(Coor) <= 0 THEN Y(Coor) = 350: Salida = 1
END IF
OldX6(1) = X(6)
OldY6(1) = Y(6)
OldTipo(1) = Tipo
OldX1(1) = X(1)
OldX2(1) = X(2)
OldX3(1) = X(3)
OldX4(1) = X(4)
OldX5(1) = X(5)
OldY1(1) = Y(1)
OldY2(1) = Y(2)
OldY3(1) = Y(3)
OldY4(1) = Y(4)
OldY5(1) = Y(5)
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(6), Y(6)), 20, Vz1: ', , , Tipo
A = 31
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)
WEND
A = 71
WHILE A >= 2
A = A - 1
OldX6(A) = OldX6(A - 1)
OldY6(A) = OldY6(A - 1)
OldTipo(A) = OldTipo(A - 1)
WEND
CIRCLE (OldX6(70), OldY6(70)), 20, 0
LINE (OldX1(30), OldY1(30))-(OldX2(30), OldY2(30)), 0
LINE (OldX2(30), OldY2(30))-(OldX3(30), OldY3(30)), 0
LINE (OldX3(30), OldY3(30))-(OldX4(30), OldY4(30)), 0
LINE (OldX4(30), OldY4(30))-(OldX5(30), OldY5(30)), 0
LINE (OldX5(30), OldY5(30))-(OldX1(30), OldY1(30)), 0
LOOP WHILE Salida <> 1
Salida = 0
LOOP
'***************************************************
'* GRAFICOS DE PRUEBA ******************************
'***************************************************
grap:
SUB PonNum (Digito$, Posicion)
SELECT CASE VAL(RTRIM$(LTRIM$(Digito$)))
CASE 0
D1 = 1: D2 = 1: D3 = 1: D4 = 1: D5 = 0: D6 = 1: D7 = 1
CASE 1
D1 = 0: D2 = 0: D3 = 1: D4 = 0: D5 = 0: D6 = 1: D7 = 0
CASE 2
D1 = 0: D2 = 1: D3 = 1: D4 = 1: D5 = 1: D6 = 0: D7 = 1
CASE 3
D1 = 0: D2 = 1: D3 = 1: D4 = 0: D5 = 1: D6 = 1: D7 = 1
CASE 4
D1 = 1: D2 = 0: D3 = 1: D4 = 0: D5 = 1: D6 = 1: D7 = 0
CASE 5
D1 = 1: D2 = 1: D3 = 0: D4 = 0: D5 = 1: D6 = 1: D7 = 1
CASE 6
D1 = 1: D2 = 1: D3 = 0: D4 = 1: D5 = 1: D6 = 1: D7 = 1
CASE 7
D1 = 0: D2 = 1: D3 = 1: D4 = 0: D5 = 0: D6 = 1: D7 = 0
CASE 8
D1 = 1: D2 = 1: D3 = 1: D4 = 1: D5 = 1: D6 = 1: D7 = 1
CASE 9
D1 = 1: D2 = 1: D3 = 1: D4 = 0: D5 = 1: D6 = 1: D7 = 1
END SELECT
IF Posicion < 5 THEN
IF D1 = 1 THEN
PSET (0 + P(A), 0), 4
DRAW "D40 R15 U26 H15"
DRAW "F13 BL5 P4,4"
ELSE
PSET (0 + P(A), 0), 0
DRAW "D40 R15 U26 H15"
DRAW "F13 BL5 P0,0"
END IF
IF D2 = 1 THEN
PSET (3 + P(A), 0), 4
DRAW "R63 G15 L33 H15"
DRAW "BR5 BD5 BR23 P4,4"
ELSE
PSET (3 + P(A), 0), 0
DRAW "R63 G15 L33 H15"
DRAW "BR5 BD5 BR23 P0,0"
END IF
IF D3 = 1 THEN
PSET (69 + P(A), 0), 4
DRAW " D40 L15 U25 E15"
DRAW "G13 BR5 P4,4"
ELSE
PSET (69 + P(A), 0), 0
DRAW " D40 L15 U25 E15"
DRAW "G13 BR5 P0,0"
END IF
IF D4 = 1 THEN
PSET (0 + P(A), 42), 4
DRAW " D50 E15 U20 H15"
DRAW "F13 BL5 P4,4"
ELSE
PSET (0 + P(A), 42), 0
DRAW " D50 E15 U20 H15"
DRAW "F13 BL5 P0,0"
END IF
IF D5 = 1 THEN
PSET (3 + P(A), 42), 4
DRAW " R63 G15 L33 H15"
DRAW "BR5 BD5 BR23 P4,4"
ELSE
PSET (3 + P(A), 42), 0
DRAW " R63 G15 L33 H15"
DRAW "BR5 BD5 BR23 P0,0"
END IF
IF D6 = 1 THEN
PSET (69 + P(A), 42), 4
DRAW " D50 H15 U20 E15"
DRAW "G13 BR5 P4,4"
ELSE
PSET (69 + P(A), 42), 0
DRAW " D50 H15 U20 E15"
DRAW "G13 BR5 P0,0"
END IF
IF D7 = 1 THEN
PSET (3 + P(A), 93), 4
DRAW " E15 R33 F15 L62"
DRAW "BR23 BU5 P4,4"
ELSE
PSET (3 + P(A), 93), 0
DRAW " E15 R33 F15 L62"
DRAW "BR23 BU5 P0,0"
END IF
'********************************************************
'**************** EL GRAN " ELSE " *********************
'********************************************************
ELSE
IF D1 = 1 THEN
PSET (0 + P(A), 45), 4
DRAW "D20 R8 U13 H8"
DRAW "F7 BL3 P4,4"
ELSE
PSET (0 + P(A), 45), 0
DRAW "D20 R8 U13 H8"
DRAW "F7 BL3 P0,0"
END IF
IF D2 = 1 THEN
PSET (3 + P(A), 45), 4
DRAW "R32 G8 L17 H8"
DRAW "BR3 BD3 BR12 P4,4"
ELSE
PSET (3 + P(A), 45), 0
DRAW "R32 G8 L17 H8"
DRAW "BR3 BD3 BR12 P0,0"
END IF
IF D3 = 1 THEN
PSET (37 + P(A), 45), 4
DRAW "D20 L8 U13 E8"
DRAW "G8 BR3 P4,4"
ELSE
PSET (37 + P(A), 45), 0
DRAW "D20 L8 U13 E8"
DRAW "G8 BR3 P0,0"
END IF
IF D4 = 1 THEN
PSET (0 + P(A), 67), 4
DRAW "D25 E8 U10 H8"
DRAW "F8 BL3 P4,4"
ELSE
PSET (0 + P(A), 67), 0
DRAW "D25 E8 U10 H8"
DRAW "F8 BL3 P0,0"
END IF
IF D5 = 1 THEN
PSET (3 + P(A), 67), 4
DRAW "R32 G8 L17 H8"
DRAW "BR3 BD3 BR12 P4,4"
ELSE
PSET (3 + P(A), 67), 0
DRAW "R32 G8 L17 H8"
DRAW "BR3 BD3 BR12 P0,0"
END IF
IF D6 = 1 THEN
PSET (37 + P(A), 67), 4
DRAW "D25 H8 U10 E8"
DRAW "G8 BR3 P4,4"
ELSE
PSET (37 + P(A), 67), 0
DRAW "D25 H8 U10 E8"
DRAW "G8 BR3 P0,0"
END IF
IF D7 = 1 THEN
PSET (3 + P(A), 93), 4
DRAW "E8 R17 F8 L34"
DRAW "BR12 BU3 P4,4"
ELSE
PSET (3 + P(A), 93), 0
DRAW "E8 R17 F8 L34"
DRAW "BR12 BU3 P0,0"
END IF
END IF
END SUB
Reference in New Issue View Git Blame Copy Permalink