Horloge 24H type tableau de bord avion

Programmation d'applications complexes
Avatar de l’utilisateur
MLD
Messages : 1097
Inscription : jeu. 05/févr./2009 17:58
Localisation : Bretagne

Horloge 24H type tableau de bord avion

Message par MLD »

Bonjour a tous
En fait Grosse mise a jour de mon Horloge de plus d'un an.

Code : Tout sélectionner

;####################################################
;# Horloge 24 Heures V3 type tableau de bord avions #
;#MLD le 03/05/2021                                 #
;#Compilation PB 5.73 LTS (X86)                     # 
;####################################################

;¤¤¤¤ Assignation des gadgets ¤¤¤¤
#Fenetre_principale = 1
#sprt_Trotteuse = 10:#sprt_GAiguille= 11:#sprt_PAiguille= 12:#sprt_Fond = 13;Les sprites
#btalrm = 20:#btstop_alrm = 21:#btTc = 22:#btrazTc = 23:#btStopTc = 24:#btbar = 25:#btStop = 26 ;Les boutons
#Falarm = 40
#Etic = 41:#Txt1 = 42:#Txt2 = 43:#Txt3 = 44:#Spin1 = 45:#Spin2 = 46:#Spin3 = 47
#btalrmOK = 48:#btalrmstop = 49
#Timer1 = 155:#Timer2 = 156 ;timer son
;¤¤¤¤¤¤¤¤
InitSprite()
Global TailleImage = 500 ; Toujours carrée et en pixels
Global colorhm.d = $8CE6F0,colort.d = $32CD32
Global XC.i, YC.i, Radius.i ;Coordonnées et rayon du point central du cercle
Global X.f, Y.f ;Coordonnées des points sur le cercle 
Global Digit.i,Dpalm.b,DpalmD.b;,Evenement
Global Buffer.s,Halm.s,Malm.s,Salm.s
Global Dpds,DpAsound ;drapeau déclenche et arrête le son
Global Dim Tcm.D(60,3), Dim Tnm.D(60,2)  
Global fontH = LoadFont(100,"Tahoma",22)
Global fontM = LoadFont(101,"Tahoma",18)
Global fontD = LoadFont(103,"Tahoma", 22)
Global fontE = LoadFont(104,"Tahoma", 14)
Global FontBT = LoadFont(105,"Tahoma", 12)

