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( )
;}
