Code : Tout sélectionner
; https://www.purebasic.fr/french/viewtopic.php?t=12523
; par LSI
Enumeration 0
#MoonPhase_None = -1
#MoonPhase_NewMoon
#MoonPhase_FirstQuarter
#MoonPhase_FullMoon
#MoonPhase_LastQuarter
EndEnumeration
Structure MoonPhase_Structure
Phase.b
Date.l
An.l
Mois.b
Jour.b
Heure.b
Minute.b
EndStructure
Global NewList MoonPhase.MoonPhase_Structure()
Procedure MoonPhase_Calculation(Year, Month)
Static MoonPhase_Calculation_Year.l, MoonPhase_Calculation_Month.b
Protected.l Date, i, ii, Heure, Minute, Mois, An, Jour, JJ
Protected.d K, T, T2, T3, J, M, MP, F
Debug #PB_Compiler_Procedure
If Year <> MoonPhase_Calculation_Year Or Month <> MoonPhase_Calculation_Month
MoonPhase_Calculation_Year = Year
MoonPhase_Calculation_Month = Month
ClearList(MoonPhase())
Repeat
GetSystemTime_(DateUTC.SYSTEMTIME)
GetLocalTime_(DateLocale.SYSTEMTIME)
Until DateUTC\wSecond = DateLocale\wSecond ; Garantit que la lecture de la date s'est effectuée sur la même seconde
DateUTC_Seconde.q = Date(DateUTC\wYear, DateUTC\wMonth, DateUTC\wDay, DateUTC\wHour, DateUTC\wMinute, DateUTC\wSecond)
DateLocale_Seconde.q = Date(DateLocale\wYear, DateLocale\wMonth, DateLocale\wDay, DateLocale\wHour, DateLocale\wMinute, DateLocale\wSecond)
DecalageHoraire_Seconde.q = DateLocale_Seconde - DateUTC_Seconde
CompilerIf #PB_Compiler_Debugger
DecalageHoraire = DecalageHoraire_Seconde / 3600
If DecalageHoraire > 0
Debug "Votre fuseau horaire : GMT+" + Str(DecalageHoraire)
Else
Debug "Votre fuseau horaire : GMT" + Str(DecalageHoraire)
EndIf
CompilerEndIf
Date = Date(Year, Month, 1, 0, 0, 0)
Date = AddDate(Date, #PB_Date_Month, -1)
K.d = Year(Date)
Select Month(Date)
Case 1
K + 0.041
Case 2
K + 0.126
Case 3
K + 0.203
Case 4
K + 0.288
Case 5
K + 0.370
Case 6
K + 0.455
Case 7
K + 0.537
Case 8
K + 0.622
Case 9
K + 0.707
Case 10
K + 0.789
Case 11
K + 0.874
Case 12
K + 0.956
EndSelect
K = (K - 1900) * 12.3685
K = Int(K) - 0.25
If K < 0
K - 1
EndIf
For ii = 0 To 11
K + 0.25
T.d = K / 1236.85
T2.d = T * T
T3.d = T * T2
J.d = 2415020.75933 + 29.5305888531 * K + 0.0001337 * T2 - 0.000000150 * T3 + 0.00033 * Sin((166.56 + 132.87 * T - 0.009 * T2) * #PI / 180)
M.d = (359.2242 + 29.10535608 * K - 0.0000333 * T2 - 0.00000347 * T3) * #PI / 180
M = M - Int(M / (2 * #PI)) * (2 * #PI)
MP.d = (306.0253 + 385.81691806 * K + 0.0107306 * T2 + 0.00001236 * T3) * #PI / 180
MP = MP - Int(MP / (2 * #PI)) * (2 * #PI)
F.d = (21.2964 + 390.67050646 * K - 0.0016528 * T2 - 0.00000239 * T3) * #PI / 180
F = F - Int(F / (2 * #PI)) * (2 * #PI)
i = ii % 4
If i = 0 Or i = 2
J + (0.1734 - 0.000393 * T) * Sin(M)
J + 0.0021 * Sin(2 * M) - 0.4068 * Sin(MP)
J + 0.0161 * Sin(2 * MP) - 0.0004 * Sin(3 * MP)
J + 0.0104 * Sin(2 * F) - 0.0051 * Sin(M + MP)
J - 0.0074 * Sin(M - MP) + 0.0004 * Sin(2 * F + M)
J - 0.0004 * Sin(2 * F - M) - 0.0006 * Sin(2 * F + MP)
J + 0.001 * Sin(2 * F - MP) + 0.0005 * Sin(M + 2 * MP)
Else
J + (0.1721 - 0.0004 * T) * Sin(M)
J + 0.0021 * Sin(2 * M) - 0.6280 * Sin(MP)
J + 0.0089 * Sin(2 * MP) - 0.0004 * Sin(3 * MP)
J + 0.0079 * Sin(2 * F) - 0.0119 * Sin(M + MP)
J - 0.0047 * Sin(M - MP) + 0.0003 * Sin(2 * F + M)
J - 0.0004 * Sin(2 * F - M) - 0.0006 * Sin(2 * F + MP)
J + 0.0021 * Sin(2 * F - MP) + 0.0003 * Sin(M + 2 * MP)
J + 0.0004 * Sin(M - 2 * MP) - 0.0003 * Sin(2 * M + MP)
If i = 1
J + 0.0028 - 0.0004 * Cos(M)
J + 0.0003 * Cos(MP)
Else
J - 0.0028 + 0.0004 * Cos(M)
J - 0.0003 * Cos(MP)
EndIf
EndIf
J + 0.5
JJ = Int(J)
If JJ >= 2299160.5
Alpha.d = Int((JJ - 1867216.25) / 36524.25)
JJ = JJ + 1 + Alpha - Int(Alpha / 4)
EndIf
JJ + 1524
Calcul_An = Int((JJ - 122.1) / 365.25)
Calcul_Jour = Int(Calcul_An * 365.25)
Calcul_Mois = Int((JJ - Calcul_Jour) / 30.6001)
Jour = Int(JJ - Calcul_Jour - Int(Calcul_Mois * 30.6001))
If Calcul_Mois < 13.5
Mois = Int(Calcul_Mois - 1)
Else
Mois = Int(Calcul_Mois - 13)
EndIf
If Mois >= 3
An = Int(Calcul_An - 4716)
Else
An = Int(Calcul_An - 4715)
EndIf
J - Int(J)
Heure = Int(J * 24)
Minute = Int((J - Heure / 24) * 1440)
CompilerIf #PB_Compiler_Debugger
Select i
Case #MoonPhase_NewMoon
Debug "Nouvelle lune"
Case #MoonPhase_FirstQuarter
Debug "Premier quartier"
Case #MoonPhase_FullMoon
Debug "Pleine lune"
Case #MoonPhase_LastQuarter
Debug "Dernier quartier"
EndSelect
Debug Str(Jour) + "/" + RSet(Str(Mois), 2, "0") + "/" + Str(An) + " à " + Str(Heure) + ":" + RSet(Str(Minute), 2, "0") + " (UTC)"
CompilerEndIf
AddElement(MoonPhase())
MoonPhase()\Phase = i
MoonPhase()\Date = Date(An, Mois, Jour, 0, 0, 0) + (Heure * 3600 + Minute * 60) + DecalageHoraire_Seconde
MoonPhase()\An = Year(MoonPhase()\Date)
MoonPhase()\Mois = Month(MoonPhase()\Date)
MoonPhase()\Jour = Day(MoonPhase()\Date)
MoonPhase()\Heure = Hour(MoonPhase()\Date)
MoonPhase()\Minute = Minute(MoonPhase()\Date)
Debug Str(MoonPhase()\Jour) + "/" + RSet(Str(MoonPhase()\Mois), 2, "0") + "/" + Str(MoonPhase()\An) + " à " + Str(MoonPhase()\Heure) + ":" + RSet(Str(MoonPhase()\Minute), 2, "0")
Next
EndIf
EndProcedure
Procedure NextMoonPhase(Year = 0, Month = 0, Day = 0) ; Get the next moon phase after the date in parameters or last result
If Year And Month And Day
MoonPhase_Calculation(Year, Month)
Date = Date(Year, Month, Day, 0, 0, 0)
ElseIf ListIndex(MoonPhase())
Year = MoonPhase()\An
Month = MoonPhase()\Mois
Day = MoonPhase()\Jour
MoonPhase_Calculation(Year, Month)
Date = Date(Year, Month, Day, 0, 0, 0) + (24 * 60 * 60)
EndIf
If Date
ForEach MoonPhase()
If MoonPhase()\Date > Date
Date = MoonPhase()\Date
Break
EndIf
Next
EndIf
Debug #PB_Compiler_Procedure
Debug Date
ProcedureReturn Date
EndProcedure
Procedure GetMoonPhase(Year = 0, Month = 0, Day = 0) ; Get Moon phase of last result or of the date in parameters
If Year And Month And Day
MoonPhase_Calculation(Year, Month)
Phase = #MoonPhase_None
ForEach MoonPhase()
If Year = MoonPhase()\An And Month = MoonPhase()\Mois And Day = MoonPhase()\Jour
Phase = MoonPhase()\Phase
Break
EndIf
Next
ElseIf ListIndex(MoonPhase())
Phase = MoonPhase()\Phase
EndIf
CompilerIf #PB_Compiler_Debugger
Debug #PB_Compiler_Procedure
Select Phase
Case #MoonPhase_None
Debug "Ce jour n'est pas un état spécifique de la Lune"
Case #MoonPhase_NewMoon
Debug "Nouvelle lune"
Case #MoonPhase_FirstQuarter
Debug "Premier quartier"
Case #MoonPhase_FullMoon
Debug "Pleine lune"
Case #MoonPhase_LastQuarter
Debug "Dernier quartier"
EndSelect
CompilerEndIf
ProcedureReturn Phase
EndProcedure
Procedure GetMoonPhaseYear() ; Get year of moon phase of last result
An = #MoonPhase_None
If ListIndex(MoonPhase())
An = MoonPhase()\An
EndIf
Debug #PB_Compiler_Procedure
Debug An
ProcedureReturn An
EndProcedure
Procedure GetMoonPhaseMonth() ; Get month of moon phase of last result
Mois = #MoonPhase_None
If ListIndex(MoonPhase())
Mois = MoonPhase()\Mois
EndIf
Debug #PB_Compiler_Procedure
Debug Mois
ProcedureReturn Mois
EndProcedure
Procedure GetMoonPhaseDay() ; Get day of moon phase of last result
Jour = #MoonPhase_None
If ListIndex(MoonPhase())
Jour = MoonPhase()\Jour
EndIf
Debug #PB_Compiler_Procedure
Debug Jour
ProcedureReturn Jour
EndProcedure
Procedure GetMoonPhaseHour(Year = 0, Month = 0, Day = 0) ; Get hour of Moon phase of last result or of the date in parameters
If Year And Month And Day
MoonPhase_Calculation(Year, Month)
Heure = #MoonPhase_None
ForEach MoonPhase()
If Year = MoonPhase()\An And Month = MoonPhase()\Mois And Day = MoonPhase()\Jour
Heure = MoonPhase()\Heure
Break
EndIf
Next
ElseIf ListIndex(MoonPhase())
Heure = MoonPhase()\Heure
EndIf
Debug #PB_Compiler_Procedure
Debug Heure
ProcedureReturn Heure
EndProcedure
Procedure GetMoonPhaseMinute(Year = 0, Month = 0, Day = 0) ; Get minute of Moon phase of last result or of the date in parameters
If Year And Month And Day
MoonPhase_Calculation(Year, Month)
Minute = #MoonPhase_None
ForEach MoonPhase()
If Year = MoonPhase()\An And Month = MoonPhase()\Mois And Day = MoonPhase()\Jour
Minute = MoonPhase()\Minute
Break
EndIf
Next
ElseIf ListIndex(MoonPhase())
Minute = MoonPhase()\Minute
EndIf
Debug #PB_Compiler_Procedure
Debug Minute
ProcedureReturn Minute
EndProcedure
; Test du programme
Enumeration
#ListeMois
#ListeAn
#An
#Mois
EndEnumeration
Procedure RemplirListe(An, Mois)
; Pour tous les jours du mois
ClearGadgetItems(#ListeMois)
Date = Date(An, Mois, 1, 0, 0, 0) ; Premier jour du mois
While Month(Date) = Mois
; Jour
Jour = Day(Date)
Jour_Texte.s = RSet(Str(Jour), 2, "0") + "/" + RSet(Str(Mois), 2, "0") + "/" + Str(An)
; Calcul de la phase de la Lune
Phase = GetMoonPhase(An, Mois, Jour)
Select Phase
Case #MoonPhase_None
Phase_Texte.s = ""
Case #MoonPhase_NewMoon
Phase_Texte.s = "Nouvelle lune"
Case #MoonPhase_FirstQuarter
Phase_Texte.s = "Premier quartier"
Case #MoonPhase_FullMoon
Phase_Texte.s = "Pleine lune"
Case #MoonPhase_LastQuarter
Phase_Texte.s = "Dernier quartier"
EndSelect
; Calcul de l'heure
If Phase <> #MoonPhase_None
Heure = GetMoonPhaseHour(An, Mois, Jour)
Minute = GetMoonPhaseMinute(An, Mois, Jour)
Heure_Texte.s = RSet(Str(Heure), 2, "0") + ":" + RSet(Str(Minute), 2, "0")
Else
Heure_Texte.s = ""
EndIf
; Affiche dans la liste
AddGadgetItem(#ListeMois, -1, Jour_Texte + Chr(10) + Heure_Texte + Chr(10) + Phase_Texte)
; Ajoute un jour
Date = AddDate(Date, #PB_Date_Day, 1)
Wend
; Pour l'année complète
ClearGadgetItems(#ListeAn)
Date = Date(An, 1, 1, 0, 0, 0) ; Premier jour de l'année
Date = NextMoonPhase(An, Mois, 1)
While Year(Date) = An
; Jour
Mois = GetMoonPhaseMonth()
Jour = GetMoonPhaseDay()
Jour_Texte.s = RSet(Str(Jour), 2, "0") + "/" + RSet(Str(Mois), 2, "0") + "/" + Str(An)
; Calcul de la phase de la Lune
Phase = GetMoonPhase()
Select Phase
Case #MoonPhase_None
Phase_Texte.s = ""
Case #MoonPhase_NewMoon
Phase_Texte.s = "Nouvelle lune"
Case #MoonPhase_FirstQuarter
Phase_Texte.s = "Premier quartier"
Case #MoonPhase_FullMoon
Phase_Texte.s = "Pleine lune"
Case #MoonPhase_LastQuarter
Phase_Texte.s = "Dernier quartier"
EndSelect
; Calcul de l'heure
Heure = GetMoonPhaseHour()
Minute = GetMoonPhaseMinute()
Heure_Texte.s = RSet(Str(Heure), 2, "0") + ":" + RSet(Str(Minute), 2, "0")
; Affiche dans la liste
AddGadgetItem(#ListeAn, -1, Jour_Texte + Chr(10) + Heure_Texte + Chr(10) + Phase_Texte)
; Phase suivante
Date = NextMoonPhase()
Wend
EndProcedure
; Lecture de la date actuelle
Date = Date()
An = Year(Date)
Mois = Month(Date)
If OpenWindow(0, 0, 0, 600, 600, "Phase de la Lune", #PB_Window_SystemMenu | #PB_Window_MinimizeGadget | #PB_Window_ScreenCentered) = 0
End
EndIf
ListIconGadget(#ListeMois, 0, 0, 300, 560, "Jour du mois", 100, #PB_ListIcon_FullRowSelect)
AddGadgetColumn(#ListeMois, 1, "Heure", 50)
AddGadgetColumn(#ListeMois, 2, "Phase de la lune", 120)
ListIconGadget(#ListeAn, 300, 0, 300, 560, "Jour de l'année", 100, #PB_ListIcon_FullRowSelect)
AddGadgetColumn(#ListeAn, 1, "Heure", 50)
AddGadgetColumn(#ListeAn, 2, "Phase de la lune", 120)
TextGadget(#PB_Any, 0, 560, 300, 16, "Année", #PB_Text_Center)
TextGadget(#PB_Any, 200, 560, 300, 16, "Mois", #PB_Text_Center)
StringGadget(#An, 0, 576, 300, 24, Str(An), #PB_String_Numeric | #ES_CENTER)
StringGadget(#Mois, 300, 576, 300, 24, Str(Mois), #PB_String_Numeric | #ES_CENTER)
RemplirListe(An, Mois)
Repeat
Event = WaitWindowEvent()
Select Event
Case #PB_Event_Gadget
Select EventGadget()
Case #An, #Mois
If EventType() = #PB_EventType_Change
An = Val(GetGadgetText(#An))
Mois = Val(GetGadgetText(#Mois))
If An And Mois
RemplirListe(An, Mois)
EndIf
EndIf
EndSelect
EndSelect
Until Event = #PB_Event_CloseWindow