Procedure ButtonColorGadget(num,x,y,w,h,text$,fcolor,bcolor,flags=0)
  img=CreateImage(#PB_Any,w,h)
  If StartDrawing(ImageOutput(img))
    DrawingFont(fontBT)  
    Box(0,0,w,h,bcolor)
    DrawText(w/2-TextWidth(text$)/2,h/2-TextHeight(text$)/2,text$,fcolor,bcolor)
    StopDrawing() : ok=ButtonImageGadget(num,x,y,w,h,ImageID(img),flags)
  EndIf
EndProcedure

Procedure Pmin()
   StartDrawing(SpriteOutput(13))
      Radius = 348:nm = -1
      For N = -90 To 274 Step 6
        X = XC + Radius * Cos(N * #PI / 180)
        Y = YC + Radius * Sin(N * #PI / 180)
        nm = nm +1
        Tnm(nm,1) = X:Tnm(nm,2) = Y
        Circle(X,Y,3.4,$00FFFF)
      Next
      For rp = 1 To Val(FormatDate("%ss", Date()));remplis les point en vert
        Circle(Tnm(rp,1),Tnm(rp,2),3,$00FF00)
      Next  
   StopDrawing()  
 EndProcedure
 
 Procedure Ralarm();réglage de l'alerte
 StickyWindow(1,0)   
 OpenWindow(40,WindowX(1)+ ((WindowWidth(1)- 350)/2),WindowY(1)+ ((WindowHeight(1)- 190)/2),350,180,"",#PB_Window_BorderLess|#NUL)
 SetWindowColor(40,$94A3A3)
 SetWindowLongPtr_(WindowID(40),#GWL_HWNDPARENT,FindWindow_(0,"program manager"))
 SetWindowLongPtr_(WindowID(40), #GWL_STYLE, GetWindowLongPtr_(WindowID(40), #GWL_STYLE) | #WS_DLGFRAME)
 SetWindowPos_(WindowID(40), 0,0,0,0,0,#SWP_NOSIZE|#SWP_NOMOVE|#SWP_NOZORDER|#SWP_FRAMECHANGED)
 StickyWindow(40,1)
;Vos gadgets ici
 N$ = " ALARME"
 For A = 1 To 7
   L$ = L$ + Mid(N$,A,1) + Chr(10) 
 Next
 TextGadget(41,0,0,30,190,L$,#PB_Text_Center)
 SetGadgetColor(41,#PB_Gadget_BackColor,$507FFF):SetGadgetColor(41,#PB_Gadget_FrontColor,$CD0000)
 TextGadget(42,40,10,70,25,"Heures")
 TextGadget(43,140,10,70,25,"Minutes")
 TextGadget(44,250,10,100,25,"Secondes")
 SpinGadget(45,35,45,70,40,00,23,#PB_Spin_ReadOnly|#PB_Spin_Numeric)
 SetGadgetText(45,"00")
 SpinGadget(46,140,45,70,40,00,59,#PB_Spin_ReadOnly|#PB_Spin_Numeric)
 SetGadgetText(46,"00")
 SpinGadget(47,255,45,70,40,00,59,#PB_Spin_ReadOnly|#PB_Spin_Numeric)
 SetGadgetText(47,"00")
 ButtonGadget(48,179,145,80,25,"Ok")
 ButtonGadget(49,260,145,80,25,"Stop")
 For c = 41 To 49
  If c < 45 Or c > 47
    SetGadgetFont(c,fontE)
    If c > 41 :SetGadgetColor(c,#PB_Gadget_BackColor,$94A3A3):SetGadgetColor(c,#PB_Gadget_FrontColor,$CD0000):EndIf
  Else
    SetGadgetFont(c,fontM)
    SetGadgetColor(c,#PB_Gadget_BackColor,$0):SetGadgetColor(c,#PB_Gadget_FrontColor,$F5F5F5)
  EndIf
 Next 
EndProcedure

Procedure AFDT(x,y,txt$)
StartDrawing(SpriteOutput(13))
 DrawingFont(FontD)
 DrawText(x,y,txt$,$FFFF00,$0)
StopDrawing() 
EndProcedure  

Procedure JMD();date avec jours et mois
Jour$ = "Dimanche,Lundi,Mardi,Mercredi,Jeudi,Vendredi,Samedi" 
Jour$= StringField (Jour$, DayOfWeek ( Date ())+1, "," )    
Date1$ = Jour$ +" " + FormatDate("%dd ", Date()):Date2$ = Mois$ + FormatDate("  %yyyy", Date()); + Mois$ + FormatDate("  %yyyy", Date())
Date2$ = FormatDate("%mm - %yyyy", Date())
AFDT(20,10,Date1$):AFDT(20,45,Date2$)
EndProcedure

Procedure calculnbjour();calcul le nombre de jour écoulé a la date indiqué et ce qui reste
 annee = Year(Date())
 If ((annee % 4 = 0 And annee % 100 <> 0) Or annee % 400 = 0) = 1;année bissextile ou pas
   totalj.w = 366
 Else
   totalj.w = 365
 EndIf  
 nbjt.w = DayOfYear(Date())
 diffjour.w = totalj - nbjt.w 
 AFDT(640,45,"J " + Str(nbjt.w) + "  " + "R "+ Str(diffjour.w))
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.i NumSem();donne le num de semaine selon norme iso
  date.i = Date()
  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
    ns = Round((jda-DjanP)/7, #PB_Round_Up)
  Else ;si non c'est dans la 1ere semaine
    ns = 1
  EndIf
  AFDT(640,10,"Semaine " + Str(ns))
EndProcedure 

Procedure Tourn()
 ClearScreen($0)
  xsec.s = FormatDate("%ss", Date())
  xmin.s = FormatDate("%ii", Date())
  xheure.s = FormatDate("%hh", Date())
  StartDrawing(SpriteOutput(13))
  DrawingFont(FontD);affiche en digital
  DrawText(342,210, xheure.s + ":" + xmin.s +":" ,$00FFFF ,$0)
  DrawText(425,210,xsec.s,$00FF00,$0)
  StopDrawing() 
  s = Val(xsec) * 6
  m = (Val(xmin) * 60) / 10
  If Val(xsec) = 0 : Pmin() : EndIf
 StartDrawing(SpriteOutput(13))
  Circle(Tnm(Val(xsec),1),Tnm(Val(xsec),2),3,$00FF00);les points seconde
  DrawingMode(#PB_2DDrawing_Transparent)
  DrawingFont(FontM)
  For z = 1 To 60
    If Val(xmin.s)  = Tcm.D(z,1)
      X = Tcm.D(z,2):Y = Tcm.D(z,3):Break
    EndIf
  Next
  DrawText(X - TextWidth(Str(Tcm.d(z,1)))/2,Y - TextHeight(Str(Tcm.d(z,1)))/2,Str(Tcm.d(z,1)),$00FFFF)
  For zz = 1 To 60
    If Val(xmin.s)-1  = Tcm.D(zz,1)
      X = Tcm.D(zz,2):Y = Tcm.D(zz,3):Break
    EndIf
   Next
   If Val(xmin.s)= 0
     zz = 60 :X = Tcm.D(zz,2):Y = Tcm.D(zz,3)
     DrawText(X - TextWidth(Str(Tcm.d(zz,1)))/2,Y - TextHeight(Str(Tcm.d(zz,1)))/2,Str(Tcm.d(zz,1)),$FFFFFF)
   Else
     DrawText(X - TextWidth(Str(Tcm.d(zz,1)))/2,Y - TextHeight(Str(Tcm.d(zz,1)))/2,Str(Tcm.d(zz,1)),$FFFFFF)
   EndIf
   StopDrawing()
   If Dpalm.b = 1;alarme indiquée
    If xheure.s = Halm.s And xmin.s = Malm.s And xsec.s = Salm.s:DpalmD.b = 1:EndIf;alarme déclenchée
    If  DpalmD.b = 1:Coloralm.f = $0000FF:Else:Coloralm.f = $00A5FF :EndIf
    StartDrawing(SpriteOutput(13))
    DrawingFont(FontD)
    DrawText(20,715,"Alarme H" ,Coloralm.f ,$0)
    DrawText(20,760, Halm.s + ":" +  Malm.s  +":" +  Salm.s ,Coloralm.f ,$0)
   StopDrawing()
 Else
   StartDrawing(SpriteOutput(13))
    Box(20,710,140,85,$0);efface inscription alarme
   StopDrawing()
  EndIf 
   
  h = (Val(xheure) * 60) / 4 ; système 24 h
  ZoomSprite(10, TailleImage, TailleImage)
  ZoomSprite(11, TailleImage, TailleImage)
  ZoomSprite(12, TailleImage, TailleImage)
  ZoomSprite(13, TailleImage, TailleImage)
  
  RotateSprite(10, s, 0);Trotteuse
  RotateSprite(11, m, 0);Grande aiguille
  RotateSprite(12, h, 0);Petite aiguille
      
  DisplayTransparentSprite(13, 0, 0, 255);Fond
  DisplayTransparentSprite(12, 0, 0, 255);Petite aiguille
  DisplayTransparentSprite(11, 0, 0, 255);Grande aiguille
  DisplayTransparentSprite(10, 0, 0, 255);troteuse
  FlipBuffers()
EndProcedure

Procedure CT(sc,mc,hc,DpTC)
 vhc.s =  Str(hc):vmc.s =  Str(mc):vsc.s =  Str(sc)
 If Len(vhc.s) < 2 :vhc.s = "0" + vhc.s :EndIf 
 If Len(vmc.s) < 2 :vmc.s = "0" + vmc.s :EndIf 
 If Len(vsc.s) < 2 :vsc.s = "0" + vsc.s :EndIf      
 af$ = "H " + vhc.s + " : " + vmc.s + " : " + vsc.s 
 If DpTC = 1
 StartDrawing(SpriteOutput(13))
    DrawingFont(FontD)
    DrawText(662,715,"T C",$FF00FF,$0)
    DrawText(602,760,af$,$FF00FF,$0)
    StopDrawing()
 Else   
  StartDrawing(SpriteOutput(13))
    Box(603,720,200,75,$0);efface inscription alarme
   StopDrawing()
 EndIf  
EndProcedure  

Global a
Procedure alerteson(*valeur)
  DpalmD.b = 0:DpAsound = 1
  a = *valeur
  b = 400: c = 200
  Repeat
   If b > 450:b = 400:c= 200:EndIf ;bis tons
   b = b + 50:c = c + 150
   Beep_(b,c) 
  Until  a = 100
EndProcedure

OpenWindow(1,0,0,TailleImage,530,"",#PB_Window_BorderLess |#PB_Window_Invisible|#PB_Window_ScreenCentered)
SetClassLongPtr_(WindowID(1),#GCL_STYLE,$00020000)
HideWindow(1,0)
StickyWindow(1,1)
SetWindowColor(1,$534845)
  If OpenWindowedScreen(WindowID(1), 0, 0, TailleImage,TailleImage,0,0,0)
    CreateSprite(10, 800, 800);trotteuse
    CreateSprite(11, 800, 800);Grande aiguille
    CreateSprite(12, 800, 800);Petite aiguille
    CreateSprite(13, 800, 800);Fond
    StartDrawing(SpriteOutput(13))
      XC = 400:YC = 400;Coordonnées du point central du cercle
      Circle(XC, YC, 2, RGB(255, 69, 0));Point central
      ;Les heures 
      Radius = 220
      For N = 0 To 345 Step 15
        X = XC + Radius * Cos(N * #PI / 180)
        Y = YC + Radius * Sin(N * #PI / 180)
        Circle(X,Y,3,$FF00FF)
      Next
      StopDrawing() 
      ;Les minutes
      Pmin()
      ;Les Chiffres des heures 
      StartDrawing(SpriteOutput(13)) 
       Digit = 0
       Radius = 260
       DrawingFont(fontH)
       For N = -75 To 275 Step 15
        Digit+1
        If Digit>24
          Digit = 1
        EndIf
        X = XC + Radius * Cos(N * #PI / 180)
        Y = YC + Radius * Sin(N * #PI / 180)
        Buffer=Str(Digit)
        If Digit = 24 :Buffer=Str(0):EndIf
        DrawingMode(#PB_2DDrawing_Transparent)
        DrawText(X-TextWidth(Buffer)/2, Y-TextHeight(Buffer)/2, Buffer,$8CE6F0)
        DrawingMode(#PB_2DDrawing_Default)
       Next
       ;Les Chiffres des minutes
       Digit= 15
       Radius = 381
       DrawingFont(FontM)
       For N = 0 To 359 Step 6
         Digit+1
         If Digit>60
           Digit = 1
         EndIf
         X = XC + Radius * Cos(N * #PI / 180)
         Y = YC + Radius * Sin(N * #PI / 180)
         Buffer=Str(Digit-1)
         Tcm.d(Digit,1) = Digit-1 : Tcm.D(Digit,2) = X : Tcm.D(Digit,3) = Y   
         DrawingMode(#PB_2DDrawing_Transparent)
         DrawText(X-TextWidth(Buffer)/2, Y-TextHeight(Buffer)/2, Buffer,$FFFFFF)
         DrawingMode(#PB_2DDrawing_Default)
       Next
      StopDrawing()
    If StartDrawing(SpriteOutput(10));Trotteuse
      LineXY(398, 550, 398, 65,colort.d)
      LineXY(399, 550, 399, 60,colort.d)
      LineXY(400, 550, 400, 55,colort.d)
      LineXY(401, 550, 401, 60,colort.d)
      LineXY(402, 550, 402, 65,colort.d)
      
      Circle(400, 530, 10,colort.d)
      Circle(400, 535,  9,colort.d)
      Circle(400, 540,  8,colort.d)
      Circle(400, 545,  7,colort.d)
      Circle(400, 550,  6,colort.d)
      Circle(400, 400, 15,colort.d)
      StopDrawing()
    EndIf
    If StartDrawing(SpriteOutput(11));Grande aiguille
      LineXY(398, 400, 398, 65,colorhm.d)
      LineXY(399, 400, 399, 60,colorhm.d)
      LineXY(400, 400, 400, 55,colorhm.d)
      LineXY(401, 400, 401, 60,colorhm.d)
      LineXY(402, 400, 402, 65,colorhm.d)
      StopDrawing()
    EndIf
    If StartDrawing(SpriteOutput(12));Petite aiguille
      LineXY(398, 400, 398, 200,colorhm.d)
      LineXY(399, 400, 399, 195,colorhm.d)
      LineXY(400, 400, 400, 190,colorhm.d)
      LineXY(401, 400, 401, 195,colorhm.d)
      LineXY(402, 400, 402, 190,colorhm.d)
      StopDrawing()
    EndIf
  EndIf
  ButtonColorGadget(20,10,502,50,25,"ALR",$00FFFF,$0)
  GadgetToolTip(20,"Programme une alarme")
  ButtonColorGadget(21,61,502,80,25,"Stop ALR",$00FFFF,$0)
  GadgetToolTip(21,"Arrête une alarme")
  ButtonColorGadget(22,150,502,50,25,"TC",$00FFFF,$0)
  GadgetToolTip(22,"Temps cumulé")
  ButtonColorGadget(23,201,502,80,25,"Raz TC",$00FFFF,$0)
  GadgetToolTip(23,"Remise a zéro du Temps cumulé")
  ButtonColorGadget(24,282,502,70,25,"Stop TC",$00FFFF,$0)
  GadgetToolTip(24,"Stop Temps cumulé") 
  ButtonColorGadget(25,360,502,70,25,"Barre " + Chr(8645),$00FFFF,$0)
  GadgetToolTip(25,"Réduction dans la barre de tâche")
  ButtonColorGadget(26,431,502,60,25,"Stop",$00FFFF,$0)
  GadgetToolTip(26,"Arrêt de l'horloge")
  AddWindowTimer(1,155,1000)
  AddWindowTimer(1,156,1)
  JMD(): NumSem(): calculnbjour()
;¤¤¤¤¤¤¤¤¤  boucle principale ¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
Repeat
  Evenement = WindowEvent()
  If DpTC = 1
   If Evenement = #PB_Event_Timer And EventTimer() = 155
    sc = sc +1
    If sc = 60 
      sc = 0
      mc = mc +1
    EndIf 
    If mc = 60
      mc = 0
      hc =hc + 1
    EndIf
   EndIf
    CT(sc,mc,hc,DpTC)
  EndIf
  If Evenement = #PB_Event_Timer And EventTimer() = 156 And DpalmD.b = 1
    ds = ds +1
    If ds = 1
      ;alerteson()
      CreateThread(@alerteson(),0) 
   EndIf
  EndIf
  Select EventWindow() 
   Case 1
    If GetActiveWindow() <>40
      If  Evenement = #WM_LBUTTONDOWN
        SendMessage_(WindowID(1), #WM_NCLBUTTONDOWN, #HTCAPTION, 0)
      EndIf  
     EndIf    
    If Evenement = #PB_Event_Gadget
     Select EventGadget()
      Case 20;alarme
       Ralarm()
      Case 21 ;stop alarme
       If DpAsound = 1
         a = 100
         DpAsound = 0:ds = 0
       EndIf  
       Dpalm.b = 0:DpalmD.b = 0
      Case 22;bt tc
       DpTC = 1
      Case 23 ;raz TC
       sc = 0:mc =0 :hc =0
      Case 24;stop TC
       sc = 0:mc =0 :hc =0:DpTC = 0
       CT(sc,mc,hc,DpTC)
      Case 25;barre
       SetWindowState(1,#PB_Window_Minimize) 
      Case 26;stop
       Break 
     EndSelect
    EndIf   
    Tourn()
   Case 40 ;2em
    If Evenement = #PB_Event_Gadget
       Select EventGadget()
       Case 48;ok
        Halm.s = GetGadgetText(45): Malm.s = GetGadgetText(46):Salm.s = GetGadgetText(47)
        If Len(Halm.s) < 2 : Halm.s = "0" + Halm.s:EndIf
        If Len(Malm.s) < 2 : Malm.s = "0" + Malm.s:EndIf
        If Len(Salm.s) < 2 : Salm.s = "0" + Salm.s:EndIf
        Dpalm.b = 1
        CloseWindow(40)
        StickyWindow(1,1)
       Case 49
        CloseWindow(40)
        StickyWindow(1,1) 
    EndSelect 
  EndIf
  EndSelect
 ForEver 
FreeArray(Tnm.D()):FreeArray(Tcm.D())
End
Avatar de l’utilisateur
Kwai chang caine
Messages : 6962
Inscription : sam. 23/sept./2006 18:32
Localisation : Isere

Re: Horloge 24H type tableau de bord avion

Message par Kwai chang caine »

Je sais pas si il y a vraiment les mêmes dans certains avions, mais elle me plait beaucoup ton horloge, c'est la classe 8O
Merci du partage 8)
ImageLe bonheur est une route...
Pas une destination

PureBasic Forum Officiel - Site PureBasic
Avatar de l’utilisateur
MLD
Messages : 1097
Inscription : jeu. 05/févr./2009 17:58
Localisation : Bretagne

Re: Horloge 24H type tableau de bord avion

Message par MLD »

Merci KCC
Avatar de l’utilisateur
Micoute
Messages : 2522
Inscription : dim. 02/oct./2011 16:17
Localisation : 35520 La Mézière

Re: Horloge 24H type tableau de bord avion

Message par Micoute »

Belle refonte, je te remercie pour le partage.
Microsoft Windows 10 Famille 64 bits : Carte mère : ASRock 970 Extreme3 R2.0 : Carte Graphique NVIDIA GeForce RTX 3080 : Processeur AMD FX 6300 6 cœurs 12 threads 3,50 GHz PB 5.73 PB 6.00 LTS (x64)
Un homme doit être poli, mais il doit aussi être libre !
Répondre