Fonctions de dates
Publié : 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.
Il y a des exemples à la fin du code.
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
