PureBasic
https://www.purebasic.fr/french/

DayOfYearToDate
https://www.purebasic.fr/french/viewtopic.php?f=3&t=17387
Page 1 sur 1

Auteur:  Micoute [ Mar 14/Aoû/2018 13:33 ]
Sujet du message:  DayOfYearToDate

Bonjour à tous,

j'ai eut besoin de retrouver une date en partant sur le nième jour de l'année, alors j'en ai fait une petite application que je vous offre si ça vous intéresse
Code:
;DayOfYearToDate

EnableExplicit

Enumeration Fenetres
  #Fenetre_principale
EndEnumeration

Enumeration Gadgets
  #Txt_Entree
  #Str_Entree
  #Str_Sortie
  #Btn_Valider
  #Btn_Quitter
EndEnumeration

Enumeration Polices
  #Police
EndEnumeration 

Structure sMaMap
  Doy.s
  Date.s
EndStructure 

Global Evenement, Cle.s, Annee = Year(Date()), Mois = Month(Date()), Jour, Resultat$
Global NewMap MaMap.sMaMap(), LngAn

LoadFont(#Police, "Times New Roman", 15, #PB_Font_Bold)
SetGadgetFont(#PB_Default, FontID(#Police))

Macro _AN_BIS(x); cette macro défini si une année x est bissextile ou non
  ;Auteur PAPIPP http://www.purebasic.fr/french/viewtopic.php?f=6&t=13296
  ((Bool(Not Bool((x%4)<>0))) & ((1-Bool(Not Bool((x%100)<>0)) ) | Bool(Not Bool(((x>>2)%100)<>0)) ) )
EndMacro

LngAn = 365+_AN_BIS(Annee)

Procedure Quitter()
  CloseWindow(#Fenetre_principale)
  FreeMap(MaMap())
  End
EndProcedure

Procedure Remplir_Map()
  Protected m, j, Nbj
  ;Faire une boucle m de 12 mois
  m = 1
  While m <= 12
    j = 1
    Select m
      Case 1,3,5,7,8,10,12
        Nbj = 31
      Case 4, 6, 9, 11
        Nbj = 30
      Case 2
        Nbj = 28 + _AN_BIS(Annee)
    EndSelect
    ;Faire une seconde boucle j avec le nombre de jours pour chaque mois
    While j <= Nbj
      AddMapElement(MaMap(), Str(DayOfYear(Date(Annee,m,j,0,0,0))))
      MaMap()\Doy = Str(DayOfYear(Date(Annee,m,j,0,0,0)))
      MaMap()\Date = RSet(Str(j),2,"0")+"/"+RSet(Str(m),2,"0")+"/"+RSet(Str(Annee),4,"0")
      j + 1
    Wend 
    m + 1
  Wend 
EndProcedure

Procedure$ NomJours()
  Protected NomJour$ = "Dimanche Lundi Mardi Mercredi Jeudi Vendredi Samedi"
  Protected Resultat$ = StringField(NomJour$, Val(Left(MaMap()\Date,2))%7 + 1, " ")
  ProcedureReturn Resultat$
EndProcedure

Procedure$ NomMois()
  Protected Mois = Val(Mid(MaMap()\Date, 4, 2))
  Protected NomMois$ = StringField("Janvier Février Mars Avril Mai Juin Juillet Août Septembre Octobre Novembre Décembre", Mois, " ")
  ProcedureReturn NomMois$
EndProcedure

Procedure Conversion()
  Cle = GetGadgetText(#Str_Entree)
  If Val(Cle) < 1 Or Val(Cle) > LngAn
    Resultat$ = "Donnée invalide"
  Else 
    FindMapElement(MaMap(), Cle)
    Resultat$ = NomJours() + " " + Val(Left(MaMap()\Date,2)) + " " + NomMois() + " " + Annee
  EndIf
  SetGadgetText(#Str_Sortie, Resultat$)
  Cle = ""
EndProcedure

Procedure Programme_principal()
  If OpenWindow(#Fenetre_principale, 0, 0, 410, 130, "DatOfYearToDate © Micoute - Août 2018", #PB_Window_SystemMenu|#PB_Window_ScreenCentered|#PB_Window_TitleBar)
    TextGadget(#Txt_Entree, 10, 10, 320, 30, "Entrez le jour de l'année:", #PB_Text_Center|#SS_CENTERIMAGE)
    StringGadget(#Str_Entree, 330, 10, 60, 30, "", #PB_String_BorderLess|#PB_String_Numeric|#ES_CENTER)
    ButtonGadget(#Btn_Valider, 250, 50, 100, 30, "Valider")
    ButtonGadget(#Btn_Quitter, 50, 50, 100, 30, "Quitter")
    StringGadget(#Str_Sortie, 10, 90, 380, 30, "",#SS_CENTERIMAGE|#ES_CENTER)
   
    SetActiveGadget(#Str_Entree)
   
    BindGadgetEvent(#Btn_Valider, @Conversion())
    BindGadgetEvent(#Btn_Quitter, @Quitter())
  EndIf
EndProcedure

Remplir_Map()
Programme_principal()

;- Boucle principale
Repeat
  Evenement = WaitWindowEvent()
Until Evenement = #PB_Event_CloseWindow


Auteur:  SPH [ Mer 15/Aoû/2018 2:49 ]
Sujet du message:  Re: DayOfYearToDate

Tu n'as pas un code qui puisse me dire quel jour etait le 6 nov 1994 et le 6 nov 1993 :?:

Merci 8)

Auteur:  Micoute [ Mer 15/Aoû/2018 8:02 ]
Sujet du message:  Re: DayOfYearToDate

Bonjour SPH,

je pense que je mettrais:
Code:
DayOfYear(ParseDate("%dd/%mm/%yyyy","06/11/1994"))

idem pour la suite

Auteur:  boby [ Mer 15/Aoû/2018 10:20 ]
Sujet du message:  Re: DayOfYearToDate

Merci pour le partage Micoute !

Auteur:  Micoute [ Mer 15/Aoû/2018 11:00 ]
Sujet du message:  Re: DayOfYearToDate

Mais de rien, ça me fait plaisir de partager et je pense qu'on peut faire mieux.

Auteur:  boby [ Mer 15/Aoû/2018 11:11 ]
Sujet du message:  Re: DayOfYearToDate

Micoute a écrit:
et je pense qu'on peut faire mieux.

C'est fonctionnel et le code est suffisement lisible pour facilement le modifier à sa sauce... C'est tout ce qu'on demande :wink:

Auteur:  MLD [ Mer 15/Aoû/2018 13:00 ]
Sujet du message:  Re: DayOfYearToDate

Pour ceux qui aime jouer avec les dates,et ce n'est pas spécialement simple
Code:
;MLD avec l'aide de Dobro

Global Dim Jour.s(6)
Jour(0) = "Lundi"
Jour(1) = "Mardi"
Jour(2) = "Mercredi"
Jour(3) = "Jeudi"
Jour(4) = "Vendredi"
Jour(5) = "Samedi"
Jour(6) = "Dimanche"

Procedure Equ(a, b)
    Protected s.L
    s = 0: If a = b: s = 1: EndIf
    ProcedureReturn s
EndProcedure

Procedure.l Bissex(x.l)
    Protected Result.l
    Result = (1 - Equ((x % 100), 0) )
    Result | Equ(((x >> 2) % 100), 0)
    Result & Equ((x % 4), 0)     
    ProcedureReturn Result
EndProcedure

Procedure JoursDansUnMois(x.l, Y.l)
    Protected Result.l   
    Result = (30 + ((x & 1) ! (x / 8) ) )
    Result - (Equ(x, 2) * (2 - Y) )
    ProcedureReturn Result
EndProcedure

Procedure.l JourJ(JJ.l, MM.l, AA.l)
    Protected JPM.l
    Protected j.l
    j = 0
    JPM = 0
    For i = 1900 To AA - 1: j + (365 + Bissex(i) ): Next
    For i = 1 To MM - 1: j + JoursDansUnMois(i, Bissex(AA) ): Next
    j = ((j + JJ) - 1) % 7
    ProcedureReturn j
EndProcedure

Date$ = InputRequester("Saisie d'une date", "JJ/MM/AAAA", "01/01/1900");mettre ici la date qui va bien ************
rep$= Jour(JourJ(Val(StringField(Date$, 1, "/") ), Val(StringField(Date$, 2, "/") ), Val(StringField(Date$, 3, "/") ) ) ) + " " + Date$

MessageRequester("reponse",rep$,#PB_MessageRequester_Ok )

Auteur:  Micoute [ Mer 15/Aoû/2018 13:27 ]
Sujet du message:  Re: DayOfYearToDate

Bonjour MLD, mon cher voisin de région et de département, il y a de très bonnes ressources dans ce programme, merci à toi et à Dobro du même coup. J'adore.

Auteur:  MLD [ Mer 15/Aoû/2018 14:44 ]
Sujet du message:  Re: DayOfYearToDate

Merci Micoute
C'est pour SPH de bleu il va devenir vert :mrgreen: :lol:

Page 1 sur 1 Heures au format UTC + 1 heure
Powered by phpBB © 2000, 2002, 2005, 2007 phpBB Group
http://www.phpbb.com/