QBASIC Clock

[James M Buggar]

I am looking for a QBASIC program that will display an analog clock. If anyone
has such a program I would greatly appreciate hearing from them sometime before
Wednesday evening.

MIke
jm...@rs6000.cmp.ilstu.edu

[Thomas Wanek]

James M Buggar (jm...@rs6000.cmp.ilstu.edu) wrote:
: I am looking for a QBASIC program that will display an analog clock. If anyone

: has such a program I would greatly appreciate hearing from them sometime before
: Wednesday evening.

Ah, left the homework 'til the last minute again, eh? :-)

The following is QuickBASIC source code originally printed in BasicPro
magazine, and displays an analog clock in CGA and EGA modes. It will
work fine in QBASIC. Cheers!

----------------------------------------------------------------------

DECLARE SUB TimeLoop (VideoX!, VideoY!, VideoAspect)
DECLARE SUB DrawHands (NewTime$, VideoX!, VideoY!, VideoAspect!, Drawcolor!)
DECLARE SUB DrawClockHands (VideoX!, VideoY!, VideoAspect)
DECLARE SUB DrawBox (VideoWidth!, VideoHeight!, VideoAspect)
DECLARE SUB SetVideoParameters (VideoType$, VideoWidth!, VideoHeight!, VideoAspect!)
DECLARE SUB SetVideoType (VideoType$)
COMMON SHARED Radian, DrawBright, DrawWhite, DrawBlack
'Analog clock for QuickBasic

Radian = 3.1415926535# / 180
DrawBlack = 0 'Black (background color)
DrawWhite = 7 'Grey (hour markers)
DrawBright = 15 'White (base and clock hands)
REM CALL SetVideoType(VideoType$)
VideoType$ = "CGA"
IF VideoType$ = "Text" THEN
PRINT "Sorry - this program only works on CGA, EGA, and VGA systems."
END 'Stops the program and returns to DOS
END IF
CALL SetVideoParameters(VideoType$, VideoX, VideoY, VideoAspect)
CALL DrawBox(VideoX, VideoY, VideoAspect)
CALL TimeLoop(VideoX, VideoY, VideoAspect)
END
VideoModeError:
VideoType$ = "Text"
RESUME NEXT

SUB DrawBox (VideoX, VideoY, VideoAspect)
CenterX = VideoX / 2
CenterY = VideoY / 2
TickLength = CenterY * .96
LINE (CenterX - CenterY * VideoAspect, 1)-(CenterX + CenterY * VideoAspect, VideoY - 1), DrawWhite, B
FOR HourCounter = 0 TO 11
TickX = CenterX + TickLength * VideoAspect * SIN(HourCounter * 30 * Radian)
TickY = CenterY - TickLength * COS(HourCounter * 30 * Radian)
LINE (TickX - 1, TickY - 1)-(TickX + 1, TickY + 1), DrawWhite, B
NEXT HourCounter
END SUB

SUB DrawHands (NewTime$, VideoX, VideoY, VideoAspect, Drawcolor)
CenterX = VideoX / 2
CenterY = VideoY / 2
HourLength = CenterY * .6
MinuteLength = CenterY * .8
SecondLength = CenterY * .9
NewSecond = VAL(MID$(NewTime$, 7, 2))
NewMinute = VAL(MID$(NewTime$, 4, 2)) + NewSecond / 60
NewHour = VAL(MID$(NewTime$, 1, 2)) + NewMinute / 60
SecondX = CenterX + VideoAspect * SIN(NewSecond * 6 * Radian) * SecondLength
SecondY = CenterY - COS(NewSecond * 6 * Radian) * SecondLength
CIRCLE (SecondX, SecondY), 4, Drawcolor
MinuteX = CenterX + VideoAspect * SIN(NewMinute * 6 * Radian) * MinuteLength
MinuteY = CenterY - COS(NewMinute * 6 * Radian) * MinuteLength
LINE (CenterX, CenterY)-(MinuteX, MinuteY), Drawcolor
HourX = CenterX + VideoAspect * SIN(NewHour * 30 * Radian) * HourLength
HourY = CenterY - COS(NewHour * 30 * Radian) * HourLength
LINE (CenterX, CenterY)-(HourX, HourY), Drawcolor
END SUB

SUB SetVideoParameters (VideoType$, VideoX, VideoY, VideoAspect)
ScreenX = 10
ScreenY = 7
SELECT CASE VideoType$
CASE "CGA"
SCREEN 1
VideoX = 320
VideoY = 200
CASE "EGA"
SCREEN 9
VideoX = 640
VideoY = 350
CASE "VGA "
SCREEN 12
VideoX = 640
VideoY = 480
END SELECT
CLS
VideoAspect = (ScreenY / ScreenX) * (VideoX / VideoY)
END SUB

SUB SetVideoType (VideoType$)
ON ERROR GOTO VideoModeError
VideoType$ = "VGA"
SCREEN 12
IF VideoType$ = "Text" THEN
VideoType$ = "EGA"
SCREEN 9
IF VideoType$ = "Text" THEN
VideoType$ = "CGA"
SCREEN 1
END IF
END IF
ON ERROR GOTO 0
END SUB

SUB TimeLoop (VideoX, VideoY, VideoAspect)
WHILE INKEY$ = ""
NewTime$ = TIME$
CALL DrawHands(NewTime$, VideoX, VideoY, VideoAspect, DrawBright)
WHILE TIME$ = NewTime$: WEND
CALL DrawHands(NewTime$, VideoX, VideoY, VideoAspect, DrawBlack)
WEND
END SUB

---------------------------------------------------------------------------

As a side note, the article pointed out that this program is a good
tutorial in some of the uses of the trigonometric functions in QBASIC/
QuickBASIC.

--
Thomas J. Wanek -- tjw...@uswnvg.com -- Seattle, WA | I do not speak for
"They that can give up essential liberty to obtain | US WEST, more's
a little temporary safety deserve neither liberty | the pity.
nor safety." Benjamin Franklin |