+- QB64 Phoenix Edition (https://staging.qb64phoenix.com)
+-- Forum: QB64 Rising (https://staging.qb64phoenix.com/forumdisplay.php?fid=1)
+--- Forum: Prolific Programmers (https://staging.qb64phoenix.com/forumdisplay.php?fid=26)
+---- Forum: TheBOB (https://staging.qb64phoenix.com/forumdisplay.php?fid=27)
+---- Thread: Clock - An Analog Clock with Alarm. (/showthread.php?tid=234)
Clock - An Analog Clock with Alarm. - Pete - 04-27-2022
Clock.bas by Bob Seguin.
![[Image: Screenshot-650.png]](https://i.ibb.co/kHDpZjn/Screenshot-650.png)
Description: An analog clock with a timer alarm setting.
Code: (Select All)
'*************************************************
'
'------------ C L O C K . B A S ------------------
'
'------- Freeware by Bob Seguin - 2001 -----------
'
'- An analog/digital clock with countdown timer -
'
'*************************************************
_TITLE "Clock.bas by Bob Seguin"
DEFINT A-Z
DECLARE SUB Digital (x, y, Num$)
CONST Degree! = 3.14159 / 180
DIM FaceBOX(6500)
DIM TickBOX(6500)
DIM SHARED DigitBOX(1 TO 400)
SCREEN 12
GOSUB GetDIGITS
OUT &H3C8, 0
OUT &H3C9, 0
OUT &H3C9, 0
OUT &H3C9, 12
OUT &H3C8, 1
OUT &H3C9, 16
OUT &H3C9, 18
OUT &H3C9, 22
OUT &H3C8, 4
OUT &H3C9, 63
OUT &H3C9, 0
OUT &H3C9, 0
ON TIMER(1) GOSUB Clock
TIMER ON
'Analog clock graphic
LINE (235, 125)-(405, 311), 1, B
LINE (240, 130)-(400, 279), 1, BF
CIRCLE (320, 210), 60, 7
PAINT STEP(0, 0), 7
CIRCLE (320, 210), 63, 7
CIRCLE STEP(0, 0), 2, 0
PAINT STEP(0, 0), 0
LINE (240, 282)-(400, 306), 1, BF
LINE (240, 282)-(400, 306), 1, BF
LINE (290, 285)-(350, 303), 0, BF
LINE (310, 291)-(310, 292), 10, B
LINE (330, 291)-(330, 292), 10, B
LINE (310, 296)-(310, 297), 10, B
LINE (330, 296)-(330, 297), 10, B
LINE (10, 10)-(629, 469), 8, B
LINE (15, 15)-(624, 464), 8, B
COLOR 8
LOCATE 24, 23: PRINT "PRESS S TO ENTER COUNTDOWN MINUTES"
LOCATE 26, 32: PRINT "PRESS [ESC] TO QUIT"
FOR n = 6 TO 360 STEP 6
Adjacent = 320 + 55 * COS(n * Degree!)
Opposite = 210 - 55 * SIN(n * Degree!)
IF n MOD 30 = 0 THEN
CIRCLE (Adjacent, Opposite), 2, 0: PAINT STEP(0, 0), 0
ELSE
CIRCLE (Adjacent, Opposite), 1, 15
END IF
NEXT n
GET (240, 130)-(400, 279), FaceBOX()
GET (240, 130)-(400, 279), TickBOX()
GOSUB Clock
DO
Count$ = UCASE$(INKEY$)
IF Count$ = "S" THEN
DO
COLOR 11
LOCATE 3, 5
INPUT "Enter minutes (Maximum 720): ", CountDOWN$
LOCATE 3, 5: PRINT SPACE$(60)
LOOP UNTIL VAL(CountDOWN$) AND VAL(CountDOWN$) <= 720
CountDOWN% = VAL(CountDOWN$)
Hr$ = MID$(TIME$, 1, 2)
Mt$ = MID$(TIME$, 4, 2)
Sc$ = MID$(TIME$, 7, 2)
Hr% = 0: Hr2% = 0: Mt% = 0
Hr% = VAL(Hr$)
Mt% = VAL(Mt$)
Mt% = Mt% + CountDOWN%
IF Mt% > 59 THEN
Hr2% = Mt% \ 60
Mt% = Mt% MOD 60
END IF
Hr% = Hr% + Hr2%
IF Hr% > 24 THEN Hr% = Hr% - 24
Hr$ = LTRIM$(STR$(Hr%))
Mt$ = LTRIM$(STR$(Mt%))
IF Hr% < 10 THEN Hr$ = "0" + Hr$
IF Hr% = 24 THEN Hr$ = "00"
IF Mt% < 10 THEN Mt$ = "0" + Mt$
CountDOWN$ = Hr$ + ":" + Mt$ + ":" + Sc$
LOCATE 28, 27: COLOR 5: PRINT "ALARM WILL SOUND AT: "; CountDOWN$
END IF
LOOP UNTIL Count$ = CHR$(27)
SYSTEM
Clock: 'update digital clock
PUT (240, 130), FaceBOX(), PSET
Hour$ = MID$(TIME$, 1, 2)
Minute$ = MID$(TIME$, 4, 2)
Second$ = MID$(TIME$, 7, 2)
Digital 294, 289, Hour$
Digital 314, 289, Minute$
Digital 334, 289, Second$
Hours = VAL(Hour$)
Minutes = VAL(Minute$)
Seconds = VAL(Second$)
nMIN = Minutes * 6 - 90
nSEC = Seconds * 6 - 90
nHRS = Hours * 30 - 90 + Minutes / 2
IF OldMIN <> nMIN THEN 'change minutes/hours
PUT (240, 130), TickBOX(), PSET
HAdjacent = 320 + 38 * COS(nHRS * Degree!)
HOpposite = 210 + 38 * SIN(nHRS * Degree!)
LINE (320, 210)-(HAdjacent, HOpposite), 0
MAdjacent = 320 + 50 * COS(nMIN * Degree!)
MOpposite = 210 + 50 * SIN(nMIN * Degree!)
LINE (320, 210)-(MAdjacent, MOpposite), 0
OldMIN = nMIN
GET (240, 130)-(400, 279), FaceBOX()
END IF
'change seconds
SAdjacent = 320 + 50 * COS(nSEC * Degree!)
SOpposite = 210 + 50 * SIN(nSEC * Degree!)
LINE (320, 210)-(SAdjacent, SOpposite), 4
IF TIME$ = CountDOWN$ THEN
PLAY "MBT120O3L32fA>fA<fA>fA<fA>fA<fA>fA<fA>fA"
LOCATE 28, 26: PRINT SPACE$(30);
END IF
RETURN
GetDIGITS:
MaxWIDTH = 70
MaxDEPTH = 10
x = 0: y = 0
DO
READ Count, Colr
FOR Reps = 1 TO Count
PSET (x, y), Colr
x = x + 1
IF x > MaxWIDTH THEN
x = 0
y = y + 1
END IF
NEXT Reps
LOOP UNTIL y > MaxDEPTH
Index = 1
FOR x = 0 TO 63 STEP 7
GET (x, 0)-(x + 6, 10), DigitBOX(Index)
Index = Index + 40
NEXT x
LINE (0, 0)-(70, 10), 0, BF
RETURN
DATA 1,0,4,10,10,0,4,10,3,0,4,10,10,0,4,10,3,0,4,10,3,0,4,10
DATA 3,0,4,10,3,0,4,10,3,0,1,10,4,0,1,10,6,0,1,10,6,0,1,10
DATA 6,0,1,10,1,0,1,10,4,0,1,10,1,0,1,10,6,0,1,10,11,0,1,10
DATA 1,0,1,10,4,0,1,10,1,0,1,10,4,0,1,10,2,0,1,10,4,0,1,10
DATA 6,0,1,10,6,0,1,10,6,0,1,10,1,0,1,10,4,0,1,10,1,0,1,10
DATA 6,0,1,10,11,0,1,10,1,0,1,10,4,0,1,10,1,0,1,10,4,0,1,10
DATA 2,0,1,10,4,0,1,10,6,0,1,10,6,0,1,10,6,0,1,10,1,0,1,10
DATA 4,0,1,10,1,0,1,10,6,0,1,10,11,0,1,10,1,0,1,10,4,0,1,10
DATA 1,0,1,10,4,0,1,10,2,0,1,10,4,0,1,10,6,0,1,10,6,0,1,10
DATA 6,0,1,10,1,0,1,10,4,0,1,10,1,0,1,10,6,0,1,10,11,0,1,10
DATA 1,0,1,10,4,0,1,10,1,0,1,10,4,0,1,10,17,0,4,10,3,0,4,10
DATA 3,0,4,10,3,0,4,10,3,0,4,10,10,0,4,10,3,0,4,10,3,0,1,10
DATA 4,0,1,10,6,0,1,10,1,0,1,10,11,0,1,10,6,0,1,10,6,0,1,10
DATA 1,0,1,10,4,0,1,10,6,0,1,10,1,0,1,10,4,0,1,10,6,0,1,10
DATA 2,0,1,10,4,0,1,10,6,0,1,10,1,0,1,10,11,0,1,10,6,0,1,10
DATA 6,0,1,10,1,0,1,10,4,0,1,10,6,0,1,10,1,0,1,10,4,0,1,10
DATA 6,0,1,10,2,0,1,10,4,0,1,10,6,0,1,10,1,0,1,10,11,0,1,10
DATA 6,0,1,10,6,0,1,10,1,0,1,10,4,0,1,10,6,0,1,10,1,0,1,10
DATA 4,0,1,10,6,0,1,10,2,0,1,10,4,0,1,10,6,0,1,10,1,0,1,10
DATA 11,0,1,10,6,0,1,10,6,0,1,10,1,0,1,10,4,0,1,10,6,0,1,10
DATA 1,0,1,10,4,0,1,10,6,0,1,10,3,0,4,10,10,0,4,10,3,0,4,10
DATA 10,0,4,10,3,0,4,10,10,0,4,10,3,0,4,10,3,0
SUB Digital (x, y, Num$)
FOR Digit = 1 TO LEN(Num$)
Digit$ = MID$(Num$, Digit, 1)
DigitINDEX = VAL(Digit$) * 40 + 1
PUT (x, y), DigitBOX(DigitINDEX), PSET
x = x + DigitBOX(DigitINDEX)
NEXT Digit
END SUB