Hi folks,
No .. not one of my clocks ;D .. this one is by Joske from 2004 - I thought it shouldn't get lost in time :)
Right click to close it ..
' 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