５．月齢計算と月相表示
【旧暦カレンダーのＶＢＡ】
[戻る]
■概要説明
- 月別旧暦カレンダーや月別家庭暦や潮時カレンダー等に月の満ち欠けが表示されています。
- 月は、約１ヶ月（29.530589日）で地球を１周する。新月は、朔と言い、地球から見て月が太陽の方向に位置し、太陽と共に昇り太陽と共に没する。満月は、望と言い地球から見て月が太陽の反対方向に位置し１晩中見えています。
この様に朔・望・朔を１ヶ月毎に繰り返します。
- 約１ヶ月（29.530589日）は、近年１０年前後の平均値で遠い昔や未来にはデータが異なってきます。 又、地球は、楕円軌道を描くので太陽との距離が刻々と違ってきますし、摂動や、黄道角と白道角の交角も刻々と変化するので、実際には、周期が固定では有りません。
- 朔日は、朔に成った瞬間を含む日を表します。旧暦の朔日に当たりますが、この略算値では、誤差が出ますので旧暦日は、天体の軌道計算をし出来るだけ誤差のないデータを用います。
- 月齢は、朔の日を１日とし、次の朔が来るまでの経過日数を表します。
- 月相は、月の見える形を表し、朔・上弦・望・下弦・朔と相を変えていきます。
カレンダーでは、この略算値を使い月齢計算をしています。１．変動する祝日の計算でも紹介しましたが、天文計算ソフトをアップしましたので、天体の軌道計算による月相の計算をご確認下さい。ＭＤＢファイルですから自由にカスマタイズして下さい。ダウンロードはこちらから。 125,286 Bytes ＩＳＤＮ約40秒
■（１）月齢計算を説明します。
Public Function Getu(CalYear As Integer, CalMonth As Integer, CalDate As Integer) As Double
Dim juli As Double
Dim Phas As Double
juli = DateSerial(CalYear, CalMonth, CalDate) + 2415019 'ユリウス日の計算
Phas = (juli + 5.287) / 29.530589 '略算式の計算
Phas = Phas - Int(Phas) '小数部分の取り出し
If Phas < 0.5 Then
Getu = (Phas + 0.5) * 29.530589
Else
Getu = (Phas - 0.5) * 29.530589
End If
End Function
この関数で月相を求めます。
潮時カレンダーで使っているＶＢＡを説明します。
'月齢計算
For k = 1 To [月日数] '或る行に月齢を表示します
Me("行" & k) = " 月齢 " & Format(Getu(Year([指定日]), Month([指定日]), k), "###.00")
Next
■（２）月相図を説明します。
図のように小さなレポートを作ります。高さも幅も0.501cmです。このレポートの中に月を描きます。行間に収まるように小さくしたので味気がないですが、もし大きい画像でしたら月の写真を背景にし満ち欠けさせることもできます。
レポートの中に小さなテキストボックスを貼り付け指定日と名付け、「可視」=「いいえ」にします。
Private Sub 詳細_Format(Cancel As Integer, FormatCount As Integer)
指定日 = Forms![月表示]![指定日]
End Sub
Private Sub 詳細_Print(Cancel As Integer, PrintCount As Integer)
Dim seri,juli,dor As Long
Dim Y, P, Q, d1, d2 As Single
Dim X, R, x1, x2 As Single
Dim pixels%
seri = DateSerial(Year([指定日]), Month([指定日]), Day([指定日]))
juli = seri + 2415019
Phase = (juli + 5.287) / 29.530589
Phase = Phase - Int(Phase)
ScaleMode = 3 : pixels% = ScaleHeight + 1
Me.Scale (-1, -1)-(1, 1) : Me.FillStyle = 1 : Me.DrawWidth = 0.005
Circle (0, 0), 1, RGB(0, 0, 0) '月の輪郭を描きます
For Y = 0 To 1 Step 4 / pixels% '月の明るい部分を描きます
X = Sqr(1 - Y * Y) : R = 2 * X
If Phase < 0.5 Then
x1 = -X : x2 = R - 2 * Phase * R - X
Else
x1 = X : x2 = X - 2 * Phase * R + R
End If
dor = RGB(255, 255, 130)
Me.Line (x1, Y)-(x2, Y), dor
Me.Line (x1, -Y)-(x2, -Y), dor
Next Y
For Q = 0 To 1 Step 4 / pixels% '月の暗い部分を描きます
P = Sqr(1 - Q * Q) : R = 2 * P
If Phase < 0.5 Then
d1 = P : d2 = R - 2 * Phase * R - P
Else
d1 = -P : d2 = P - 2 * Phase * R + R
End If
Me.Line (d1, Q)-(d2, Q), RGB(80, 80, 80)
Me.Line (d1, -Q)-(d2, -Q), RGB(80, 80, 80)
Next Q
End Sub
これで小さいレポート一杯に月が描かれます。
このレポートをサブレポートとして表示したいリフィルに貼り付けていきます。
[戻る]