请输入专案类型(网站专案或者应用程式专案)：
日出日落计算式
可以帮我检查一下吗？
Public Sub SunRiseSet(Lat As Double, Lon As Double)
Dim A(2), D(2)
Dim Day, Month, Year, ZuluOffSet As Double
Dim T, T0, TT, S, L0, L, G, F, U, V, W, A5, D5, R5, DR, K1, b As Double
Dim V0, V1, V2 As Double
Dim j, J3 As Integer
Dim RiseSet As Boolean: RiseSet = True 'Sunrise
Dim SunSet As String: SunSet = "Sunset at "
Dim SunRise As String: SunRise = "Sunrise at "
Dim M1 As String: M1 = "No sunrise this date"
Dim M2 As String: M2 = "No sunset this date"
Dim M3 As String: M3 = "Sun down all day"
Dim M4 As String: M4 = "Sun up all day"
P2 = 2 * PI
DR = PI / 180
K1 = 15 * DR * 1.0027379
Day = CDbl(Format(Now, "dd"))
Month = CDbl(Format(Now, "mm"))
Year = CDbl(Format(Now, "yyyy"))
'***************************************************
'****Get Time Zone off computer regional setting****
'***************************************************
'Call GetLocalTZ function
ZuluOffSet = CDbl(GetLocalTZ()) * -1
'Call Daylight Function
DST = Daylight()
'YOU CAN RECONFIGURE THESE STATEMENTS TO WORK ANYWHERE.
'IT JUST TACKS ON THE TIME ZONE ABBREVIATION TO THE SUNRISE/SET
If ZuluOffSet = 0 Then
Zone = "UTC"
End If
If ZuluOffSet = 3 Then
If DST = 0 Then
Zone = "ADT"
Else: Zone = "AST"
End If
End If
If ZuluOffSet = 4 Then
If DST = 0 Then
Zone = "AST"
Else: Zone = "EDT"
End If
End If
If ZuluOffSet = 5 Then
If DST = 0 Then
Zone = "EST"
Else: Zone = "CDT"
End If
End If
If ZuluOffSet = 6 Then
If DST = 0 Then
Zone = "CST"
Else: Zone = "MDT"
End If
End If
If ZuluOffSet = 7 Then
If DST = 0 Then
Zone = "MST"
Else: Zone = "PDT"
End If
End If
If ZuluOffSet = 8 Then
If DST = 0 Then
Zone = "PST"
Else: Zone = "ADT"
End If
End If
If ZuluOffSet = 9 Then
If DST = 0 Then
Zone = "AST"
Else: Zone = "HDT"
End If
End If
If ZuluOffSet > 9 Then
If DST = 0 Then
Zone = "HST"
Else: Zone = "You Have Problems"
End If
End If
If ZuluOffSet < 0 Then
MsgBox "According to your computer's regional settings, this program
will not work. This program is for persons in North America Only. ", ,
"Program Error"
End If
Lon = Lon / 360
ZuluOffSet = ZuluOffSet / 24
'Get Year, Month, Day from System Clock
G = 1
F = Day - Int(Day) - 0.5
j = -Int(7 * (Int((Month + 9) / 12) + Year) / 4)
S = Sgn(Month - 9)
J3 = Int(Year + S * Int(Abs(Month - 9) / 7))
J3 = -Int((Int(J3 / 100) + 1) * 3 / 4)
j = j + Int(275 * Month / 9) + Int(Day) + G * J3
j = j + 1721027 + 2 + (367 * Year)
If F < 0 Then
F = F + 1
j = j - 1
End If
T = (j - 2451545) + F
TT = T / 36525 + 1
T0 = T / 36525
S = 24110.5 + 8640184.813 * T0
S = S + 86636.6 * ZuluOffSet + 86400 * Lon
S = S / 86400
S = S - Int(S)
T0 = S * 360 * DR
T = T + ZuluOffSet
L = 0.779072 + 0.00273790931 * T
G = 0.993126 + 0.0027377785 * T
L = L - Int(L)
G = G - Int(G)
L = L * P2
G = G * P2
V = 0.39785 * Sin(L)
V = V - 0.01 * Sin(L - G)
V = V + 0.00333 * Sin(L + G)
V = V - 0.00021 * TT * Sin(L)
U = 1 - 0.03349 * Cos(G)
U = U - 0.00014 * Cos(2 * L)
U = U + 0.00008 * Cos(L)
W = -0.0001 - 0.04129 * Sin(2 * L)
W = W + 0.03211 * Sin(G)
W = W + 0.00104 * Sin(2 * L - G)
W = W - 0.00035 * Sin(2 * L + G)
W = W - 0.00008 * TT * Sin(G)
S = W / Sqr(U - V * V)
A5 = L + Atn(S / Sqr(1 - S * S))
S = V / Sqr(U)
D5 = Atn(S / Sqr(1 - S * S))
R5 = 1.00021 * Sqr(U)
A(1) = A5
D(1) = D5
T = T + 1
L = 0.779072 + 0.00273790931 * T
G = 0.993126 + 0.0027377785 * T
L = L - Int(L)
G = G - Int(G)
L = L * P2
G = G * P2
V = 0.39785 * Sin(L)
V = V - 0.01 * Sin(L - G)
V = V + 0.00333 * Sin(L + G)
V = V - 0.00021 * TT * Sin(L)
U = 1 - 0.03349 * Cos(G)
U = U - 0.00014 * Cos(2 * L)
U = U + 0.00008 * Cos(L)
W = -0.0001 - 0.04129 * Sin(2 * L)
W = W + 0.03211 * Sin(G)
W = W + 0.00104 * Sin(2 * L - G)
W = W - 0.00035 * Sin(2 * L + G)
W = W - 0.00008 * TT * Sin(G)
S = W / Sqr(U - V * V)
A5 = L + Atn(S / Sqr(1 - S * S))
S = V / Sqr(U)
D5 = Atn(S / Sqr(1 - S * S))
R5 = 1.00021 * Sqr(U)
A(2) = A5
D(2) = D5
If A(2) < A(1) Then A(2) = A(2) + P2
Z1 = DR * 90.833
S = Sin(Lat * DR): c = Cos(Lat * DR)
z = Cos(Z1): M8 = 0: W8 = 0
A0 = A(1): D0 = D(1)
DA = A(2) - A(1): DD = D(2) - D(1)
For C0 = 0 To 23
p = (CO + 1) / 24
A2 = A(1) + p * DA: D2 = D(1) + p * DD
L0 = T0 + C0 * K1: L2 = L0 + K1
H0 = L0 - A0: H2 = L2 - A2
H1 = (H2 + H0) / 2
D1 = (D2 + D0) / 2
If C0 <= 0 Then
V0 = S * Sin(D0) + c * Cos(D0) * Cos(H0) - z
End If
V2 = S * Sin(D2) + c * Cos(D2) * Cos(H2) - z
If Sgn(V0) <> Sgn(V2) Then
V1 = S * Sin(D1) + c * Cos(D1) * Cos(H1) - z
A9 = 2 * V2 - 4 * V1 + 2 * V0: b = 4 * V1 - 3 * V0 - V2
D9 = b * b - 4 * A9 * V0
If D9 >= 0 Then
D9 = Sqr(D9)
If V0 < 0 And V2 > 0 Then RiseSet = True
If V0 < 0 And V2 > 0 Then M8 = 1
If V0 > 0 And V2 < 0 Then RiseSet = False
If V0 > 0 And V2 < 0 Then W8 = 1
E = (-b + D9) / (2 * A9)
If E > 1 Or E < 0 Then E = (-b - D9) / (2 * A9)
T3 = C0 + E + 1 / 120
H3 = Int(T3): M3 = Int((T3 - H3) * 60)
If ZuluOffSet <> 0 Then
If H3 < 0 Then
H3 = 12 + H3
AMPM = "PM"
ElseIf H3 > 12 Then
H3 = H3 - 12
AMPM = "PM"
ElseIf H3 = 0 Then
H3 = 12
AMPM = "AM"
ElseIf H3 = 12 Then
AMPM = "PM"
Else: AMPM = "AM"
End If
ElseIf H3 < 10 Then
H3 = "0" + CStr(H3)
End If
If M3 < 10 Then
M3 = "0" + CStr(M3)
End If
If RiseSet = True Then
txtSunrise.Text = " " + CStr(H3) + ":" + CStr(M3) + " " + AMPM + " "
+ Zone
Else:
txtSunset.Text = " " + CStr(H3) + ":" + CStr(M3) + " " + AMPM + " "
+ Zone
End If
End If
End If
A0 = A2: D0 = D2: V0 = V2
Next
If M8 = 0 And W8 = 0 Then
If V2 < 0 Then txtSunrise.Text = M3
If V2 > 0 Then txtSunset.Text = M4
ElseIf M8 = 0 Then
txtSunrise.Text = M1
ElseIf W8 = 0 Then
txtSunset.Text = M2
End If
End Sub
'PUT THESE IN A MODULE
'System clock/Time zone stuff
Type SYSTEMTIME ' 16 Bytes
wYear As Integer
wMonth As Integer
wDayOfWeek As Integer
wDay As Integer
wHour As Integer
wMinute As Integer
wSecond As Integer
wMilliseconds As Integer
End Type
Public Type TIME_ZONE_INFORMATION
Bias As Long
StandardName(31) As Integer
StandardDate As SYSTEMTIME
StandardBias As Long
DaylightName(31) As Integer
DaylightDate As SYSTEMTIME
DaylightBias As Long
End Type
Public Declare Function GetTimeZoneInformation Lib "kernel32"
(lpTimeZoneInformation As TIME_ZONE_INFORMATION) As Long
Function GetLocalTZ(Optional ByRef strTZName As String) As Long
Dim objTimeZone As TIME_ZONE_INFORMATION
Dim lngResult As Long
Dim i As Long
lngResult = GetTimeZoneInformation&(objTimeZone)
Select Case lngResult
Case 0&, 1& 'use standard time
'GetLocalTZ = -(objTimeZone.Bias + objTimeZone.StandardBias) * 60
'into minutes
GetLocalTZ = -(objTimeZone.Bias + objTimeZone.StandardBias) / 60
For i = 0 To 31
If objTimeZone.StandardName(i) = 0 Then Exit
For
strTZName = strTZName &
Chr(objTimeZone.StandardName(i))
Next
Case 2& 'use daylight savings time
'GetLocalTZ = -(objTimeZone.Bias +
objTimeZone.DaylightBias) * 60 'into minutes
GetLocalTZ = -(objTimeZone.Bias +
objTimeZone.DaylightBias) / 60
For i = 0 To 31
If objTimeZone.DaylightName(i)
= 0 Then Exit For
strTZName = strTZName &
Chr(objTimeZone.DaylightName(i))
Next
End Select
End Function
Function Daylight(Optional ByRef strTZName As String) As Long
Dim objTimeZone As TIME_ZONE_INFORMATION
Dim lngResult As Long
Dim i As Long
lngResult = GetTimeZoneInformation&(objTimeZone)
If lngResult = 2 Then
Daylight = 1
Else: Daylight = 0
End If
End