PureBasic Forums - English

http://www.purebasic.com
https://www.purebasic.fr/english/

the Tectonic Clock

https://www.purebasic.fr/english/viewtopic.php?t=51149

Page 1 of 1

the Tectonic Clock

Posted: Sat Sep 01, 2012 2:38 pm
by dobro
je ressors un de mes vieux code fait en Purebasic 4.01 ...
je n'ai eu aucune retouche a faire !! :)
marche toujours , meme sur Seven
pour info a cette epoque la Tectonic n'existait pas ... ;)
I pull one of my old code made ​​PureBasic 4.01 ...
I had no editing to do! :)
still works, even on Seven
for info at this time, the Tectonic did not exist ... ;)
dans ce code plusieurs choses intéressantes :

; dans ce code : comment faire une fenêtre ronde.. piqué au Soldat inconnu
; comment faire disparaitre le prg de la barre des taches
; 2 formule de calcul de rotations, tres utile dans tout les Jeux Video
; utilisation d'un callback
; une procédure du Soldat pour faire un mélange de couleur , dans la cabane du pécheur ...

; mis en bouteille par Dobro and Co :)

ps : pour info la couleur du tour de l'horloge doit changer suivant le moment de la journée :)
et retient sa position si vous la deplacez ... ( a mettre dans le dossier Démarrage du menu démarrer...mais c'est pas obligé :) )
on clique avec le bouton droit de la souris pour quitter l'horloge
in this code several interesting things:

And in this code: how to make a round window .. Dive the Soldat inconnu
, How to make disappear the prg the taskbar
, 2 formula rotations, very useful in all Games
And use of a callback
And a procedure of Soldat inconnu to a mixture of color, in the cabin of the fisherman's hut ... (untranslatable reference to Francis Cabrel, singer)

, Bottled by Dobro and Co :)

