Desktop Clock

[GWS]

Hi folks,

No .. not one of my clocks  .. this one is by Joske from 2004 - I thought it shouldn't get lost in time 

Right click to close it ..

Code Select Expand


' Filename: clock.cba
' creates a round clock with Hour, minute and second hand
' that is always on top
' created by Jos de Jong, 2004
' wjosdejong@hotmail.com
' API Declarations
DECLARE "gdi32", CreateEllipticRgn(X1:INT, Y1:INT, X2:INT, Y2:INT),INT
DECLARE "gdi32", CombineRgn(hDestRgn:INT, hSrcRgn1:INT, hSrcRgn2:INT, nCombineMode:INT),INT
DECLARE "user32",SetWindowRgn(hWnd:WINDOW, hRgn:INT, bRedraw:INT),INT
DECLARE "gdi32", DeleteObject(hObject:INT),INT
DECLARE "user32",InvalidateRect(hwnd:WINDOW, lpRect:INT, bErase:INT),INT
DECLARE "user32",GetWindowLongA(hwnd:INT, nIndex:INT),INT
DECLARE "user32",SetWindowLongA(hwnd:INT, nIndex:INT, dwNewLong:INT),INT
DECLARE "user32",SetWindowPos(hwnd:INT, hWndInsertAfter:INT, x:INT, y:INT, cx:INT, cy:INT, wFlags:INT),INT
' Constants
SETID "TRUE",1
SETID "FALSE",0
SETID "SPACEBAR",&H20
SETID "RGN_OR",2
SETID "IDSKIN",100
SETID "GWL_STYLE",-16
SETID "SWP_NOMOVE",&H2
SETID "SWP_NOZORDER",&H4
SETID "WM_NCLBUTTONDOWN",&HA1
SETID "HTCAPTION",2
' Globals
DEF Run:INT
DEF Skin:INT
DEF Style:INT
DEF Region1:INT
DEF main:WINDOW
DEF Temp:INT
DEF Xclock,Yclock,Rclock:int
DEF Pi:double
DEF AlwaysOnTop:int
DEF Left, Top:int
Const Black = rgb(0,0,0)
Const White = rgb(255,255,255)
Const Red = rgb(200,0,0)
Const mnuOnTop = 100
Const mnuExit = 101
Const mnuLine = 102
Pi = 4 * Atan(1)
Xclock=50
Yclock=50
Rclock=30
AlwaysOnTop = 1
' Create the main window
WINDOW main,-200,0,100,100,@nocaption,0,"Clock", mainRoutine
temp = SetWindowPos(Main, -1, 0, 0, 0, 0, 3)   :'always on top
setwindowcolor main, rgb(255,255,255)
RegionMe
'place the clock to lefttop of the screen
getscreensize Left,Top
setsize main, Left-150,0, 100,100
starttimer main, 1000
PaintClock
Run = @TRUE
WAITUNTIL Run = @FALSE
CLOSEWINDOW main
END
SUB mainRoutine
' Message handler for the window
SELECT @CLASS
   CASE @IDCLOSEWINDOW
      Run = @FALSE
   Case @idtimer
      PaintClock
   CASE @IDCHAR
      if @code=27 then run=0   :'ESC
   CASE @IDLBUTTONDN
      SENDMESSAGE main, @WM_NCLBUTTONDOWN,@HTCAPTION,0   :'to move the window by dragging it
   CASE @IDRBUTTONDN
      if AlwaysOnTop = 0
         contextmenu main, @MOUSEX, @MOUSEY, "I,Always on Top,0,mnuOnTop", "I,--,0,mnuLine",  "I,Close,0,mnuExit"
      else
         contextmenu main, @MOUSEX, @MOUSEY, "I,NOT Always on Top,0,mnuOnTop", "I,--,0,mnuLine", "I,Close,0,mnuExit"
      endif   
   CASE @IDMENUPICK
      if @menunum = mnuExit then run=@False
      if @menunum = mnuOnTop then SetAlwaysOnTop
     
