Mondphasen berechnen
Markus Eisenbart
z.Zt. versuche ich, ein Programm zu erstellen, mit dem man u. a. auch
die Mondphasen berechnen kann. Da mir hierzu das notwendige Fachwissen
fehlt, versuche ich es mal auf diesem Weg;-).
Ich suche eine Funktion, die alle Mondphasen (Neumond /Erstes Viertel
/Vollmond /Letztes Viertel) eines Jahres/Monats mit Datum und Uhrzeit
berechnet.
Kennt jemand die dafür notwendigen Formeln oder hat einen guten Tipp, wo
man einen VB-Code für dieses Problem findet?
Vielen Dank für Eure Hilfe!
Gruß
Markus
Michaela Meier
Hi,
Ich hoffe, dies hilft Dir weiter :-)
Den Code in Command1 kannst Du beliebig anpassen
Laß das programm erst mal laufen und schau's Dir an
Michaela
-----------------------------
Private Sub Command1_Click()
jahr = 1952
'k=.0 : Neumond
'k=.25: 1. Viertel
'k=.5 : Vollmond
'k=.75: 3. Viertel
MondPhase = Array("Neumond", "1. Viertel", "Vollmond", "3.Viertel")
'Startwert abschätzen
kk = (jahr + 1 / 12 - 1900) * 12.3685
'mit einem Neumond beginnen
kk = Int(kk) - 1
'und die nächsten 12 Monate berechnen
For k = kk To kk + 13 Step 0.25
k = Format(k, "0.00") 'wg. Rundungsfehlern
jd = MoonPhaseTime(k)
CalendarDate jd, dd, mm, yyyy, hh, nn, ss
If yyyy = jahr Then
Debug.Print MondPhase((k - Int(k)) * 4);
Debug.Print " am "; DateSerial(yyyy, mm, dd); " um "; _
TimeSerial(hh, nn, ss); " GMT"
End If
Next
End Sub
Function JulianDay(dd, mm, yyyy, hh, nn, ss)
'Eingabe: dd=Tag, mm=Monat, yyyy=Jahr, hh=Stunde,nn=Minute, ss=Sekunde
If mm > 2 Then
y = yyyy
m = mm
Else
y = yyyy - 1
m = mm + 12
End If
If yyyy + mm / 100 + dd / 10000 >= 1582.1015 Then
a = Int(y / 100)
b = 2 - a + Int(a / 4)
Else
b = 0
End If
t = hh / 24 + nn / (24 * 60) + ss / (24 * 60 * 60#)
JulianDay = Int(365.25 * y) + Int(30.6001 * (m + 1)) + dd + 1720994.5 + b +
t
End Function
Sub CalendarDate(ByVal jd, dd, mm, yyyy, hh, nn, ss)
'Eingabe: jd=Julian Day
'Ergebnis: dd=Tag, mm=Monat, yyyy=Jahr, hh=Stunde,nn=Minute, ss=Sekunde
jd = jd + 0.5
z = Int(jd)
f = jd - z
If z < 2299161 Then
a = z
Else
aa = Int((z - 1867216.25) / 36524.25)
a = z + 1 + aa - Int(aa / 4)
End If
b = a + 1524
c = Int((b - 122.1) / 365.25)
d = Int(365.25 * c)
e = Int((b - d) / 30.6001)
dd = b - d - Int(30.6001 * e) + f
t = (dd - Int(dd)) * 24
hh = Int(t)
t = (t - hh) * 60
nn = Int(t)
t = (t - nn) * 60
ss = CInt(t)
dd = Int(dd)
If e < 13.5 Then
mm = e - 1
Else
mm = e - 13
End If
If mm > 2.5 Then
yyyy = c - 4716
Else
yyyy = c - 4715
End If
End Sub
Function MoonPhaseTime(k)
'Eingabe: k nur .0, .25, .5 .75
'Ergebnis als JulianDay
p = (k * 4) Mod 4
t = k / 1236.85
m = 359.2242 + 29.10535608 * k _
- 0.0000333 * t ^ 2 _
- 0.00000347 * t ^ 3
m1 = 306.0253 + 385.81691806 * k _
+ 0.0107306 * t ^ 2 _
+ 0.00001236 * t ^ 3
f = 21.2964 + 390.67050646 * k _
- 0.0016528 * t ^ 2 _
- 0.00000239 * t ^ 3
m = m - Int(m / 360) * 360
m1 = m1 - Int(m1 / 360) * 360
f = f - Int(f / 360) * 360
jd = 2415020.75933 + 29.53058868 * k _
+ 0.0001178 * t ^ 2 _
- 0.000000155 * t ^ 3 _
+ 0.00033 * xSin(166.56 + 132.87 * t - 0.009173 * t ^ 2)
If p = 0 Or p = 2 Then
jd = jd + (0.1734 - 0.000393 * t) * xSin(m) _
+ 0.0021 * xSin(2 * m) _
- 0.4068 * xSin(m1) _
+ 0.0161 * xSin(2 * m1) _
- 0.0004 * xSin(3 * m1) _
+ 0.0104 * xSin(2 * f) _
- 0.0051 * xSin(m + m1) _
- 0.0074 * xSin(m - m1) _
+ 0.0004 * xSin(2 * f + m) _
- 0.0004 * xSin(2 * f - m) _
- 0.0006 * xSin(2 * f + m1) _
+ 0.001 * xSin(2 * f - m1) _
+ 0.0005 * xSin(m + 2 * m1)
Else
jd = jd + (0.1721 - 0.0004 * t) * xSin(m) _
+ 0.0021 * xSin(2 * m) _
- 0.628 * xSin(m1) _
+ 0.0089 * xSin(2 * m1) _
- 0.0004 * xSin(3 * m1) _
+ 0.0079 * xSin(2 * f) _
- 0.0119 * xSin(m + m1) _
- 0.0047 * xSin(m - m1) _
+ 0.0003 * xSin(2 * f + m) _
- 0.0004 * xSin(2 * f - m) _
- 0.0006 * xSin(2 * f + m1) _
+ 0.0021 * xSin(2 * f - m1) _
+ 0.0003 * xSin(m + 2 * m1) _
+ 0.0004 * xSin(m - 2 * m1) _
- 0.0003 * xSin(2 * m + m1)
If p = 3 Then
jd = jd + 0.0028 - 0.0004 * xCos(m) + 0.0003 * xCos(m1)
Else
jd = jd - 0.0028 + 0.0004 * xCos(m) - 0.0003 * xCos(m1)
End If
End If
MoonPhaseTime = jd
End Function
Function xSin(x)
'x=Winkel in Grad
pi = Atn(1) * 4
xSin = Sin(x * pi / 180)
End Function
Function xCos(x)
'x=Winkel in Grad
pi = Atn(1) * 4
xCos = Cos(x * pi / 180)
End Function
Johannes Tschebisch
ich habe mir einen Kalender mit einem Excel-Worksheet als Ausgabefläche
gebaut, habe aber alle notwendigen Berechnungen (auch die Mondphasen) in
Excel-VB durchgeführt. Diese Berechnungsbestandteile sind mit keinem oder
sehr geringem Aufwand in eine reine VB-Umgebung portierbar.
http://www.jojotsch.de/downloads/jojokalender
Wenn Du über Excel verfügst, sollte es kein Problem sein, die entsprechenden
Teile aus den VB-Modulen herauszuholen.
MfG
Johannes
Klaus Oberdalhoff
> z.Zt. versuche ich, ein Programm zu erstellen, mit dem man u. a. auch
> die Mondphasen berechnen kann. Da mir hierzu das notwendige Fachwissen
> fehlt, versuche ich es mal auf diesem Weg;-).
'###########################################################################
######################
'''''''''''' Mondphasenberechnung
'###########################################################################
######################
Function Mondphase_Prom(Optional ByVal XDatum As Date) As Integer
'Rückgabe: Mondphase in Promille (als Teil einer kompletten Mondphase
zwischen Vollmond und Vollmond)
' 0 o/oo = Vollmond
' 250 o/oo = Halbmond abnehmend
' 500 o/oo = Neumond
' 750 o/oo = Halbmond zunehmend
'1000 o/oo = Vollmond
'Achtung: Berechnung kann um einen Tag + / - differieren ...
'Beispiel: Der Wert für den 29.4.1999 ist 977
' Der Wert für den 30.4.1999 ist 011
'D.h. am 29.4.1999 um 0:00 Uhr fehlen noch ca. 23 tausendstel (einer
Mondphase) bis zum Vollmond, wärend
'am 30.4.1999 um 0:00 Uhr bereits 11 tausendstel (einer Mondphase) schon
wieder vorbei sind.
'Die Frage: Wann exakt ist Vollmond ? bleibt also bestehen.
'Ich habe in der Funktion Mondphase (willkürlich) folgende vier "Stichtage"
festgelegt:
'Wenn die Intervalle geändert werden, erhält man manchmal mehr als einen Tag
pro Phase,
'und das wollte ich vermeiden
'Wenn der Mondphasenwert >= 982 oder <= 15 (Moon5) ist, dann ist Vollmond.
'Wenn der Mondphasenwert >= 482 oder <= 515 (Moon1) ist, dann ist Neumond.
'Wenn der Mondphasenwert >= 232 oder <= 265 (Moon7) ist, dann ist Halbmond
(abnehmend).
'Wenn der Mondphasenwert >= 732 oder <= 765 (Moon3) ist, dann ist Halbmond
(zunehmend).
'ansonsten sind es einfach "zunehmende" oder "abnehmende" Mondphasen mit
jeweils mehreren Tagen
'frmKalender enthält 8 Mondphasenbilder (ico), von denen immer nur eines
sichtbar ist.
'Die zurückgegebenen Nummern 1 - 8 entsprechen dem Bildnamen ...
'Die Namen sind Moon1 bis Moon8
'Mondphasenberechnung: (Info aus einer Newsgroup)
'Well, you can calculate this fairly easily by knowing the length of the
'lunar cycle (29.5302 days), a known full moon in the past (Nov. 11, 1753
'is a good one since it is after the Gregorian reformation and the full
'moon was at almost exactly 0:00 GMT), and a formula for calculating the
'number of days between two dates (these are readily available).
'
'For example: I was born Aug. 11, 1964. I need to calculate the number
'of days since Nov. 11, 1753.
'Number of days (VBA: datediff)
'1964-1753 = 211 years
'211*365 = 77015 days.
'211/4 = 52.75 = 53 leap days
'1800, and 1900 were not leap years so 51 leap days
'77015+51 = 77066
'subtract 30 days for Sep, and 31 days for Oct, (31-11) for Aug, and 11
'days for Nov
'77066-30-31-20-11 = 76974 days (a good Julian date calculator would
make
'this much easier.)
'Divide this (number of days) by the lunar cycle of 29.5302 days:
'76974/29.5302 = 2606.62
'So the moon is 62% into the cycle where 50% would be a new moon and 100%
(or
'0%) would be full moon.
Const vgldat As Date = #11/11/1753#
Const Mooncyc As Double = 29.5302
Dim xDat As Double
On Error Resume Next
If (Not IsDate(XDatum)) Or (IsMissing(XDatum) Or (XDatum = 0)) Then XDatum =
Date
xDat = Abs(DateDiff("d", vgldat, XDatum, vbMonday, vbFirstFourDays))
xDat = xDat / Mooncyc
Mondphase_Prom = CInt((xDat - Int(xDat)) * 1000)
End Function
Function Mondphase(Optional ByVal XDatum As Date, Optional AlsZahl As
Boolean = True) As Variant
Dim XTm As Integer
If (Not IsDate(XDatum)) Or (IsMissing(XDatum) Or (XDatum = 0)) Then XDatum =
Date
XTm = Mondphase_Prom(XDatum)
If XTm >= 982 Or XTm <= 15 Then
If AlsZahl = False Then
Mondphase = "Vollmond"
Else
Mondphase = 5
End If
Exit Function
End If
If XTm >= 482 And XTm <= 515 Then
If AlsZahl = False Then
Mondphase = "Neumond"
Else
Mondphase = 1
End If
Exit Function
End If
If (XTm >= 232 And XTm <= 265) Then
If AlsZahl = False Then
Mondphase = "Halbmond (abnehmend)"
Else
Mondphase = 7
End If
Exit Function
End If
If (XTm >= 732 And XTm <= 765) Then
If AlsZahl = False Then
Mondphase = "Halbmond (zunehmend)"
Else
Mondphase = 3
End If
Exit Function
End If
'
'Nur, wenn nicht bereits direkt Neu- Voll- oder Halbmond angezeigt wurde
If XTm >= 0 And XTm <= 250 Then
If AlsZahl = False Then
Mondphase = "Abnehmender Mond (Vollmond -> Halbmond) - " & XTm & "
o/oo"
Else
Mondphase = 6
End If
Exit Function
End If
If XTm > 250 And XTm <= 500 Then
If AlsZahl = False Then
Mondphase = "Abnehmender Mond (Halbmond -> Neumond) - " & XTm & "
o/oo"
Else
Mondphase = 8
End If
Exit Function
End If
If XTm > 500 And XTm <= 750 Then
If AlsZahl = False Then
Mondphase = "Zunehmender Mond (Neumond -> Halbmond) - " & XTm & "
o/oo"
Else
Mondphase = 2
End If
Exit Function
End If
If XTm > 750 And XTm <= 1000 Then
If AlsZahl = False Then
Mondphase = "Zunehmender Mond (Halbmond -> Vollmond) - " & XTm & "
o/oo"
Else
Mondphase = 4
End If
Exit Function
End If
End Function
--
mfg
Klaus KO...@gmx.de
PS:Tips und Tricks zu ACCESS 97 (** KnowHow-MDB ** Ver 3.0 - 30.9.1999)
unter http://www.accessware.de/
Access-FAQ bei: http://www.donkarl.com/AccessFAQ.htm
Michaela Meier
>
> 'Achtung: Berechnung kann um einen Tag + / - differieren ...
>
Hi,
:-) :-) Schau Dir mal meinen Code an. Die exakte Formel ist bei Jean Meeus
abgetippt und ziemlich verlنكlich. Ist nur ein Vorschlag :-)
Michaela
Klaus Oberdalhoff
>> Mondphasen Berechnung <<
danke für den Tip.
Nach meinen bisherigen Erfahrungen ist die Berechnung genau genug.
> > 'Achtung: Berechnung kann um einen Tag + / - differieren ...
das bezieht sich - wie im weiteren Text expliztit erklärt - darauf, dass der
(berechnete) Vollmondzyklus manchmal vor Mitternacht und manchmal erst nach
Mitternacht ist, aber der Datumswechsel genau um Mitternacht stattfindet.
Von daher differiert die Berechnung __subjektiv__ manchmal um einen Tag ...