sun.vb

计算日出日落的vb2005类

Public Structure month

    Public name As String
    Public numdays As Double '= numdays
    Public abbr As String ' = abbr
    Sub New(ByVal name1 As String, ByVal numdays1 As Double, ByVal abbr1 As String)
        name = name1
        numdays = numdays1
        abbr = abbr1
    End Sub
End Structure
Public Structure ans '(
    Public daySave As String   ' = daySave;
    Public value As Double ' = value;
    Sub New(ByVal daySave1 As String, ByVal value1 As Double)
        daySave = daySave1
        value = value1
    End Sub
End Structure

Public Structure city1 '(ByVal name, ByVal lat, ByVal lng, ByVal zoneHr)
    Public name As String
    Public lat As Double
    Public lng As Double
    Public zoneHr As Double
    Sub New(ByVal name1 As String, ByVal lat1 As Double, ByVal lng1 As Double, ByVal zoneHr1 As Double)
        name = name1
        lat = lat1
        lng = lng1
        zoneHr = zoneHr1
    End Sub
    Public Overrides Function ToString() As String
        Dim STR1 As String
        STR1 = name    ' & "," & Me.lat & "," & Me.lng & "," & Me.zoneHr
        Return STR1
    End Function


End Structure
Public Structure latLongForm1
    Public latdeg As Double
    Public latmin As Double
    Public latsec As Double
    Public londeg As Double
    Public lonmin As Double
    Public lonsec As Double
    Public hrsToGMT As Double
End Structure
Public Structure riseSetForm1
    Public sunrise As String
    Public sunset As String
    Public solnoon As String
    Public utcsunrise As String

    Public utcsunset As String

    Public utcsolnoon As String
    Public eqTime As String  '时差
    Public solarDec As String  '赤纬度

End Structure


