sun.vb

计算日出日落的vb2005类

            timeStr += ("" & minute.ToString) + (IIf((PM), "PM", "AM"))
        End If

        If daychange Then
            Return (timeStr & " ") + calcDayFromJD(julianday)
        End If
        Return timeStr
    End Function


    '***********************************************************************/
    '* Name: timeStringAMPMDate */
    '* Type: Function */
    '* Purpose: convert time of day in minutes to a zero-padded string */
    '* suitable for printing to the form text fields, and appends */
    '* the date. */
    '* Arguments: */
    '* minutes : time of day in minutes */
    '* JD : julian day */
    '* Return value: */
    '* string of the format HH:MM[AM/PM] DDMon */
    '***********************************************************************/

    ' timeStringAMPMDate returns a zero-padded string (HH:MM[AM/PM]) given time
    ' in minutes and julian day, and appends the short date

    ' 将分钟转换成HH:MM[AM/PM]格式。
    Public Function timeStringAMPMDate(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)

        minute += IIf((second >= 30), 1, 0)

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

        If hour > 23 Then
            hour -= 24
            julianday += 1.0R
        End If

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

        Dim PM As Boolean = False
        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
            timeStr += minute.ToString + (IIf((PM), "PM", "AM"))
        End If

        Return (timeStr & " ") + calcDayFromJD(julianday)
    End Function


    '***********************************************************************/
    '* Name: timeStringDate */
    '* Type: Function */
    '* Purpose: convert time of day in minutes to a zero-padded 24hr time */
    '* 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 (DDMon) */
    '***********************************************************************/

    ' timeStringDate returns a zero-padded string (HH:MM) given time in minutes
    ' and julian day, and appends the short date if time crosses a day boundary

    ' 将分钟转换成HH:MM格式的24小时。
    Public Function timeStringDate(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)

        minute += IIf((second >= 30), 1, 0)

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

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

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

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

        If daychange Then
            Return (timeStr & " ") + calcDayFromJD(julianday)
        End If
        Return timeStr
    End Function


    '***********************************************************************/
    '* Name: calcSun */
    '* Type: Main Function called by form controls */
    '* Purpose: calculate time of sunrise and sunset for the entered date */
    '* and location. In the special cases near earth's poles, */
    '* the date of nearest sunrise and set are reported. */
    '* Arguments: */
    '* riseSetForm : for displaying results */
    '* latLongForm : for reading latitude and longitude data */
    '* index : daylight saving yes/no select */
    '* index2 : city select index */
    '* Return value: */
    '* none */
    '* (fills riseSetForm text fields with results of calculations) */
    '***********************************************************************/

    ' 计算表单中输入的日期和位置的日出日落的时间。
    Public Sub calcSun(ByVal sundate As Date, ByVal latLongForm As latLongForm1, ByVal index As Double)
        'If index2 <> 0 Then
        '    setLatLong(latLongForm, index2)
        'End If

        Dim latitude As Double = getLatitude(latLongForm)


        Dim longitude As Double = getLongitude(latLongForm)

        Dim indexRS As Double = sundate.Month - 1  '   ????           riseSetForm.mos.selectedIndex  '月份

        'If (latitude >= -90) AndAlso (latitude < -89) Then
        '    alert("All latitudes between 89 and 90 S" & vbLf & " will be set to -89")
        '    latlongform("latDeg").value = -89
        '    latitude = -89
        'End If
        'If (latitude <= 90) AndAlso (latitude > 89) Then
        '    alert("All latitudes between 89 and 90 N" & vbLf & " will be set to 89")
        '    latlongform("latDeg").value = 89
        '    latitude = 89
        'End If

        '***** Calculate the time of sunrise

        '*********************************************************************/
        '**************** NEW STUFF ****** 一月, 2001 ****************
        '*********************************************************************/

        Dim JD As Double '= calcJD(parseFloat(riseSetForm("year").value), indexRS + 1, parseFloat(riseSetForm("day").value))
        JD = calcJD(sundate.Year, sundate.Month, sundate.Day)

        Dim dow As String = calcDayOfWeek(JD)
        Dim doy As Double '= calcDayOfYear(indexRS + 1, parseFloat(riseSetForm("day").value), isLeapYear(riseSetForm("year").value))

        doy = calcDayOfYear(sundate.Month, sundate.Day, isLeapYear(sundate.Year))
        Dim T As Double = calcTimeJulianCent(JD)

        Dim alpha As Double = calcSunRtAscension(T)
        Dim theta As Double = calcSunDeclination(T)
        Dim Etime As Double = calcEquationOfTime(T)

        'riseSetForm["dbug"].value = doy;

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

        Dim eqTime As Double = Etime
        Dim solarDec As Double = theta

        ' Calculate sunrise for this date
        ' if no sunrise is found, set flag nosunrise

        Dim nosunrise As Boolean = False

        Dim riseTimeGMT As Double = calcSunriseUTC(JD, latitude, longitude)
        If Not isNumber(riseTimeGMT) Then
            nosunrise = True
        End If

        ' Calculate sunset for this date
        ' if no sunset is found, set flag nosunset

        Dim nosunset As Boolean = False
        Dim setTimeGMT As Double = calcSunsetUTC(JD, latitude, longitude)
        If Not isNumber(setTimeGMT) Then
            nosunset = True
        End If

        Dim daySavings As Double = YesNo(index).value
        ' = 0 (no) or 60 (yes)
        Dim zone As Double = latLongForm.hrsToGMT
        If zone > 12 OrElse zone < -12.5 Then
            MsgBox("The offset must be between -12.5 and 12. " & vbLf & " Setting ""Off-Set""=0")
            zone = 0
            latLongForm.hrsToGMT = zone
        End If

        If Not nosunrise Then
            ' Sunrise was found
            Dim riseTimeLST As Double = riseTimeGMT - (60 * zone) + daySavings
            ' in minutes
            Dim riseStr As String = timeStringShortAMPM(riseTimeLST, JD)
            Dim utcRiseStr As String = timeStringDate(riseTimeGMT, JD)

            riseSetForm.sunrise = riseStr
            riseSetForm.utcsunrise = utcRiseStr
        End If





        If Not nosunset Then
            ' Sunset was found
            Dim setTimeLST As Double = setTimeGMT - (60 * zone) + daySavings
            Dim setStr As String = timeStringShortAMPM(setTimeLST, JD)
            Dim utcSetStr As String = timeStringDate(setTimeGMT, JD)

            riseSetForm.sunset = setStr
            riseSetForm.utcsunset = utcSetStr
        End If

        ' Calculate solar noon for this date

        Dim solNoonGMT As Double = calcSolNoonUTC(T, longitude)
        Dim solNoonLST As Double = solNoonGMT - (60 * zone) + daySavings

        Dim solnStr As String = timeString(solNoonLST)
        Dim utcSolnStr As String = timeString(solNoonGMT)

        riseSetForm.solnoon = solnStr
        riseSetForm.utcsolnoon = utcSolnStr

        Dim tsnoon As Double = calcTimeJulianCent(calcJDFromJulianCent(T) - 0.5 + solNoonGMT / 1440.0R)

        eqTime = calcEquationOfTime(tsnoon)
        solarDec = calcSunDeclination(tsnoon)

        riseSetForm.eqTime = (Math.Floor(100 * eqTime)) / 100
        riseSetForm.solarDec = (Math.Floor(100 * (solarDec))) / 100

        '***********Convert lat and long to standard format
        ' convLatLong(latLongForm)

        ' report special cases of no sunrise
        Dim newjd As Double
        Dim newtime As Double
        If nosunrise Then
            riseSetForm.utcsunrise = ""
            ' if Northern hemisphere and spring or summer, OR
            ' if Southern hemisphere and fall or winter, use
            ' previous sunrise and next sunset

            If ((latitude > 66.4) AndAlso (doy > 79) AndAlso (doy < 267)) OrElse ((latitude < -66.4) AndAlso ((doy < 83) OrElse (doy > 263))) Then
                newjd = findRecentSunrise(JD, latitude, longitude)
                newtime = calcSunriseUTC(newjd, latitude, longitude) - (60 * zone) + daySavings
                If newtime > 1440 Then
                    newtime -= 1440
                    newjd += 1.0R
                End If
                If newtime < 0 Then
                    newtime += 1440
                    newjd -= 1.0R
                End If



                riseSetForm.sunrise = timeStringAMPMDate(newtime, newjd)
                '    riseSetForm.utcsunrise = "prior sunrise"
                riseSetForm.utcsunrise = "前一次日出时间"

                ' if Northern hemisphere and fall or winter, OR
                ' if Southern hemisphere and spring or summer, use
                ' next sunrise and previous sunset

            ElseIf ((latitude > 66.4) AndAlso ((doy < 83) OrElse (doy > 263))) OrElse ((latitude < -66.4) AndAlso (doy > 79) AndAlso (doy < 267)) Then
                newjd = findNextSunrise(JD, latitude, longitude)
                newtime = calcSunriseUTC(newjd, latitude, longitude) - (60 * zone) + daySavings
                If newtime > 1440 Then
                    newtime -= 1440
                    newjd += 1.0R
                End If
                If newtime < 0 Then
                    newtime += 1440
                    newjd -= 1.0R
                End If
                riseSetForm.sunrise = timeStringAMPMDate(newtime, newjd)
                ' riseSetForm["sunrise"].value = calcDayFromJD(newjd)
                ' + " " + timeStringDate(newtime, newjd);

                '  riseSetForm.utcsunrise = "next sunrise"
                riseSetForm.utcsunrise = "下一次日出时间"
            Else
                '
                MsgBox("没能发现日出时间")
            End If

            ' alert("Last Sunrise was on day " + findRecentSunrise(JD, latitude, longitude));
            ' alert("Next Sunrise will be on day " + findNextSunrise(JD, latitude, longitude));


            '不用提示


            'MsgBox("最后一次日出时间在:" & findRecentSunrise(JD, latitude, longitude))
            'MsgBox("下一次日出时间在" & findNextSunrise(JD, latitude, longitude))



        End If

        If nosunset Then
            riseSetForm.utcsunset = ""
            ' if Northern hemisphere and spring or summer, OR
            ' if Southern hemisphere and fall or winter, use
            ' previous sunrise and next sunset

            If ((latitude > 66.4) AndAlso (doy > 79) AndAlso (doy < 267)) OrElse ((latitude < -66.4) AndAlso ((doy < 83) OrElse (doy > 263))) Then
                newjd = findNextSunset(JD, latitude, longitude)
                newtime = calcSunsetUTC(newjd, latitude, longitude) - (60 * zone) + daySavings
                If newtime > 1440 Then
                    newtime -= 1440
                    newjd += 1.0R
                End If
                If newtime < 0 Then
                    newtime += 1440
                    newjd -= 1.0R
                End If
                riseSetForm.sunset = timeStringAMPMDate(newtime, newjd)
                '  riseSetForm.utcsunset = "next sunset"
                riseSetForm.utcsunset = "下一次日落时间"
                riseSetForm.utcsolnoon = ""

                ' if Northern hemisphere and fall or winter, OR
                ' if Southern hemisphere and spring or summer, use
                ' next sunrise and last sunset

            ElseIf ((latitude > 66.4) AndAlso ((doy < 83) OrElse (doy > 263))) OrElse ((latitude < -66.4) AndAlso (doy > 79) AndAlso (doy < 267)) Then
                newjd = findRecentSunset(JD, latitude, longitude)
                newtime = calcSunsetUTC(newjd, latitude, longitude) - (60 * zone) + daySavings
                If newtime > 1440 Then
                    newtime -= 1440
                    newjd += 1.0R
                End If
                If newtime < 0 Then
                    newtime += 1440
                    newjd -= 1.0R
                End If
                riseSetForm.sunset = timeStringAMPMDate(newtime, newjd)
                '   riseSetForm.utcsunset = "prior sunset"
                riseSetForm.utcsunset = "前一次日落时间"
                ' riseSetForm.solnoon = "N/A"
                riseSetForm.solnoon = "没有"
                riseSetForm.utcsolnoon = ""
            Else

                ' MsgBox("Cannot Find Sunset!")
                MsgBox("没能发现日落时间!")

            End If
        End If

    End Sub

End Class