DayOfYearToDate

Programmation d'applications complexes
Avatar de l’utilisateur
Micoute
Messages : 2522
Inscription : dim. 02/oct./2011 16:17
Localisation : 35520 La Mézière

DayOfYearToDate

Message par Micoute »

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 : Tout sélectionner

;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

Dernière modification par Micoute le sam. 06/juil./2019 7:26, modifié 1 fois.
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 !
Avatar de l’utilisateur
SPH
Messages : 4721
Inscription : mer. 09/nov./2005 9:53

Re: DayOfYearToDate

Message par SPH »

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

Merci 8)
http://HexaScrabble.com/
!i!i!i!i!i!i!i!i!i!
!i!i!i!i!i!i!
!i!i!i!
//// Informations ////
Intel Core i7 4770 64 bits - GTX 650 Ti
Version de PB : 6.00 - 64 bits
Avatar de l’utilisateur
Micoute
Messages : 2522
Inscription : dim. 02/oct./2011 16:17
Localisation : 35520 La Mézière

Re: DayOfYearToDate

Message par Micoute »

Bonjour SPH,

je pense que je mettrais:

Code : Tout sélectionner

DayOfYear(ParseDate("%dd/%mm/%yyyy","06/11/1994"))
idem pour la suite
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 !
boby
Messages : 261
Inscription : jeu. 07/juin/2007 22:54

Re: DayOfYearToDate

Message par boby »

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

Re: DayOfYearToDate

Message par Micoute »

Mais de rien, ça me fait plaisir de partager et je pense qu'on peut faire mieux.
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 !
boby
Messages : 261
Inscription : jeu. 07/juin/2007 22:54

Re: DayOfYearToDate

Message par boby »

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:
Dernière modification par boby le mer. 15/août/2018 13:03, modifié 1 fois.
Avatar de l’utilisateur
MLD
Messages : 1097
Inscription : jeu. 05/févr./2009 17:58
Localisation : Bretagne

Re: DayOfYearToDate

Message par MLD »

Pour ceux qui aime jouer avec les dates,et ce n'est pas spécialement simple

Code : Tout sélectionner

;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 )
Avatar de l’utilisateur
Micoute
Messages : 2522
Inscription : dim. 02/oct./2011 16:17
Localisation : 35520 La Mézière

Re: DayOfYearToDate

Message par Micoute »

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.
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 !
Avatar de l’utilisateur
MLD
Messages : 1097
Inscription : jeu. 05/févr./2009 17:58
Localisation : Bretagne

Re: DayOfYearToDate

Message par MLD »

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