Public Class sun

    Public latlongform As New latLongForm1
    Public riseSetForm As New riseSetForm1
    Public monthList(13) As month
    Public YesNo(3) As ans '	//夏令时选项	
    Public City(300) As city1 ' new Array();
    Sub New()
        '= new Array();	//	list of months and days for non-leap year
        '英文简称可以修改为汉字
        'monthList(0) = New month("一月", 31, "Jan")
        'monthList(1) = New month("二月", 28, "Feb")
        'monthList(2) = New month("三月", 31, "Mar")
        'monthList(3) = New month("四月", 30, "Apr")
        'monthList(4) = New month("五月", 31, "May")
        'monthList(5) = New month("六月", 30, "Jun")
        'monthList(6) = New month("七月", 31, "Jul")
        'monthList(7) = New month("八月", 31, "Aug")
        'monthList(8) = New month("九月", 30, "Sep")
        'monthList(9) = New month("十月", 31, "Oct")
        'monthList(10) = New month("十一月", 30, "Nov")
        'monthList(11) = New month("十二月", 31, "Dec")


        monthList(0) = New month("一月", 31, "一月")
        monthList(1) = New month("二月", 28, "二月")
        monthList(2) = New month("三月", 31, "三月")
        monthList(3) = New month("四月", 30, "四月")
        monthList(4) = New month("五月", 31, "五月")
        monthList(5) = New month("六月", 30, "六月")
        monthList(6) = New month("七月", 31, "七月")
        monthList(7) = New month("八月", 31, "八月")
        monthList(8) = New month("九月", 30, "九月")
        monthList(9) = New month("十月", 31, "十月")
        monthList(10) = New month("十一月", 30, "十一月")
        monthList(11) = New month("十二月", 31, "十二月")



        YesNo(1) = New ans("否", 0)
        YesNo(2) = New ans("是", 60)


        '将以下城市信息,存储到文本文件中,读取文本内容,然后写入到city中,如需增加可以修改文本文件
        '前两个可以保留
        '增加银川
        '也可以考虑放到数据库中

        'City(1) = New city1("输入经纬度 -->", 0, 0, 0)
        'City(2) = New city1("  ", 0, 0, 0)
        'City(3) = New city1("中国城市", 0, 0, 0)
        'City(4) = New city1("北京, 中国", 39.9167, -116.4167, -8)
        'City(5) = New city1("北京2, 中国", 39.9, -116.4667, -8)




    End Sub


    ' isLeapYear returns 1 if the 4-digit yr is a leap year, 0 if it is not

    ' 如果指定的年份(用4位阿拉伯数字表示)是闰年则返回1；否则返回0。
    Public Function isLeapYear(ByVal yr As Double) As Boolean
        isLeapYear = IIf(Date.IsLeapYear(yr), True, False)
        Return isLeapYear
        'Return ((yr Mod 4 = 0 AndAlso yr Mod 100 <> 0) OrElse yr Mod 400 = 0)
    End Function


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

    ' isPosdouble returns false if the value is not a positive double, true is
    ' returned otherwise. The code is from taken from Danny Goodman's Javascript
    ' Handbook, p. 372.

    ' 如果指定的值不是正正数则返回false；否则返回true。
    Public Function isPosdouble(ByVal inputVal As String) As Boolean
        Dim inputStr As String = "" & inputVal
        For i As Double = 0 To inputStr.Length - 1
            ' Dim oneChar = inputStr.charAt(i)
            Dim oneChar As Char = inputStr.Substring(i)
            If oneChar < "0" OrElse oneChar > "9" Then
                Return False
            End If
        Next
        Return True
    End Function

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

    ' 判断指定的数字是否为整数。
    Public Function isdouble(ByVal inputVal As Double) As Boolean
        Dim inputStr As String = "" & inputVal
        If inputStr = "NaN" Then
            Return False
        End If
        If inputStr = "-NaN" Then
            Return False
        End If
        For i As Double = 0 To inputStr.Length - 1
            '   Dim oneChar As Char = inputStr.charAt(i)
            Dim oneChar As Char = inputStr.Substring(i)
            If i = 0 AndAlso (oneChar = "-" OrElse oneChar = "+") Then
                Continue For
            End If
            If oneChar < "0" OrElse oneChar > "9" Then
                Return False
            End If
        Next
        Return True
    End Function

    ' 判断所指定的是否为数字。
    Public Function isNumber(ByVal inputVal As Double) As Boolean
        Dim oneDecimal As Boolean = False
        Dim inputStr As String = "" & inputVal
        For i As Double = 0 To inputStr.Length - 1
            '  Dim oneChar As Char = inputStr.charAt(i)
            Dim oneChar As Char = inputStr.Substring(i)
            If i = 0 AndAlso (oneChar = "-" OrElse oneChar = "+") Then
                Continue For
            End If
            If oneChar = "." AndAlso Not oneDecimal Then
                oneDecimal = True
                Continue For
            End If
            If oneChar < "0" OrElse oneChar > "9" Then
                Return False
            End If
        Next
        Return True
    End Function
    '*********************************************************************/

    '/ isValidInput makes sure valid input is entered before going ahead to
    '/ calculate the sunrise and sunset. False is returned if an invalid entry
    '/ was made, true is the entry is valid.

    ' // 计算日出和日落之前确保输入是有效的。所有项都有效返回true；否则返回false。
    ' bool isValidInput(f, index, latLongForm)
    ' {
    ' if (f["day"].value == "")
    ' { // see if the day field is empty
    ' alert("请先输入日期再计算.");
    ' return false;
    ' }
    ' else if (f["year"].value == "")
    ' { // see if the year field is empty
    ' alert("请先输入年份再计算.");
    ' return false;
    ' }
    ' else if (!isPosdouble(f["day"].value) || f["day"].value == 0)
    ' {
    ' alert("日期值必须为正.");
    ' return false;
    ' }
    ' else if (!isdouble(f["year"].value))
    ' {
    ' alert("年份必须是整数.");
    ' return false;
    ' }
    ' else if ( (f["year"].value < -1000) || (f["year"].value > 3000) )
    ' {
    ' alert("本算法在 -1000 ~ 3000年间适用.");
    ' return false;
    ' }


    ' // For the non-二月 months see if the day entered is greater than
    ' // the number of days in the selected month

    ' else if ((index != 1) && (f["day"].value > monthList[index].numdays))
    ' {
    ' alert("只有 " + monthList[index].numdays + " 天 "
    ' + monthList[index].name + ".");
    ' return false;
    ' }

    ' // First see if the year entered is a leap year. If so we have to make sure
    ' // the days entered is <= 29. If not a leap year we make sure that the days
    ' // entered is <= 28.

    ' else if (index == 1)
    ' { // month selected is 二月 the screwball month
    ' if (isLeapYear(f["year"].value)) { // year entered is a leap year
    ' if (f["day"].value > (monthList[index].numdays + 1))
    ' {
    ' alert("There are only " + (monthList[index].numdays + 1)
    ' + " days in " + monthList[index].name + ".");
    ' return false;
    ' }
    ' else
    ' return true;
    ' }
    ' else
    ' { // year entered is not a leap year
    ' if (f["day"].value > monthList[index].numdays)
    ' {
    ' alert(monthList[index].name +"只有" +monthList[index].numdays
    ' + " 天" +"。");
    ' return false;
    ' }
    ' else
    ' return true;
    ' }
    ' }
    ' else
    ' return true;
    ' }


    ' 将弧度转为度数。
    Private Function radToDeg(ByVal angleRad As Double) As Double
        Return (180.0R * angleRad / Math.PI)
    End Function

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

    ' Convert degree angle to radians

    ' 将度数转换为弧度。
    Private Function degToRad(ByVal angleDeg As Double) As Double
        Return (Math.PI * angleDeg / 180.0R)
    End Function



    '***********************************************************************/
    '* Name: calcDayOfYear */
    '* Type: Function */
    '* Purpose: Finds numerical day-of-year from mn, day and lp year info */
    '* Arguments: */
    '* month: 一月 = 1 */
    '* day : 1 - 31 */
    '* lpyr : 1 if leap year, 0 if not */
    '* Return value: */
    '* The numerical day of year */
    '***********************************************************************/

    ' 根据月份、天数和是否为闰年计算是否为闰年。
    Private Function calcDayOfYear(ByVal mn As Double, ByVal dy As Double, ByVal lpyr As Boolean) As Double
        Dim k As Double
        If lpyr Then
            k = 1
        Else
            k = 2
        End If
        Dim doy As Double = Math.Floor((275 * mn) / 9) - k * Math.Floor((mn + 9) / 12) + dy - 30
        Return doy
    End Function


    '***********************************************************************/
    '* Name: calcDayOfWeek */
    '* Type: Function */
    '* Purpose: Derives weekday from Julian Day */
    '* Arguments: */
    '* juld : Julian Day */
    '* Return value: */
    '* String containing name of weekday */
    '***********************************************************************/
    ' 使用儒略日计算星期名称。
    Public Function calcDayOfWeek(ByVal juld As Double) As String
        Dim A As Double = (juld + 1.5) Mod 7
        Dim DOW As String
        If A = 0 Then
            DOW = "Sunday"
        ElseIf A = 1 Then
            DOW = "Monday"
        ElseIf A = 2 Then
            DOW = "Tuesday"
        ElseIf A = 3 Then
            DOW = "Wednesday"
        ElseIf A = 4 Then
            DOW = "Thursday"
        ElseIf (A = 5) Then
            DOW = "Friday"
        Else
            DOW = "Saturday"
        End If

        Return DOW
    End Function


    '***********************************************************************/
    '* Name: calcJD */
    '* Type: Function */
    '* Purpose: Julian day from calendar day */
    '* Arguments: */
    '* year : 4 digit year */
    '* month: 一月 = 1 */
    '* day : 1 - 31 */
    '* Return value: */
    '* The Julian day corresponding to the date */
    '* Note: */
    '* Number is returned for start of day. Fractional days should be */
    '* added later. */
    '***********************************************************************/
    ' 通过历日计算儒略日。
    Public Function calcJD(ByVal year As Double, ByVal month As Double, ByVal day As Double) As Double
        If month <= 2 Then
            year -= 1
            month += 12
        End If
        Dim A As Double = Math.Floor(year / 100)
        Dim B As Double = 2 - A + Math.Floor(A / 4)

        Dim JD As Double = Math.Floor(365.25 * (year + 4716)) + Math.Floor(30.6001 * (month + 1)) + day + B - 1524.5
        Return JD
    End Function



    '***********************************************************************/
    '* Name: calcDateFromJD */
    '* Type: Function */
    '* Purpose: Calendar date from Julian Day */
    '* Arguments: */
    '* jd : Julian Day */
    '* Return value: */
    '* String date in the form DD-MONTHNAME-YYYY */
    '* Note: */
    '***********************************************************************/

    ' 通过天略日计算日期。
    '本函数没有用到

    Public Function calcDateFromJD(ByVal jd As Double) As String
        Dim z As Integer = Math.Floor(jd + 0.5)
        Dim f As Double = (jd + 0.5) - z
        Dim A As Double

        If z < 2299161 Then
            A = z
        Else
            Dim alpha As Double = Math.Floor((z - 1867216.25) / 36524.25)
            A = z + 1 + alpha - Math.Floor(alpha / 4)
        End If

        Dim B As Double = A + 1524