Ecran de veille : Horloge analogique 24h.
Publié : ven. 03/juil./2026 16:37
Bonjour à tous,
Voici une horloge originale que j’affectionne tout particulièrement.
C'est un écran de veille qui utilise le module "ScreenSaver.pb" publié précédemment .
C'est avec grand plaisir que Je la partage.
Compilez en la nomant "Horloge 24h.exe" et remplacer ".exe" par ".scr" puis clic gauche sur "Horloge 24h.scr" et installer
C'est tout.
Voici une horloge originale que j’affectionne tout particulièrement.
C'est un écran de veille qui utilise le module "ScreenSaver.pb" publié précédemment .
C'est avec grand plaisir que Je la partage.
Compilez en la nomant "Horloge 24h.exe" et remplacer ".exe" par ".scr" puis clic gauche sur "Horloge 24h.scr" et installer
C'est tout.
Code : Tout sélectionner
; Horloge analogique 24h pour un tour de cadran avec deux aiguilles.
; Une seule aiguille pour les heures et une trotteuse.
; Windows 11
; PB 6.40
;-Module ScreenSaver
;{ Version 20260628
DeclareModule ScreenSaver
; ******** Constantes et variables Publiques ***************
; ******** Declaration des procedures Publiques ***************
Declare .a CheckStatus ( )
Declare Start ( saverName.s )
Declare Stop ( )
Declare .i GetWinSaver ( )
Declare .i GetWinPreview ( )
Declare .a IsScreenSaverMode ( )
Declare .s GetParameter ( )
Declare .f GetRatioX ( )
Declare .f GetRatioY ( )
EndDeclareModule
Module ScreenSaver
; ******** Constantes et variables privées ***************
Enumeration
#ScreenSaverMode
#PreviewMode
EndEnumeration
Global width .l
Global height .l
Global RatioX .f
Global RatioY .f
Global SaverMode .b
Global previewWndHandleStr$ = ""
; ******** Procedures Privées ***************
; ******** Procedures Publiques ************
;************************************************************************************
; Garantit qu'une seule instance du programme sera lancée
; Parameters: Nom de l'économiseur (utilisé pour nommer le mutex)
;************************************************************************************
Procedure Start(saverName.s)
Shared OnlyOneStartMutex.l
Protected OnlyOneStartError.l
*MutexName = @saverName
OnlyOneStartMutex = CreateMutex_(0, 1, *MutexName)
OnlyOneStartError = GetLastError_()
If OnlyOneStartMutex <> 0 And OnlyOneStartError = 0
ProcedureReturn 1
Else
CloseHandle_(OnlyOneStartMutex)
End
EndIf
EndProcedure
;************************************************************************************
; Libérer le mutex pour permettre le lancement d'une autre instance
;************************************************************************************
Procedure Stop()
SystemParametersInfo_ ( #SPI_SCREENSAVERRUNNING , 0 , @oldval , 0 ) ; Indiquez au système que l'économiseur d'écran n'est plus en fonction
CloseHandle_(OnlyOneStartMutex)
EndProcedure
;************************************************************************************
; En mode économiseur d'écran, recherchez toute action de l'utilisateur
; Return-Value: 1 si quelque chose a bougé depuis la dernière boucle
;************************************************************************************
Procedure .a CheckStatus ( )
If saverMode = #ScreenSaverMode
ExamineKeyboard() : ExamineMouse()
If MouseDeltaX() Or MouseDeltaY() Or KeyboardPushed(#PB_Key_All) Or MouseButton(#PB_MouseButton_Left) Or MouseButton(#PB_MouseButton_Right)
ProcedureReturn 1
EndIf
If GetActiveWindow() = ScreenID()
ProcedureReturn 1
EndIf
EndIf
ProcedureReturn 0
EndProcedure
;************************************************************************************
; Passe en mode Ecran de veille et en informe Windows
; Return-Value: Identifiant de la fenêtre créée en mode plein écran
;************************************************************************************
Procedure .i GetWinSaver ( )
saverMode = #ScreensaverMode
SystemParametersInfo_ ( #SPI_SCREENSAVERRUNNING , 1 , @oldval , 0 )
ExamineDesktops ( )
RatioX = 1.0
RatioY = 1.0
ProcedureReturn OpenWindow ( #PB_Any , 0 , 0 , DesktopWidth( 0 ) , DesktopHeight( 0 ) , "" , #PB_Window_BorderLess )
EndProcedure
;************************************************************************************
; Passe en mode previsualisation et crée une fenêtre fille
; Return-Value: Identifiant de la fenêtre créée en mode previsualisation
;************************************************************************************
Procedure .i GetWinPreview ( )
saverMode = #PreviewMode
DisplayHwnd = Val ( previewWndHandleStr$ )
GetClientRect_ ( DisplayHwnd , @PSize.RECT )
width = PSize\right
height = PSize\bottom
ExamineDesktops ( )
RatioX = width / DesktopWidth ( 0 )
RatioY = height / DesktopHeight ( 0 )
ProcedureReturn OpenWindow ( #PB_Any , 0 , 0 , width , height , "" , #WS_CHILD , DisplayHwnd )
EndProcedure
;************************************************************************************
; Teste si l'on se trouve en mode Ecran de veille
; Return-Value: 1 si oui, 0 si non
;************************************************************************************
Procedure .a IsScreenSaverMode ( )
ProcedureReturn Bool( SaverMode = #ScreenSaverMode )
EndProcedure
; ***************************************************************
; Pour prévisualiser l'écran de veille Windows lance l'application
; en lui passant -P, /P ou P en premier paramètre.
;
; Pour la configuration, les paramètres sont par exemple -> /C:3606164
; Le second paramètre est le Handle de la fenêtre dans laquelle doit s'afficher l'écran de veille.
;
; Les paramètres peuvent commencer par un - ou un /
; Entre le premier et le deuxième paramètre il peut y avoir un deux-points ou un espace.
; S'ils sont connectés par deux points, PB ne le reconnaît pas comme deux paramètres, et enregistre les deux dans Parametre1
; ***************************************************************
Procedure .s GetParameter ( )
Protected .s Parameter$ = ProgramParameter( 0 )
If Len( Parameter$ ) > 2 ; Deux paramètres en un "/C:3606164"
previewWndHandleStr$ = RemoveString ( Parameter$ , Left( Parameter$ , 3 ) , 1 )
Parameter$ = RemoveString ( Parameter$ , Left( Parameter$ , 1 ) , 1 )
Parameter$ = Left ( Parameter$ , 1 )
Else ; Deux paramètres séparé -> /p /12345
If Len( Parameter$ ) > 1
Parameter$ = RemoveString ( Parameter$ , Left( Parameter$ , 1 ) , 1 )
EndIf
previewWndHandleStr$ = ProgramParameter( 1 )
If FindString ( previewWndHandleStr$ , "-" , 0 ) <> 0 : previewWndHandleStr$ = RemoveString ( previewWndHandleStr$ , "-" , 1 ) : EndIf
If FindString ( previewWndHandleStr$ , "/" , 0 ) <> 0 : previewWndHandleStr$ = RemoveString ( previewWndHandleStr$ , "/" , 1 ) : EndIf
EndIf
ProcedureReturn Parameter$
EndProcedure
;************************************************************************************
; Calcule le facteur d'échelle
; Un GetWinSaver() ou GetWinPreview() doit être appelé.
; Return-Value: Le raport de la fenêtre retournée par rapport au plein écran
;************************************************************************************
Procedure .f GetRatioX ( )
ProcedureReturn RatioX
EndProcedure
Procedure .f GetRatioY ( )
ProcedureReturn RatioY
EndProcedure
; ******* Initialisation *******
InitKeyboard ( )
InitMouse ( )
EndModule
;}
;-Obj Horloge Analogique 24h
;{ Version 20260628
;
; L'horloge s'ajuste dans une Window, une ImageGadget ou un CanvasGadget
; elle s'adaptera automatiquement aux dimensions de celle-ci.
; Win_0 = OpenWindow ( #PB_Any , #PB_Ignore , #PB_Ignore , 300 , 200 , Titre , Option )
;
; ImageHorlogeAnalogique = ImageGadget ( #PB_Any , 0 , 0 , WindowWidth(Win_0) , WindowHeight(Win_0) , 0 )
; ImageHorlogeAnalogique = CanvasGadget ( #PB_Any , 0 , 0 , WindowWidth(Win_0) , WindowHeight(Win_0) )
; ImageHorlogeAnalogique = Win_0
Interface NewObj_Horloge
NewAiguille ( Typ.s )
AddPointAiguille ( Typ.s , Dx.w , Dy.w )
AddPointFill ( Typ.s , Dx.w , Dy.w )
SetColor ( Typ.s , Coul.i )
SetTime ( Time.q )
SetTexte ( Nom.s , Dx.w , Dy.w , Txt.s )
SetFont ( Txt.s , Dh.a , Styl.i )
SetSens ( SensRot.b )
Free ( )
EndInterface
Enumeration GadgetTyp
#PL_GadgetType_Canvas
#PL_GadgetType_Image
#PL_GadgetType_Screen
EndEnumeration
Structure Coordonnee
x .w
y .w
Ray .f
Arg .f
EndStructure
Structure Texte
x .w
y .w
Txt .s
EndStructure
Structure Obj_Horloge_Typ
*DSVT
Diametre .f
Rayon .f
RadParSeconde_H .f
;RadParSeconde_M .f
RadParSeconde_S .f
RadParSeconde .f
Sens .f
Couleur_H .l
;Couleur_M .l
Couleur_S .l
CouleurFond .l
CouleurRepereCadran .l
NbPointAigui .a ; Nombre maxi de coordonnées.
NbPointAigui_H .b
;NbPointAigui_M .b
NbPointAigui_S .b
NbPointFill_H .b
;NbPointFill_M .b
NbPointFill_S .b
Remplissage_H .b
;Remplissage_M .b
Remplissage_S .b
GadgetTyp .a
GadgetImage .i
CadranFond .i
CadranHorloge .i
DimX .l
DimY .l
RayonMini .w
RayonMaxi .w
RayonUnit .w
RayonMini_S .w
RayonMaxi_S .w
RayonUnit_S .w
OldSec .u
Police .i
PoliceStyle .i
PoliceTxt .s
TexteH .a
Array FillHeure .Coordonnee ( 1 )
;Array FillMinute .Coordonnee ( 1 )
Array FillSeconde .Coordonnee ( 1 )
Array AiguilleHeure .Coordonnee ( 1 )
;Array AiguilleMinute .Coordonnee ( 1 )
Array AiguilleSeconde .Coordonnee ( 1 )
Map MapTexte .Texte ( )
EndStructure
; Procedures Privees
Procedure .f GetAngleRad ( Dx.f , Dy.f )
Protected .f ValTmp
ValTmp = ATan2( Dx, Dy)
If ValTmp < 0 : ValTmp + ( 2* #PI ) : EndIf
ProcedureReturn ValTmp
EndProcedure
Procedure .f GetModule ( Dx.f , Dy.f )
ProcedureReturn Sqr( Dx*Dx + Dy*Dy )
EndProcedure
Procedure .w GetCoordX ( Modul.f , Argum.f )
ProcedureReturn Modul * Cos( Argum )
EndProcedure
Procedure .w GetCoordY ( Modul.f , Argum.f )
ProcedureReturn Modul * Sin( Argum )
EndProcedure
Procedure Obj_Horloge_CalcPtsAiguille ( *This.Obj_Horloge_Typ , Rad_H.f , Rad_M.f , Rad_S.f )
Protected .i i
With *This
For i = 0 To \NbPointAigui_H
\AiguilleHeure( i )\x = GetCoordX( \AiguilleHeure ( i )\Ray , \AiguilleHeure ( i )\Arg + Rad_H )
\AiguilleHeure( i )\y = GetCoordY( \AiguilleHeure ( i )\Ray , \AiguilleHeure ( i )\Arg + Rad_H )
Next
For i = 0 To \NbPointFill_H
\FillHeure( i )\x = GetCoordX( \FillHeure ( i )\Ray , \FillHeure ( i )\Arg + Rad_H )
\FillHeure( i )\y = GetCoordY( \FillHeure ( i )\Ray , \FillHeure ( i )\Arg + Rad_H )
Next
;For i = 0 To \NbPointAigui_M
; \AiguilleMinute( i )\x = GetCoordX( \AiguilleMinute ( i )\Ray , \AiguilleMinute ( i )\Arg + Rad_M )
; \AiguilleMinute( i )\y = GetCoordY( \AiguilleMinute ( i )\Ray , \AiguilleMinute ( i )\Arg + Rad_M )
;Next
;For i = 0 To \NbPointFill_M
; \FillMinute( i )\x = GetCoordX( \FillMinute ( i )\Ray , \FillMinute ( i )\Arg + Rad_M )
; \FillMinute( i )\y = GetCoordY( \FillMinute ( i )\Ray , \FillMinute ( i )\Arg + Rad_M )
;Next
For i = 0 To \NbPointAigui_S
\AiguilleSeconde( i )\x = GetCoordX( \AiguilleSeconde ( i )\Ray , \AiguilleSeconde ( i )\Arg + Rad_S )
\AiguilleSeconde( i )\y = GetCoordY( \AiguilleSeconde ( i )\Ray , \AiguilleSeconde ( i )\Arg + Rad_S )
Next
For i = 0 To \NbPointFill_S
\FillSeconde( i )\x = GetCoordX( \FillSeconde ( i )\Ray , \FillSeconde ( i )\Arg + Rad_S )
\FillSeconde( i )\y = GetCoordY( \FillSeconde ( i )\Ray , \FillSeconde ( i )\Arg + Rad_S )
Next
EndWith
EndProcedure
Procedure Obj_Horloge_DessineAiguille ( *This.Obj_Horloge_Typ )
Protected .i i
Protected .w X , Y , Dx , Dy
With *This
; FreeImage( \CadranHorloge )
; \CadranHorloge = CopyImage ( \CadranFond , #PB_Any )
; StartDrawing ( ImageOutput( \CadranHorloge ) )
SetOrigin ( \DimX / 2 , \DimY / 2 ) ; Place l'origine du tracé
DrawingMode( #PB_2DDrawing_Outlined )
If MapSize( \MapTexte() ) ; 20250707
FrontColor ( \CouleurFond ) ; 20250707
BackColor ( \CouleurRepereCadran ) ; 20250707
DrawingFont ( \Police ) ; 20250707
ForEach \MapTexte( )
X = \Rayon * \MapTexte()\x / 100 ; 20250707
Y = -\Rayon * \MapTexte()\y / 100 ; 20250707
Dx = TextWidth ( \MapTexte()\Txt ) / 2 ; 20250707
Dy = TextHeight( \MapTexte()\Txt ) / 2 ; 20250707
DrawText( X - Dx , Y - Dy , \MapTexte()\Txt ) ; 20250707
Next
EndIf ; 20250707
; Dessinne la seconde
FrontColor( \Couleur_S )
If \NbPointAigui_S > 0 ; Si l'Aiguille a plusieurs points
For i = 0 To \NbPointAigui_S - 1
LineXY( \AiguilleSeconde( i )\x , -\AiguilleSeconde( i )\y , \AiguilleSeconde( i + 1 )\x , -\AiguilleSeconde( i + 1 )\y )
Next
ElseIf \NbPointAigui_S = 0 ; Si l'Aiguille a un seul point
Circle ( \AiguilleSeconde( 0 )\x , -\AiguilleSeconde( 0 )\y , \RayonUnit )
EndIf
If \Remplissage_S = #True
For i = 0 To \NbPointFill_S
FillArea( \FillSeconde( i )\x , -\FillSeconde( i )\y , \Couleur_S )
Next
EndIf
; ; Dessinne la minute
; FrontColor( \Couleur_M )
; If \NbPointAigui_M > 0 ; Si l'Aiguille a plusieurs points
; For i = 0 To \NbPointAigui_M - 1
; LineXY( \AiguilleMinute( i )\x , -\AiguilleMinute( i )\y , \AiguilleMinute( i + 1 )\x , -\AiguilleMinute( i + 1 )\y )
; Next
; ElseIf \NbPointAigui_M = 0 ; Si l'Aiguille a un seul point
; Circle ( \AiguilleMinute( 0 )\x , -\AiguilleMinute( 0 )\y , \RayonUnit )
; EndIf
; If \Remplissage_M = #True
; For i = 0 To \NbPointFill_M
; FillArea( \FillMinute( i )\x , -\FillMinute( i )\y , \Couleur_M )
; Next
; EndIf
; Dessinne l'heure
FrontColor( \Couleur_H )
If \NbPointAigui_H > 0 ; Si l'Aiguille a plusieurs points
For i = 0 To \NbPointAigui_H - 1
LineXY( \AiguilleHeure( i )\x , -\AiguilleHeure( i )\y , \AiguilleHeure( i + 1 )\x , -\AiguilleHeure( i + 1 )\y )
Next
ElseIf \NbPointAigui_H = 0 ; Si l'Aiguille a un seul point
Circle ( \AiguilleHeure( 0 )\x , -\AiguilleHeure( 0 )\y , \RayonUnit )
EndIf
If \Remplissage_H = #True
For i = 0 To \NbPointFill_H
FillArea( \FillHeure( i )\x , -\FillHeure( i )\y , \Couleur_H )
Next
EndIf
; Dessinne l'axe du cadran
FrontColor( \CouleurRepereCadran )
DrawingMode( #PB_2DDrawing_Default )
Circle ( 0, 0, 2 )
;StopDrawing()
EndWith
EndProcedure
; Procedures Publiques
Procedure Obj_Horloge_NewAiguille ( *This.Obj_Horloge_Typ , Typ.s ) ; Mise a zéro, nouvelles aiguilles
With *This
Select UCase( Typ )
Case "H"
\NbPointAigui_H = -1
\NbPointFill_H = -1
\Remplissage_H = #False
;CaseEnd
;Case "M"
; \NbPointAigui_M = -1
; \NbPointFill_M = -1
; \Remplissage_M = #False
;;CaseEnd
Case "S"
\NbPointAigui_S = -1
\NbPointFill_S = -1
\Remplissage_S = #False
;CaseEnd
Default
\NbPointAigui_H = -1
;\NbPointAigui_M = -1
\NbPointAigui_S = -1
\NbPointFill_H = -1
;\NbPointFill_M = -1
\NbPointFill_S = -1
\Remplissage_H = #False
;\Remplissage_M = #False
\Remplissage_S = #False
;DefaultEnd
EndSelect
EndWith
EndProcedure
Procedure Obj_Horloge_AddPointAiguille ( *This.Obj_Horloge_Typ , Typ.s , Dx.w , Dy.w ) ; Ajoute une coordonnée au dessin des aiguilles , Coordonnéesen %
Protected .w X , Y
Protected .w Dmin , Dmax , DifX , DifY
With *This
X = \Rayon * Dx / 100
Y = \Rayon * Dy / 100
Select UCase( Typ )
Case "H"
\NbPointAigui_H + 1
If \NbPointAigui_H > \NbPointAigui
\NbPointAigui_H - 1
MessageRequester( "Limite atteinte" , Str( \NbPointAigui + 1 ) + " Points MAXI" , #PB_MessageRequester_Ok )
ProcedureReturn -1
Else
\AiguilleHeure ( \NbPointAigui_H )\X = X
\AiguilleHeure ( \NbPointAigui_H )\Y = Y
\AiguilleHeure ( \NbPointAigui_H )\Ray = GetModule ( X , Y )
\AiguilleHeure ( \NbPointAigui_H )\Arg = GetAngleRad ( X , Y )
EndIf
;CaseEnd
;Case "M"
; \NbPointAigui_M + 1
; If \NbPointAigui_M > \NbPointAigui
; \NbPointAigui_M - 1
; MessageRequester( "Limite atteinte" , Str( \NbPointAigui + 1 ) + " Points MAXI" , #PB_MessageRequester_Ok )
; ProcedureReturn -1
; Else
; \AiguilleMinute ( \NbPointAigui_M )\X = X
; \AiguilleMinute ( \NbPointAigui_M )\Y = Y
; \AiguilleMinute ( \NbPointAigui_M )\Ray = GetModule ( X , Y )
; \AiguilleMinute ( \NbPointAigui_M )\Arg = GetAngleRad ( X , Y )
; EndIf
;;CaseEnd
Case "S"
\NbPointAigui_S + 1
If \NbPointAigui_S > \NbPointAigui
\NbPointAigui_S - 1
MessageRequester( "Limite atteinte" , Str( \NbPointAigui + 1 ) + " Points MAXI" , #PB_MessageRequester_Ok )
Else
\AiguilleSeconde ( \NbPointAigui_S )\X = X
\AiguilleSeconde ( \NbPointAigui_S )\Y = Y
\AiguilleSeconde ( \NbPointAigui_S )\Ray = GetModule ( X , Y )
\AiguilleSeconde ( \NbPointAigui_S )\Arg = GetAngleRad ( X , Y )
EndIf
;CaseEnd
EndSelect
EndWith
EndProcedure
Procedure Obj_Horloge_AddPointFill ( *This.Obj_Horloge_Typ , Typ.s , Dx.w , Dy.w ) ; Ajoute une coordonnée pour le remplissage , Coordonnéesen %
Protected .w X , Y
With *This
X = \Rayon * Dx / 100
Y = \Rayon * Dy / 100
Select UCase( Typ )
Case "H"
\NbPointFill_H + 1
If \NbPointFill_H > \NbPointAigui
\NbPointFill_H - 1
MessageRequester( "Limite atteinte" , Str( \NbPointAigui + 1 ) + " Points MAXI" , #PB_MessageRequester_Ok )
ProcedureReturn -1
Else
\FillHeure ( \NbPointFill_H )\X = X
\FillHeure ( \NbPointFill_H )\Y = Y
\FillHeure ( \NbPointFill_H )\Ray = GetModule ( X , Y )
\FillHeure ( \NbPointFill_H )\Arg = GetAngleRad ( X , Y )
\Remplissage_H = #True
EndIf
;CaseEnd
;Case "M"
; \NbPointFill_M + 1
; If \NbPointFill_M > \NbPointAigui
; \NbPointFill_M - 1
; MessageRequester( "Limite atteinte" , Str( \NbPointAigui + 1 ) + " Points MAXI" , #PB_MessageRequester_Ok )
; ProcedureReturn -1
; Else
; \FillMinute ( \NbPointFill_M )\X = X
; \FillMinute ( \NbPointFill_M )\Y = Y
; \FillMinute ( \NbPointFill_M )\Ray = GetModule ( X , Y )
; \FillMinute ( \NbPointFill_M )\Arg = GetAngleRad ( X , Y )
; \Remplissage_M = #True
;
; EndIf
;;CaseEnd
Case "S"
\NbPointFill_S + 1
If \NbPointFill_S > \NbPointAigui
\NbPointFill_S - 1
MessageRequester( "Limite atteinte" , Str( \NbPointAigui + 1 ) + " Points MAXI" , #PB_MessageRequester_Ok )
ProcedureReturn -1
Else
\FillSeconde ( \NbPointFill_S )\X = X
\FillSeconde ( \NbPointFill_S )\Y = Y
\FillSeconde ( \NbPointFill_S )\Ray = GetModule ( X , Y )
\FillSeconde ( \NbPointFill_S )\Arg = GetAngleRad ( X , Y )
\Remplissage_S = #True
EndIf
;CaseEnd
EndSelect
EndWith
EndProcedure
Procedure Obj_Horloge_SetColor ( *This.Obj_Horloge_Typ , Typ.s , Coul.i ) ; Couleurs des aiguilles
With *This
Select UCase( Typ )
Case "H"
\Couleur_H = Coul
;CaseEnd
;Case "M"
; \Couleur_M = Coul
;;CaseEnd
Case "S"
\Couleur_S = Coul
;CaseEnd
EndSelect
EndWith
EndProcedure
Procedure Obj_Horloge_SetTime ( *This.Obj_Horloge_Typ , Time.q ) ; mise a jour de l'horloge
Protected .u Heures , Minutes , Seconds
Protected .f AngleHeures , AngleMinutes , AngleSecondes
Heures = Hour ( Time )
Minutes = Minute ( Time )
Seconds = Second ( Time )
With *This
; Si changement de second
If Seconds <> \OldSec
; Calcule l'angle de chacunes des aiguilles
AngleHeures = -\Sens * \RadParSeconde_H * ( 3600 * Heures + 60 * Minutes + Seconds )
;AngleMinutes = -\Sens * \RadParSeconde_M * ( 60 * Minutes + Seconds )
AngleSecondes = -\Sens * \RadParSeconde * ( Seconds ) ; \RadParSeconde_S * Seconds
;Obj_Horloge_CalcPtsAiguille ( *This , AngleHeures , AngleMinutes , AngleSecondes )
Obj_Horloge_CalcPtsAiguille ( *This , AngleHeures , 0 , AngleSecondes )
Select \GadgetTyp
Case #PL_GadgetType_Image
FreeImage( \CadranHorloge )
\CadranHorloge = CopyImage ( \CadranFond , #PB_Any )
StartDrawing ( ImageOutput( \CadranHorloge ) )
Obj_Horloge_DessineAiguille ( *This )
StopDrawing()
; Rafraichi l'affichage en Plaqant le fichier image dans l'objet ImageGadget
SetGadgetState ( \GadgetImage , ImageID( \CadranHorloge ) )
;CaseEnd
Case #PL_GadgetType_Canvas
StartDrawing ( CanvasOutput( \GadgetImage ) )
DrawImage( ImageID( \CadranFond ) , 0 , 0 )
Obj_Horloge_DessineAiguille ( *This )
StopDrawing()
;CaseEnd
Case #PL_GadgetType_Screen
StartDrawing ( ScreenOutput( ) )
DrawImage( ImageID( \CadranFond ) , 0 , 0 )
Obj_Horloge_DessineAiguille ( *This )
StopDrawing()
FlipBuffers()
;CaseEnd
EndSelect
\OldSec = Seconds
EndIf
EndWith
EndProcedure
Procedure Obj_Horloge_SetTexte ( *This.Obj_Horloge_Typ , Nom.s , Dx.w , Dy.w , Txt.s ) ; Affiche un texte sur l'horloge , Coordonnéesen %
With *This
AddMapElement( \MapTexte( ) , Nom , #PB_Map_ElementCheck )
\MapTexte( )\x = Dx
\MapTexte( )\y = Dy
\MapTexte( )\Txt = Txt
EndWith
EndProcedure
Procedure Obj_Horloge_SetFont ( *This.Obj_Horloge_Typ , Txt.s , Dh.a , Styl.i ) ; Police du texte et hauteur du texte en %
With *This
\PoliceTxt = Txt
\TexteH = \Rayon * Dh / 100
If \Police : FreeFont( 0 ) : EndIf
\Police = LoadFont( 0 , \PoliceTxt , \TexteH , Styl )
EndWith
EndProcedure
Procedure Obj_Horloge_SetSens ( *This.Obj_Horloge_Typ , SensRot.b ) ; Sens de rotation des aiguilles +1 -1
With *This
\Sens = Sign( SensRot )
EndWith
EndProcedure
Procedure Obj_Horloge_Free ( *This.Obj_Horloge_Typ ) ; Libère les resources
With *This
If \GadgetTyp = #PL_GadgetType_Screen : CloseScreen ( ) : EndIf
FreeMemory ( *This )
EndWith
EndProcedure
; Procedures d'initialisation de l'objet
Procedure .i Obj_Horloge_Init ( GadImg.i , ColFond.i , FullWin.b=0 ) ; Initialisation de l'horloge
Protected *Object.Obj_Horloge_Typ
*Object = AllocateMemory( SizeOf( Obj_Horloge_Typ ) )
If *Object
With *Object
\DSVT = ?Obj_Horloge_Class
If IsGadget( GadImg )
If GadgetType( GadImg ) = #PB_GadgetType_Canvas
\DimX = GadgetWidth ( GadImg )
\DimY = GadgetHeight ( GadImg )
\GadgetTyp = #PL_GadgetType_Canvas
ElseIf GadgetType( GadImg ) = #PB_GadgetType_Image
\DimX = GadgetWidth ( GadImg )
\DimY = GadgetHeight ( GadImg )
\GadgetTyp = #PL_GadgetType_Image
EndIf
ElseIf IsWindow( GadImg )
If FullWin
\DimX = WindowWidth ( GadImg , #PB_Window_FrameCoordinate ) - 2
\DimY = WindowHeight ( GadImg , #PB_Window_FrameCoordinate ) - 2
Else
\DimX = WindowWidth ( GadImg )
\DimY = WindowHeight ( GadImg ) - MenuHeight ( )
EndIf
\GadgetTyp = #PL_GadgetType_Screen
InitSprite ( )
OpenWindowedScreen ( WindowID( GadImg ) , 1 , 1 , \DimX , \DimY )
Else
MessageRequester( "Erreur." , "Un ImageGadget, CanvasGadget ou une fenêtre est attendu." , #PB_MessageRequester_Error | #PB_MessageRequester_Ok )
End
EndIf
If \DimX < \DimY : \Diametre = \DimX
Else : \Diametre = \DimY
EndIf
\Rayon = Int( \Diametre / 2.0 ) - 1
\RadParSeconde_H = #PI / 43200.0 ;( 24 * 60 * 60 ) / 2
;\RadParSeconde_M = #PI / 1800.0 ;( 60 * 60 ) / 2
\RadParSeconde_S = #PI / 72.0 ;( 24 * 6 ) / 2
\RadParSeconde = #PI / 30.0 ;( 60 ) / 2
\Sens = 1
\Couleur_H = $00ff00 ; ( B, V, R ) Vert
;\Couleur_M = $ff0000 ; ( B, V, R ) Bleu
\Couleur_S = $0000ff ; ( B, V, R ) Rouge
\CouleurFond = ColFond
\CouleurRepereCadran = \CouleurFond ! $FFFFFF
\NbPointAigui = 31 ; ( 32 points maxi de 0 a 31 )
\NbPointAigui_H = -1
;\NbPointAigui_M = -1
\NbPointAigui_S = -1
\NbPointFill_H = -1
;\NbPointFill_M = -1
\NbPointFill_S = -1
\GadgetImage = GadImg
\CadranFond = CreateImage ( #PB_Any , \DimX , \DimY , 32 , \CouleurFond )
\CadranHorloge = CopyImage ( \CadranFond , #PB_Any )
\RayonMini = 0.95 * \Rayon
\RayonMaxi = 0.99 * \Rayon
\RayonUnit = 0.05 * \Rayon
\RayonMini_S = 0.80 * \Rayon
\RayonMaxi_S = 0.85 * \Rayon
\RayonUnit_S = 0.05 * \Rayon
\OldSec = 0
\TexteH = \Rayon * 10 / 100
\PoliceTxt = "Arial"
\Police = LoadFont( 0 , \PoliceTxt , \TexteH , 0 )
\Remplissage_H = #False
;\Remplissage_M = #False
\Remplissage_S = #False
NewMap \MapTexte .Texte ( )
Dim \AiguilleHeure .Coordonnee( \NbPointAigui )
;Dim \AiguilleMinute .Coordonnee( \NbPointAigui )
Dim \AiguilleSeconde .Coordonnee( \NbPointAigui )
Dim \FillHeure .Coordonnee( \NbPointAigui )
;Dim \FillMinute .Coordonnee( \NbPointAigui )
Dim \FillSeconde .Coordonnee( \NbPointAigui )
; Initialise des aiguilles par defaut
; Aiguille des heures
Obj_Horloge_AddPointAiguille( *Object , "H" , 0 , 95 ) ; 0
Obj_Horloge_AddPointAiguille( *Object , "H" , 0 , -10 ) ; 1
; Aiguille des secondes
Obj_Horloge_AddPointAiguille( *Object , "S" , 0 , 80 ) ; 0
Obj_Horloge_AddPointAiguille( *Object , "S" , 0 , -30 ) ; 1
; Initialise le cadran
Protected .w X1 , Y1 , X2 , Y2
Protected .f ValCos , ValSin
Protected .i i
Protected .s Txt
StartDrawing ( ImageOutput( \CadranFond ) ) ; Demarre la procedure de tracé dans le fichier image
SetOrigin ( \DimX / 2 , \DimY / 2 ) ; Place l'origine du tracé
; Dessine les repère des heures sur le cadran 24h
FrontColor( \CouleurRepereCadran )
For i = 0 To 144 ; ( 24 x 6 )
ValCos = Cos( i * \RadParSeconde_S )
ValSin = Sin( i * \RadParSeconde_S )
; Les repaires 10 minutes
X1 = \RayonMini
Y1 = \RayonMini
; Les repaires 1 heure
If i % 6 = 0 : X1 - \RayonUnit : Y1 - \RayonUnit : EndIf
; Les repaires 3 heures
If i % 18 = 0 : X1 - \RayonUnit : Y1 - \RayonUnit : EndIf
; Calcule les coordonnées du point 1
X1 = X1 * ValCos
Y1 = Y1 * ValSin
; Calcule les coordonnées du point 2
X2 = \RayonMaxi * ValCos
Y2 = \RayonMaxi * ValSin
; Trace les repaires sur le cadran
LineXY( X1 , -Y1 , X2 , -Y2 )
Next
; Dessine les repère des secondes sur le cadran
FrontColor( RGB( Red( \CouleurRepereCadran ) / 2 , Green( \CouleurRepereCadran ) / 2 , Blue( \CouleurRepereCadran ) / 2 ) )
For i = 0 To 59
ValCos = Cos( i * \RadParSeconde )
ValSin = Sin( i * \RadParSeconde )
; Les repaires 1 seconde
X1 = \RayonMini_S
Y1 = \RayonMini_S
; Les repaires 5 secondes
If i % 5 = 0 : X1 - \RayonUnit_S : Y1 - \RayonUnit_S : EndIf
; Les repaires 15 secondes
If i % 15 = 0 : X1 - \RayonUnit_S : Y1 - \RayonUnit_S : EndIf
; Calcule les coordonnées du point 1
X1 = X1 * ValCos
Y1 = Y1 * ValSin
; Calcule les coordonnées du point 2
X2 = \RayonMaxi_S * ValCos
Y2 = \RayonMaxi_S * ValSin
; Trace les repaires sur le cadran
LineXY( X1 , -Y1 , X2 , -Y2 )
Next
; Affichage textes des heures
FrontColor ( \CouleurRepereCadran )
BackColor ( \CouleurFond )
DrawingFont ( \Police )
X1 = 0.70 * \Rayon
For i = 0 To 144 Step 18 ; ( 24 x 6 )
ValCos = Cos( i * \RadParSeconde_S - (#PI / 2 ) )
ValSin = Sin( i * \RadParSeconde_S - (#PI / 2 ) )
; Les repaires 3 heures
If i % 18 = 0
Txt = Str( i / 6 )
; Calcule les coordonnées du point 1
X2 = X1 * ValCos
Y2 = X1 * ValSin
; Calcule les coordonnées du point 2
; Trace les repaires sur le cadran
X2 = X2 - TextWidth ( Txt ) / 2
Y2 = Y2 - TextHeight ( Txt ) / 2
DrawText( X2 , Y2 , Txt )
EndIf
Next
; Trace L'axe des aiguilles sur le cadran
Circle ( 0, 0, 2 )
StopDrawing( )
EndWith
EndIf
ProcedureReturn *object
EndProcedure
DataSection
Obj_Horloge_Class:
Data.i @Obj_Horloge_NewAiguille ( )
Data.i @Obj_Horloge_AddPointAiguille ( )
Data.i @Obj_Horloge_AddPointFill ( )
Data.i @Obj_Horloge_SetColor ( )
Data.i @Obj_Horloge_SetTime ( )
Data.i @Obj_Horloge_SetTexte ( )
Data.i @Obj_Horloge_SetFont ( )
Data.i @Obj_Horloge_SetSens ( )
Data.i @Obj_Horloge_Free ( )
EndDataSection
; ; *******************
; ; *** Utilisation ***
; ; *******************
; ;
; ; MonHorloge .NewObj_Horloge = Obj_Horloge_Init ( GadImg.i , ColFond.i , FullWin.b=0 ) ; Initialisation de l'horloge
; ; MonHorloge\NewAiguille ( Typ.s ) ; Mise a zéro, nouvelles aiguilles
; ; MonHorloge\AddPointAiguille ( Typ.s , Dx.w , Dy.w ) ; Ajoute une coordonnée au dessin des aiguilles , Coordonnéesen % ; 32 points maxi
; ; MonHorloge\AddPointFill ( Typ.s , Dx.w , Dy.w ) ; Ajoute une coordonnée pour le remplissage , Coordonnéesen %
; ; MonHorloge\SetColor ( Typ.s , Coul.i ) ; Couleurs des aiguilles
; ; MonHorloge\SetTime ( Time.q ) ; Mise a jour de l'horloge
; ; MonHorloge\SetTexte ( Dx.w , Dy.w , Txt.s ) ; Affiche un texte sur l'horloge centée sur le pont , Coordonnées en %
; ; MonHorloge\SetFont ( Txt.s , Dh.a=10 , Styl.i ) ; Police du texte et hauteur du texte en %
; ; MonHorloge\SetSens ( SensRot.b ) ; Sens de rotation des aiguilles +1 -1
; ; MonHorloge\Free ( ) ; Libère les resources
; ;
; ;; Exemple :
; ;; Init Affichage Horloge Analogique
; Titre$ = "Horloge 24"
; Option = #PB_Window_SystemMenu | #PB_Window_SizeGadget | #PB_Window_BorderLess
; Win_0 = OpenWindow(#PB_Any, #PB_Ignore , #PB_Ignore , 800 , 600, Titre$ , Option )
; WindowBounds ( Win_0 , 800 , 600 , #PB_Ignore , #PB_Ignore )
; ;ImageHorlogeAnalogique = ImageGadget ( #PB_Any , 0 , 0 , WindowWidth(Win_0) , WindowHeight(Win_0) , 0 )
; ;ImageHorlogeAnalogique = CanvasGadget ( #PB_Any , 0 , 0 , WindowWidth(Win_0) , WindowHeight(Win_0) )
; ImageHorlogeAnalogique = Win_0
;
; ObjHorlogeAnalogique.NewObj_Horloge = Obj_Horloge_Init ( ImageHorlogeAnalogique , #Black )
;
; Repeat
;
; ObjHorlogeAnalogique\SetTime ( Date( ) ) ; Mise a jour de l'horloge
; Delay(1)
;
; Until WindowEvent() = #PB_Event_CloseWindow
;
;}
;-ScreenSaver Horloge 24h
;{ Version 20260702
Global .i ColAiguilleH = #Green
Global .i ColAiguilleS = #Red
Global .s CheminIni$ = GetHomeDirectory() + "AppData\Local\VirtualStore\Windows\"
Global .s FichierIni = CheminIni$ + "Horloge.Ini"
Global .s ScreensaverName = "Horloge 24h"
Global .s Parameter = ""
Global .s previewWndHandleStr = ""
Global ObjHorlogeAnalogique .NewObj_Horloge
Procedure SauveParametresIni ( )
OpenPreferences( FichierIni )
PreferenceGroup("Horloge")
WritePreferenceInteger ( "ColAiguilleH" , ColAiguilleH )
WritePreferenceInteger ( "ColAiguilleS" , ColAiguilleS )
ClosePreferences()
EndProcedure
Procedure ChargeParametresIni ( )
If OpenPreferences( FichierIni )
PreferenceGroup("Horloge")
ColAiguilleH = ReadPreferenceInteger ( "ColAiguilleH" , #Green )
ColAiguilleS = ReadPreferenceInteger ( "ColAiguilleS" , #Red )
ClosePreferences()
Else
SauveParametresIni ( )
EndIf
EndProcedure
Procedure InitAiguille ( Typ.a = 1 )
; ***********************
; * Aiguille N°1 *
; * *
ObjHorlogeAnalogique\NewAiguille ( "" ) ; Remise à 0 de l' aiguilles des Heures
; Initialise des aiguilles par defaut
; Aiguille des heures
ObjHorlogeAnalogique\AddPointAiguille( "H" , 0 , 95 ) ; 0
ObjHorlogeAnalogique\AddPointAiguille( "H" , 0 , -10 ) ; 1
; Aiguille des secondes
ObjHorlogeAnalogique\AddPointAiguille( "S" , 0 , 80 ) ; 0
ObjHorlogeAnalogique\AddPointAiguille( "S" , 0 , -30 ) ; 1
EndProcedure
Procedure ConfigScreen ( )
; Configuration de l'économiseur, Initialisation fenetre Parametres
;{
Options = #PB_Window_Tool | #PB_Window_ScreenCentered
Protected .i FenetreParametre = OpenWindow( #PB_Any , 0 , 0 , 210 , 340 , "Paramètres" , Options )
yPose = 10
Protected .i ImageHorlogeAnalogique = CanvasGadget ( #PB_Any , 30 , 10 , 150 , 150 ) : yPose + 170
Protected .i Text_Heure = TextGadget ( #PB_Any , 20 , yPose , 90 , 20 , "Heure" )
Protected .i ButtonImage_Couleur_Heure = ButtonImageGadget ( #PB_Any , 120 , yPose , 40 , 20 , 0 ) : yPose + 20
Protected .i Option_Seconde = TextGadget ( #PB_Any , 20 , yPose , 90 , 20 , "Seconde" )
Protected .i ButtonImage_Couleur_Seconde = ButtonImageGadget ( #PB_Any , 120 , yPose , 40 , 20 , 0 ) : yPose + 30
Protected .i ParamButtonValideParametres = ButtonGadget ( #PB_Any , 20 , yPose , 70 , 30 , "Valide" )
Protected .i ParamButtonAnnuleParametres = ButtonGadget ( #PB_Any , 120 , yPose , 70 , 30 , "Annule" ) : yPose + 40
ResizeWindow ( FenetreParametre , #PB_Ignore , #PB_Ignore , #PB_Ignore , yPose )
; Initialisation des boutons Image
Protected .i Image_Couleur_Heure = CreateImage ( #PB_Any , 40 , 20 , 32 )
Protected .i Image_Couleur_Seconde = CreateImage ( #PB_Any , 40 , 20 , 32 )
StartDrawing( ImageOutput( Image_Couleur_Heure ) )
Box( 0 , 0 , 40 , 20 , ColAiguilleH )
StopDrawing()
SetGadgetAttribute( ButtonImage_Couleur_Heure , #PB_Button_Image , ImageID( Image_Couleur_Heure ) )
StartDrawing( ImageOutput( Image_Couleur_Seconde ) )
Box( 0 , 0 , 40 , 20 , ColAiguilleS )
StopDrawing()
SetGadgetAttribute( ButtonImage_Couleur_Seconde , #PB_Button_Image , ImageID( Image_Couleur_Seconde ) )
;}
ObjHorlogeAnalogique = Obj_Horloge_Init ( ImageHorlogeAnalogique , #Black )
; Initialise l'horloge
InitAiguille ( TypeAiguille )
ObjHorlogeAnalogique\SetColor ( "H" , ColAiguilleH )
ObjHorlogeAnalogique\SetColor ( "S" , ColAiguilleS )
AddWindowTimer ( FenetreParametre , 1 , 100 )
Protected .a Fini = #False
Repeat
Event = WindowEvent( )
If Event
Select EventWindow()
Case FenetreParametre
Select Event
Case #PB_Event_Timer
If EventTimer( ) = 1
ObjHorlogeAnalogique\SetTime ( Date ( ) )
EndIf
;CaseEnd
Case #PB_Event_Gadget
Select EventGadget()
Case ParamButtonValideParametres
SauveParametresIni( )
Fini = #True
;CaseEnd
Case ParamButtonAnnuleParametres
Fini = #True
;CaseEnd
Case ButtonImage_Couleur_Heure
Couleur = ColorRequester()
If Couleur > -1
ColAiguilleH = Couleur
StartDrawing( ImageOutput( Image_Couleur_Heure ) )
Box( 0 , 0 , 40 , 20 , ColAiguilleH )
StopDrawing()
SetGadgetAttribute( ButtonImage_Couleur_Heure , #PB_Button_Image , ImageID( Image_Couleur_Heure ) )
ObjHorlogeAnalogique\SetColor( "H" , ColAiguilleH )
EndIf
;CaseEnd
Case ButtonImage_Couleur_Seconde
Couleur = ColorRequester()
If Couleur > -1
ColAiguilleS = Couleur
StartDrawing( ImageOutput( Image_Couleur_Seconde ) )
Box( 0 , 0 , 40 , 20 , ColAiguilleS )
StopDrawing()
SetGadgetAttribute( ButtonImage_Couleur_Seconde , #PB_Button_Image , ImageID( Image_Couleur_Seconde ) )
ObjHorlogeAnalogique\SetColor( "S" , ColAiguilleS )
EndIf
;CaseEnd
EndSelect
;CaseEnd
EndSelect
;CaseEnd
EndSelect
Else
Delay( 10 )
EndIf
Until Fini
CloseWindow( FenetreParametre )
EndProcedure
;***********************
;* Programme principal *
;***********************
; Autoriser une seule instance de ce programme
ScreenSaver::Start(ScreensaverName)
ChargeParametresIni()
Parameter = ScreenSaver::GetParameter()
Select UCase( Parameter )
Case "C" ;"C" => écran de configuration.
ConfigScreen( )
End
;CaseEnd
Case "P" ; Aperçu. Ce paramètre est suivi d'un autre, le handle de la fenêtre d'aperçu : '-p -123456' ou '/p /12345'
Win_0 = ScreenSaver::GetWinPreview( ) ; previewWndHandleStr
;CaseEnd
Case "S" , "" ; Mode économiseur d'écran
Win_0 = ScreenSaver::GetWinSaver()
;CaseEnd
Default
End
;DefaultEnd
EndSelect
ObjHorlogeAnalogique = Obj_Horloge_Init ( Win_0 , #Black , 1 )
; Initialise l'horloge
InitAiguille ( TypeAiguille )
ObjHorlogeAnalogique\SetColor ( "H" , ColAiguilleH )
ObjHorlogeAnalogique\SetColor ( "S" , ColAiguilleS )
AddWindowTimer ( Win_0 , 1 , 100 )
Repeat
Evenement = WaitWindowEvent( )
Select Evenement
Case #PB_Event_Timer
If EventTimer( ) = 1
ObjHorlogeAnalogique\SetTime ( Date ( ) )
EndIf
;CaseEnd
EndSelect
If ScreenSaver::IsScreenSaverMode() And ScreenSaver::CheckStatus()
ScreenSaver::Stop()
Break
EndIf
ForEver
ObjHorlogeAnalogique\Free( )
;}
