Page 1 sur 1

Horloge style tableau de bord avion

Publié : mar. 03/mars/2020 10:43
par MLD
Bonjour a tous
Pour le fun. un petit code que vous pourrez améliorer a votre guise. :D
Avec son autorisation j'ai un peu pompé du code a Micoute. Merci a lui :oops:
Un clic droit de la souris sur la pendule pour arrêter le programme.

Code : Tout sélectionner

;#################################################
;# Horloge 24 Heures type tableau de bord avions #
;# Merci a Micoute auquel j'ai repris l'éssentiel#
;#MLD le 1/03/2020.                              #
;#Compilation PB 5.71 LTS (X86)                  # 
;#################################################

Enumeration Font
  #FontHour
  #FontMinute
  #Fontdigit 
EndEnumeration

Enumeration Fenetre
  #Fenetre_principale
EndEnumeration

Enumeration Sprites
  #Trotteuse
  #GrandeAiguille
  #PetiteAiguille
  #Fond
EndEnumeration

InitSprite()

Global TailleImage = 500 ; Toujours carrée et en pixels
Global colorhm.d = $8CE6F0
Global colort.d = $32CD32;$0045FF
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
Global Buffer.s

Procedure Pmin()
  Global Dim Tnm.D(60,2) 
  StartDrawing(SpriteOutput(#Fond))
      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  

OpenWindow(#Fenetre_principale,0,0,TailleImage,TailleImage,"",#PB_Window_BorderLess |#PB_Window_Invisible|#PB_Window_ScreenCentered)
SetClassLongPtr_(WindowID(#Fenetre_principale),#GCL_STYLE,$00020000)
HideWindow(#Fenetre_principale,0)
StickyWindow(#Fenetre_principale,1)
SetWindowColor(#Fenetre_principale,$808080)

  If OpenWindowedScreen(WindowID(#Fenetre_principale), 0, 0, TailleImage, TailleImage,1,0,0)
    
    CreateSprite(#Trotteuse, 800, 800)
    CreateSprite(#GrandeAiguille, 800, 800)
    CreateSprite(#PetiteAiguille, 800, 800)
    CreateSprite(#Fond, 800, 800)
        
    LoadFont(#FontHour, "Tahoma",22);, #PB_Font_Bold
    LoadFont(#FontMinute, "Tahoma",18)
    LoadFont(#Fontdigit, "Tahoma", 22)
    
    StartDrawing(SpriteOutput(#Fond))
      ;Coordonnées du point central du cercle
      XC = 400
      YC = 400
      ;Point central
      Circle(XC, YC, 2, RGB(255, 69, 0))
      ;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(#Fond)) 
       Digit = 0
       Radius = 260
       DrawingFont(FontID(#FontHour))
       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
       Global Dim Tcm.D(60,3) 
       Digit= 15
       Radius = 381
       DrawingFont(FontID(#FontMinute))
       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(#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(#GrandeAiguille))
      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(#PetiteAiguille))
      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

Repeat
  Evenement = WindowEvent()
  If Evenement = #WM_LBUTTONDOWN
     SendMessage_(WindowID(#Fenetre_principale), #WM_NCLBUTTONDOWN, #HTCAPTION, 0)
   EndIf
  ClearScreen($0)
  xsec.s = FormatDate("%ss", Date())
  xmin.s = FormatDate("%ii", Date())
  xheure.s = FormatDate("%hh", Date())
  StartDrawing(SpriteOutput(#Fond))
  
  DrawingFont(FontID(#Fontdigit))
  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(#Fond))
  Circle(Tnm(Val(xsec),1),Tnm(Val(xsec),2),3,$00FF00);les points seconde
  DrawingMode(#PB_2DDrawing_Transparent)
  DrawingFont(FontID(#FontMinute))
  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()
  h = (Val(xheure) * 60) / 4 ; système 24 h
  ZoomSprite(#Trotteuse, TailleImage, TailleImage)
  ZoomSprite(#GrandeAiguille, TailleImage, TailleImage)
  ZoomSprite(#PetiteAiguille, TailleImage, TailleImage)
  ZoomSprite(#Fond, TailleImage, TailleImage)
  
  RotateSprite(#Trotteuse, s, 0)
  RotateSprite(#GrandeAiguille, m, 0)
  RotateSprite(#PetiteAiguille, h, 0)
      
  DisplayTransparentSprite(#Fond, 0, 0, 255)
  DisplayTransparentSprite(#PetiteAiguille, 0, 0, 255)
  DisplayTransparentSprite(#GrandeAiguille, 0, 0, 255)
  DisplayTransparentSprite(#Trotteuse, 0, 0, 255)
  FlipBuffers()
Until Evenement = #WM_RBUTTONUP  ;#PB_Event_CloseWindow
FreeArray(Tnm.D()):FreeArray(Tcm.D())
End

Re: Horloge style tableau de bord avion

Publié : mar. 03/mars/2020 13:49
par Micoute
Tu as bien fait d'afficher l'heure en haut, parce que c'est un peu déconcertant les heures et les minutes qui sautent d'un cran d'un coup, mais finalement on arrive à lire l'heure normalement.

Merci pour avoir créé et partagé cette version.

Re: Horloge style tableau de bord avion

Publié : mar. 03/mars/2020 16:21
par Kwai chang caine
Oui elle a de la gueule :D , manque que l'avion :mrgreen:
Merci du partage 8)

Re: Horloge style tableau de bord avion

Publié : mar. 03/mars/2020 16:56
par MLD
Merci les copains :lol:
ATTENTION GROS BUG AU PASSAGE DES HEURES. correction au poste 1
@ Micoute avec ta pendule on peu lire 24H30 ce qui n'existe pas. :mrgreen:
@KCC J'attend avec impatience ta livraison de l'avion pour la programmée dessus. :mrgreen:

Re: Horloge style tableau de bord avion

Publié : mer. 04/mars/2020 9:03
par Kwai chang caine
C'est le retour du bug de l'an 2000 :lol:
@KCC J'attend avec impatience ta livraison de l'avion pour la programmée dessus. :mrgreen:
Si j'savais programmer ce genre de trucs...ça se saurait :mrgreen: