Fonctions de dates

Micoute · Message par **Micoute** » jeu. 09/mars/2017 10:39

Bonjour à tous, je vous offre ma bibliothèque de fonctions de dates et j'espère que ça vous plaira, vous avez le droit de modifier le logiciel.

Code : Tout sélectionner

;Fonctions_Date.pbi

EnableExplicit

#SecsParJour = 86400
Enumeration
  #Date_Annee
  #Date_Mois
  #Date_Semaine
  #Date_Jour
  #Date_Heure
  #Date_Minute
  #Date_Seconde
EndEnumeration

Structure DiffTemps 
  TotalJours.i
  Annees.i 
  Mois.i 
  JoursRestants.i 
  Heures.i 
  Minutes.i 
  Secondes.i 
EndStructure

Structure StrucSaisons
  Printemps.i[20]
  Ete.i[20]
  Automne.i[20]
  Hiver.i[20]
EndStructure

Structure StrucSoleil
  Lever$
  Coucher$
EndStructure  

#Quantite = 365

Structure MaDate
  Jour.i
  Mois.i
  NSem.i ;Numéro de semaine
EndStructure 


Declare.b SiBissextile(Annee=-1)
Declare$ ChaineDate(Masque$, date.i) 
Declare.b JoursDansMois(Annee=-1, mois=-1)
Declare$ DDA(Annee=-1) ;
Declare$ FDA(Annee=-1) ;
Declare$ DDM(Annee=-1,Mois=-1) ;
Declare$ FDM(Annee=-1, Mois=-1);
Declare.w JDA(Annee=-1)        ;
Declare.w JourRestantAnnee()   ;
Declare.b DonneSemaine(PAnnee.i,PMois.b,PJour.b) ;
Declare.b NumSemaine()                           ;
Declare.i NumeroSemaine(Date.i)                  ;
Declare.b NbSemRestant()                         ;
Declare$ JDS()                                   ;
Declare.b Jour(_Jour_=-1)                        ;
Declare$ NomMois()                               ;
Declare.i Mois(_Mois_=-1)
Declare.w JourRestantMois(Mois) ;
Declare.i Annee(_Annee_=-1)
Declare.i EstDateValide(Jour,Mois,Annee) ;
Declare$ CToD(Chaine$)                   ;
Declare$ DToC(Chaine$)                   ;
Declare.i DToN(Chaine$)                  ;
Declare$ NToD(Nombre.i)                  ;
Declare.i IncrementerAnnees(Annee =-1, Nombre_d_annees = 1)
Declare.i IncrementerMois(Annee = -1, Nombre_de_mois = 1)
Declare.i IncrementerJours(Annee = -1, Nombre_de_jours = 1)
Declare.i IncrementerHeures(Annee = -1, Nombre_d_heures = 1)
Declare.i IncrementerMinutes(Annee = -1, Nombre_de_Minutes = 1)
Declare.i IncrementerSecondes(Annee = -1, Nombre_de_Secondes = 1)
Declare.i IncrementerDate(Annee = -1, Nombre_d_annees = 0, Nombre_de_mois = 0, Nombre_de_jours = 0, Nombre_d_heures = 0, Nombre_de_Minutes = 0, Nombre_de_Secondes = 0)
Declare.i DateDiff(dateAvant, dateApres, *diff.DiffTemps) 
Declare.i AnalyserDate(Date$)
Declare.s ComparerDates(Date1$, Date2$)
Declare.i CalculerAge(jour_naissance.b,mois_naissance.b,annee_naissance.q)
Declare.i TrouverPremierDimanche(Annee, Mois)
Declare.i TrouverDeuxiemeDimanche(Annee, Mois)
Declare.i TrouverTroisiemeDimanche(Annee, Mois)
Declare.i TrouverQuatriemeDimanche(Annee, Mois)
Declare.i TrouverDernierDimanche(Annee, Mois)
Declare.s TrouverPremierJourSemaine(Annee, Mois, Joursem)
Declare.s TrouverDeuxiemeJourSemaine(Annee, Mois, Joursem)
Declare.s TrouverTroisiemeJourSemaine(Annee, Mois, Joursem)
Declare.s TrouverQuatriemeJourSemaine(Annee, Mois, Joursem)
Declare.s TrouverCinquiemeJourSemaine(Annee, Mois, Joursem)
Declare ChercherVendredi13(Annee, Mois)
Declare$ SigneAstro(Jour,Mois) ;
Declare$ Saison(Jour, Mois)    ;
Declare$ Article_Saison(jour, mois)
Declare$ Article_Astro(jour, mois)
Declare.s NomJourSemaine(Annee=-1,Mois=-1,Jour=-1)
Declare.s ZoneFuseau()
Declare.i DecalageHoraire(type)
Declare.s CalculerSoleil (lat.f, lon.f, JA.i, tz.d)  
Declare.s Lever_Soleil(lat.f, lon.f, JA.i, tz.d)
Declare.s Coucher_Soleil(lat.f, lon.f, JA.i, tz.d)
Declare.i MonJDS (date.i)
Declare.i NumSem(date.i)
Declare CalculerNumSem()

Global Annee, mois, NbjoursMois
Global NumSem.b, NbJMR.b, date, NumJS, i
Global JourCourant$, MoisCourant$, DateCourante$
Global Semaine.b
Global Masque$ = "%dddd %dd %mmm %yyyy" 
Global NomJours$ = "dimanche lundi mardi mercredi jeudi vendredi samedi"
Global NomJoursAbr$ = "dim lun mar mer jeu ven sam"
Global NomMois$ = "janvier février mars avril mai juin juillet août septembre octobre novembre décembre"
Global NomMoisAbr$ = "jan. fév. mars avr. mai juin juil. août sept. oct. nov. déc."
Global *Saison.StrucSaisons = AllocateStructure(StrucSaisons), *Soleil.StrucSoleil = AllocateStructure(StrucSoleil), w=1, X, Y, Z
Global Dim TabNomMois$(1,12), Dim TabNomJours$(1,7)
Global.s Date_Printemps, Date_Ete, Date_Automne, Date_Hiver, Lever$, Coucher$
Global.MaDate Dim MaDonnee(365)

CalculerNumSem()

Restore Printemps
For Z = 0 To 19
  Read.s Date_Printemps
  With *Saison
    \Printemps[Z] = ParseDate("%dd/%mm/%yyyy", Date_Printemps)
  EndWith
Next Z
Restore Ete
For Z = 0 To 19
  Read.s Date_Ete
  With *Saison
    \Ete[Z] = ParseDate("%dd/%mm/%yyyy", Date_Ete)
  EndWith
Next Z
Restore Automne
For Z = 0 To 19
  Read.s Date_Automne
  With *Saison
    \Automne[Z] = ParseDate("%dd/%mm/%yyyy", Date_Automne)
  EndWith
Next Z
Restore Hiver
For Z = 0 To 19
  Read.s Date_Hiver
  With *Saison
    \Hiver[Z] = ParseDate("%dd/%mm/%yyyy", Date_Hiver)
  EndWith
Next Z  

DataSection
  Printemps:
  Data.s "20/03/2016", "20/03/2017", "20/03/2018", "20/03/2019", "20/03/2020", "20/03/2021", "20/03/2022", "20/03/2023", "20/03/2024", "20/03/2025",
         "20/03/2026", "20/03/2027", "20/03/2028", "20/03/2029", "20/03/2030", "20/03/2031", "20/03/2032", "20/03/2033", "20/03/2034", "20/03/2035"
  Ete:
  Data.s "21/06/2016", "21/06/2017", "21/06/2018", "21/06/2019", "20/06/2020", "21/06/2021", "21/06/2022", "21/06/2023", "20/06/2024", "21/06/2025",
         "21/06/2026", "21/06/2027", "20/06/2028", "21/06/2029", "21/06/2030", "21/06/2031", "20/06/2032", "21/06/2033", "21/06/2034", "21/06/2035"
  Automne:
  Data.s "22/09/2016", "22/09/2017", "23/09/2018", "23/09/2019", "22/09/2020", "22/09/2021", "23/09/2022", "23/09/2023", "22/09/2024", "22/09/2025",
         "23/09/2026", "23/09/2027", "22/09/2028", "22/09/2029", "23/09/2030", "23/09/2031", "22/09/2032", "22/09/2033", "23/09/2034", "23/09/2035"
  Hiver:
  Data.s "21/12/2016", "21/12/2017", "21/12/2018", "22/12/2019", "21/12/2020", "21/12/2021", "21/12/2022", "22/12/2023", "21/12/2024", "21/12/2025",
         "21/12/2026", "22/12/2027", "21/12/2029", "21/12/2029", "21/12/2030", "22/12/2031", "21/12/2032", "21/12/2033", "21/12/2034", "22/12/2035"
EndDataSection

Macro Bissextile(Annee)
  Bool(((Not Year(Annee) % 4) And Year(Annee) % 100) Or (Not Year(Annee) % 400))
EndMacro

For i = 1 To 12
  TabNomMois$(0, i) = StringField(NomMois$, i, " ")
  TabNomMois$(1, i) = Str(i)
Next i

For i = 1 To 7
  TabNomJours$(0, i) = StringField(NomJours$, i, " ")
  TabNomJours$(1, i) = Str(i)
Next i

Procedure.b SiBissextile(Annee=-1)
  ; Retourne Vrai si l'année est une année bissextile (366 jours)
  ; S'il n'y a aucun argument, l'année en cours est utilisée
  ;   Dans le calendrier grégorien, l'année bissextile est
  ;   toute année divisible par 4, sauf
  ;   année du centenaire non divisible par 400
  ; L'année équinoxe de printemps est d'environ 365.242374 jours longs (et croissants)
  ; Le calendrier iranien est basée sur 8 jours bissextiles tous les 33 ans (365,242424 jours)
  ; dictionary.die.net/leap%20year
  ; en.wikipedia.org/wiki/Leap_year
  If Annee<=0
    Annee = Year(Date())
  EndIf ; Cette année
  If (Mod(Annee,4)=0 And Mod(Annee,100)<>0) Or (Mod(Annee,400)=0)
    ProcedureReturn #True
  EndIf
  ProcedureReturn #False
EndProcedure

;FormatDate personnalisé
Procedure$ ChaineDate(Masque$, date.i) 
  
  Masque$ = ReplaceString (Masque$, "%dddd" , StringField ( NomJours$ , DayOfWeek (date) + 1, " " )) 
  Masque$ = ReplaceString (Masque$, "%ddd" , StringField ( NomJoursAbr$ , DayOfWeek (date) + 1, " " )) 
  Masque$ = ReplaceString (Masque$, "%mmmm" , StringField ( NomMois$ , Month (date), " " )) 
  Masque$ = ReplaceString (Masque$, "%mmm" , StringField ( NomMoisAbr$ , Month (date), " " )) 
  
  ProcedureReturn FormatDate (Masque$, date) 
  
EndProcedure

Procedure.b JoursDansMois(Annee=-1, mois=-1)
  ; Retourne le nombre de jours dans le mois donné (28 .. 31)
  ; Si l'année est absente, l'année en cours est utilisée
  ; Si l'année est présente mais le mois est absent, février est utilisé
  ; Si l'année et le mois sont tous deux absents, le mois courant de l'année en cours est utilisé
  
  Protected Jours
  
  If Annee = -1
    Annee = Year(Date())
    If mois = -1
      mois = Month(Date())
    EndIf
  Else
    If mois<=0: mois = 2: EndIf
  EndIf
  
  If mois=2
    If Bissextile(Annee)
      Jours = 29
    Else
      Jours = 28
    EndIf  
  Else
    jours = 31-$A55>>mois&1
  EndIf
  
  NbjoursMois = Jours
  
  ProcedureReturn NbjoursMois
EndProcedure

Procedure$ DDA(Annee=-1) ; Début de l'année
  ; Si l'année est absente, l'année en cours est utilisée
  If Annee < 0
    DateCourante$ = ChaineDate(Masque$,Date(Year(Date()),1,1,0,0,0))
  Else
    DateCourante$ = ChaineDate(Masque$,Date(Annee,1,1,0,0,0))
  EndIf
  ProcedureReturn DateCourante$
EndProcedure

Procedure$ FDA(Annee=-1) ; Fin de l'année
  ; Si l'année est absente, l'année en cours est utilisée
  If Annee < 0
    DateCourante$ = ChaineDate(Masque$,Date(Year(Date()),12,31,0,0,0))
  Else
    DateCourante$ = ChaineDate(Masque$,Date(Annee,12,31,0,0,0))
  EndIf
  ProcedureReturn DateCourante$
EndProcedure

Procedure$ DDM(Annee=-1,Mois=-1) ; Début du mois
  ; Si l'année est absente, l'année en cours est utilisée
  ; Si l'année est présente mais le mois est absent, février est utilisé
  ; Si l'année et le mois sont tous deux absents, le mois courant de l'année en cours est utilisé
  If Annee < 0 Or mois < 0
    DateCourante$ = ChaineDate(Masque$,Date(Year(Date()),Month(Date()),1,0,0,0))
  Else
    DateCourante$ = ChaineDate(Masque$,Date(Annee,Mois,1,0,0,0))
  EndIf
  ProcedureReturn DateCourante$
EndProcedure

Procedure$ FDM(Annee=-1, Mois=-1) ; Fin du mois
  ; Si l'année est absente, l'année en cours est utilisée
  ; Si l'année est présente mais le mois est absent, février est utilisé
  ; Si l'année et le mois sont tous deux absents, le mois courant de l'année en cours est utilisé
  If Annee < 0 Or mois < 0
    ProcedureReturn ChaineDate(Masque$,Date(Year(Date()),Month(Date()),JoursDansMois(),0,0,0))
  Else
    ProcedureReturn ChaineDate(Masque$,Date(Annee,Mois,JoursDansMois(),0,0,0))
  EndIf
EndProcedure

Procedure.w JDA(Annee=-1) ; Jour de l'année
  ; Si l'année est absente, l'année en cours est utilisée
  If Annee < 0
    ProcedureReturn DayOfYear(Date())
  Else
    ProcedureReturn DayOfYear(Annee)
  EndIf
EndProcedure

Procedure.w JourRestantAnnee() ; Jours restants pour finir l'année
  ; Si l'année est absente, l'année en cours est utilisée
  
  Protected reste = 365 + SiBissextile(Annee)
  
  ProcedureReturn reste-Int(DayOfYear(Date()))
EndProcedure

Procedure.b DonneSemaine(PAnnee.i,PMois.b,PJour.b) ; Numéro de semaine correspondant à la date
  PAnnee=Year(Date())
  PMois=Month(Date())
  PJour=Day(Date())
  
  Protected Semaine4J.b = DayOfWeek(Date(PAnnee,1,4,0,0,0)) 
  If Semaine4J = 0 : Semaine4J = 7 : EndIf 
  Protected MoSemaine1.b = 4-Semaine4J 
  Protected SemaineGD.b = DayOfWeek(Date(PAnnee,PMois,PJour,0,0,0)) 
  ; Lundi = 1 Dimanche = 7. 
  If SemaineGD = 0 : SemaineGD = 7 : EndIf 
  Protected MoGD.w = DayOfYear(Date(PAnnee,PMois,PJour,0,0,0))-SemaineGD 
  Semaine = Int((MoGD-MoSemaine1)/7)+1 
  If PMois = 12 
    Protected NumSem1Q.w = DayOfYear(Date(PAnnee,PMois,PJour,0,0,0)) 
    Protected Semaine4JNA.b = DayOfWeek(Date(PAnnee+1,1,4,0,0,0)) 
    ; Lundi = 1 Dimanche = 7. 
    If Semaine4JNA = 0 : Semaine4JNA = 7 : EndIf 
    Protected JourAnneDerniere.w = DayOfYear(Date(PAnnee,12,31,0,0,0)) 
    If JourAnneDerniere - NumSem1Q < Semaine4JNA -4 
      Semaine = 1 
    EndIf 
  EndIf 
  
  If PMois = 1 And PJour < 4 
    If Semaine4J.b < SemaineGD.b
      ;Semaine = DonneSemaine(PAnnee-1,12,31) 
    EndIf 
  EndIf 
  ProcedureReturn Semaine
EndProcedure

Procedure.b NumSemaine() ; Numéro de la semaine
  Protected date.b, NumSem.i
  ;NumSem=DonneSemaine(Year(date),Month(date),Day(date))
  NumSem=MaDonnee(DayOfYear(Date()))\NSem
  ProcedureReturn NumSem
EndProcedure

Procedure.i NumeroSemaine(Date) ; Retourne le numéro de semaine de l'année
  Protected Semaine.i = 0
  Protected Compteur=Date(Year(Date),1,1,0,0,1) ;/ jour du nouvel an
  
  ;/ Aller au premier lundi
  Repeat
    If DayOfWeek(Compteur)=1 : Break : EndIf
    Compteur=AddDate(Compteur,#PB_Date_Day,1)
  ForEver
  
  ;/ Ajouter 1 semaine / Teste si la date est atteinte
  Repeat
    If Compteur>Date : Break : EndIf
    Compteur=AddDate(Compteur,#PB_Date_Week,1)
    Semaine+1
  ForEver
  
  ProcedureReturn Semaine
EndProcedure

Procedure.b NbSemRestant() ; Nombre de semaines pour finir l'année
  If JourRestantAnnee() > 6
    ProcedureReturn (52 - NumSemaine())+1
  Else
    ProcedureReturn (52 - NumSemaine())
  EndIf
EndProcedure

Procedure$ JDS() ; Jour de la semaine
  NumJS = DayOfWeek(Date())+1
  JourCourant$ = StringField(NomJours$,NumJS," ")
  ProcedureReturn JourCourant$
EndProcedure

Procedure.b Jour(_Jour_=-1) ; Jour actuel
  If _Jour_ <=0
    _Jour_ = Day(Date())
  EndIf  
  ProcedureReturn _Jour_
EndProcedure

Procedure$ NomMois() ; Mois actuel
  MoisCourant$ = StringField(NomMois$,Month(Date())," ")
  ProcedureReturn MoisCourant$
EndProcedure

Procedure.i Mois(_Mois_=-1)
  If _Mois_<=0
    _Mois_ = Month(Date()) ;Ce mois-ci
  EndIf
  ProcedureReturn _Mois_
EndProcedure 

Procedure.w JourRestantMois(Mois) ; Nombre de jours pour finir le mois
  NbJMR = JoursDansMois(Annee,Mois) - Jour()
  ProcedureReturn NbJMR
EndProcedure

Procedure.i Annee(_Annee_=-1)
  If _Annee_<=0
    _Annee_ = Year(Date()) ; Cette année
  EndIf
  ProcedureReturn _Annee_
EndProcedure

Procedure.i EstDateValide(Jour,Mois,Annee) ; - Indique si la date proposée est valide
  Protected Validite = 1 , Jour1 = 1 , Mois1 = 1 , Annee1 = 1 ; 1 = Valide, 0 = non valide.
  If Jour < 1 Or Jour > 31
    Jour1 = 0 ; Jour doit être 1-31.
  ElseIf Mois < 1 Or Mois > 12
    Mois1 = 0 ; Mois doit être 1-12.
  ElseIf Mois = 2 And Jour > 28 
    If Jour	>	29
      Jour1=0 ; février n'a JAMAIS plus de 29 Jours.
    Else
      ; Vérifie si février de l'année "Annee" est une année bissextile.  Notez que l'année
      ; 3600 est un cas spécial unique (www.google.com/search?q=leap+year+faq).
      Jour1 = Bool(Mod(Annee, 4) = 0 And
                   (Mod(Annee, 100) <> 0 Or
                    Mod(Annee, 400) = 0) And
                   Annee <> 3600)
    EndIf
  ElseIf (Mois = 4 Or Mois = 6 Or Mois = 9 Or Mois = 11) And Jour = 31
    Jour1=0 ; Ces mois ont seulement 30 jours.
  ElseIf Annee < 1 Or Annee > 9999
    Annee1 = 0 ; limite l'année à une gamme de 9999 ans
  EndIf
  If Jour1 = 0
    Validite = 0
  ElseIf Mois1 = 0
    Validite = 0
  ElseIf Annee1 = 0
    Validite = 0
  EndIf  
  ProcedureReturn Validite
EndProcedure

Procedure$ CToD(Chaine$) ; - Transforme une chaine en Date
  Protected Jour$, Mois$, Annee$, Resultat$
  
  Jour$  = RSet(Left(Chaine$,   2), 2,   "00")
  Mois$  = RSet(Mid(Chaine$, 3, 2), 2,   "00")
  Annee$ = RSet(Right(Chaine$,  4), 4, "0000")
  
  If Len(Chaine$) = 6
    Annee$ = Right(Chaine$, 2)
  ElseIf Len(Chaine$) = 8
    Annee$ = Right(Chaine$, 4)
  EndIf
  
  If   Val(Jour$) > 31 Or Val(Mois$) > 12
    Resultat$ = "Le format est : CToD(JJ/MM/AA) ou CToD(JJ/MM/AAAA)"
  EndIf		
  
  If Not EstDateValide(Val(Jour$), Val(Mois$), Val(Annee$))
    Resultat$ = "Date non valide"
  Else
    Resultat$ = Jour$+"/"+Mois$+"/"+Annee$
  EndIf
  ProcedureReturn resultat$
EndProcedure

Procedure$ DToC(Chaine$) ; - Transforme une Date en chaîne
  Protected Jour$, Mois$, Annee$, Resultat$
  
  Jour$ = StringField(Chaine$, 1, "/") : Mois$ = StringField(Chaine$, 2, "/") : Annee$ = StringField(Chaine$, 3, "/")
  
  Jour$ = RSet(Jour$, 2, "00")
  Mois$ = RSet(Mois$, 2, "00")
  Annee$ = RSet(Annee$, 4, "0000")
  
  If Len(Chaine$) < 8 Or Len(Chaine$) > 10
    Resultat$ = "Le format est : DToC(JJMMAA) ou DToC(JJMMAAAA)"
  EndIf
  
  If Not EstDateValide(Val(Jour$), Val(Mois$), Val(Annee$))
    Resultat$ = "Date non valide"
  Else 
    Resultat$ = Jour$ + Mois$ + Annee$
  EndIf
  ProcedureReturn Resultat$
EndProcedure

Procedure.i DToN(Chaine$) ; Convertit une date "JJ/MM/AAAA" en nombre entier
  Protected Jour$,Mois$,Annee$,Resultat
  
  Jour$ = StringField(Chaine$,1,"/") : Mois$ = StringField(Chaine$,2,"/") : Annee$ = StringField(Chaine$,3,"/")
  
  Jour$ = RSet(Jour$,2,"00")
  Mois$ = RSet(Mois$,2,"00")
  Annee$ = RSet(Annee$,4,"0000")
  
  If Val(Mois$)
    Resultat = Val(Jour$)*1000000+Val(Mois$)*10000+Val(Annee$)
  EndIf
  
  Select Mois$
    Case "02" 
      If Val(Jour$) <= 28 + SiBissextile(Val(Annee$))
        ProcedureReturn Resultat
      EndIf
    Case "01","03","05","07","08","10","12"
      If Val(Jour$) <= 31
        ProcedureReturn Resultat
      EndIf
    Case "04","06","09","11"
      If Val(Jour$) <= 30
        ProcedureReturn Resultat
      EndIf
  EndSelect
  
  If Resultat <= 31129999
    ProcedureReturn 0
  EndIf
  
EndProcedure

Procedure$ NToD(Nombre.i) ; Convertit un nombre >= 01011001 <= 31129999 en date
  Protected sJour$, sMois$, sAnnee$, Resultat$, valide, Jour, Mois, Annee
  Resultat$ = RSet(Str(Nombre),8,"0")
  
  Jour = Val(Left(Resultat$,2))
  Mois = Val(Mid(Resultat$,3,2))
  Annee = Val(Right(Resultat$,4))
  valide = #True
  Select Annee
    Case 1 To 9999
      Select Mois
        Case 2
          If Jour < 1 Or Jour > 28 + SiBissextile(Annee)
            valide = #False
          EndIf
        Case 1,3,5,7,8,10,12
          If Jour < 1 Or Jour > 31
            valide = #False
          EndIf
        Case 4,6,9,11
          If Jour < 1 Or Jour > 30
            valide = #False
          EndIf
        Default
          valide = #False
      EndSelect
    Default
      valide = #False
  EndSelect
  
  If valide
    sJour$ = RSet(Str(Jour),2,"0")+"/"
    sMois$ = RSet(Str(Mois),2,"0")+"/"
    sAnnee$ = RSet(Str(Annee),4,"0")
    
    Resultat$ = sJour$+sMois$+sAnnee$
    ProcedureReturn Resultat$
  Else
    ProcedureReturn "Erreur"
  EndIf
EndProcedure

; Années
Procedure.i IncrementerAnnees(Annee =-1, Nombre_d_annees = 1)
  If Annee < 0
    Annee = Year(Date())
  EndIf  
  ProcedureReturn Date(Year(Annee) + Nombre_d_annees, Month(Annee), Day(Annee), Hour(Annee), Minute(Annee), Second(Annee))
EndProcedure

; Mois
Procedure.i IncrementerMois(Annee = -1, Nombre_de_mois = 1)
  Protected i
  If Annee < 0
    Annee = Year(Date())
  EndIf    
  For i = 1 To Nombre_de_mois
    Select Month(Annee)
      Case 12
        Annee = Date(Year(Annee) + 1, 1, Day(Annee), Hour(Annee), Minute(Annee), Second(Annee))
      Default
        Annee = Date(Year(Annee), Month(Annee) + 1, Day(Annee), Hour(Annee), Minute(Annee), Second(Annee))
    EndSelect
  Next
  ProcedureReturn Annee
EndProcedure

; Jours
Procedure.i IncrementerJours(Annee = -1, Nombre_de_jours = 1)
  Protected i
  For i = 1 To Nombre_de_jours
    Select Month(Annee)
      Case 4, 6, 9, 11
        If Day(Annee) = 30
          Annee = Date(Year(Annee), Month(Annee) + 1, 1, Hour(Annee), Minute(Annee), Second(Annee))
        Else
          Annee = Date(Year(Annee), Month(Annee), Day(Annee) + 1, Hour(Annee), Minute(Annee), Second(Annee))
        EndIf
      Case 1, 3, 5, 7, 8, 10
        If Day(Annee) = 31
          Annee = Date(Year(Annee), Month(Annee) + 1, 1, Hour(Annee), Minute(Annee), Second(Annee))
        Else
          Annee = Date(Year(Annee), Month(Annee), Day(Annee)+1, Hour(Annee), Minute(Annee), Second(Annee))
        EndIf
      Case 12
        If Day(Annee) = 31
          Annee = Date(Year(Annee) + 1, 1, 1, Hour(Annee), Minute(Annee), Second(Annee))
        Else
          Annee = Date(Year(Annee), Month(Annee), Day(Annee) + 1, Hour(Annee), Minute(Annee), Second(Annee))
        EndIf
      Case 2
        If Day(Annee) = 29 ; année bissextile
          Annee = Date(Year(Annee), Month(Annee) + 1, 1, Hour(Annee), Minute(Annee), Second(Annee))
        ElseIf Day(Annee) = 28
          ; Est-ce une année bissextile
          If Bissextile(Annee)
            Annee = Date(Year(Annee), Month(Annee), Day(Annee) + SiBissextile(Annee), Hour(Annee), Minute(Annee), Second(Annee))
          Else
            Annee = Date(Year(Annee), Month(Annee) + 1, 1, Hour(Annee), Minute(Annee), Second(Annee))
          EndIf
        Else
          Annee = Date(Year(Annee), Month(Annee), Day(Annee) + 1, Hour(Annee), Minute(Annee), Second(Annee))
        EndIf
    EndSelect
  Next
  ProcedureReturn Annee
EndProcedure

; Heures
Procedure.i IncrementerHeures(Annee = -1, Nombre_d_heures = 1)
  If Annee < 0
    Annee = Year(Date())
  EndIf  
  If (Hour(Annee) + Nombre_d_heures) / 24
    Annee = IncrementerJours(Annee, (Hour(Annee) + Nombre_d_heures) / 24)
  EndIf
  ProcedureReturn Date(Year(Annee), Month(Annee), Day(Annee), (Hour(Annee) + Nombre_d_heures) % 24, Minute(Annee), 
                       Second(Annee)) 
EndProcedure

; Minutes
Procedure.i IncrementerMinutes(Annee = -1, Nombre_de_Minutes = 1)
  If Annee < 0
    Annee = Year(Date())
  EndIf  
  If (Minute(Annee) + Nombre_de_Minutes) / 60
    Annee = IncrementerHeures(Annee, (Minute(Annee) + Nombre_de_Minutes) / 60)
  EndIf
  ProcedureReturn Date(Year(Annee), Month(Annee), Day(Annee), Hour(Annee), (Minute(Annee) + Nombre_de_Minutes) % 60, Second(Annee)) 
EndProcedure

; Secondes 
Procedure.i IncrementerSecondes(Annee = -1, Nombre_de_Secondes = 1)
  If Annee < 0
    Annee = Year(Date())
  EndIf  
  If (Second(Annee) + Nombre_de_Secondes) / 60
    Annee = IncrementerMinutes(Annee, (Second(Annee) + Nombre_de_Secondes) / 60)
  EndIf
  ProcedureReturn Date(Year(Annee), Month(Annee), Day(Annee), Hour(Annee), Minute(Annee), (Second(Annee) + Nombre_de_Secondes) % 60) 
EndProcedure

; Dates
Procedure.i IncrementerDate(Annee = -1, Nombre_d_annees = 0, Nombre_de_mois = 0, Nombre_de_jours = 0, Nombre_d_heures = 0, Nombre_de_Minutes = 0, Nombre_de_Secondes = 0)
  If Annee < 0
    Annee = Year(Date())
  EndIf  
  If Nombre_d_annees
    Annee = IncrementerAnnees(Annee, Nombre_d_annees)
  EndIf
  If Nombre_de_mois
    Annee = IncrementerMois(Annee, Nombre_de_mois)
  EndIf
  If Nombre_de_jours
    Annee = IncrementerJours(Annee, Nombre_de_jours)
  EndIf
  If Nombre_d_heures
    Annee = IncrementerHeures(Annee, Nombre_d_heures)
  EndIf
  If Nombre_de_Minutes
    Annee = IncrementerMinutes(Annee, Nombre_de_Minutes)
  EndIf
  If Nombre_de_Secondes
    Annee = IncrementerSecondes(Annee, Nombre_de_Secondes)
  EndIf
  ProcedureReturn Annee
EndProcedure

Procedure.i DateDiff(dateAvant, dateApres, *diff.DiffTemps) 
  
  Protected TotalJours,Annees,Mois,JoursRestants,Heures,Minutes,Secondes,DateCourante, dateTest, jourDebut
  
  If dateAvant > dateApres
    Swap dateAvant, dateApres
  EndIf
  
  DateCourante = dateAvant 
  dateTest = dateAvant 
  jourDebut = Day(dateAvant) 
  TotalJours = 0
  JoursRestants = 0 
  
  While dateTest <= dateApres 
    dateTest = AddDate(DateCourante, #PB_Date_Day, 1) 
    If dateTest <= dateApres 
      DateCourante = dateTest 
      TotalJours+1 
      JoursRestants+1
      If Day(DateCourante) = jourDebut 
        Mois+1 
        JoursRestants=0 
      EndIf 
    EndIf 
  Wend 
  
  dateTest = DateCourante 
  Heures = 0 
  While dateTest<dateApres 
    dateTest = AddDate(DateCourante, #PB_Date_Hour, 1) 
    If dateTest <= dateApres 
      DateCourante = dateTest 
      Heures+1 
    EndIf 
  Wend 
  
  dateTest = DateCourante
  Minutes = 0 
  While dateTest<dateApres 
    dateTest = AddDate(DateCourante, #PB_Date_Minute, 1) 
    If dateTest <= dateApres 
      DateCourante = dateTest 
      Minutes+1 
    EndIf 
  Wend 
  
  dateTest = DateCourante 
  Secondes = 0 
  While dateTest<dateApres 
    dateTest = AddDate(DateCourante, #PB_Date_Second, 1) 
    If dateTest <= dateApres 
      DateCourante = dateTest 
      Secondes+1 
    EndIf 
  Wend 
  
  Annees = Mois/12 
  If Annees 
    Mois % 12 
  EndIf 
  
  *diff\TotalJours = TotalJours
  *diff\Annees = Annees 
  *diff\Mois = Mois 
  *diff\JoursRestants = JoursRestants 
  *diff\Heures = Heures 
  *diff\Minutes = Minutes 
  *diff\Secondes = Secondes 
  
EndProcedure

Procedure.i AnalyserDate(Date$)
  Protected Resultat
  Resultat = ParseDate("%dd/%mm/%yyyy", Date$)
  ProcedureReturn Resultat
EndProcedure

Procedure.s ComparerDates(Date1$, Date2$)
  If ParseDate("%dd/%mm/%yyyy", Date1$) > ParseDate("%dd/%mm/%yyyy", Date2$)
    ProcedureReturn date1$ + " > " + date2$
  ElseIf ParseDate("%dd/%mm/%yyyy", Date1$) < ParseDate("%dd/%mm/%yyyy", Date2$)
    ProcedureReturn date1$ + " < " + date2$
  ElseIf  ParseDate("%dd/%mm/%yyyy", Date1$) = ParseDate("%dd/%mm/%yyyy", Date2$)
    ProcedureReturn date1$ + " = " + date2$
  EndIf
EndProcedure

Procedure.i CalculerAge(jour_naissance.b,mois_naissance.b,annee_naissance.q)
  Protected aujourdhui = Date()
  Protected ce_jour = Day(aujourdhui)
  Protected ce_mois = Month(aujourdhui)
  Protected cette_annee = Year(aujourdhui)
  Protected j = ce_jour - jour_naissance
  Protected m = ce_mois - mois_naissance
  Protected a = cette_annee - annee_naissance
  
  ProcedureReturn a
  
EndProcedure

Procedure.i TrouverPremierDimanche(Annee, Mois)
  Protected Jour=1
  Protected DatePremierDimanche=Date(Annee, Mois, Jour, 0, 0, 0)
  
  ;Cherche le premier dimanche
  While DayOfWeek(DatePremierDimanche)<>0
    
    jour + 1
    DatePremierDimanche= Date(Annee, mois, jour, 0, 0, 0)
  Wend
  
  ProcedureReturn DatePremierDimanche
  
EndProcedure

Procedure.i TrouverDeuxiemeDimanche(Annee, Mois)
  Protected Jour=8
  Protected DateDeuxiemeDimanche=Date(Annee, Mois, Jour, 0, 0, 0)
  
  ;Cherche le deuxième dimanche
  While DayOfWeek(DateDeuxiemeDimanche)<>0
    
    jour + 1
    DateDeuxiemeDimanche= Date(Annee, mois, jour, 0, 0, 0)
  Wend
  
  ProcedureReturn DateDeuxiemeDimanche
  
EndProcedure

Procedure.i TrouverTroisiemeDimanche(Annee, Mois)
  Protected Jour=15
  Protected DateTroisiemeDimanche=Date(Annee, Mois, Jour, 0, 0, 0)
  
  ;Cherche le Troisième dimanche
  While DayOfWeek(DateTroisiemeDimanche)<>0
    
    jour + 1
    DateTroisiemeDimanche= Date(Annee, mois, jour, 0, 0, 0)
  Wend
  
  ProcedureReturn DateTroisiemeDimanche
  
EndProcedure

Procedure.i TrouverQuatriemeDimanche(Annee, Mois)
  Protected Jour=22
  Protected DateQuatriemeDimanche=Date(Annee, Mois, Jour, 0, 0, 0)
  
  ;Cherche le Quatrième dimanche
  While DayOfWeek(DateQuatriemeDimanche)<>0
    
    jour + 1
    DateQuatriemeDimanche= Date(Annee, mois, jour, 0, 0, 0)
  Wend
  
  ProcedureReturn DateQuatriemeDimanche
  
EndProcedure

Procedure.i TrouverDernierDimanche(Annee, Mois)
  Protected Jour=JoursDansMois(mois)
  Protected DateDernierDimanche=Date(Annee, Mois, Jour, 0, 0, 0)
  
  ;Cherche le dernier dimanche
  While DayOfWeek(DateDernierDimanche)<>0
    
    jour + 1
    DateDernierDimanche= Date(Annee, mois, jour, 0, 0, 0)
  Wend
  ;drawvectortext(DateDernierDimanche
  ;If DateDernierDimanche <> -1
  ProcedureReturn DateDernierDimanche
  ;EndIf  
  
EndProcedure

Procedure.s TrouverPremierJourSemaine(Annee, Mois, Joursem)
  Protected Jour=1
  Protected DatePremierJourSemaine=Date(Annee, Mois, Jour, 0, 0, 0)
  
  ;Cherche le premier JourSemaine
  While DayOfWeek(DatePremierJourSemaine)<>Joursem
    
    jour + 1
    DatePremierJourSemaine= Date(Annee, mois, jour, 0, 0, 0)
  Wend
  
  ProcedureReturn FormatDate("%dd/%mm/%yyyy", DatePremierJourSemaine)
  
EndProcedure

Procedure.s TrouverDeuxiemeJourSemaine(Annee, Mois, Joursem)
  Protected Jour=8
  Protected DateDeuxiemeJourSemaine=Date(Annee, Mois, Jour, 0, 0, 0)
  
  ;Cherche le deuxième JourSemaine
  While DayOfWeek(DateDeuxiemeJourSemaine)<>Joursem
    
    jour + 1
    DateDeuxiemeJourSemaine= Date(Annee, mois, jour, 0, 0, 0)
  Wend
  
  ProcedureReturn FormatDate("%dd/%mm/%yyyy", DateDeuxiemeJourSemaine)
  
EndProcedure

Procedure.s TrouverTroisiemeJourSemaine(Annee, Mois, Joursem)
  Protected Jour=15
  Protected DateTroisiemeJourSemaine=Date(Annee, Mois, Jour, 0, 0, 0)
  
  ;Cherche le Troisième JourSemaine
  While DayOfWeek(DateTroisiemeJourSemaine)<>Joursem
    
    jour + 1
    DateTroisiemeJourSemaine= Date(Annee, mois, jour, 0, 0, 0)
  Wend
  
  ProcedureReturn FormatDate("%dd/%mm/%yyyy", DateTroisiemeJourSemaine)
  
EndProcedure

Procedure.s TrouverQuatriemeJourSemaine(Annee, Mois, Joursem)
  Protected Jour=22
  Protected DateQuatriemeJourSemaine=Date(Annee, Mois, Jour, 0, 0, 0)
  
  ;Cherche le Quatrième JourSemaine
  While DayOfWeek(DateQuatriemeJourSemaine)<>Joursem
    
    jour + 1
    DateQuatriemeJourSemaine= Date(Annee, mois, jour, 0, 0, 0)
  Wend
  
  ProcedureReturn FormatDate("%dd/%mm/%yyyy", DateQuatriemeJourSemaine)
  
EndProcedure

Procedure.s TrouverCinquiemeJourSemaine(Annee, Mois, Joursem)
  Protected Jour = JoursDansMois(Annee, Mois)
  Protected DateCinquiemeJourSemaine
  
  ;Chercher le CinquiemeJourSemaine
  DateCinquiemeJourSemaine = AddDate(ParseDate("%dd/%mm/%yyyy", TrouverQuatriemeJourSemaine(Annee, Mois, Joursem)), #PB_Date_Week, 1)
  If Val(Mid(FormatDate("%dd/%mm/%yyyy", DateCinquiemeJourSemaine), 4, 2)) = Mois
    ProcedureReturn FormatDate("%dd/%mm/%yyyy", DateCinquiemeJourSemaine)
  Else
    ProcedureReturn ""
  EndIf  
  
EndProcedure

Procedure ChercherVendredi13(Annee, Mois)
  Protected Jour=13
  Protected DateVendredi13 = Date(Annee, Mois, Jour, 0, 0, 0)
  
  ;Cherche le vendredi 13
  While DayOfWeek(DateVendredi13) <> 5    
    jour + 1
    DateVendredi13 = Date(annee, mois, jour, 0, 0, 0)
  Wend
  
  ProcedureReturn DateVendredi13
EndProcedure

Procedure$ SigneAstro(Jour,Mois) ;Permet de déterminer le signe astrologique correspondant au jour et au mois donnés
  Protected$ Resultat
  
  If (Jour >= 22 And Mois = 12) Or (Jour <= 20 And Mois = 1)
    Resultat = "Capricorne"
  ElseIf (Jour >= 21 And Mois = 1) Or (jour <= 19 And Mois = 2)
    Resultat = "Verseau"
  ElseIf (Jour >= 20 And Mois = 2) Or (jour <= 20 And Mois = 3)
    Resultat = "Poissons"
  ElseIf (Jour >= 21 And Mois = 3) Or (Jour <= 20 And Mois = 4)
    Resultat = "Bélier"
  ElseIf (Jour >= 21 And Mois = 4) Or (Jour <= 21 And Mois = 5)
    Resultat = "Taureau"
  ElseIf (Jour >= 22 And mois = 5) Or (Jour <= 21 And Mois = 6)
    Resultat = "Gémeaux"
  ElseIf (Jour >= 22 And Mois = 6) Or (Jour <= 22 And Mois = 7)
    Resultat = "Cancer"
  ElseIf (Jour >= 23 And Mois = 7) Or (Jour <= 22 And Mois = 8)
    Resultat = "Lion"
  ElseIf (Jour >= 23 And Mois = 8) Or (Jour <= 22 And Mois = 9)
    Resultat = "Vierge"
  ElseIf (Jour >= 23 And Mois = 9) Or (Jour <= 22 And Mois = 10)
    Resultat = "Balance"
  ElseIf (Jour >= 23 And Mois = 10) Or (Jour <= 22 And Mois = 11)
    Resultat = "Scorpion"
  ElseIf (Jour >= 23 And Mois = 11) Or (Jour <= 21 And Mois = 12)
    Resultat = "Sagittaire"
  EndIf
  
  ProcedureReturn Resultat
EndProcedure

Procedure$ Saison(_Jour, _Mois)
  Protected$ _Resultat
  If (_Jour < 31 And _Mois < 3) Or (_Jour < 20 And _Mois = 3)
    _Resultat = "Hiver"
  ElseIf (_Jour >= 20 And _Mois = 3) Or (_Jour < 19 And _Mois = 6)
    _Resultat = "Printemps"
  ElseIf (_Jour > 22 And _Mois = 6) Or (_Jour < 22 And _Mois = 9)
    _Resultat = "Été"
  ElseIf (_Jour > 21 And _Mois = 9) Or (_Jour < 21 And _Mois = 12)
    _Resultat = "Automne"
  ElseIf (_Jour > 21 And _Mois = 12)
    _Resultat = "Hiver"
  EndIf
  ProcedureReturn _Resultat
EndProcedure

Procedure$ TxtSaison(nJour, nMois) ;Permet de déterminer la saison correspondant au jour et au mois donnés
  Protected$ sResultat
  
  i = Annee - 2016
  
  If (nJour >= Day(*Saison\Printemps[i]) And nMois = 3) Or nMois = 4 Or nMois = 5 Or (nJour < Day(*Saison\Ete[i]) And nMois = 6)
    sResultat = "printemps"
  ElseIf (nJour >= Day(*Saison\Ete[i]) And nMois = 6) Or nMois = 7 Or nMois = 8 Or (nJour < Day(*Saison\Automne[i]) And nMois = 9)
    sResultat = "été"
  ElseIf (nJour >= Day(*Saison\Automne[i]) And nMois = 9) Or nMois = 10 Or nMois = 11 Or (nJour < Day(*Saison\Hiver[i]) And nMois = 12)
    sResultat = "automne"
  ElseIf (nJour >= Day(*Saison\Hiver[i]) And nMois = 12) Or nMois = 1 Or nMois = 2 Or (nJour < Day(*Saison\Printemps[i]) And nMois = 3)
    sResultat = "hiver"
  EndIf
  ProcedureReturn sResultat
EndProcedure

Procedure$ Article_Saison(jour, mois)
  Protected texte$
  Select TxtSaison(jour, mois)
    Case "printemps"
      texte$ = "au "
    Case "été", "automne", "hiver"
      texte$ = "en "
  EndSelect
  ProcedureReturn texte$ + TxtSaison(jour, mois)
EndProcedure

Procedure$ Article_Astro(jour, mois)
  Protected texte$
  Select SigneAstro(jour, mois)
    Case "Bélier", "Taureau", "Cancer", "Lion", "Scorpion", "Sagittaire", "Capricorne", "Verseau"
      texte$ = "du "
    Case "Gémeaux", "Poissons"
      texte$ = "des "
    Case "Vierge", "Balance"
      texte$ = "de la "
  EndSelect
  ProcedureReturn texte$ + SigneAstro(jour, mois)
EndProcedure

Procedure.s NomJourSemaine(Annee=-1,Mois=-1,Jour=-1)
  Protected _Annee_, _Mois_, _Jour_, _JS_.s
  If _Annee_<=0
    _Annee_ = Annee() ; Cette année
  EndIf
  
  If _Mois_<=0
    _Mois_ = Mois() ;Ce mois-ci
  EndIf
  
  If _Jour_ <=0
    _Jour_ = Jour() ;aujourd'hui
  EndIf
  
  _JS_ = StringField(NomJours$, DayOfWeek(Date(_Annee_, _Mois_, _Jour_, 0, 0, 0)) + 1, " ")
  ;drawvectortext(""+_Jour_+" "+_Mois_+" "+_Annee_
  ProcedureReturn _JS_
  
EndProcedure

Procedure.s ZoneFuseau()
  ; Retourne le nom du fuseau horaire
  ; www.purebasic.fr/english/viewtopic.php?p=181541
  Protected TimeZoneInfo.TIME_ZONE_INFORMATION
  Protected i=0, NomStandard$=""
  GetTimeZoneInformation_(TimeZoneInfo)
  While TimeZoneInfo\StandardName[i]<>0 And i<=32
    NomStandard$ + Chr(TimeZoneInfo\StandardName[i])
    i + 1
  Wend
  ProcedureReturn NomStandard$
EndProcedure

Procedure.i DecalageHoraire(type)
  ; Retourne l'heure de la zone d'information de polarisation en quelques minutes
  ; Decalage=1 retourne (localtime-UTCTime) excluant l'heure d'été
  ; Decalage=2 retourne (localtime-UTCTime), y compris l'heure d'été
  ; Decalage=3 retourne la polarisation d'été locale qui est
  ;   en vigueur à ce moment et sera de 0 en hiver
  ; Decalage=4 retourne la polarisation d'été locale fixe (généralement 60)
  ; N.B. DecalageHoraire(2)=DecalageHoraire(1)+DecalageHoraire(3)
  ; L'heure UTC utilisée est appelée GMT
  ; www.purebasic.fr/english/viewtopic.php?t=17158
  Protected zoneid, tz.TIME_ZONE_INFORMATION, daylight
  zoneid = GetTimeZoneInformation_(tz)
  With tz
    If zoneid=#TIME_ZONE_ID_DAYLIGHT
      daylight = tz\DaylightBias
    Else
      daylight = 0
    EndIf
    Select type
      Case 1
        ProcedureReturn -tz\Bias
      Case 2
        ProcedureReturn -tz\Bias-daylight
      Case 3
        ProcedureReturn -daylight
      Case 4
        ProcedureReturn -tz\DaylightBias
    EndSelect
    ProcedureReturn 0
  EndWith
EndProcedure

Procedure.s CalculerSoleil (lat.f, lon.f, JA.i, tz.d)  
  Define.d B, D, DiffJour, Jourglg, AMOZ, UMOZ, Lever, pi = 3.1415927, h = -0.0145, Coucher
  ; lat = latitude (N/S), lon=longitude (E/O), JA=Jour de l'année, tz=décalage horaire de GMT    pi = 3.1415927 <-- utilise #PI de PureBasic
  ;         Latitude : ( Lignes Horizontales )                                    Longitude : ( Lignes Verticales )
  ;[Q] = Equateur = 0.0000000 degré Latitude                          [P] = Premier Meridien = 0.0000000 degré Longitude @ Greenwich, England
  ;[N] = Hemisphere Nord ( Valeur positive, Nord de l'Equateur )      [E] = Hemisphere Est ( Valeur positive, à l'Est du Premier Méridien )
  ;[S] = Hemisphere Sud  ( - Valeur négative, Sud fr l'Equateur )     [O] = Hemisphere Ouest ( - Valeur négative , à l'Oest du Premier Méridien )
  ; 
  
  If JA = 0
    JA = DayOfYear(Date())
  EndIf
  
  B = Radian(lat)
  D = 0.40954*Sin(0.0172*(JA-79.349740))
  DiffJour=12*ACos((Sin(h)-Sin(B)*Sin(D))/(Cos(B)*Cos(D)))/#PI
  Jourglg=-0.1752*Sin(0.033430*JA+0.5474)-0.1340*Sin(0.018234*JA-0.1939)
  
  ;~~~~~ Lever
  AMOZ=12-DiffJour-Jourglg;
  Lever=AMOZ-lon/15+tz    ;
  
  ;~~~~~ Coucher
  UMOZ=12+DiffJour-Jourglg;
  Coucher=UMOZ-lon/15+tz-12;
  Lever$=RSet(Str(Int(Lever)),2,"0") + ":" + RSet(Str(Round(Mod(Lever,1) * 60,#PB_Round_Down)),2,"0")
  Coucher$=RSet(Str(Int(Coucher+12)),2,"0") + ":" + RSet(Str(Round(Mod(Coucher,1) * 60,#PB_Round_Down)),2,"0")
  
  *Soleil\Lever$ = Lever$
  *Soleil\Coucher$ = Coucher$
  
  ProcedureReturn "Lever du soleil = " + Lever$ + " - Coucher = " + Coucher$
EndProcedure

Procedure.s Lever_Soleil(lat.f, lon.f, JA.i, tz.d)
  CalculerSoleil (lat.f, lon.f, JA.i, tz.d)
  ProcedureReturn *Soleil\Lever$  
EndProcedure

Procedure.s Coucher_Soleil(lat.f, lon.f, JA.i, tz.d)
  CalculerSoleil (lat.f, lon.f, JA.i, tz.d)
  ProcedureReturn *Soleil\Coucher$  
EndProcedure

Procedure.i MonJDS (date.i)
  Protected d.i
  
  d = DayOfWeek(date)
  If d = 0
    d = 7             ; pour le dimanche, retourne 7 au lieu de 0
  EndIf
  ProcedureReturn d
EndProcedure


Procedure.i NumSem(date.i)
  ; Les calculs sont basés sur le fait que la première semaine de l'année
  ; contient toujours le 4 Janvier.
  ; [conformément à http://en.wikipedia.org/wiki/Seven-day_week#Week_numbering
  ;  ou mieux    http://de.wikipedia.org/wiki/Woche#Kalenderwoche]
  
  Protected jda.i=DayOfYear(date), annee.i=Year(date)
  Protected DernPrec.i  ; dernier jour de la dernière semaine de l'année précédente
  Protected DernCour.i  ; dernier jour de la dernière semaine de l'année en cours
  
  DernPrec = 4 - MonJDS(Date(annee, 1, 4, 0,0,0))
  DernCour = 4 - MonJDS(Date(annee,12,28, 0,0,0)) + DayOfYear(Date(annee,12,31, 0,0,0))
  
  If jda <= DernCour
    If jda <= DernPrec
      ; Le jour donné est dans la dernière semaine de l'année précédente.
      jda + DayOfYear(Date(annee-1,12,31, 0,0,0))
      DernPrec = 4 - MonJDS(Date(annee-1,1,4, 0,0,0))
    EndIf
    ProcedureReturn Round((jda-DernPrec)/7, #PB_Round_Up)
  Else
    ; Le jour donné est dans la première semaine de l'année prochaine.
    ProcedureReturn 1
  EndIf
EndProcedure

Procedure CalculerNumSem()
  Protected j
  For j = 1 To 12
    For i = 1 To JoursDansMois(Year(Date()), j)
      MaDonnee(W-1)\Jour = i
      MaDonnee(W-1)\Mois = j
      MaDonnee(W-1)\NSem = NumSem(Date(Year(Date()), j, i, 0, 0, 0))
      W + 1
    Next i
  Next j 
EndProcedure

CompilerIf #PB_Compiler_IsMainFile
  
  ;- Programme principal
  Enumeration Fenetre
    #fenetre_principale
    #fenetre_secondaire
  EndEnumeration
  
  Enumeration 0 Step 12 ;Gadgets
    #Txt
  EndEnumeration
  
  Enumeration #PB_Compiler_EnumerationValue ;Gadgets
    #Bouton_Ok
    #jour
    #valider
  EndEnumeration
  
  Enumeration mois
    #Janvier = 1
    #fevrier
    #Mars
    #Avril
    #Mai
    #Juin
    #Juillet
    #Aout
    #Septembre
    #Octobre
    #Novembre
    #Decembre
  EndEnumeration
  
  Enumeration
    #Police
  EndEnumeration  
  
  Enumeration
    #Faux
    #Vrai
  EndEnumeration
  
  ;SiBissextile() ; savoir si l'année en cours est bissextile
  
  LoadFont(#Police, "Calibri", 20,#PB_Font_Bold)
  SetGadgetFont(#PB_Default, FontID(#Police))
  
  Global Couleur =  2865001
  Global Quitter.i = #Faux
  Global Annee_courante$ = Str(Year(Date())), fin.i,Masque$ = "%dddd %dd %mmmm %yyyy", texte$ = "", texte2$ = "", jour, mois
  
  Declare Suite()
  
  If OpenWindow(#fenetre_principale, 510, 0, 800, 600 , "Fonction de Dates")
    SetWindowColor(#fenetre_principale, Couleur) 
    
    TextGadget(#Txt, 10, 20, 780, 30, "DDA() Début de l'année courante :  " + DDA(), #PB_Text_Center)
    SetGadgetColor(#Txt,  #PB_Gadget_BackColor, Couleur)
    TextGadget(#Txt+1, 10, 60, 780, 30, "FDA() Fin de l'année courante :  " + FDA(), #PB_Text_Center)
    SetGadgetColor(#Txt+1,  #PB_Gadget_BackColor, Couleur)
    TextGadget(#Txt+2, 10, 100, 780, 30, "DDM() Début du mois courant : " + DDM(), #PB_Text_Center)
    SetGadgetColor(#Txt+2,  #PB_Gadget_BackColor, Couleur)
    TextGadget(#Txt+3, 10, 140, 780, 30, "FDM() Fin du mois courant : " + FDM(), #PB_Text_Center)
    SetGadgetColor(#Txt+3,  #PB_Gadget_BackColor, Couleur)
    If JDA() = 1
      texte$ = "er"
    Else  
      texte$ = "ème"
    EndIf  
    TextGadget(#Txt+4, 10, 180, 780, 30, "JDA() Nous sommes le " + Str(JDA()) + texte$ + 
                                         " jour de l'année",#PB_Text_Center)
    SetGadgetColor(#Txt+4,  #PB_Gadget_BackColor, Couleur)
    TextGadget(#Txt+5, 10, 220, 780, 30, "JourRestantAnnee() Il en reste encore: " + 
                                         Str(JourRestantAnnee()),#PB_Text_Center)
    SetGadgetColor(#Txt+5,  #PB_Gadget_BackColor, Couleur)
    TextGadget(#Txt+6, 10, 260, 780, 30, "NumSemaine() Semaine N° : " + Str(NumSemaine()), #PB_Text_Center)
    SetGadgetColor(#Txt+6,  #PB_Gadget_BackColor, Couleur)
    TextGadget(#Txt+7, 10, 300, 780, 30, "NbSemRestant() Il en reste : " + Str(NbSemRestant()), #PB_Text_Center)
    SetGadgetColor(#Txt+7,  #PB_Gadget_BackColor, Couleur)
    TextGadget(#Txt+8, 10, 340, 780, 30, "JDS() Aujourd'hui nous sommes un : " + JDS(), #PB_Text_Center)
    SetGadgetColor(#Txt+8,  #PB_Gadget_BackColor, Couleur)
    TextGadget(#Txt+9, 10, 380, 780, 30, "Jour() Aujourd'hui, nous sommes le : " + Str(Jour()),#PB_Text_Center)
    SetGadgetColor(#Txt+9, #PB_Gadget_BackColor, Couleur)
    If Mois() = 4 Or Mois() = 8 Or Mois() = 10
      texte$ = "d'"
    Else
      texte$ = "de "
    EndIf  
    TextGadget(#Txt+10, 10, 420, 780, 30, "NomMois$() Nous sommes au mois "+ texte$ + NomMois(), #PB_Text_Center)
    SetGadgetColor(#Txt+10, #PB_Gadget_BackColor, Couleur)
    If JourRestantMois(Mois()) <= 1
      texte$ = " jour"
    Else
      texte$ = " jours"
    EndIf
    TextGadget(#Txt+11, 10, 460, 780, 30, "JourRestantMois() : " + Str(JourRestantMois(Mois())) + texte$, #PB_Text_Center)
    SetGadgetColor(#Txt+11, #PB_Gadget_BackColor, Couleur)
    ButtonGadget(#Bouton_Ok, 370, 540, 70, 30, "Ok")
    SetActiveGadget(#Bouton_Ok)    
    
    Global d = Date(), d1, dateAvant, dateApres, EventID, MaDiff.DiffTemps, date1$, date2$
    
    dateAvant = ParseDate("%dd/%mm/%yyyy/%hh:%ii:%ss", "25/12/2018/21:45:00") 
    dateApres = Date()
    
    Suite()
    
    Quitter = #Faux ; place une variable à 0 pour la rendre non vraie, 
                    ;bon pour une manière différente de sortir d'un programme
    
    ;boucle principale
    Repeat
      If EventID = #PB_Event_Gadget ; vérifie pour voir si un gadget a été pressé
        Select EventGadget()
          Case #Bouton_Ok ; vérifie si #Bouton_Ok ou (bouton OK) a été pressé
                          ; si le #Bouton_Ok a été pressé faire ce qui est indiqué ici
                          ; jusqu'au prochain Case
            Quitter = #Vrai
            End
          Case #PB_Event_CloseWindow
            Quitter = #Vrai
        EndSelect
        
      EndIf
      EventID = WaitWindowEvent() ; Bloque l'exécution du programme jusqu'à ce qu'un évènement intervienne
      
    Until EventID = #PB_Event_CloseWindow Or Quitter = #Vrai
  EndIf
  FreeFont(#Police)
  End ; Fin du programme
  
  Procedure Suite()
    OpenWindow(#fenetre_secondaire, 0, 0, 500, 1040, "", #PB_Window_SystemMenu)
    
    X = 10 : Y = 0
    
    StartVectorDrawing(WindowVectorOutput(#fenetre_secondaire))
    VectorFont(FontID(#Police),15)
    VectorSourceColor($FF000000)
    
    Annee = Val(InputRequester("Vendredi 13", "Quelle année ?", Str(Year(Date()))))
    
    If Annee > 1970 And Annee < 2038
      For Mois = #Janvier To #Decembre
        Global vendredi13 =  ChercherVendredi13(Annee, Mois)
        
        If Day(Vendredi13) = 13
          Y + VectorTextHeight(" ")
          MovePathCursor(X,Y)
          DrawVectorText("vendredi "+FormatDate("%dd", Vendredi13)+" "+StringField(NomMois$,mois," ")+" "+Annee)
        EndIf 
        
      Next Mois  
    EndIf
    Y + VectorTextHeight(" ")
    MovePathCursor(X,Y)
    DrawVectorText("")
    
    Question:
    Global JourSemaine = Val(InputRequester("Question","quel jour de semaine 0=dimanche, 6=samedi ?", "0"))
    
    If JourSemaine < 0 Or JourSemaine > 6
      Goto Question
    EndIf  
    
    Global JourSemaine$ = StringField(NomJours$, JourSemaine + 1, " ")
    
    Question_2:
    Annee = Val(InputRequester("Du premier au dernier " + JourSemaine$, "Quelle année ? 1970-2037", Str(Year(Date()))))
    
    If annee < 1970 Or Annee > 2037
      Goto Question_2
    EndIf
    
    
    Y + VectorTextHeight(" ")
    MovePathCursor(X,Y)
    DrawVectorText("Tous les " + JourSemaine$ + "s de " + Annee + #CRLF$)
    
    For i = #janvier To #Decembre
      Global PremierJourSemaine.s = TrouverPremierJourSemaine(Annee, i, JourSemaine)
      Global DeuxiemeJourSemaine.s = TrouverDeuxiemeJourSemaine(Annee, i, JourSemaine)
      Global TroisiemeJourSemaine.s = TrouverTroisiemeJourSemaine(Annee, i, JourSemaine)
      Global QuatriemeJourSemaine.s = TrouverQuatriemeJourSemaine(Annee, i, JourSemaine)
      Global CinquiemeJourSemaine.s = TrouverCinquiemeJourSemaine(Annee, i, JourSemaine)
      Global texte$ = PremierJourSemaine  + " " + DeuxiemeJourSemaine + " " + TroisiemeJourSemaine + " " + QuatriemeJourSemaine + " " + CinquiemeJourSemaine
      
      Y + VectorTextHeight(" ")
      MovePathCursor(X,Y)
      DrawVectorText(texte$)
    Next i
    
    Question_3:
    Z = Val(InputRequester("Saisons", "De quelle année ? 2016-2035", Str(Year(Date()))))
    
    If Z < 2016 Or Z > 2035
      Goto Question_3
    EndIf
    
    Z - 2016
    Y + VectorTextHeight(" ")
    MovePathCursor(X,Y)
    DrawVectorText("")
    
    With *Saison
      Y + VectorTextHeight(" ")
      MovePathCursor(X,Y)
      DrawVectorText("Printemps : " + ChaineDate(Masque$,\Printemps[Z]))
      Y + VectorTextHeight(" ")
      MovePathCursor(X,Y)
      DrawVectorText("Eté : " + ChaineDate(Masque$,\Ete[Z]))
      Y + VectorTextHeight(" ")
      MovePathCursor(X,Y)
      DrawVectorText("Automne : " + ChaineDate(Masque$,\Automne[Z]))
      Y + VectorTextHeight(" ")
      MovePathCursor(X,Y)
      DrawVectorText("Hiver : " + ChaineDate(Masque$,\Hiver[Z]))
    EndWith
    
    Day(*Saison\Printemps[Z])
    Y + VectorTextHeight(" ")
    MovePathCursor(X,Y)
    DrawVectorText("")
    
    Y + VectorTextHeight(" ")
    MovePathCursor(X,Y)
    DrawVectorText("Aujourd'hui à Coutances " + Lever_Soleil(49.053546,-1.432954, DayOfYear(Date()), 1) + " - " + Coucher_Soleil(49.053546,-1.432954, DayOfYear(Date()), 1)) ;coordonnées du 13 avenue J-F Millet
    Y + VectorTextHeight(" ")
    MovePathCursor(X,Y)
    DrawVectorText("Aujourd'hui à Poitiers " + CalculerSoleil(46.58055,-0.33972, DayOfYear(Date()), 1))
    Y + VectorTextHeight(" ")
    MovePathCursor(X,Y)
    DrawVectorText("Aujourd'hui à Marseille " + CalculerSoleil(43.29667, -4.63139, DayOfYear(Date()), 1))
    Y + VectorTextHeight(" ")
    MovePathCursor(X,Y)
    DrawVectorText("")
    
    d1 = IncrementerDate(d, 0, 0, 326, 0, 0, 0)
    
    Y + VectorTextHeight(" ")
    MovePathCursor(X,Y)
    DrawVectorText( "IncrementerDate(" + FormatDate("%dd/%mm/%yyyy", d) + ", 0, 0, 326, 0, 0, 0)")
    Y + VectorTextHeight(" ")
    MovePathCursor(X,Y)
    DrawVectorText("326 jours, après le " + FormatDate("%dd/%mm/%yyyy %hh:%ii:%ss", d))
    Y + VectorTextHeight(" ")
    MovePathCursor(X,Y)
    DrawVectorText("nous serons le :    " + FormatDate("%dd/%mm/%yyyy %hh:%ii:%ss", d1))    
    Y + VectorTextHeight(" ")
    MovePathCursor(X,Y)
    DrawVectorText("")
    
    Y + VectorTextHeight(" ")
    MovePathCursor(X,Y)
    DrawVectorText("AddDate(" + FormatDate("%dd/%mm/%yyyy", d) + ", #PB_Date_Day, 326)")
    d = Date()
    d1 = AddDate(d, #PB_Date_Day, 326)
    Y + VectorTextHeight(" ")
    MovePathCursor(X,Y)
    DrawVectorText("326 jours, après le " + FormatDate("%dd/%mm/%yyyy %hh:%ii:%ss", d))
    Y + VectorTextHeight(" ")
    MovePathCursor(X,Y)
    DrawVectorText("nous serons le : " + FormatDate("%dd/%mm/%yyyy %hh:%ii:%ss", d1))
    Y + VectorTextHeight(" ")
    MovePathCursor(X,Y)
    DrawVectorText("")
    
    DateDiff(dateAvant,dateApres,@MaDiff)
    Y + VectorTextHeight(" ")
    MovePathCursor(X,Y)    
    DrawVectorText("Date à analyser: "+FormatDate("%dd/%mm/%yyyy %hh:%ii:%ss",dateAvant))    
    Y + VectorTextHeight(" ")
    MovePathCursor(X,Y)
    DrawVectorText("Total de Jours: " + Str(MaDiff\TotalJours) + ", ce qui nous donne :")
    Y + VectorTextHeight(" ")
    MovePathCursor(X,Y)
    DrawVectorText(Str(MaDiff\Annees) + " an(s)")
    Y + VectorTextHeight(" ")
    MovePathCursor(X,Y)
    DrawVectorText(Str(MaDiff\Mois) + " mois")
    Y + VectorTextHeight(" ")
    MovePathCursor(X,Y)
    DrawVectorText(Str(MaDiff\JoursRestants) + " jour(s)")
    Y + VectorTextHeight(" ")
    MovePathCursor(X,Y)
    DrawVectorText(Str(MaDiff\Heures) + " heure(s)")
    Y + VectorTextHeight(" ")
    MovePathCursor(X,Y)
    DrawVectorText(Str(MaDiff\Minutes) + " minute(s)")
    Y + VectorTextHeight(" ")
    MovePathCursor(X,Y)
    DrawVectorText(Str(MaDiff\Secondes) + " seconde(s)")
    Y + VectorTextHeight(" ")
    MovePathCursor(X,Y)
    DrawVectorText("")
    
    Y + VectorTextHeight(" ")
    MovePathCursor(X,Y)
    DrawVectorText("AnalyserDate")
    Y + VectorTextHeight(" ")
    MovePathCursor(X,Y)
    DrawVectorText("Au 1  avril  1970  :          " + AnalyserDate("01/01/1970"))
    Y + VectorTextHeight(" ")
    MovePathCursor(X,Y)
    DrawVectorText("Au 1 janvier 2015  : " + AnalyserDate("01/01/2015"))
    Y + VectorTextHeight(" ")
    MovePathCursor(X,Y)
    DrawVectorText("    Aujourd'hui    : " + AnalyserDate(FormatDate("%dd/%mm/%yyyy", d)))
    Y + VectorTextHeight(" ")
    MovePathCursor(X,Y)
    DrawVectorText("Au 19 janvier 2038 : " + AnalyserDate("19/01/2038"))
    Y + VectorTextHeight(" ")
    MovePathCursor(X,Y)
    DrawVectorText("")
    
    Y + VectorTextHeight(" ")
    MovePathCursor(X,Y)
    DrawVectorText("ComparerDates")
    date1$ = "17/11/2015"
    date2$ = "17/11/2016"
    Y + VectorTextHeight(" ")
    MovePathCursor(X,Y)
    DrawVectorText(ComparerDates(date1$,date2$))
    date1$ = "17/11/2016"
    date2$ = "17/11/2015"
    Y + VectorTextHeight(" ")
    MovePathCursor(X,Y)
    DrawVectorText(ComparerDates(date1$,date2$))
    date1$ = "17/11/2016"
    date2$ = "17/11/2016"
    Y + VectorTextHeight(" ")
    MovePathCursor(X,Y)
    DrawVectorText(ComparerDates(date1$,date2$))
    Y + VectorTextHeight(" ")
    MovePathCursor(X,Y)    
    DrawVectorText("")
    
    Y + VectorTextHeight(" ")
    MovePathCursor(X,Y)
    DrawVectorText("CalculerAge(19, 6, 1950)")
    Y + VectorTextHeight(" ")
    MovePathCursor(X,Y)
    DrawVectorText("Micoute a " + CalculerAge(19,6,1950)+ " ans, cette année")
    Y + VectorTextHeight(" ")
    MovePathCursor(X,Y)
    DrawVectorText("")
    
    Mois = 2 : Jour = 24    
    
    Y + VectorTextHeight(" ")
    MovePathCursor(X,Y)
    DrawVectorText("Une personne qui est née un " + Jour + " " + TabNomMois$(0, mois) + " est née " + Article_Saison(jour, mois) + ", sous le signe " + Article_Astro(jour, mois))
    Mois = 8 : Jour = 21
    Y + VectorTextHeight(" ")
    MovePathCursor(X,Y)
    DrawVectorText("Une personne qui est née un " + Jour + " " + TabNomMois$(0, mois) + " est née " + Article_Saison(jour, mois) + ", sous le signe " + Article_Astro(jour, mois))
    Mois = 8 : Jour = 22
    Y + VectorTextHeight(" ")
    MovePathCursor(X,Y)
    DrawVectorText("Une personne qui est née un " + Jour + " " + TabNomMois$(0, mois) + " est née " + Article_Saison(jour, mois) + ", sous le signe " + Article_Astro(jour, mois))
    Mois = 8 : Jour = 24
    Y + VectorTextHeight(" ")
    MovePathCursor(X,Y)
    DrawVectorText("Une personne qui est née un " + Jour + " " + TabNomMois$(0, mois) + " est née " + Article_Saison(jour, mois) + ", sous le signe " + Article_Astro(jour, mois))
    
    Y + VectorTextHeight(" ")
    MovePathCursor(X,Y)
    DrawVectorText("")
    Y + VectorTextHeight(" ")
    MovePathCursor(X,Y)
    DrawVectorText("Aujourd'hui nous sommes un "+NomJourSemaine())    
    Y + VectorTextHeight(" ")
    MovePathCursor(X,Y)
    DrawVectorText("Zone fuseau horaire : " + ZoneFuseau())    
    Y + VectorTextHeight(" ")
    MovePathCursor(X,Y)
    DrawVectorText("Décalage horaire = " + DecalageHoraire(3) + "h")
    Y + VectorTextHeight(" ")
    MovePathCursor(X,Y)
    DrawVectorText("Semaine N° "  + MaDonnee(DayOfYear(Date()))\NSem)
    
    StopVectorDrawing()
  EndProcedure
  
CompilerEndIf

Il y a des exemples à la fin du code.

Kwai chang caine · Message par **Kwai chang caine** » jeu. 09/mars/2017 11:03

Et ben !!!! si aprés ça on a encore une question à propos d'une date !!!

Je savais même pas qu'on pouvait en dire autant, et pourtant en temps normal je peux faire un discours interminable à propos d'une seule sylabe

L'avantage de donner whatmiles infos sur un sujet c'est que si tu t'es gouré "somewhere" ça se voit pas

En tout cas ... merci beaucoup du partage

Micoute · Message par **Micoute** » jeu. 09/mars/2017 12:11

Ravi que ça te plaise, j'espère tout cœur ne pas m'être gouré quelque part, car j'ai tout bien vérifié, mais dans ce monde, la perfection n'existe pas.

Kwai chang caine · Message par **Kwai chang caine** » jeu. 09/mars/2017 12:13

La preuve.....puisque moooaaa j'existe ...

Ar-S · Message par **Ar-S** » jeu. 09/mars/2017 13:21

Encore une fois c'est du graphique donc un affichage foireux pour du windows > 100% d'affichage
Je poste une solutionici : http://www.purebasic.fr/french/viewtopi ... =6&t=16557

falsam · Message par **falsam** » jeu. 09/mars/2017 13:30

Une solution simple proposée par Gally que j'utilise dans mes applications pour palier à ce souci d'affichage.

Code : Tout sélectionner

Procedure.f AjustFontSize(Size.l)
  Define lPpp.l = GetDeviceCaps_(GetDC_(#Null), #LOGPIXELSX)
  ProcedureReturn (Size * 96) / lPpp
EndProcedure

Dans le code de Micoute il suffit de remplacer

Code : Tout sélectionner

LoadFont(#Police, "Calibri", 20,#PB_Font_Bold)

par

Code : Tout sélectionner

LoadFont(#police, "Calibri", AjustFontSize(20), #PB_Font_Bold)

Kwai chang caine · Message par **Kwai chang caine** » jeu. 09/mars/2017 13:41

Je sais pas si les deux font exactement la même chose...mais au niveau du code y'a pas photo

PureBasic

Fonctions de dates

Fonctions de dates

Re: Fonctions de dates

Re: Fonctions de dates

Re: Fonctions de dates

Re: Fonctions de dates

Re: Fonctions de dates

Re: Fonctions de dates