ps: FYI the color of the clock tower should change depending on the time of day :)
and retains its position if you move ... (To put in the Startup folder of the Start menu ... but it's not required :))
clicking with the right mouse button to exit the clock

Code: Select all

; Code : Dobro
; PureBasic 4.01  ; ça date , mais ça marche toujours en 4.61 !! et meme sur Seven :o)
; Horloge Tectonic (j?étais en avance sur mon temps LOL
; dans ce code : comment faire une fenêtre ronde.. piqué au Soldat inconnu
; comment faire disparaitre le prg de la barre des taches
; 2 formule de calcul de rotations, tres utile dans tout les Jeux Video
; utilisation d'un callback
; une procédure du Soldat pour faire un mélange de couleur , dans la cabane du pécheur ...

;***********************************************
;Titre  :Horloge Tectonic
;Auteur  : Dobro
;Date  :28/08/2013
;Heure  :16:17:10
;Version Purebasic :  PureBasic 5.11 (Windows - x86)
;Version de l'editeur :EPB V2.40
; Libairies necessaire : Aucune 
;***********************************************


Enumeration
	#fenetre
	#rond
	#petitrond
	#moyenrond
	#Image
	#Text_0
	#dobro
	#minute
	#Police
	#Police2
EndEnumeration
#CAPTUREBLT = $40000000

Declare.f RotationX(x, angle.f, dist)
Declare.f RotationY(y, angle.f, dist)
Declare  Forme(fenetre,forme)
Declare RemoveFromTaskbar(hwnd)
Declare WindowCallback( WindowID ,message,wParam,lParam)
Declare dessin_horloge()
Declare.l ColorBlending(Couleur1.l, Couleur2.l, Echelle.f)
; *********** initialisation *********
Global rezX=200
Global rezy=200
Global xa=rezy/2
Global ya=rezy/2
Global distance=rezy/2-4
Global Perdu=0 ; defini si l'on perds le focus !!
Global Sprite=200
Global degress,degresm,degresh, tops, topm, toph,Pos_wx,Pos_wy, pas,tour_col,compteur
Global coul_dep_matin,coul_arr_matin,coul_dep_amidi,coul_arr_amidi,coul_dep_soir,coul_arr_soir,coul_dep_nuit,coul_arr_nuit
Global  tour,i8,c_r,c_v,c_b,memheure




Global NewList buffer.l ()
; matin
coul_dep_matin=RGB($35,$35,$FF) ; bleu_nuit
coul_arr_matin=RGB(255,255,0); au jaune
;apres midi
coul_dep_amidi=RGB(255,255,0) ; du jaune
coul_arr_amidi=RGB($FF,$80,$40) ; a l'orange
;soir
coul_dep_soir=RGB($FF,$80,$40) ; de l'orange
coul_arr_soir=RGB($E7,$3A,$AA) ; au mauve
;nuit
coul_dep_nuit=RGB($E7,$3A,$AA) ; au mauve
coul_arr_nuit=RGB($35,$35,$FF) ; bleu_nuit

Global date
Global Heure
Global Minute
Global Seconde
Global degress,degresm,degresh



date = Date()
Heure=Hour(date) 
nombre_minute=Heure*60+Minute(date) 
nombre_heure=nombre_minute/60 
tour= nombre_minute

LoadFont(#Police, "Comic Sans MS", 8) ; police de la signature
LoadFont(#Police2, "Comic Sans MS", 12) ; police de l'heure


Structure sprite2
	x.l
	y.l
	vitesse.l
	couleur_r.l
	couleur_v.l
	couleur_b.l
EndStructure
Global Dim sprite2.sprite2(Sprite)

ExamineDesktops ()

For i=1 To Sprite-1
	sprite2(i)\x=Random(rezX)+1
	sprite2(i)\y=Random(rezy)+1
	sprite2(i)\vitesse=Random(5)+1
	sprite2(i)\ couleur_r=Random(255)+50
	sprite2(i)\ couleur_v=Random(255)+50
	sprite2(i)\ couleur_b=Random(255)+50
Next i




;  *************************************************************************
If OpenFile(1,"Horloge.ini")
	Pos_wx=Val(ReadString(1))
	Pos_wy=Val(ReadString(1))
	CloseFile(1)
EndIf


OpenWindow( #fenetre, 0,0, rezX, rezy,  "Horloge",#PB_Window_BorderLess ) ; on ouvre une fenetre
Handle=WindowID(#fenetre)
SetWindowColor(#fenetre, RGB(0,0,0))

SetWindowCallback (@WindowCallback()) ; un callback pour que le dessin reste sur la fenetre (repaint)

RemoveFromTaskbar(FindWindow_(#fenetre,"Horloge")) ; fait disparaitre la fenetre de la barre des taches

Forme (#fenetre,2); ronde
ResizeWindow( #fenetre,Pos_wx,Pos_wy,rezX,rezy)

Repeat ; boucle principale 
	;
	; *************************
	
	date = Date()
	Heure=Hour(date)
	Minute = Minute(date)
	Seconde=Second(date)
	
	Event=WindowEvent() ; on regarde si quelqu'un a cliqué sur la croix pour quitter
	If Event <>0
		
	EndIf
	If  Event=  #WM_MOUSEFIRST  Or Event= #PB_Event_ActivateWindow  Or Event=49310  ; la souris est sur l'horloge
	EndIf
	
	Select Event
		Case #WM_LBUTTONDOWN ; deplace fenetre   
		SendMessage_(WindowID(#fenetre), #WM_NCLBUTTONDOWN, #HTCAPTION, 0)     
		Case #WM_RBUTTONDOWN  ; click droit sur l'horloge
		Pos_wx = WindowX(#fenetre)
		Pos_wy = WindowY(#fenetre)
		
		OpenFile(1,"Horloge.ini")
		WriteStringN(1,Str(Pos_wx))
		WriteStringN(1,Str(Pos_wy))
		CloseFile(1)
		End
	EndSelect
	If Memsecond<>Seconde
		SendMessage_(WindowID(#fenetre), #dobro, #HTCAPTION, 0) ; chaque seconde on envoi un message #dobro
	EndIf
	Memsecond=Seconde
	
	If Memminute<>Minute
		SendMessage_(WindowID(#fenetre), #minute, #HTCAPTION, 0) ; chaque minute on envoi un message #minute
	EndIf
	Memminute=Minute
	
	; ***************************************************   
	
	dessin_horloge()
ForEver  ;

Return

Procedure.f RotationX(x, angle.f, dist)
	ProcedureReturn x + Cos(angle.f*#PI/180)*dist
EndProcedure


Procedure.f RotationY(y, angle.f, dist)
	ProcedureReturn y + Sin(angle.f*#PI/180)*dist
EndProcedure


Procedure Forme(fenetre,forme) 
	If forme=2 ; si on a choisi la forme 2 Ronde
		Region = CreateEllipticRgn_( 0,  0, WindowHeight(#fenetre), WindowHeight(#fenetre)) ; Création de la région pour faire une fenêtre ronde !!!
		SetWindowRgn_(WindowID(#fenetre), Region, #True) ; On applique la région
		DeleteObject_(Region) ; On supprime la région
	EndIf
EndProcedure


Procedure RemoveFromTaskbar(hwnd)
	If IsWindow_(hwnd)
		a=hwnd : b=GetWindowLong_(a,#GWL_HWNDPARENT) : If b<>0 : a=b : EndIf
		ShowWindow_(a,#SW_HIDE) : GetWindowRect_(a,win.RECT) : w=win\right-win\left : h=win\bottom-win\top
		SetWindowLong_(a,#GWL_EXSTYLE,#WS_EX_TOOLWINDOW) :  SetWindowPos_(a,0,0,0,w-1,h-1,#SWP_NOMOVE)
		SetWindowPos_(a,0,0,0,w,h,#SWP_NOMOVE|#SWP_SHOWWINDOW) : ProcedureReturn 1
	EndIf
EndProcedure



Procedure WindowCallback( WindowID ,message,wParam,lParam) 
	RES= #PB_ProcessPureBasicEvents 
	If message= #WM_PAINT ; on repaint la fenetre     
		dessin_horloge()
		ElseIf message= #WM_MOVE ; au cas ou l'on bouge la fenetre
		; ******** dessin du rond d'effacement *************
		StartDrawing(WindowOutput(#fenetre))
			Circle(xa, ya, 100 ,RGB(0,0,0)) 
		StopDrawing()   
		; **********************************************
		
		; ********* dessin des etoiles *************
		For i=1 To Sprite-1
			sprite2(i)\y=sprite2(i)\y+sprite2(i)\vitesse
			If sprite2(i)\y>WindowHeight(#fenetre)
				sprite2(i)\y=0
			EndIf 
			StartDrawing(WindowOutput(#fenetre))
				Circle(sprite2(i)\x,sprite2(i)\y,1,RGB(sprite2(i)\ couleur_r,sprite2(i)\ couleur_v,sprite2(i)\ couleur_b))   
			StopDrawing()
		Next i
		; ******************************************
		dessin_horloge()
		ElseIf message =#dobro  ; chaque seconde 
		
		date = Date()
		Heure=Hour(date) 
		nombre_minute=Heure*60+Minute(date) 
		nombre_heure=nombre_minute/60 
		tour= (nombre_minute/6)
		
		If (nombre_minute>=420) And  (nombre_minute<=720) ;(de 7 a 12 h)
			tour_col=ColorBlending( coul_arr_matin,coul_dep_matin, tour)  ; matin  /360 car 24/4=6 ,  60*6=360
			ElseIf (nombre_minute=>780) And  (nombre_minute<=1080) ;(de 13 a 18h)
			tour_col=ColorBlending( coul_arr_amidi,coul_dep_amidi, tour)  ; apres-midi
			ElseIf (nombre_minute=>1140) And  (nombre_minute<=1440) ;(de 19 a 00h)
			tour_col=ColorBlending( coul_arr_soir,coul_dep_soir, tour)  ; soir
			ElseIf (nombre_minute>=0) And  (nombre_minute<=360) ;(de 00 a 06h)
			tour_col=ColorBlending( coul_arr_nuit,coul_dep_nuit, tour)  ; nuit
		EndIf
		
		; ******** dessin du rond d'effacement *************
		StartDrawing(WindowOutput(#fenetre))
			Circle(xa, ya, 100 ,RGB(0,0,0)) 
		StopDrawing()
		
		; **********************************************
		
		; ********* dessin des etoiles *************
		
		For i=1 To Sprite-1
			sprite2(i)\y=sprite2(i)\y+sprite2(i)\vitesse
			If sprite2(i)\y>WindowHeight(#fenetre)
				sprite2(i)\y=0
			EndIf 
			StartDrawing(WindowOutput(#fenetre))
				Circle(sprite2(i)\x,sprite2(i)\y,2,RGB(sprite2(i)\ couleur_r,sprite2(i)\ couleur_v,sprite2(i)\ couleur_b))   
			StopDrawing()
		Next i
		; ******************************************
		
		ElseIf  message =#minute  ; chaque minute   
		
		Else   
		ProcedureReturn #PB_ProcessPureBasicEvents ; rend la main ! 
	EndIf
EndProcedure



;{ ****************** dessin de l'horloge **********************
Procedure dessin_horloge()   
	
	; ********************************************************
	;                     AFFICHE LES AIGUILLES
	;*********************************************************
	degress=Seconde*6
	; Ici, le code affiche les secondes
	xs= RotationX(xa, degress-90, distance)
	Ys= RotationY(ya, degress-90, distance) 
	; aiguille des secondes
	StartDrawing(WindowOutput(#fenetre))
		LineXY(xa, ya, xs, Ys , RGB($E9,$32,$92)) ; les secondes rouge
		For i=-2 To 2
			LineXY(xa+i, ya+i, xs, Ys , RGB($E9,$32,$92)) ; les secondes rouge
		Next i
	StopDrawing()
	
	; Ici, le code  affiche les minutes
	degresm =Minute*6
	xm= RotationX(xa, degresm-90, distance-25)
	Ym= RotationY(ya, degresm-90, distance-25) 
	; aiguille des minute
	StartDrawing(WindowOutput(#fenetre))
		LineXY(xa, ya, xm, Ym , RGB($5,$E2,$B6)) ; les minutes verte
		For i=-2 To 2
			LineXY(xa+i, ya+i, xm, Ym , RGB($5,$E2,$B6)) ; les secondes rouge
		Next i
	StopDrawing()
	
	; Ici, le code  affiche  les heures
	degresh =Heure*6*5
	xh= RotationX(xa, degresh-90, distance-50)
	Yh= RotationY(ya, degresh-90, distance-50) 
	; aiguille des heures
	StartDrawing(WindowOutput(#fenetre))
		LineXY(xa, ya, xh, Yh , RGB($F5,$F9,$6A)) ; les heures  jaune
		For i=-2 To 2
			LineXY(xa+i, ya+i, xh, Yh , RGB($F5,$F9,$6A)) ; les secondes rouge
		Next i
	StopDrawing()
	; ********************************************************
	;*********************************************************
	
	
	
	StartDrawing(WindowOutput(#fenetre))
		DrawingMode(#PB_2DDrawing_Transparent)
		DrawingFont(FontID(#Police))
		DrawText(xa-TextWidth("By Dobro")/2, rezy/2+50,"By Dobro", tour_col,RGB($0,$0,$0))
		DrawingFont(FontID(#Police2))
		DrawText(ya-TextWidth(  FormatDate("%hh:%ii:%ss", Date())  )/2, rezy/2,  FormatDate("%hh:%ii:%ss", Date())   ,RGB($FF,$FF,$59),RGB($0,$0,$0))
	StopDrawing()   
	For a=1 To 60
		degres =degres+6 : If degres=360:degres=0:EndIf : ; cela fait tourner
		xc= RotationX(xa, degres, distance)
		Yc= RotationY(ya, degres, distance)   
		quart=quart+1
		If quart=15
			quart=0   
			StartDrawing(WindowOutput(#fenetre))
				Circle(xc,Yc,8,RGB($FF,$2D,$2D))
			StopDrawing()
		EndIf
		
		
		
		; ***************** Coloration du Tour *************************** 
		c_r = Red(tour_col)
		c_v = Green(tour_col)
		c_b = Blue(tour_col) ;
		
		c_rmem=c_r
		c_vmem=c_v
		c_bmem=c_b
		mem_tour_col=  tour_col
		
		c_v=c_v+8
		If c_v>250
			c_v= 1
		EndIf
		
		c_b=c_b+8
		If c_b>250
			c_b= 1
			Delay(25)
		EndIf
		
		tour_col=RGB(c_r, c_v, c_b)
		
		StartDrawing(WindowOutput(#fenetre))
			Circle(xc,Yc,4,tour_col)
		StopDrawing()
		
		; **************************************************
		
		
		min2=min2+1
		If min2=5
			StartDrawing(WindowOutput(#fenetre))
				Circle(xc,Yc,4,RGB($E7,$F0,$39))
			StopDrawing()
			min2=0
		EndIf 
	Next a 
	
EndProcedure
;} ****************************************************************************


; Mélanger 2 couleurs
ProcedureDLL.l ColorBlending(Couleur1.l, Couleur2.l, Echelle.f)
	;Soldat inconu
	Protected rouge, vert, bleu, Rouge2, Vert2, Bleu2
	
	rouge = Couleur1 & $FF
	vert = Couleur1 >> 8 & $FF
	bleu = Couleur1 >> 16
	Rouge2 = Couleur2 & $FF
	Vert2 = Couleur2 >> 8 & $FF
	Bleu2 = Couleur2 >> 16
	
	rouge = Sqr(rouge * rouge * Echelle + Rouge2 * Rouge2 * (1 - Echelle))
	vert = Sqr(vert * vert * Echelle + Vert2 * Vert2 * (1 - Echelle))
	bleu = Sqr(bleu * bleu * Echelle + Bleu2 * Bleu2 * (1 - Echelle))
	
	ProcedureReturn (rouge | vert <<8 | bleu << 16)
EndProcedure

; EPB

Re: the Tectonic Clock

Posted: Thu Sep 12, 2013 1:01 am
by BasicallyPure
I found this lonely posting a while back and thought it looked like a diamond in the rough.
Going with the philosophy that you just can't have too many clocks I started polishing the code from dobro's original posting.
Now IMHO the diamond has a nicer shine.

I have been using this on my desktop as a replacement for the windows clock gadget.
I just added shortcut in the startup folder.

CPU usage has been reduced to acceptable levels and I got rid of some annoying flicker.
While the code has changed a lot I have preserved most of the original characteristics.
I added a few new features.
Use a right mouse click on the clock face to access the pop up menu.

Thanks to dobro for the original concept.

BP

Image

Code: Select all

; Code : Dobro
; PureBasic 4.01  ; ça date , mais ça marche toujours en 4.61 !! et meme sur Seven :o)
; Horloge Tectonic (j’étais en avance sur mon temps LOL 
; dans ce code : comment faire une fenêtre ronde.. piqué au Soldat inconnu
; comment faire disparaitre le prg de la barre des taches
; 2 formule de calcul de rotations, tres utile dans tout les Jeux Video
; utilisation d'un callback
; une procédure du Soldat pour faire un mélange de couleur , dans la cabane du pécheur ...
; forum: http://www.purebasic.fr/english/viewtopic.php?f=12&t=51149
;
; modified by BasicallyPure 9/8/2013
; PureBasic 5.20
; Windows only

;{ Main
EnableExplicit

;{ procedure declarations
Declare Init_GUI()
Declare EventLoop(TopState)
Declare RemoveFromTaskbar(hwnd)
Declare WindowCallback(hWin , message, wParam, lParam)
Declare dessin_horloge()
Declare DrawRim()
Declare Update_ini()
;}

;{ constants
#Win_0     = 0
#Police1   = 1
#Police2   = 2
#rezX      = 201
#rezY      = 201
#xa        = #rezX/2
#ya        = #rezY/2
#Radius    = #ya - 6
#Balls     = 200
#PopUpMenu = 0
#MenuChoice_OnTop  = 0
#MenuChoice_Second = 1
#MenuChoice_Quit   = 2
;}

Structure BallType
   x.l
   y.l
   vitesse.l
   couleur_r.l
   couleur_v.l
   couleur_b.l 
EndStructure

Global Dim ball.BallType(#Balls)
Global SecondHand.i

EventLoop(Init_GUI())

End
;}


Procedure Init_GUI()
   Protected Pos_wx, Pos_wy, Region, TopState, i
   
   LoadFont(#Police1, "Comic Sans MS", 8) ; police de la signature
   
   If OpenFile(1,"Horloge.ini")
      Pos_wx = Val(ReadString(1))
      Pos_wy = Val(ReadString(1))
      TopState = Val(ReadString(1))
      SecondHand = Val(ReadString(1))
      CloseFile(1)
   EndIf
   
   For i = 1 To #Balls - 1
      ball(i)\x = Random(#rezX-1)
      ball(i)\y = Random(#rezY-1)
      ball(i)\vitesse = Random(5) + 1
      ball(i)\ couleur_r = Random(230) + 25
      ball(i)\ couleur_v = Random(230) + 25
      ball(i)\ couleur_b = Random(230) + 25
   Next i
   
   If OpenWindow(#Win_0, Pos_wx, Pos_wy, #rezX, #rezY, "Horloge",#PB_Window_BorderLess ) ; on ouvre une fenetre
      StickyWindow(#Win_0, TopState)
      SetWindowColor(#Win_0, 0)
      CanvasGadget(1,0,0,#rezX,#rezY)
      AddWindowTimer(#Win_0, 0, 100)
      
      CreatePopupMenu(#PopUpMenu)
         MenuItem(#MenuChoice_OnTop, "Always on top")
         MenuItem(#MenuChoice_Second, "Show second hand")
         MenuItem(#MenuChoice_Quit,"Quit")
      
      SetMenuItemState(#PopUpMenu, #MenuChoice_OnTop, TopState)
      SetMenuItemState(#PopUpMenu, #MenuChoice_Second, SecondHand)
      
      SetWindowCallback(@WindowCallback()) ; un callback pour que le dessin reste sur la fenetre (repaint) 
      
      RemoveFromTaskbar(FindWindow_(#Win_0,"Horloge")) ; fait disparaitre la fenetre de la barre des taches
      
      Region = CreateEllipticRgn_(0, 0, WindowHeight(#Win_0), WindowWidth(#Win_0)) ; Création de la région pour faire une fenêtre ronde !!!
      SetWindowRgn_(WindowID(#Win_0), Region, #True) ; On applique la région
      DeleteObject_(Region) ; On supprime la région 
      
      ProcedureReturn TopState
   Else
      ProcedureReturn -1
   EndIf
EndProcedure


Procedure EventLoop(TopState)
   Protected OffsetX, OffsetY, drag, Event, Quit = #False
   
   If TopState = -1 : Quit = #True : EndIf
   
   Repeat
      Event = WaitWindowEvent() ; on regarde si quelqu'un a cliqué sur la croix pour quitter
      
      If drag ; move the window
         ResizeWindow(#Win_0,DesktopMouseX()-OffsetX,DesktopMouseY()-OffsetY,#PB_Ignore,#PB_Ignore)
      EndIf
      
      Select Event
         Case #PB_Event_Menu
            Select EventMenu()
               Case #MenuChoice_OnTop : TopState ! 1
                  StickyWindow(#Win_0, TopState)
                  SetMenuItemState(#PopUpMenu, #MenuChoice_OnTop, TopState)
                  Update_ini()
               Case #MenuChoice_Second : SecondHand ! 1
                  SetMenuItemState(#PopUpMenu, #MenuChoice_Second, SecondHand)
                  Update_ini()
               Case #MenuChoice_Quit
                  Quit = #True
            EndSelect
         Case #PB_Event_Timer
            dessin_horloge()
         Case #PB_Event_Gadget
            If EventGadget() = 1
               Select EventType()
                  Case #PB_EventType_LeftButtonDown
                     drag = #True
                     OffsetX = DesktopMouseX() - WindowX(#Win_0)
                     OffsetY = DesktopMouseY() - WindowY(#Win_0)
                  Case  #PB_EventType_LeftButtonUp
                     drag = #False
                     Update_ini()
                  Case #PB_EventType_RightButtonUp
                     DisplayPopupMenu(#PopUpMenu, WindowID(#Win_0))
               EndSelect
            EndIf
      EndSelect
      
   Until Quit = #True
EndProcedure


Procedure RemoveFromTaskbar(hwnd)
   Protected a, b, w, h, win.RECT
   If IsWindow_(hwnd)
      a = hwnd : b = GetWindowLong_(a,#GWL_HWNDPARENT) : If b<>0 : a=b : EndIf
      ShowWindow_(a,#SW_HIDE) : GetWindowRect_(a,win.RECT) : w = win\right-win\left : h = win\bottom-win\top
      SetWindowLong_(a,#GWL_EXSTYLE,#WS_EX_TOOLWINDOW) :  SetWindowPos_(a,0,0,0,w-1,h-1,#SWP_NOMOVE)
      SetWindowPos_(a,0,0,0,w,h,#SWP_NOMOVE|#SWP_SHOWWINDOW) : ProcedureReturn 1
   EndIf
EndProcedure


Procedure WindowCallback(hWin , message, wParam, lParam)
   Protected i
   
   If message = #WM_MOVE ; au cas ou l'on bouge la fenetre
      ; ******** dessin du rond d'effacement *************
      StartDrawing(CanvasOutput(1))
         Box(0,0,OutputWidth(),OutputHeight(),0)
         
         ; ********* dessin des etoiles *************
         With ball(i)
            For i = 1 To #Balls-1
               \y + \vitesse
               If \y > OutputHeight() : \y=0 : EndIf
               Circle(\x,\y, 1, RGB(\couleur_r, \couleur_v, \couleur_b))
            Next i
         EndWith
         DrawRim()
      StopDrawing()
      ; ******************************************
      
   Else
      ProcedureReturn #PB_ProcessPureBasicEvents
   EndIf 
EndProcedure 


Procedure DrawRim()
   Protected degres, xc, yc, c_r, c_v, c_b, i
   Static tour_col
   
   For degres = 0 To 354 Step 6
      xc = #xa + Cos(Radian(degres)) * (#Radius)
      Yc = #ya + Sin(Radian(degres)) * (#Radius)
      
      ; ***************** Coloration du Tour ***************************  
      c_r = Red(tour_col)
      c_v = Green(tour_col)
      c_b = Blue(tour_col)
      
      c_r + 4 : c_v + 8 : c_b + 8
      If c_r > 247 : c_r = 1 : EndIf
      If c_v > 247 : c_v = 1 : EndIf
      If c_b > 247 : c_b = 1 : EndIf
      
      tour_col = RGB(c_r, c_v, c_b)
      
      ; **************************************************
      
      If degres % 30
         Circle(xc, Yc, 4, tour_col)
      Else
         Circle(xc, Yc, 4, $39F0E7) ; 5 minute mark
      EndIf
      
   Next degres
   
   For degres = 0 To 270 Step 90
      xc = #xa + Cos(Radian(degres)) * (#Radius-3)
      Yc = #ya + Sin(Radian(degres)) * (#Radius-3)
      Circle(xc, Yc, 8, $2D2DFF)
      Circle(xc, Yc, 4, $39F0E7)
   Next degres
   
EndProcedure


Procedure dessin_horloge()
   ; ********************************************************
   ;                     AFFICHE LES AIGUILLES
   ;*********************************************************
   
   Macro DrawHand(angle, radius, color, sec=0)
         xs = #xa + Cos(angle) * radius
         Ys = #ya + Sin(angle) * radius
         
         If sec
            LineXY(#xa,#ya,xs,ys,$9232E9) ; single line for second hand
         Else
            x1 = #xa + Cos(angle - hPI) * 3
            x2 = #xa + Cos(angle + hPI) * 3
            y1 = #ya + Sin(angle - hPI) * 3
            y2 = #ya + Sin(angle + hPI) * 3
            LineXY(x1, y1, xs, ys, color)
            LineXY(x2, y2, xs, ys, color)
            LineXY(x1, y1, x2, y2, color)
            FillArea(#xa + Sign(xs-#xa), #ya + Sign(ys-#ya), color, color)
         EndIf
   EndMacro
   
   Static.f x1, x2, y1, y2
   Static xs, ys, i, xm, ym, xh, yh, tour_col, lastSecond
   Static sRadius = #Radius - 12, mRadius = #Radius - 25, hRadius = #Radius - 50, hPI.f = #PI/2
   Protected date = Date()
   Protected Seconde = Second(date)
   
   If Seconde = lastSecond
      StartDrawing(CanvasOutput(1))
         DrawRim()
      StopDrawing()
      ProcedureReturn
   Else
      lastSecond = Seconde
   EndIf
   
   Protected Minute.i  = Minute(date)
   Protected Hour.i  = Hour(date) ; AMPM needs integer
   Protected Heure.f = Hour + Minute / 60.0 ; positon of hour hand needs float
   Protected dText.s, AMPM.s
   
   If Hour/12 : AMPM = " PM" : Else : AMPM = " AM" : EndIf
   If Hour : If Hour > 12 : Hour - 12 : EndIf : Else : Hour = 12 : EndIf
   
   dText = Str(Hour) + ":" + FormatDate("%ii:%ss",date) + AMPM
   
   StartDrawing(CanvasOutput(1))
      Box(0,0,OutputWidth(),OutputHeight(),0) ; erase clock face
      
      DrawRim()
      
      With ball(i) ; draw the falling balls
         For i = 1 To #Balls - 1
            \y + \vitesse
            If \y >= OutputHeight() : \y = 0 : EndIf
            Circle(\x, \y, 1, RGB(\couleur_r, \couleur_v, \couleur_b))
         Next i
      EndWith
      
      If SecondHand
         DrawHand(Radian(Seconde*6 - 90), sRadius, $9232E9, 1)
      EndIf
      DrawHand(Radian(Minute*6  - 90), mRadius, $B6E205)
      DrawHand(Radian(Heure*30  - 90), hRadius, $6AF9F5)
      Circle(#xa, #ya, 6, $30BDB1)
      
      DrawingMode(#PB_2DDrawing_Transparent)
      DrawingFont(FontID(#Police1))
      DrawText(#xa - TextWidth(dText)/2, #ya+45, dText, #White)
      
   StopDrawing()
EndProcedure


Procedure Update_ini()
   If OpenFile(1,"Horloge.ini")
      WriteStringN(1,Str(WindowX(#Win_0)))
      WriteStringN(1,Str(WindowY(#Win_0)))
      WriteStringN(1,Str(GetMenuItemState(#PopUpMenu, #MenuChoice_OnTop)))
      WriteStringN(1,Str(SecondHand))
      CloseFile(1)
      ProcedureReturn 1
   Else
      ProcedureReturn 0
   EndIf
EndProcedure

Re: the Tectonic Clock

Posted: Thu Sep 12, 2013 1:32 am
by IdeasVacuum
Great code 8) - very difficult to look at the clock after a while :mrgreen:

Re: the Tectonic Clock

Posted: Thu Sep 12, 2013 10:39 am
by dobro
Thanks :)

Re: the Tectonic Clock

Posted: Thu Sep 12, 2013 11:43 am
by davido
Very nice.
Thank you for sharing. :D
All times are UTC+01:00
Page 1 of 1

Powered by phpBB® Forum Software © phpBB Limited