请输入专案类型(网站专案或者应用程式专案)： 日出日落计算式 可以帮我检查一下吗？ 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 --

※ 发信站: 批踢踢实业坊(ptt.cc), 来自: 42.72.108.170 ※ 文章网址: https://webptt.com/cn.aspx?n=bbs/Visual_Basic/M.1459442544.A.754.html