sun.vb

计算日出日落的vb2005类

        Dim HA As Double = (Math.Acos(Math.Cos(degToRad(90.833)) / (Math.Cos(latRad) * Math.Cos(sdRad)) - Math.Tan(latRad) * Math.Tan(sdRad)))

        Return HA
        ' in radians
    End Function

    '***********************************************************************/
    '* Name: calcHourAngleSunset */
    '* Type: Function */
    '* Purpose: calculate the hour angle of the sun at sunset for the */
    '* latitude */
    '* Arguments: */
    '* lat : latitude of observer in degrees */
    '* solarDec : declination angle of sun in degrees */
    '* Return value: */
    '* hour angle of sunset in radians */
    '***********************************************************************/
    ' 计算落时太阳时角。
    Public Function calcHourAngleSunset(ByVal lat As Double, ByVal solarDec As Double) As Double
        Dim latRad As Double = degToRad(lat)
        Dim sdRad As Double = degToRad(solarDec)
        Dim HAarg As Double = (Math.Cos(degToRad(90.833)) / (Math.Cos(latRad) * Math.Cos(sdRad)) - Math.Tan(latRad) * Math.Tan(sdRad))

        Dim HA As Double = (Math.Acos(Math.Cos(degToRad(90.833)) / (Math.Cos(latRad) * Math.Cos(sdRad)) - Math.Tan(latRad) * Math.Tan(sdRad)))

        Return -HA
        ' in radians
    End Function



    '***********************************************************************/
    '* Name: calcSunriseUTC */
    '* Type: Function */
    '* Purpose: calculate the Universal Coordinated Time (UTC) of sunrise */
    '* for the given day at the given location on earth */
    '* Arguments: */
    '* JD : julian day */
    '* latitude : latitude of observer in degrees */
    '* longitude : longitude of observer in degrees */
    '* Return value: */
    '* time in minutes from zero Z */
    '***********************************************************************/

    ' 计算地球上特定位置特定日太阳升起的UTC时间。
    Public Function calcSunriseUTC(ByVal JD As Double, ByVal latitude As Double, ByVal longitude As Double) As Double
        Dim t As Double = calcTimeJulianCent(JD)

        ' *** Find the time of solar noon at the location, and use
        ' that declination. This is better than start of the
        ' Julian day

        Dim noonmin As Double = calcSolNoonUTC(t, longitude)
        Dim tnoon As Double = calcTimeJulianCent(JD + noonmin / 1440.0R)

        ' *** First pass to approximate sunrise (using solar noon)

        Dim eqTime As Double = calcEquationOfTime(tnoon)
        Dim solarDec As Double = calcSunDeclination(tnoon)
        Dim hourAngle As Double = calcHourAngleSunrise(latitude, solarDec)

        Dim delta As Double = longitude - radToDeg(hourAngle)
        Dim timeDiff As Double = 4 * delta
        ' in minutes of time
        Dim timeUTC As Double = 720 + timeDiff - eqTime
        ' in minutes
        ' alert("eqTime = " + eqTime + "\nsolarDec = " + solarDec + "\ntimeUTC = " + timeUTC);

        ' *** Second pass includes fractional jday in gamma calc

        Dim newt As Double = calcTimeJulianCent(calcJDFromJulianCent(t) + timeUTC / 1440.0R)
        eqTime = calcEquationOfTime(newt)
        solarDec = calcSunDeclination(newt)
        hourAngle = calcHourAngleSunrise(latitude, solarDec)
        delta = longitude - radToDeg(hourAngle)
        timeDiff = 4 * delta
        timeUTC = 720 + timeDiff - eqTime
        ' in minutes
        ' alert("eqTime = " + eqTime + "\nsolarDec = " + solarDec + "\ntimeUTC = " + timeUTC);

        Return timeUTC
    End Function

    '***********************************************************************/
    '* Name: calcSolNoonUTC */
    '* Type: Function */
    '* Purpose: calculate the Universal Coordinated Time (UTC) of solar */
    '* noon for the given day at the given location on earth */
    '* Arguments: */
    '* t : number of Julian centuries since J2000.0 */
    '* longitude : longitude of observer in degrees */
    '* Return value: */
    '* time in minutes from zero Z */
    '***********************************************************************/
    ' 计算地球上特定位置特定日的视中午UTC时间。
    Public Function calcSolNoonUTC(ByVal t As Double, ByVal longitude As Double) As Double
        ' First pass uses approximate solar noon to calculate eqtime
        Dim tnoon As Double = calcTimeJulianCent(calcJDFromJulianCent(t) + longitude / 360.0R)
        Dim eqTime As Double = calcEquationOfTime(tnoon)
        Dim solNoonUTC As Double = 720 + (longitude * 4) - eqTime
        ' min
        Dim newt As Double = calcTimeJulianCent(calcJDFromJulianCent(t) - 0.5 + solNoonUTC / 1440.0R)

        eqTime = calcEquationOfTime(newt)
        ' var solarNoonDec = calcSunDeclination(newt);
        solNoonUTC = 720 + (longitude * 4) - eqTime
        ' min
        Return solNoonUTC
    End Function

    '***********************************************************************/
    '* Name: calcSunsetUTC */
    '* Type: Function */
    '* Purpose: calculate the Universal Coordinated Time (UTC) of sunset */
    '* for the given day at the given location on earth */
    '* Arguments: */
    '* JD : julian day */
    '* latitude : latitude of observer in degrees */
    '* longitude : longitude of observer in degrees */
    '* Return value: */
    '* time in minutes from zero Z */
    '***********************************************************************/

    ' 计算地球上特定位置特定日太阳落下的UTC时间。
    Public Function calcSunsetUTC(ByVal JD As Double, ByVal latitude As Double, ByVal longitude As Double) As Double
        Dim t As Double = calcTimeJulianCent(JD)

        ' *** Find the time of solar noon at the location, and use
        ' that declination. This is better than start of the
        ' Julian day

        Dim noonmin As Double = calcSolNoonUTC(t, longitude)
        Dim tnoon As Double = calcTimeJulianCent(JD + noonmin / 1440.0R)

        ' First calculates sunrise and approx length of day

        Dim eqTime As Double = calcEquationOfTime(tnoon)
        Dim solarDec As Double = calcSunDeclination(tnoon)
        Dim hourAngle As Double = calcHourAngleSunset(latitude, solarDec)

        Dim delta As Double = longitude - radToDeg(hourAngle)
        Dim timeDiff As Double = 4 * delta
        Dim timeUTC As Double = 720 + timeDiff - eqTime

        ' first pass used to include fractional day in gamma calc

        Dim newt As Double = calcTimeJulianCent(calcJDFromJulianCent(t) + timeUTC / 1440.0R)
        eqTime = calcEquationOfTime(newt)
        solarDec = calcSunDeclination(newt)
        hourAngle = calcHourAngleSunset(latitude, solarDec)

        delta = longitude - radToDeg(hourAngle)
        timeDiff = 4 * delta
        timeUTC = 720 + timeDiff - eqTime
        ' in minutes
        Return timeUTC
    End Function


    '*********************************************************************/

    ' Returns the decimal latitude from the degrees, minutes and seconds entered
    ' into the form

    ' 根据表单输入的度数、分、秒获取十进制的纬度。
    Public Function getLatitude(ByVal latLongForm As latLongForm1) As Double

        Dim decLat As Double
        If latLongForm.latdeg > 0 Then
            decLat = latLongForm.latdeg + latLongForm.latmin / 60 + latLongForm.latsec / 3600
        Else
            decLat = latLongForm.latdeg - latLongForm.latmin / 60 - latLongForm.latsec / 3600
        End If

        Return decLat
    End Function


    '*********************************************************************/

    ' Returns the decimal longitude from the degrees, minutes and seconds entered into the form
    ' 根据表单输入的度、分、秒获取十进制的经度。
    Public Function getLongitude(ByVal latLongForm As latLongForm1) As Double
        Dim decLon As Double
        If latLongForm.londeg > 0 Then
            decLon = latLongForm.londeg + latLongForm.lonmin / 60 + latLongForm.lonsec / 3600
        Else
            decLon = latLongForm.londeg - latLongForm.lonmin / 60 - latLongForm.lonsec / 3600
        End If


        Return decLon
    End Function


    '***********************************************************************/
    '* Name: findRecentSunrise */
    '* Type: Function */
    '* Purpose: calculate the julian day of the most recent sunrise */
    '* starting from the given day at the given location on earth */
    '* Arguments: */
    '* JD : julian day */
    '* latitude : latitude of observer in degrees */
    '* longitude : longitude of observer in degrees */
    '* Return value: */
    '* julian day of the most recent sunrise */
    '***********************************************************************/
    ' 搜寻地球上特定位置给定日期以来最近的日出儒略日。
    Public Function findRecentSunrise(ByVal jd As Double, ByVal latitude As Double, ByVal longitude As Double) As Double
        Dim julianday As Double = jd

        Dim time As Double = calcSunriseUTC(julianday, latitude, longitude)
        While Not isNumber(time)
            julianday -= 1.0R
            time = calcSunriseUTC(julianday, latitude, longitude)
        End While

        Return julianday
    End Function


    '***********************************************************************/
    '* Name: findRecentSunset */
    '* Type: Function */
    '* Purpose: calculate the julian day of the most recent sunset */
    '* starting from the given day at the given location on earth */
    '* Arguments: */
    '* JD : julian day */
    '* latitude : latitude of observer in degrees */
    '* longitude : longitude of observer in degrees */
    '* Return value: */
    '* julian day of the most recent sunset */
    '***********************************************************************/
    ' 搜寻地球上特定位置给定日期以来最近的日落儒略日。
    Public Function findRecentSunset(ByVal jd As Double, ByVal latitude As Double, ByVal longitude As Double) As Double
        Dim julianday As Double = jd

        Dim time As Double = calcSunsetUTC(julianday, latitude, longitude)
        While Not isNumber(time)
            julianday -= 1.0R
            time = calcSunsetUTC(julianday, latitude, longitude)
        End While

        Return julianday
    End Function


    '***********************************************************************/
    '* Name: findNextSunrise */
    '* Type: Function */
    '* Purpose: calculate the julian day of the next sunrise */
    '* starting from the given day at the given location on earth */
    '* Arguments: */
    '* JD : julian day */
    '* latitude : latitude of observer in degrees */
    '* longitude : longitude of observer in degrees */
    '* Return value: */
    '* julian day of the next sunrise */
    '***********************************************************************/
    ' 搜寻地球上特定位置给定日期以来下一个的日出儒略日。
    Public Function findNextSunrise(ByVal jd As Double, ByVal latitude As Double, ByVal longitude As Double) As Double
        Dim julianday As Double = jd

        Dim time As Double = calcSunriseUTC(julianday, latitude, longitude)
        While Not isNumber(time)
            julianday += 1.0R
            time = calcSunriseUTC(julianday, latitude, longitude)
        End While

        Return julianday
    End Function


    '***********************************************************************/
    '* Name: findNextSunset */
    '* Type: Function */
    '* Purpose: calculate the julian day of the next sunset */
    '* starting from the given day at the given location on earth */
    '* Arguments: */
    '* JD : julian day */
    '* latitude : latitude of observer in degrees */
    '* longitude : longitude of observer in degrees */
    '* Return value: */
    '* julian day of the next sunset */
    '***********************************************************************/
    ' 搜寻地球上特定位置给定日期以来下一个的日落儒略日。
    Public Function findNextSunset(ByVal jd As Double, ByVal latitude As Double, ByVal longitude As Double) As Double
        Dim julianday As Double = jd

        Dim time As Double = calcSunsetUTC(julianday, latitude, longitude)
        While Not isNumber(time)
            julianday += 1.0R
            time = calcSunsetUTC(julianday, latitude, longitude)
        End While

        Return julianday
    End Function

    '***********************************************************************/
    '* Name: timeString */
    '* Type: Function */
    '* Purpose: convert time of day in minutes to a zero-padded string suitable for printing to the form text fields */
    '* Arguments: */
    '* minutes : time of day in minutes */
    '* Return value: */
    '* string of the format HH:MM:SS, minutes and seconds are zero padded*/
    '***********************************************************************/
    ' 将分钟转换成HH:MM:SS格式。
    Public Function timeString(ByVal minutes As Double) As String
        ' timeString returns a zero-padded string (HH:MM:SS) given time in minutes
        Dim floatHour As Double = minutes / 60.0R
        Dim hour As Double = Math.Floor(floatHour)
        Dim floatMinute As Double = 60.0R * (floatHour - Math.Floor(floatHour))
        Dim minute As Double = Math.Floor(floatMinute)
        Dim floatSec As Double = 60.0R * (floatMinute - Math.Floor(floatMinute))
        Dim second As Double = Math.Floor(floatSec + 0.5)

        Dim timeStr As String = hour & ":"
        If minute < 10 Then
            ' i.e. only one digit
            timeStr += "0" & minute.ToString & ":"
        Else
            timeStr += minute.ToString & ":"
        End If
        If second < 10 Then
            ' i.e. only one digit
            timeStr += "0" & second.ToString
        Else
            timeStr += second.ToString
        End If

        Return timeStr
    End Function


    '***********************************************************************/
    '* Name: timeStringShortAMPM */
    '* Type: Function */
    '* Purpose: convert time of day in minutes to a zero-padded string */
    '* suitable for printing to the form text fields. If time */
    '* crosses a day boundary, date is appended. */
    '* Arguments: */
    '* minutes : time of day in minutes */
    '* JD : julian day */
    '* Return value: */
    '* string of the format HH:MM[AM/PM] (DDMon) */
    '***********************************************************************/

    ' timeStringShortAMPM returns a zero-padded string (HH:MM *M) given time in
    ' minutes and appends short date if time is > 24 or < 0, resp.
    ' 将分钟转换成HH:MM[AM/PM]格式。
    Public Function timeStringShortAMPM(ByVal minutes As Double, ByVal JD As Double) As String
        Dim julianday As Double = JD
        Dim floatHour As Double = minutes / 60.0R
        Dim hour As Double = Math.Floor(floatHour)
        Dim floatMinute As Double = 60.0R * (floatHour - Math.Floor(floatHour))
        Dim minute As Double = Math.Floor(floatMinute)
        Dim floatSec As Double = 60.0R * (floatMinute - Math.Floor(floatMinute))
        Dim second As Double = Math.Floor(floatSec + 0.5)
        Dim PM As Boolean = False


        If second >= 30 Then
            minute += 1
        Else
            minute += 0
        End If

        If minute >= 60 Then
            minute -= 60
            hour += 1
        End If

        Dim daychange As Boolean = False
        If hour > 23 Then
            hour -= 24
            daychange = True
            julianday += 1.0R
        End If

        If hour < 0 Then
            hour += 24
            daychange = True
            julianday -= 1.0R
        End If

        If hour > 12 Then
            hour -= 12
            PM = True
        End If

        If hour = 12 Then
            PM = True
        End If

        If hour = 0 Then
            PM = False
            hour = 12
        End If

        Dim timeStr As String = hour & ":"
        If minute < 10 Then
            ' i.e. only one digit
            timeStr += ("0" & minute.ToString) + (IIf(PM, "PM", "AM"))
        Else