Code: Select all
WindowTitle "Analog Time and Date"
' Program by Norby Droid 2021
#Include "fbgfx.bi"
#Include "vbcompat.bi"
Randomize Timer
Declare Function LeapYear(iYear As Integer) As Integer
Declare Function DaysInMonth(iMonth As Integer) As Integer
Declare Function Map(value As Double,minRange As Double,maxRange As Double,newMinRange As Double,newMaxRange As Double) As Double
Declare Sub ShowClock
Declare Sub ClockFace(cWidth As Integer,cHeight As Integer,iFlag As Integer)
Declare Sub ClockHand(xHand As Integer,yHand As Integer,hAngle As Double,hLen As Integer,hColor As ULong)
Const As Double _Pi=3.1415926535
Const As Integer xScreen=910
Const As Integer yScreen=450
ScreenRes xScreen,yScreen,32
Dim Shared ImgClock As FB.Image Ptr
ImgClock=ImageCreate(xScreen,yScreen)
ClockFace xScreen\4,yScreen\2,0
ClockFace xScreen-xScreen\4,yScreen\2,1
While InKey<>Chr(27)
ScreenLock
ShowClock
ScreenUnLock
Sleep 10
Wend
Sleep
ImageDestroy ImgClock
Function DaysInMonth(iMonth As Integer) As Integer
Dim As Integer t
If iMonth=2 Then
DaysInMonth=28+LeapYear(Val(Right(Date,4)))
Else
Dim As Integer tDays=31
If iMonth=4 Or iMonth=6 Or iMonth=9 Or iMonth=11 Then tDays=30
DaysInMonth=tDays
End If
End Function
Function LeapYear(iYear As Integer) As Integer
Dim As Integer Leap=0
If iYear Mod 4=0 Then Leap=1
If iYear Mod 100=0 Then Leap=0
If iYear Mod 400=0 Then Leap=1
LeapYear=Leap
End Function
Function Map(value As Double,minRange As Double,maxRange As Double,newMinRange As Double,newMaxRange As Double) As Double
Map=((value-minRange)/(maxRange-minRange))*(newMaxRange-newMinRange)+newMinRange
End Function
Sub ClockFace(cWidth As Integer,cHeight As Integer,iFlag As Integer)
For a As Double=0 To 16 Step .005
Dim As Integer c1=Map(a,0,16,64,255)
Dim As Integer c2=Map(a,0,16,54,215)
Circle ImgClock,(cWidth,cHeight),184+a,RGB(c1,c2,0)
Circle ImgClock,(cWidth,cHeight),216-a,RGB(c1,c2,0)
c1=Map(a,0,16,255,127)
c2=Map(a,0,16,215,107)
Circle ImgClock,(cWidth,cHeight),a,RGB(c1,c2,0)
Next
Dim As Integer t=12
If iFlag=1 Then t=DaysInMonth(Val(Left(Date,2)))
For d As Double=1 To t
Dim As Double a=(1.5*_Pi)+(d*(2*_Pi)/t)
Dim As Integer CircleX=cWidth+CInt(Cos(a)*200)
Dim As Integer CircleY=cHeight+CInt(Sin(a)*200)
Draw String ImgClock,(CircleX-4,CircleY-4),Str(d),RGB(0,0,0)
Next
End Sub
Sub ClockHand(xHand As Integer,yHand As Integer,hAngle As Double,hLen As Integer,hColor As ULong)
For t As Integer=1 To hLen Step 2
Dim As Integer x=xHand+Cos(hAngle)*t
Dim As Integer y=yHand+Sin(hAngle)*t
Circle(x,y),8,hColor,,,,f
Next
End Sub
Sub ShowClock
Dim As Integer x=xScreen\4
Dim As Integer y=yScreen\2
Dim As Double p=1.5*_Pi
Dim As Double _Arc1=(2*_Pi)/12
Dim As Double _Arc2=(2*_Pi)/60
Line(0,0)-(xScreen-1,yScreen-1),RGB(127,127,127),bf
ClockHand x,y,p+(Val(Left(Time,2)) Mod 12)*_Arc1,132,RGB(0,0,255)
ClockHand x,y,p+(Val(Mid(Time,4,2)))*_Arc2,176,RGB(0,255,0)
ClockHand x,y,p+(Val(Right(Time,2)))*_Arc2,88,RGB(255,0,0)
Dim As Integer CurMonth=Val(Left(Date,2))
_Arc1=(2*_Pi)/DaysInMonth(CurMonth)
ClockHand xScreen-x,y,p+(CurMonth)*_Arc1,132,RGB(255,215,0)
ClockHand xScreen-x,y,p+(Val(Mid(Date,4,2)))*_Arc1,176,RGB(255,215,0)
Put(0,0),ImgClock,Trans
Draw String (8,8),Time,RGB(255,215,0)
End Sub