PureBasic

Forums PureBasic - Français
http://www.purebasic.fr/french/

Horloge avec alarme programmable

http://www.purebasic.fr/french/viewtopic.php?t=19566

Page 1 sur 1

Horloge avec alarme programmable

Publié : lun. 06/juil./2026 15:47
par MLD
Oui encore une horloge.
Pour une application j'ai eu le plaisir de programmer cette horloge.
Je vous donne le code, vous pouvez en faire ce que bon vous semble, mais si vous modifiez le code, faite une publication sur ce forum svp.
ATTENTION. Comme pour presque tous mes programmes, il faut décocher la case DPI de PB

Code : Tout sélectionner

;**********************************************************
;     MLD le 6/07/2026 Horloge avec alarme 
;          Compilation PB 6.40 X86
;  Impératif décochez le facteur d'échelle(DPI) de PB
;***********************************************************
#fen = 1:#bandimage = 3:#bandimage2 = 4:#trait3d1 = 5:#compbbg = 6:#compbbgd= 7:#traitsoulH = 8
#btB_alr =10:#btB_tc =11
#btstopalr = 15:#btraztc = 16:#btstoptc = 17:#btbarre = 18:#btaid = 19:#btstop = 20
#txtH1 = 25:#txtH2 = 26:#txtH3 = 27:#txtH4 = 28:#txtH5 = 29:#txtH6 = 30
#txtalm1 = 31:#txtalm2 = 32:#txtalm3 = 33
#txtct1 = 35:#txtct2 = 36
;****************  container alarme ******************************
#contalrm = 40:#altxt1 = 41:#altxt2 = 42:#altxt3 = 43:#altxt4 = 44:#altxt5 = 49
#alspin1 = 45:#alspin2 = 46:#alspin3 = 47:#alspin4 = 48
#albt11 = 60:#albt12 = 61
;*********************************************************
#timerW =100:#canvas1 = 101
;*********************************************************
#Ldef = 1920:#Hdef = 1080 :#Corf = 12
Global definecrlarg.d = GetSystemMetrics_(#SM_CXSCREEN)
Global definecrht.d = GetSystemMetrics_(#SM_CYSCREEN)
Global typH.b
Global St,balrB,btcB
Global L.d,Hwq.d
Global difm,dpalarm = 0,al; al pour alarme 
Global Hda$;heure alarme
Global SJ$, Date$,dt$,afhdalm$ 
Global dptc, Hdtc$; drapeau pour TC t heure de départ
hdc = GetDC_(GetDesktopWindow_())
If hdc : dpiX.d = GetDeviceCaps_(hdc, #LOGPIXELSX) :EndIf
If hdc : Global dpiY.d = GetDeviceCaps_(hdc, #LOGPIXELSY) : ReleaseDC_(GetDesktopWindow_(), hdc) : EndIf
Global mmx.d = (dpiX / 2.54)/10
Global mmy.d = (dpiY / 2.54)/10
  If definecrht.d = #Hdef And dpiY.d = 96
    dft.w = #Corf
    Global FontID0 = LoadFont(0, "Arial",dft.w,#PB_Font_HighQuality)
  Else
    dft.W = (#Corf / (#Hdef/definecrht.d)-1)
    If dft.W < 7 : dft.W = 7:EndIf
    Global FontID0 = LoadFont(0, "Microsoft Sans Serif",dft.w,#PB_Font_HighQuality)
  EndIf  
  SetGadgetFont(#PB_Default, FontID(0))
  
Procedure Ywp(y.d)
Select y.d
  Case 0
   ProcedureReturn 0 ;en haut de l'écran
 Default
  If definecrht.d = #Hdef
   ProcedureReturn y.d 
  Else
   ProcedureReturn y.d * (definecrht /#Hdef)
  EndIf 
EndSelect   
EndProcedure

Procedure Hw(Dh.d,typH.b)
definecrht.d = GetSystemMetrics_(#SM_CYSCREEN)
SystemParametersInfo_(#SPI_GETWORKAREA,0,@DesktopWorkArea.RECT,0)
htTaskbarwin.d = definecrht.d - DesktopWorkArea\Bottom
OpenWindow(2000,0,0,200,200,"",#PB_Window_SystemMenu|#PB_Window_Invisible)
If OSVersion() = #PB_OS_Windows_XP
 EPframeH.d = WindowX(2000, #PB_Window_InnerCoordinate)
 EPframeL.d = WindowX(2000, #PB_Window_InnerCoordinate)
Else
 EPframeH.d = (WindowX(2000, #PB_Window_InnerCoordinate)*3)
 EPframeL.d = WindowX(2000, #PB_Window_InnerCoordinate)  
EndIf  
Httitre.d = WindowY(2000, #PB_Window_InnerCoordinate)
CloseWindow(2000)
Select typH.b
 Case 1 ;fen avec titre et haut max
  If St = 0  
   Hwq.d = definecrht - (Httitre.d + EPframeH) 
   ProcedureReturn Hwq.d
  Else ; fen sans titre et hauteur max
   Hwq.d = definecrht
   ProcedureReturn Hwq.d 
  EndIf 
 Case 2 ;fen avec titre et barre de tache win visible
  If St = 0   
   Hwq.d = definecrht - (htTaskbarwin  + Httitre.d  + EPframeH)+5
   ProcedureReturn hwq.d 
  Else  ; fen sans titre et barre de tache win visible
   Hwq.d = definecrht - htTaskbarwin 
   ProcedureReturn Hwq.d
  EndIf 
 Default ;fen quelconque
  If Dh = 0:Dh = 1:EndIf
  If definecrht <> #Hdef
   Hwq.d =  Dh * (definecrht /#Hdef)
   ProcedureReturn Hwq.d
  Else
   Hwq.d =  Dh
   ProcedureReturn Hwq.d 
  EndIf  
EndSelect 
EndProcedure

Procedure XWp(lp.d)
Select lp.d
 Case 0
  ProcedureReturn 1 ;a gauche
 Default
  If definecrlarg <> #Ldef
   ProcedureReturn lp.d * (definecrlarg /#Ldef)
  Else
   ProcedureReturn lp.d
  EndIf 
EndSelect 
EndProcedure

Procedure Lw(dL.d)
Select dL.d
 Case 0 
   If St = 0 ;largeur max avec bordure
    L.d = definecrlarg - 10
    ProcedureReturn L.d
   Else ;largeur max sans bordure
    L.d = definecrlarg
    ProcedureReturn L.d
   EndIf 
 Default
  If definecrlarg <> #Ldef
    L.d = dL * (definecrlarg /#Ldef)
    ProcedureReturn L.d
   Else 
     L.d = dL
     ProcedureReturn L.d
   EndIf
EndSelect 
EndProcedure

Procedure MLD_openfen(ng.d,x.d,y.d,Lf.d,H.d,titre$,opt1.l,opt2.l,opt3.l,opt4.l,typH.b)
  If y.d <> 0 :typH.b = 0:EndIf 
  Select #PB_Window_BorderLess
   Case opt1.l,opt2.l,opt3.l,opt4.l
    Global St = 1
   Default
     Global St = 0
     If L.d < 300 And L.d > 0:L.d = 300:EndIf
  EndSelect 
  Select #PB_Window_ScreenCentered 
   Case opt1.l,opt2.l,opt3.l,opt4.l
     typH.b =0
 EndSelect
 If opt1.l = 0 And opt2.l = 0 And opt3.l = 0 And opt4.l = 0; les options ne supporte pas les 0(pas de bouton)
    OpenWindow(ng.d,Xwp(x.d),Ywp(y.d),Lw(Lf.d),Hw(H.d,typH.b),titre$)
 Else  
   OpenWindow(ng.d,Xwp(x.d),Ywp(y.d),Lw(Lf.d),Hw(H.d,typH.b),titre$,opt1.l|opt2.l|opt3.l|opt4.l)
   a.d = Xwp(x.d)
 EndIf 
EndProcedure   

Procedure X(lg.d)
  ProcedureReturn lg *(definecrlarg.d/#Ldef)
EndProcedure

Procedure Y(h.d)
  ProcedureReturn h *(definecrht.d /#Hdef) 
EndProcedure 
;¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
Global FontID0 = LoadFont(0,"Tahoma", X(12))
Global FontID1 = LoadFont(1,"Segoe Print",X(20),#PB_Font_HighQuality)
Global FontID2 = LoadFont(2,"Segoe Print",X(16),#PB_Font_HighQuality)
Global FontID3 = LoadFont(3,"Tahoma", X(16),#PB_Font_HighQuality)
Global FontID4 = LoadFont(4,"Tahoma", X(12),#PB_Font_HighQuality)
Global FontID5 = LoadFont(5,"Microsoft YaHei UI", X(72),#PB_Font_HighQuality) 
;¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
Macro Coulgad(gad,cf,ct,ft)
  SetGadgetColor(gad,#PB_Gadget_FrontColor,ct):SetGadgetColor(gad,#PB_Gadget_BackColor,cf):SetGadgetFont(gad,ft) 
EndMacro
Macro almvis(gad,dpal)
  If dpal = 1 :HideGadget(gad,1):EndIf;invisible
  If dpal = 2:HideGadget(gad,0):EndIf;visible 
EndMacro  

Procedure MLD_ImageGadget(numgad.d,x.d,y.d,Gl.d,Gh.d,img.d,Opt1.l,Opt2.l,Opt3.l,Opt4.l)
  If img.d = 0
    idimg.d = 0
  Else
    idimg.d = ImageID(img.d)
  EndIf  
  ImageGadget(numgad.d,X(x.d),y(y.d),X(Gl.d),Y(Gh.d),idimg.d, Opt1|Opt2|Opt3|Opt4)
EndProcedure

Procedure MLD_TextGadget(numgad.d,x.d,y.d,Gl.d,Gh.d,Text$,Opt1.l,Opt2.l,Opt3.l,Opt4.l)
  TextGadget(numgad.d,X(x.d),y(y.d),X(Gl.d),Y(Gh.d),Text$,Opt1|Opt2|Opt3|Opt4)
EndProcedure

Procedure MLD_ButtonImageGadget(numgad.d,x.d,y.d,Gl.d,Gh.d,img.d,Opt1.l,Opt2.l,Opt3.l,Opt4.l)
  If img.d = 0
    ButtonImageGadget(numgad.d,X(x.d),Y(y.d),X(Gl.d),Y(Gh.d),0, Opt1|Opt2|Opt3|Opt4) 
  Else  
    ButtonImageGadget(numgad.d,X(x.d),Y(y.d),X(Gl.d),Y(Gh.d),ImageID(img.d), Opt1|Opt2|Opt3|Opt4)
  EndIf
EndProcedure

Procedure MLD_CanvasGadget(numgad.d,x.d,y.d,Gl.d,Gh.d,Opt1.l,Opt2.l,Opt3.l,Opt4.l)
  CanvasGadget(numgad.d,X(x.d),y(y.d),X(Gl.d),Y(Gh.d),Opt1.l|Opt2.l|Opt3.l|Opt4.l)
EndProcedure

Procedure MLD_SpinGadget(numgad.d,x.d,y.d,Gl.d,Gh.d,Min.d,Max.d,Opt1.l,Opt2.l,Opt3.l,Opt4.l)
  SpinGadget(numgad.d,X(x.d),y(y.d),X(Gl.d),Y(Gh.d),Min.d,Max.d,Opt1|Opt2|Opt3|Opt4)
EndProcedure

Procedure MLD_ContainerGadget(numgad.d,x.d,y.d,Gl.d,Gh.d,Opt1.l,Opt2.l,Opt3.l,Opt4.l)
  ContainerGadget(numgad.d,X(x.d),y(y.d),X(Gl.d),Y(Gh.d),Opt1.l|Opt2.l|Opt3.l|Opt4.l)
EndProcedure

Procedure Cibt(num,larg,haut,coulfond,pos);utile pour boutons Cibt = change image bouton
CreateImage(num, larg,haut)  
StartDrawing(ImageOutput(num))
DrawingMode(#PB_2DDrawing_Gradient) ;Dessine le fond de l'image 
  If pos = 1 
   BackColor($FFFFFF):FrontColor(coulfond)
  Else  
   BackColor(coulfond):FrontColor($FFFFFF)
  EndIf
  LinearGradient(0,Y(haut) *1.5,0,0)
  Box(0,0,larg,haut) 
EndProcedure

Procedure MLD_BtTxt(Gad,x.D,y.D,larg.D,haut.D,txt$,font,coultext,coulfond,pos) ;le num de gadget ne doit jamais être 0
  Cibt(Gad,larg,haut,coulfond,pos)
  ; Position du texte
  DrawingMode(#PB_2DDrawing_Transparent) 
  DrawingFont(font)
  hautxt = TextHeight(txt$)
  largtxt = TextWidth(txt$)
  ctrtxt = (larg - largtxt)/2 ; centre le text en largeur
  ctxt=(haut - hautxt)/2 ; centre le text en hauteur
  DrawText(ctrtxt,ctxt,txt$,coultext)
  StopDrawing ()
  If pos = 0
    MLD_ButtonImageGadget(Gad,x,y,larg,haut,Gad,0,0,0,0)
  Else
    ProcedureReturn Gad
  EndIf  
EndProcedure

Procedure aide()
Dim L.s(6)  
L.s(1) = "Merci a ceux qui utilisent ce logiciel." +#CRLF$ 
L.s(2) = "Pendule toute simple avec alarme programmable, et temps cumulé."+#CRLF$
L.s(3) = "Simplicité absolue, tous est indiqué. Simplement les chiffres dans le cercle tournant indique les secondes restantes avant la minute."+#CRLF$
L.s(4) = "La programmation de l’alarme ne ce fait qu’avec les flèches dans les cases heure, minute, seconde."+#CRLF$
L.s(5) = "Idem pour la case H + minute(s)."+#CRLF$
L.s(6) = "Programmeur MLD le 6/07/2026 Logiciel PB 6,40(X86)"
For X = 1 To 6
   LT$ = LT$ + L.s(X)
 Next
FreeArray(L.s())
MessageRequester("PENDULE",LT$,#PB_MessageRequester_Ok | #PB_MessageRequester_Info)   
EndProcedure

Procedure bissextile(annee) 
    If (annee % 4 = 0 And annee % 100 <> 0) Or annee % 400 = 0
        bissextile= #True
    Else
        bissextile = #False
    EndIf
    ProcedureReturn bissextile
EndProcedure
  
Procedure.i DF(date.i);dimanche europe
  d.i = DayOfWeek(date)
  If d = 0 :d = 7 :EndIf ;dimanche, retourne 7 au lieu de 0
  ProcedureReturn d
EndProcedure

Procedure calculdt()
 Jour$ = "Dimanche,Lundi,Mardi,Mercredi,Jeudi,Vendredi,Samedi" 
 Jour$= StringField (Jour$, DayOfWeek ( Date ())+1, "," )    
 Mois$="Janvier,Février,Mars,Avril,Mai,Juin,Juillet,Août,Septembre,Octobre,Novembre,Décembre"
 Mois$ = StringField(Mois$,Month(Date()),",")
 Date$ = Jour$ +" " + FormatDate(" %dd ", Date()) + Mois$ + FormatDate("  %yyyy", Date())
EndProcedure 

Procedure.i NumSem(date.i);donne le num de semaine selon norme iso
  jda.i = DayOfYear(date): an.i = Year(date)
  DjanP.i = 4 - DF(Date(an, 1, 4, 0,0,0));dernier jour année précédente
  Djan.i = 4 - DF(Date(an,12,28, 0,0,0)) + DayOfYear(Date(an,12,31, 0,0,0));dernier jour de l'année
  If jda.i <= Djan.i
    If jda.i <= DjanP.i
     jda.i + DayOfYear(Date(an-1,12,31, 0,0,0));le 1er est dans la dernière semaine de l'année précédente.
     DjanP.i = 4 - DF(Date(an-1,1,4, 0,0,0))
    EndIf
    ProcedureReturn Round((jda-DjanP)/7, #PB_Round_Up)
  Else ;si non c'est dans la 1ere semaine
   ProcedureReturn 1
  EndIf
EndProcedure 

Procedure calculnbjour();calcul le nombre de jour écoulé a la date indiqué et ce qui reste
If bissextile(Year(Date())) = 1
  totalj.w = 366
 Else
  totalj.w = 365
EndIf
 nbjt.w = DayOfYear(Date())
 diffjour.w = totalj - nbjt.w 
 numS$ = Str(NumSem(Date()))
 If Len(numS$)<2:numS$ = "0" + numS$ :EndIf ;num semaine
 If diffjour.w < 2:df$ = "jour": Else : df$ = "jours": EndIf
 SJ$ ="Semaine  " + numS$ + "    Jour  " + Str(nbjt.w) + " / " + Str(totalj.w) + "   Reste  " + Str(diffjour.w)+ "  " + df$
EndProcedure

Procedure bd(); dessine le bandeau
 calculdt() 
calculnbjour()  
CreateImage(4,X(1125),Y(50))  
StartDrawing(ImageOutput(4))
  DrawingMode(#PB_2DDrawing_Gradient) ;Dessine le fond de l'image 
  BackColor($0):FrontColor($FFFFFF)
  LinearGradient(0,Y(70) *1.5,0,0)
  Box(0,0,X(1500),Y(70))
  DrawingMode(#PB_2DDrawing_Transparent) 
  DrawingFont(FontID2)
  DrawText(x(30),Y(7),Date$,$FF0000)
  DrawText(x(500),Y(7), SJ$,$FF0000)   
StopDrawing()
EndProcedure

Procedure WindowCallback(WindowID, message, wParam, lParam);survol gadgets
  Global svgn 
  Resultat = #PB_ProcessPureBasicEvents
  Select message
   Case #WM_SETCURSOR
     svgn = GetDlgCtrlID_(wParam)
    EndSelect
   ProcedureReturn Resultat
 EndProcedure 

Procedure bts(cd); commande des boutons
  Static svgnp,Txt$,Fontg,Clt,Clf,image
   Select cd
    Case 513;bt enfoncé
      svgnp = svgn
      Select svgnp 
        Case 15 To 20,60,61;bt texte
            If svgnp = 15:Txt$ = "OK":Fontg = FontID4:Clt = $0045FF:Clf = $FF0000:EndIf 
            If svgnp = 16:Txt$ = "OK" :Fontg = FontID4:Clt = $0045FF:Clf = $8CB4D2:EndIf 
            If svgnp = 17:Txt$ = "OK" :Fontg = FontID4:Clt = $0045FF:Clf = $FF0000:EndIf
            If svgnp = 18:Txt$ = "OK" :Fontg = FontID4:Clt = $0045FF:Clf = $20A5DA:EndIf
            If svgnp = 19:Txt$ = "OK":Fontg = FontID4:Clt = $0045FF:Clf = $00008B:EndIf 
            If svgnp = 20:Txt$ = "OK":Fontg = FontID4:Clt =  $0045FF:Clf = $E22B8A:EndIf
            If svgnp = 60:Txt$ = "OK":Fontg = FontID4:Clt = $FF0000:Clf = $00FF7F:EndIf
            If svgnp = 61:Txt$ = "OK":Fontg = FontID4:Clt = $FF0000:Clf = $4763FF:EndIf
          im = ImageID(MLD_BtTxt(svgnp,GadgetX(svgnp),GadgetY(svgnp),GadgetWidth(svgnp),GadgetHeight(svgnp),Txt$,Fontg,Clt,Clf,1))
          SetGadgetAttribute(svgnp,#PB_Button_Image,im)
     EndSelect
   Case 514
     Select svgnp  
       Case 15 To 20,60,61;bt texte
           If svgnp = 15:Txt$ = "Stop Alarme":clt = $0:EndIf
           If svgnp = 16:Txt$ = "R A Z  TC":clt = $0:EndIf
           If svgnp = 17:Txt$ = "Stop TC":clt = $0:EndIf
           If svgnp = 18:Txt$ = "Barre  " + Chr(8645) + Chr(8645):clt = $0:EndIf
           If svgnp = 19:Txt$ = " Aide":clt = $0:EndIf
           If svgnp = 20:Txt$ = "Stop":clt = $0:EndIf
           If svgnp = 60:Txt$ = "Départ":EndIf
           If svgnp = 61:Txt$ = "Stop":EndIf
         im = ImageID( MLD_BtTxt(svgnp,GadgetX(svgnp),GadgetY(svgnp),GadgetWidth(svgnp),GadgetHeight(svgnp),Txt$,Fontg,Clt,Clf,2)) 
         SetGadgetAttribute(svgnp,#PB_Button_Image,im)
     EndSelect
  EndSelect  
EndProcedure

Procedure btsB(cd,gad); commande des boutons bascule
  Static svgnp,Txt$,Clt,Clf,image
  svgnp = gad
   Select cd
    Case 1;bt enfoncé
      Select svgnp 
        Case 10,11;bt texte
           If svgnp = 10:Txt$ = "Alarme":Fontg = FontID4:Clt = $FF0000:Clf = $0000FF:EndIf 
           If svgnp = 11:Txt$ = "Temps cumulé":Fontg = FontID4:Clt = $FF0000:Clf = $238E6B:EndIf 
          im = ImageID(MLD_BtTxt(svgnp,GadgetX(svgnp),GadgetY(svgnp),GadgetWidth(svgnp),GadgetHeight(svgnp),Txt$,Fontg,Clt,Clf,1))
          SetGadgetAttribute(svgnp,#PB_Button_Image,im)
     EndSelect
   Case 0
     Select svgnp  
       Case 10,11;bt texte
         Fontg = FontID4
         If svgnp = 10:Txt$ = "Alarme":clt = $0:Clf = $0000FF:EndIf
         If svgnp = 11:Txt$ = "Temps cumulé":clt = $0:Clf = $238E6B:EndIf
         im = ImageID( MLD_BtTxt(svgnp,GadgetX(svgnp),GadgetY(svgnp),GadgetWidth(svgnp),GadgetHeight(svgnp),Txt$,Fontg,Clt,Clf,2)) 
         SetGadgetAttribute(svgnp,#PB_Button_Image,im)
     EndSelect
 EndSelect 
EndProcedure

 Procedure alerteson(*valeur)
   al = *valeur
   b = 400: c = 200
   Repeat
     b = b + 50:c = c + 150
     If b > 560:b = 400:c= 300:EndIf ;tri tons
     Beep_(b,c) 
   Until  al = 100
EndProcedure

Procedure GalArm(Hda.s)
  ;Hda.s heure de l'alarme
  If dpalarm = 1
   For T =31 To 33
    SetGadgetText(T,"00")
    almvis(T,2)
  Next   
  hdadif$ = Left(Hda.s,2)+"/"+ Mid(Hda.s,6,2)+"/" + Right(Hda.s,2)
  heuralarm = ParseDate("%hh/%ii/%ss",hdadif$) ;heure de l'alarme
  hec$ = Left(dt$,2) +"/"+ Mid(dt$,6,2)+"/" + Right(dt$,2)
  hec = ParseDate("%hh/%ii/%ss",hec$  ) ;heure en cours
  difhalarm =  heuralarm - hec
  If difhalarm > 60 :Coulgad(33,$8799A8,$7FFF00,FontID1):EndIf
  If difhalarm = 60 :Coulgad(33,$8799A8,$00A5FF,FontID1):EndIf
  If difhalarm = 30 :Coulgad(33,$8799A8,$2222B2,FontID1):EndIf
  If difhalarm = 0 :dpalarm = 0:almvis(33,1):CreateThread(@alerteson(),0) :EndIf
  Tralm.s = FormatDate("%hh h %ii : %ss",difhalarm ); Temps restant avant alarme
  SetGadgetText(31,"Départ alarme      " + afhdalm$); heure de départ de l'alarme ok
  SetGadgetText(32,"Heure de l'alarme  " +Hda.s);heure e l'alarme
  SetGadgetText(33,"Alarme dans        " +Tralm.s) 
 EndIf 
EndProcedure

Procedure Gtc(dptc,htc)
 If dptc =0 :HideGadget(35,1):HideGadget(36,1):EndIf    
 If dptc =1 :HideGadget(35,0):HideGadget(36,0):SetGadgetText(36,"Temps cumulé     " +FormatDate("%hh h %ii : %ss",htc)):EndIf
EndProcedure  
  
Procedure TimerProc(hwnd.l, uMsg.l, idEvent.l, dwTime.l) 
   Select uMsg 
     Case #WM_TIMER
       dt$ = FormatDate("%hh h %ii : %ss", Date())
       SetGadgetText(26,Left(dt$,2)):SetGadgetText(28,Mid(dt$,6,2)):SetGadgetText(30,Right(dt$,2))
       difm = 60 - Val(Right(dt$,2))
       If dpalarm = 1 :GalArm(Hda$):EndIf
       If dptc = 1
         dptc$ = Left( Hdtc$,2)+"/"+ Mid( Hdtc$,6,2)+"/" + Right(Hdtc$,2);heure de dép
         hcourtc$ = Left(dt$,2)+"/"+ Mid(dt$,6,2)+"/" + Right(dt$,2);heure en cours
         x = ParseDate("%hh/%ii/%ss",dptc$) : y = ParseDate("%hh/%ii/%ss",hcourtc$) 
         z = y - x :Gtc(dptc,z)
      EndIf 
  EndSelect 
EndProcedure
 
Procedure ct(x)
  StartDrawing(CanvasOutput(101))
  Box(0,0,150,150,GetWindowColor(1))
  StopDrawing()  
  Static Angle
  Angle = Angle + 10 
  If StartVectorDrawing(CanvasVectorOutput(101))
    AddPathCircle(X(70), Y(70), X(50), 0, 360)
    VectorSourceColor(RGBA(0,206,209, 255))
    StrokePath(10)
    ClosePath()
    AddPathCircle(X(70), Y(70), X(50),Angle,Angle + 80)
    VectorSourceColor(RGBA(0,255,127, 255));tournant
    StrokePath(10)
    VectorFont(FontID(3),X(35)) 
    MovePathCursor(X(52),Y(50),#PB_Path_Default)
    If difm < 10 
      VectorSourceColor(RGBA(255,140,0,255)):DrawVectorText("0" + Str(difm))
    Else 
      VectorSourceColor(RGBA(138,43,226,255)): DrawVectorText(Str(difm))
    EndIf 
    StopVectorDrawing()
  EndIf
  If Angle => 360 :Angle = 0:EndIf 
EndProcedure 

Procedure stopalm();stop alarm
 dpalarm = 0  
 balrB  = 0:btsB(0,10):almvis(40,1)
 For s = 45 To 48
  SetGadgetText(s,"00")
 Next
 For T =31 To 33
  SetGadgetText(T,"00")
  almvis(T,1)
Next 
 al = 100; pour arr du son
EndProcedure 

hwnd = MLD_openfen(1,720,75,1125,750,"",#PB_Window_BorderLess,#PB_Window_ScreenCentered,#NUL,#NUL,0)
SetWindowCallback(@WindowCallback())
HideWindow(1,1) 
SetWindowColor(1,$8799A8)
SetWindowLongPtr_(WindowID(1), #GWL_STYLE, GetWindowLongPtr_(WindowID(1), #GWL_STYLE) | #WS_DLGFRAME)
SetWindowPos_(WindowID(1), 0,0,0,0,0,#SWP_NOSIZE|#SWP_NOMOVE|#SWP_NOZORDER|#SWP_FRAMECHANGED)
HideWindow(1,0)
StickyWindow(1,1)
bd()
SetTimer_ (WindowID (1) ,0,100, @TimerProc()) ; envoie un evenement toutes les 100 millisecondes 
MLD_ImageGadget(4,0,0,1000,70,4,Opt1.l,Opt2.l,Opt3.l,Opt4.l)
MLD_TextGadget(5,0,685,1120,0,"00",0,0,0,$D4898) 
MLD_TextGadget(6,0,700,18,40,"",0,0,0,0)
Coulgad(6,$DCDCDC,$DCDCDC,FontID5)
MLD_TextGadget(7,1102,700,18,40,"",0,0,0,0)
Coulgad(7,$DCDCDC,$DCDCDC,FontID5)
MLD_TextGadget(8,225,320,665,1,"",0,0,0,0)
Coulgad(8,$FF0000,$00FF00,FontID5)
MLD_BtTxt(10,20,700,135,40,"Alarme",FontID4,$0,$0000FF,0)
MLD_BtTxt(11,287,700,135,40,"Temps cumulé",FontID4,$0,$238E6B,0)
MLD_BtTxt(15,151,700,135,40,"Stop Alarme",FontID4,$0,$FF0000,0)
MLD_BtTxt(16,423,700,135,40,"R A Z  TC",FontID4,$0,$8CB4D2,0)
MLD_BtTxt(17,559,700,135,40,"Stop TC",FontID4,$0,$FF0000,0)
MLD_BtTxt(18,695,700,135,40,"Barre  " + Chr(8645) + Chr(8645),FontID4,$0,$20A5DA,0)
MLD_BtTxt(19,831,700,135,40,"Aide",FontID4,$0,$00008B,0)
MLD_BtTxt(20,967,700,133,40,"Stop",FontID4,$0,$E22B8A,0)
MLD_TextGadget(25,225,200,100,120,"H",0,0,0,0) 
Coulgad(25,$8799A8,$228B22,FontID5)
MLD_TextGadget(26,345,200,120,120,"00",0,0,0,0) 
Coulgad(26,$8799A8,$228B22,FontID5)
MLD_TextGadget(27,500,193,30,120,":",0,0,0,0) 
Coulgad(27,$8799A8,$228B22,FontID5)
MLD_TextGadget(28,565,200,120,120,"00",0,0,0,0) 
Coulgad(28,$8799A8,$FF0000,FontID5)
MLD_TextGadget(29,715,193,30,120,":",0,0,0,0) 
Coulgad(29,$8799A8,$228B22,FontID5)
MLD_TextGadget(30,775,200,120,120,"00",0,0,0,0) 
Coulgad(30,$8799A8,$00FFFF,FontID5)
MLD_TextGadget(31,20,400,480,40,"",0,0,0,0) 
Coulgad(31,$8799A8,$00FFFFFF,FontID1):almvis(31,1)
MLD_TextGadget(32,20,450,480,40,"",0,0,0,0) 
Coulgad(32,$8799A8,$2222B2,FontID1):almvis(32,1)
MLD_TextGadget(33,20,500,480,40,"",0,0,0,0) 
Coulgad(33,$8799A8,$7FFF00,FontID1):almvis(33,1)
MLD_TextGadget(35,650,400,480,40,"",0,0,0,0)
Coulgad(35,$8799A8,$00FFFFFF,FontID1):HideGadget(35,1)
MLD_TextGadget(36,650,500,480,40,"",0,0,0,0) 
Coulgad(36,$8799A8,$7FFF00,FontID1):HideGadget(36,1)
MLD_ContainerGadget(40,40,400,350,200,#PB_Container_Raised,0,0,0);*****
SetGadgetColor(40,#PB_Gadget_BackColor,$CD0000)
 MLD_TextGadget(42,35,10,70,25,"Heures",0,0,0,0)
 MLD_TextGadget(43,140,10,70,25,"Minutes",0,0,0,0)
 MLD_TextGadget(44,245,10,100,25,"Secondes",0,0,0,0)
 For z = 42 To 44
   Coulgad(z,$CD0000,$FFFFFF,FontID3)
 Next 
  MLD_SpinGadget(45,35,45,70,40,00,23,#PB_Spin_ReadOnly,#PB_Spin_Numeric,0,0)
  MLD_SpinGadget(46,140,45,70,40,00,59,#PB_Spin_ReadOnly,#PB_Spin_Numeric,0,0)
  MLD_SpinGadget(47,255,45,70,40,00,59,#PB_Spin_ReadOnly,#PB_Spin_Numeric,0,0)
  MLD_SpinGadget(48,30,120,80,40,00,1440,#PB_Spin_ReadOnly,#PB_Spin_Numeric,0,0)
 For zz = 45 To 48
   SetGadgetText(zz,"00")
   Coulgad(zz,$0,$F5F5F5,FontID3)
 Next  
  MLD_TextGadget(49,130,125,140,25,"H + minute(s)",0,0,0,0)
  Coulgad(49,$CD0000,$FFFFFF,FontID3)
  MLD_BtTxt(60,179,160,80,30,"Départ",FontID4,$0,$00FF7F,0)
  MLD_BtTxt(61,260,160,80,30,"Stop",FontID4,$0,$4763FF,0)
CloseGadgetList();**** 
HideGadget(40,1)
MLD_CanvasGadget(101,490, 400, 150, 150,0,0,0,0)
AddWindowTimer(1, 100, 40)
Repeat
 Select WindowEvent ()
  Case #WM_LBUTTONDOWN
    If svgn = 0 
      SendMessage_(WindowID(1), #WM_NCLBUTTONDOWN, #HTCAPTION, 0)
    Else
      bts(#WM_LBUTTONDOWN)
    EndIf 
  Case #WM_LBUTTONUP
    bts(#WM_LBUTTONUP)
  Case  #PB_Event_Timer 
    If EventTimer() = 100:CreateThread(@ct(),10):EndIf
  Case #PB_Event_Gadget
   Select  EventGadget()
    Case 10 ; bt larme
      If EventGadget()  = 10
        If balrB  = 0:btsB(1,10):balrB  = 1: almvis(40,2):EndIf
      EndIf
    Case 11 ;bt temps cumulé
      Hdtc$ = dt$:dptc = 1
      If EventGadget()  = 11:btcB  = 0:btsB(1,11):btcB  = 1:SetGadgetText(35,"Heure de départ " +dt$):Gtc(dptc,0):EndIf
    Case 15 ;bt stop alarme 
      If EventGadget()  = 15
      dpalarm = 0 : stopalm() 
     EndIf
    Case 16;bt raz Tc
      Hdtc$ = dt$
     If EventGadget()  = 16:btcB  = 0:SetGadgetText(35,"Heure de départ " +dt$):Gtc(dptc,0) :EndIf 
    Case 17 ;bt stop Tc 
     dptc = 0 
      If EventGadget()  = 17:btcB  = 0:btsB(0,11):Gtc(dptc ,0):EndIf   
    Case 18;  bt barre
      ShowWindow_(WindowID(1),#SW_MINIMIZE)
    Case 19 ;bt aide
       aide()
    Case 20 ;bt stop 
      If EventType ()= #PB_EventType_LeftClick 
        CloseWindow(1)
        Break   
      EndIf
    Case 48;spin H + minute
       Select EventType()
         Case #PB_EventType_Up
           Actspin$= FormatDate("%hh:%ii:%ss",AddDate(Date(), #PB_Date_Minute,Val(GetGadgetText(48)))) 
           SetGadgetText(45,StringField(Actspin$,1,":")):SetGadgetText(46,StringField(Actspin$,2,":"))
         Case #PB_EventType_Down  
           Actspin$= FormatDate("%hh:%ii:%ss",AddDate(Date(), #PB_Date_Minute,Val(GetGadgetText(48)))) 
           SetGadgetText(45,StringField(Actspin$,1,":")):SetGadgetText(46,StringField(Actspin$,2,":"))
       EndSelect    
    Case 60 ;bt départ dans le cont alarme
      sec$ = GetGadgetText(47):minut$ = GetGadgetText(46) :heur$ = GetGadgetText(45)
      If Len(heur$) < 2 : heur$  = InsertString(heur$ , "0", 1):EndIf
      If Len(minut$) < 2 : minut$ = InsertString(minut$, "0", 1):EndIf
      If Len(sec$) < 2 : sec$ = InsertString(sec$, "0", 1):EndIf
      Hda$ =  heur$ + " h " + minut$ + " : "+ sec$ ;Hda$ = heure de déclenchement de l'alarme
      afhdalm$ = dt$:almvis(40,1):dpalarm = 1 :GalArm(Hda$)
    Case 61 ;bt stop dans le cont alarme 
      dpalarm = 0 : stopalm() 
  EndSelect
 EndSelect 
ForEver
End

Re: Horloge avec alarme programmable

Publié : sam. 11/juil./2026 11:02
par Micoute
Bonjour MLD,

effectivement c'est une belle horloge multifonctions, ce qui ne gâte rien, j'aime bien c'est épuré, ça ne peut que plaire en plus de donner l'heure et les données de l'année en cours et même le mode d'emploi.

Re: Horloge avec alarme programmable

Publié : sam. 11/juil./2026 13:22
par MLD
Merci Micoute
Elle ne fait pas encore le café, mais va donc savoir un jour. :oops: :lol: :lol:
Bon WE a plus
Fuseau horaire sur UTC+01:00
Page 1 sur 1

Développé par phpBB® Forum Software © phpBB Limited

Traduction française officielle © Qiaeru