De temps en temps il faut le dire....
Ce code date de 2012....il fonctionne avec PB 5.62
Regardez le travail que cela représente ,la clarté,la pureté et l'élégance , et le fonctionnement de ce code...///
Bon moi je sais pas faire d'aussi bon code mais je sais apprécier ce qui est bien fait.
En 2003 je suivais déjà Le soldat inconnu et Horst Shaffer (pardon pour l'ortographe).
donc je recherchais sur Goo...les codes des ces personnes pré cités, pour moi ils ont été avec d'autres bien sûr,
les précurseurs avec fred de code aussi évolués.
Donc "Coup de châpeau"...
Je sais pas exactement quand a été créé le "Forum"" je ne le connais que depuis peu de temps because:
G changé plusieurs fois de "fournisseur" et que PureBasic n'était accessible qu'avec le "fournisseur de 1e fois....
que mon fils avait à l'époque, enfin bref...
Bien sûr certains d'entre vous connaissent ces personnes et ce code , mais avouez que "Cà c du PureBasic" en pureté...///
De temps en temps beaucoup d'entre vous font du beau code , je l'ajoute ...
Voilà et Bravo à L S I...///
Code : Tout sélectionner
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