ENDSELECT
RETURN
SUB RegionMe
' Creates a circular window
   Region1 = CreateEllipticRgn(Xclock-Rclock,Yclock-Rclock,Xclock+Rclock+1,Yclock+Rclock+1)
   SetWindowRgn(main, Region1, @TRUE)
   DeleteObject(Region1)
   Style = GetWindowLongA(main, @GWL_STYLE)
   SetWindowLongA(main,@GWL_STYLE,Style)
   
RETURN
sub PaintClock
'repaint the clock
def Point:int
def Angle:double
def Hour:int
def Min:int
def Sec:int
def HourHand:double
def MinHand:double
def SecHand:double
def TimeNow:string
def Xs, Ys, Xe, Ye:int
'calculate the new time
TimeNow = Time$
Sec = Val(Mid$(TimeNow, 7, 2)): SecHand = Sec * Pi / 30 - 0.5 * Pi
Min = Val(Mid$(TimeNow, 4, 2)): MinHand = (Min + Sec / 60) * Pi / 30 - 0.5 * Pi
Hour = Val(Mid$(TimeNow, 1, 2)): HourHand = (Hour + Min / 60 + Sec / 3600) * Pi / 6 - 0.5 * Pi
'now repaint all points and the hands
'paint the border of the clock
SETLINESTYLE main,@LSSOLID, int(Rclock/6)
Circle main, Xclock, Yclock, Rclock, Black, White
'paint 12 small circles for each hour
SETLINESTYLE main,@LSSOLID, int(Rclock/15)
For Point = 0 To 60 Step 5
   Angle = Point * Pi / 30 - 0.5 * Pi
   Xs = Xclock + Rclock *.8 * Cos(Angle)
   Ys = Yclock + Rclock * .8 * Sin(Angle)
   line main, Xs, Ys, Xs, Ys, Black
Next Point
'paint a line for 12, 3, 6 and 9 hour
SETLINESTYLE main,@LSSOLID, int(Rclock/15)
For Point = 0 To 60 Step 15
   Angle = Point * Pi / 30 - 0.5 * Pi
   Xs = Xclock + Rclock *.8 * Cos(Angle)
   Ys = Yclock + Rclock * .8 * Sin(Angle)
   Xe = Xclock + Rclock *.7 * Cos(Angle)
   Ye = Yclock + Rclock * .7 * Sin(Angle)
   Line main, Xs,Ys, Xe,Ye, Black
Next Point
'paint the hour hand
SETLINESTYLE main,@LSSOLID, int(Rclock/10)
Xs = Xclock + Rclock *.4 * Cos(HourHand)
Ys = Yclock + Rclock * .4 * Sin(HourHand)
Line main, Xclock,Yclock, Xs,Ys, Black
'paint the minute hand
SETLINESTYLE main,@LSSOLID, int(Rclock/20)
Xs = Xclock + Rclock *.7 * Cos(MinHand)
Ys = Yclock + Rclock * .7 * Sin(MinHand)
Line main, Xclock,Yclock, Xs,Ys, Black
'paint the second hand
SETLINESTYLE main,@LSSOLID, int(Rclock/50)
Xs = Xclock + Rclock *.8 * Cos(SecHand)
Ys = Yclock + Rclock * .8 * Sin(SecHand)
Line main, Xclock,Yclock, Xs,Ys, Red
SETLINESTYLE main,@LSSOLID, int(Rclock/15)
Line main, Xclock,Yclock, Xclock,Yclock, Red
return
sub SetAlwaysOnTop
'adjust the windowposition to normal or to AlwaysOnTop
AlwaysOnTop = 1 - AlwaysOnTop
if AlwaysOnTop = 1
   'always on top
   temp = SetWindowPos(Main, -1, 0, 0, 0, 0, 3)
else
   'normal
   temp = SetWindowPos(Main, 1, 0, 0, 0, 0, 3)
   temp = SetWindowPos(Main, 0, 0, 0, 0, 0, 3)
endif
return


Thanks Joske .. 

best wishes,

Graham