Code : Tout sélectionner
;....................................................................................
; .: CALCUL SUR LES DATES :.
;============================
; Jour Julien astronomique
;============================
; Auteur Mesa
; PureBasic v4.61
;
; D'après "Astronomie pratique et informatique"
; de C. DUMOULIN et JP PARISOT, Ed MASSON (niveau scientifique : Master)
;
; Le jour julien est universellement utilisé par les astronomes et les historiens.
; Sa précision est de l'ordre de la minute de temps entre les années -5000 et +8000 au moins
;
; Le calcul du jour julien (JJ ou JD en anglais pour Jour Julien)
; est indispensable pour effectuer des calculs astronomiques
; mais aussi pour faire des calculs sur des dates du calendrier.
;
; Opérations sur les dates : addition, soustraction, etc...
;
; Par ex : Le 6 juin 1944 à 6h 10' 24" + 3 mois 4 jour 1h 47' 12" = ?
;......................................................................................
;OS : Tous
;Institut de mecanique celeste et de calcul des ephemerides
;http://www.imcce.fr/fr/grandpublic/temps/jour_julien.php
;
Procedure.d jd(Annee, Mois, jour, Heure, Minute, Seconde); Jour Julien à 0h TU (Temps Universel )
Protected y.d=0
Protected m.d=0
Protected a.d=0
Protected jj.d=0
Protected z.d=0
If Mois<3
y=Annee-1
m=Mois+12
Else
y=Annee
m=Mois
EndIf
jj=Int(365.25*(y+4716))+Int(30.6001*(m+1))+jour-1524.5
; Réforme Grégorienne
; Au Jeudi 4 Octobre 1582 succède le Vendredi 15 Octobre 1582
;
a=Annee+(Mois/100)+(jour/10000)
If a>1582.1014;
a = Int(y/100)
jj = jj + 2 - a + Int(a/4)
EndIf
;Ajout h m s
jj + (Heure + Minute/60 + Seconde/3600)/24
ProcedureReturn jj
EndProcedure
Procedure.d jd2(Annee, Mois, jour, Heure, Minute, Seconde); Jour Julien à 0h TU (Temps Universel )
; --Ne fonctionne pas avant le 15 Octobre 15 1582 mais plus rapide que jd()--
Protected j.d
Protected m
Protected a
Protected jj.d
a=Annee
m=Mois
j=jour+(Heure + Minute/60 + Seconde/3600)/24
jj=367*a -Int(1.75*(Int((m+9)/12)+a))
jj-Int(0.75*(1+Int((Int((m-9)/7)+a)*0.01)))
jj+Int((275*m)/9)+j+1721028.5
ProcedureReturn jj
EndProcedure
Procedure.s jd2Date(jj.d) ; Jour Julien -> Date
Protected j1.d,f.d,dm.d,h.d
Protected z,aa,al,b,c,d,e,an
Protected Resultat.s
j1=jj+0.5
z=Int(j1)
f=j1-z
If z<2299161
aa=z
Else
al=Int((z-1867216.25)/36524.25)
aa=z+1+al-Int(al/4)
EndIf
b=aa+1524
c=Int((b-122.1)/365.25)
d=Int(365.25*c)
e=Int((b-d)/30.6001)
dm=b-d-Int(30.6001*e)+f
If e<14
m=e-1
Else
m=e-13
EndIf
If m>2
an=c-4716
Else
an=c-4715
EndIf
h=24*(dm-Int(dm))
Resultat=Str(an)+"/"+Str(m)+"/"+Str(Int(dm))+" "+StrD(h); Année Mois Jour Heure (fraction)
ProcedureReturn Resultat
EndProcedure
Procedure.b DayOfWeekJD(jj.d)
;Renvoie 0=Dimanche, 1 Lundi, 2=Mardi, 3=Mercredi, 4=Jeudi, 5=Vendredi, 6=Samedi
Protected j.d
Protected Resultat.b
j=jj+1.5
Resultat=Int(j-7*Int(j/7));j%7
ProcedureReturn Resultat
EndProcedure
Procedure DayOfYearJD(Annee, Mois, jour) ;Renvoie le rang du jour dans l'année
Protected Resultat
Resultat = 1+ jd(Annee, Mois, jour, 0, 0, 0) - jd(Annee, 1, 1, 0, 0, 0)
ProcedureReturn Resultat
EndProcedure
Procedure.b IsLeapYear(Annee) ; Renvoie : 0 = pas bissextile, 1 = est bissextile
;Bissextile
Protected Resultat.b
If Annee < 1582 ; Trop compliqué, croyez moi !
ProcedureReturn 0; -1
EndIf
If Annee%4=0
If y%100<>0
Resultat=1
ElseIf Annee%400=0
Resultat=1
EndIf
Resultat=1
EndIf
ProcedureReturn Resultat
EndProcedure
Debug ("_____________.: Jour Juliens :.______________")
Debug "date Grégorienne : 1,1,-4712 :-> Jour Julien = " + StrD(jd(-4712,1,1,0,0,0),2)
Debug " Réforme Grégorienne "
Debug " Au Jeudi 4 Octobre 1582 succède le Vendredi 15 Octobre 1582"
Debug "date Grégorienne : 4,10,1582 :-> Jour Julien = " + StrD(jd(1582,10,4,0,0,0),2)
Debug "date Grégorienne : 15,10,1582 :-> Jour Julien = " + StrD(jd(1582,10,15,0,0,0),2)
Debug " Réforme Grégorienne OK"
Debug "date Grégorienne : 14,7,1789 :-> Jour Julien = " + StrD(jd(1789,7,14,0,0,0),2)
Debug "date Grégorienne : 1,1,1900 :-> Jour Julien = " + StrD(jd(1900,1,1,0,0,0),2)
Debug "date Grégorienne : 1,1,2000 :-> Jour Julien = " + StrD(jd(2000,1,1,0,0,0),2)
Debug "Jugement dernier ;) : 21,12,2012,12,12,12 :-> Jour Julien = " + StrD(jd(2012,12,21,12,12,12),6)
Debug "date Grégorienne : 1,1,3000 :-> Jour Julien = Ouf ! ;)) " + StrD(jd(3000,1,1,0,0,0),2)
Debug ""
Debug("___________Quick JD_____________")
Debug "Calcul rapide mais pas de Réforme Grégorienne"
Debug "date Grégorienne : 15,10,1582 :-> Jour Julien = " + StrD(jd2(1582,10,15,0,0,0),2)
Debug "date Grégorienne : 14,7,1789 :-> Jour Julien = " + StrD(jd2(1789,7,14,0,0,0),2)
Debug "date Grégorienne : 1,1,1900 :-> Jour Julien = " + StrD(jd2(1900,1,1,0,0,0),2)
Debug "date Grégorienne : 1,1,2000 :-> Jour Julien = " + StrD(jd2(2000,1,1,0,0,0),2)
Debug "Jugement dernier ;) : 21,12,2012,12,12,12 :-> Jour Julien = " + StrD(jd2(2012,12,21,12,12,12),6)
Debug ""
Debug("___________JD -> Grego_(Y, M, D, h)____________")
Debug "Jour Julien = 0.00 :-> date Grégorienne : " + jd2Date(0.00)
; Réforme Grégorienne
Debug " Au Jeudi 4 Octobre 1582 succède le Vendredi 15 Octobre 1582"
Debug "Jour Julien = 2299159.50 :-> date Grégorienne : " + jd2Date(2299159.50)
Debug "Jour Julien = 2299160.50 :-> date Grégorienne : " + jd2Date(2299160.50)
Debug " Réforme Grégorienne OK"
Debug "Jour Julien = 2374673.50 :-> date Grégorienne : " + jd2Date(2374673.50)
Debug "Jour Julien = 2415020.50 :-> date Grégorienne : " + jd2Date(2415020.50)
Debug "Jour Julien = 2451544.50 :-> date Grégorienne : " +jd2Date(2451544.50)
Debug "Jour Julien =2456283.008472 :-> date Grégorienne : " + jd2Date(2456283.008472)
Debug "Jour Julien = 2816787.50 :-> date Grégorienne : " + jd2Date(2816787.50)
Debug ""
Debug("___________jour de la semaine____________")
Debug "0=Dimanche, 1 Lundi, 2=Mardi, 3=Mercredi, 4=Jeudi, 5=Vendredi, 6=Samedi"
Debug " Au Jeudi 4 Octobre 1582 succède le Vendredi 15 Octobre 1582"
Debug "jour de la semaine du 4,10,1582 est " + Str(DayOfWeekJD(jd(1582,10,4,0,0,0)))
Debug "jour de la semaine du 15,10,1582 est " + Str(DayOfWeekJD(jd(1582,10,15,0,0,0)))
Debug "jour de la semaine du 1,1,2000 est " + Str(DayOfWeekJD(jd(1582,10,15,0,0,0)))
Debug ""
Debug("___________Aujourd'hui____________")
Tojour$=FormatDate("%yyyy/%mm/%dd %hh:%ii:%ss", Date())
jdTojour.d=jd(Year(Date()),Month(Date()),Day(Date()),Hour(Date()),Minute(Date()),Second(Date()))
dow=DayOfWeekJD(jdTojour)
dow$=""
;0=Dimanche, 1 Lundi, 2=Mardi, 3=Mercredi, 4=Jeudi, 5=Vendredi, 6=Samedi
Select dow
Case 0 : dow$="Dimanche "
Case 1 : dow$="Lundi "
Case 2 : dow$="Mardi "
Case 3 : dow$="Mercredi "
Case 4 : dow$="Jeudi "
Case 5 : dow$="Vendredi "
Case 6 : dow$="Samedi "
EndSelect
Debug "Aujourd'hui :" + dow$ + Tojour$
Debug "Jour Julien " + StrD(jdTojour)
Debug "jour n° " + Str(DayOfYearJD(Year(Date()), Month(Date()), Day(Date()))) + " de l'année"
isleap$ =" est une année bissextile"
isnotleapAnnee$ = " n'est pas une année bissextile"
If IsLeapYear(Year(Date())) = 1
Debug Str(Year(Date())) + isleap$
Else
Debug Str(Year(Date())) + isnotleapAnnee$
EndIf
MessageRequester("Maintenant","Faisons quelques calculs sur les dates.",0)
ClearDebugOutput()
Debug "Faisons quelques calculs sur les dates."
Debug "Quelle est la date au : 373 jours après le 1/1/2000 0h ?"
Newjd.d=jd(2000,1,1,0,0,0) + 373
Debug jd2Date(Newjd)
Debug ""
Debug "Quelle est la date au : 119 jours avant le 1/1/2000 0h ?"
Debug jd2Date(jd(2000,1,1,0,0,0) - 119)
Debug ""
Debug "Quelle est la date au : 3 semaines après le 1/1/2000 0h ?"
Debug jd2Date(jd(2000,1,1,0,0,0) + 7*3)
Debug ""
Debug "Quelle est le nombre de jours entre le 1/1/2000 12h 14m 37s et le 1/1/3000 6h 56m 12s ?"
jd1.d=jd(2000,1,1,12,14,37)
jd2.d=jd(3000,1,1,6,56,12)
Debug jd2-jd1
Debug ""
Debug "Bébé naîtra 9 mois après aujourd'hui :"
Debug jd2Date(jdTojour + 9*30.5)
