gongli2nongli.vb

农历日历 农历日历 农历日历 农历日历 农历日历 农历日历 农历日历 农历日历

'Imports System
'Imports System.Data
'Imports System.Configuration
'Imports System.Web

Public Class gongli2nongli
    '定义全局变量
    Public ML(12)
    Public NM(100)
    Public i As Integer
    '初始化数据
    Function DateStar()
        '定义公历月份天数
        ML(0) = 31
        ML(1) = 28
        ML(2) = 31
        ML(3) = 30
        ML(4) = 31
        ML(5) = 30
        ML(6) = 31
        ML(7) = 31
        ML(8) = 30
        ML(9) = 31
        ML(10) = 30
        ML(11) = 31

        '定义农历数据
        NM(0) = "0,0217,0318,0417,0517,0615,0715,0814,0912,1011,1110,1209,1308"
        NM(1) = "0,0206,0308,0406,0506,0605,0704,0803,0901,1001,1030,1129,1228"
        NM(2) = "5,0127,0225,0326,0424,0524,0622,0722,0820,0919,1019,1117,1217,1315"
        NM(3) = "0,0214,0315,0414,0513,0611,0711,0810,0908,1008,1107,1206,1305"
        NM(4) = "0,0203,0305,0403,0503,0601,0630,0730,0828,0927,1027,1125,1225"
        NM(5) = "3,0124,0222,0324,0422,0522,0620,0719,0818,0916,1016,1114,1214,1313"
        NM(6) = "0,0212,0312,0411,0510,0609,0708,0806,0905,1004,1103,1202,1301"
        NM(7) = "8,0131,0302,0331,0430,0529,0628,0727,0825,0924,1023,1122,1221,1320"
        NM(8) = "0,0218,0320,0419,0519,0617,0717,0815,0913,1013,1111,1211,1309"
        NM(9) = "0,0208,0309,0408,0508,0606,0706,0804,0903,1002,1101,1130,1230"
        NM(10) = "6,0128,0227,0327,0426,0525,0624,0724,0822,0921,1020,1119,1218,1317"
        NM(11) = "0,0215,0317,0415,0515,0613,0713,0811,0910,1010,1108,1208,1306"
        NM(12) = "0,0205,0306,0405,0504,0602,0702,0731,0830,0929,1028,1127,1227"
        NM(13) = "4,0125,0224,0325,0424,0523,0621,0721,0819,0918,1017,1116,1216,1315"
        NM(14) = "0,0213,0314,0412,0512,0610,0709,0808,0906,1006,1104,1204,1303"
        NM(15) = "0,0202,0303,0402,0501,0531,0629,0728,0827,0925,1024,1123,1223"
        NM(16) = "3,0121,0220,0322,0421,0520,0619,0718,0816,0915,1014,1112,1212,1311"
        NM(17) = "0,0209,0311,0410,0509,0608,0708,0806,0904,1004,1102,1202,1231"
        NM(18) = "7,0130,0228,0329,0427,0527,0626,0725,0824,0922,1022,1120,1220,1318"
        NM(19) = "0,0217,0318,0417,0516,0615,0714,0813,0912,1011,1110,1209,1308"
        NM(20) = "0,0206,0308,0406,0505,0604,0703,0802,0901,0930,1030,1129,1228"
        NM(21) = "5,0127,0225,0327,0425,0524,0623,0722,0821,0919,1019,1118,1218,1316"
        NM(22) = "0,0215,0315,0414,0513,0611,0711,0809,0908,1007,1106,1206,1304"
        NM(23) = "0,0203,0305,0403,0503,0601,0630,0730,0828,0926,1026,1125,1224"
        NM(24) = "4,0123,0222,0324,0422,0522,0620,0719,0818,0916,1015,1114,1214,1312"
        NM(25) = "0,0211,0313,0412,0511,0610,0709,0807,0906,1005,1103,1203,1301"
        NM(26) = "8,0131,0301,0331,0429,0529,0627,0727,0825,0924,1023,1121,1221,1319"
        NM(27) = "0,0218,0320,0418,0518,0617,0716,0815,0913,1013,1111,1211,1309"
        NM(28) = "0,0207,0309,0407,0507,0606,0705,0804,0903,1002,1101,1130,1230"
        NM(29) = "6,0128,0227,0328,0426,0526,0624,0724,0823,0921,1021,1120,1219,1318"
        NM(30) = "0,0216,0317,0415,0514,0613,0712,0811,0909,1009,1108,1207,1306"
        NM(31) = "0,0205,0306,0405,0504,0602,0702,0731,0829,0928,1028,1126,1226"
        NM(32) = "4,0125,0224,0325,0424,0523,0621,0721,0819,0917,1017,1115,1215,1314"
        NM(33) = "0,0213,0315,0413,0513,0611,0710,0809,0907,1006,1105,1204,1303"
        NM(34) = "10,0202,0303,0401,0501,0531,0629,0728,0827,0925,1024,1123,1222,1321"
        NM(35) = "0,0220,0321,0420,0520,0618,0718,0816,0915,1014,1112,1212,1310"
        NM(36) = "0,0209,0310,0409,0509,0607,0707,0806,0904,1004,1102,1202,1231"
        NM(37) = "6,0129,0228,0329,0428,0527,0626,0726,0824,0923,1023,1121,1221,1319"
        NM(38) = "0,0217,0318,0416,0516,0614,0714,0812,0911,1011,1109,1209,1308"
        NM(39) = "0,0206,0308,0406,0505,0604,0703,0802,0831,0930,1029,1128,1228"
        NM(40) = "5,0127,0225,0327,0425,0524,0623,0722,0820,0919,1018,1117,1217,1316"
        NM(41) = "0,0215,0316,0415,0514,0612,0712,0810,0908,1008,1106,1206,1305"
        NM(42) = "0,0204,0304,0403,0503,0601,0630,0730,0828,0926,1026,1124,1224"
        NM(43) = "3,0123,0221,0323,0422,0521,0620,0719,0818,0916,1015,1114,1213,1312"
        NM(44) = "0,0210,0312,0411,0511,0609,0709,0807,0906,1005,1103,1203,1301"
        NM(45) = "8,0131,0301,0331,0430,0529,0628,0727,0826,0925,1024,1122,1222,1320"
        NM(46) = "0,0219,0319,0418,0517,0616,0716,0814,0913,1012,1111,1211,1309"
        NM(47) = "0,0207,0309,0407,0507,0605,0705,0803,0902,1002,1031,1130,1230"
        NM(48) = "5,0128,0227,0328,0426,0526,0624,0723,0822,0921,1020,1119,1219,1317"
        NM(49) = "0,0216,0318,0416,0515,0614,0713,0811,0910,1009,1108,1208,1307"
        NM(50) = "0,0205,0306,0405,0504,0602,0702,0731,0829,0928,1027,1126,1226"
        NM(51) = "4,0124,0223,0325,0423,0523,0621,0721,0819,0917,1017,1115,1215,1313"
        NM(52) = "0,0212,0314,0413,0512,0611,0710,0809,0907,1006,1105,1204,1303"
        NM(53) = "0,0201,0303,0402,0501,0531,0630,0729,0828,0926,1025,1124,1223"
        NM(54) = "2,0122,0220,0321,0419,0519,0618,0717,0816,0914,1014,1112,1212,1310"
        NM(55) = "0,0209,0310,0409,0508,0607,0706,0805,0904,1003,1102,1201,1231"
        NM(56) = "7,0129,0228,0329,0428,0527,0626,0725,0824,0922,1022,1121,1220,1319"
        NM(57) = "0,0218,0319,0417,0517,0615,0714,0813,0911,1011,1110,1210,1308"
        NM(58) = "0,0207,0308,0406,0505,0604,0703,0801,0831,0929,1029,1128,1227"
        NM(59) = "5,0126,0225,0327,0425,0524,0623,0722,0820,0919,1018,1117,1216,1315"
        NM(60) = "0,0214,0316,0414,0514,0612,0712,0810,0908,1008,1106,1206,1304"
    End Function
    '################################################
    '辅助方法 length
    '根据年月求得公历该月的天数
    'y：年份，四位整型
    'm：月份，整型
    '################################################
    Public Function length(ByVal y As Integer, ByVal m As Integer) As Integer
        DateStar()
        If m = 2 And ((y Mod 400 = 0) Or (y Mod 4 = 0 And y Mod 100 <> 0)) Then
            length = 29
        Else
            length = ML((m + 1) Mod 12)
        End If
    End Function
    '################################################
    '主要方法 ctog
    '农历转公历主函数
    'cdate：农历日期，标准日期格式
    'r：闰月标志，1为闰月，其它值为非闰月
    '################################################
    Public Function ctog(ByVal cenDate As Date, ByVal R As Integer) As Date

        Dim y, m, d, yd, outy, outm, outd
        y = cenDate.Year
        m = cenDate.Month
        d = cenDate.Day
        yd = Split(NM(y - 1950), ",")
        If R = 1 And m <> CInt(yd(0)) Then
            ctog = "1900-1-1"
            Exit Function
        End If
        If (R = 1 And m = CInt(yd(0))) Or (CInt(yd(0)) > 0 And m > CInt(yd(0))) Then m = m + 1
        outm = Int(Left(yd(m), 2))
        outd = Int(Right(yd(m), 2)) + d - 1
        If outd > length(y, outm) Then
            outd = outd - length(y, outm)
            outm = outm + 1
        End If
        outy = y
        If outm > 12 Then
            outm = outm - 12
            outy = outy + 1
        End If
        ctog = DateValue(outy & "-" & outm & "-" & outd)
    End Function
    '################################################
    '主要方法 gtoc
    '公历转农历主函数
    'gdate：公历日期，标准日期格式
    '##注意：本函数输出为带汉字字符串，非标准日期格式
    '################################################
    Public Function gtoc(ByVal gdate As Date) As String

        Dim y, m, d, yd, outy, outm, outd, sd, r
        y = gdate.Year
        m = gdate.Month
        d = gdate.Day
        If d > length(y, m) Then
            gtoc = "1900-1-1"
            Exit Function
        End If
        yd = Split(NM(y - 1950), ",")
        sd = CStr(d)
        If Len(sd) < 2 Then sd = "0" & sd
        sd = CStr(m) & sd
        If Len(sd) < 4 Then sd = "0" & sd
        For i = 0 To 12
            If i + 1 <= UBound(yd) Then
                If CInt(yd(i + 1)) > CInt(sd) Or i = UBound(yd) Then Exit For
            Else
                Exit For
            End If
        Next
        If i = 0 Then
            If y - 1950 = 0 Then
                gtoc = "1900-1-1"
                Exit Function
            End If
            y = y - 1
            yd = Split(NM(y - 1950), ",")
            i = UBound(yd)
            sd = CStr(CInt(sd) + 1200)
            If CInt(yd(i)) > CInt(sd) Then i = i - 1
        End If
        If Left(yd(i), 2) = Left(sd, 2) Then
            outd = CInt(Right(sd, 2)) - CInt(Right(yd(i), 2)) + 1
        Else
            outd = length(y, CInt(Left(yd(i), 2))) + CInt(Right(sd, 2)) - CInt(Right(yd(i), 2)) + 1
        End If
        outm = i
        r = ""
        If yd(0) <> 0 Then
            If outm = yd(0) + 1 Then r = "闰"
            If outm > CInt(yd(0)) Then outm = outm - 1
        End If
        outy = y
        gtoc = "农历" & outy & "年" & r & outm & "月" & outd & "日"
    End Function
End Class

Public Class GtoC
    Dim WeekName(7), MonthAdd(11), NongliData(99), TianGan(9), DiZhi(11), ShuXiang(11), DayName(30), MonName(12)
    Dim WeekNameEngL(7), MonNameEng(11), WeekNameEngS(7)
    Dim JeiRiNongli(100), JeiRiNongliEng(100), JeiRiGongliEng(100), JeiRiGongli(100) As String
    Dim curTime, curYear, curMonth, curDay, curWeekday
    Dim GongliStr, WeekdayStr, NongliStr, NongliDayStr
    Dim i, m, n, k, isEnd, bit, TheDate

    Function Gtoc(ByVal CurTime As Date) As String
        '获取当前系统时间   
        CurTime = Date.Today

        '星期名   
        WeekName(0) = "   *   "
        WeekName(1) = "星期日"
        WeekName(2) = "星期一"
        WeekName(3) = "星期二"
        WeekName(4) = "星期三"
        WeekName(5) = "星期四"
        WeekName(6) = "星期五"
        WeekName(7) = "星期六"
        WeekNameEngS(0) = " * "
        WeekNameEngS(1) = "Sun"
        WeekNameEngS(2) = "Mon"
        WeekNameEngS(3) = "Tue"
        WeekNameEngS(4) = "Wed"
        WeekNameEngS(5) = "Thu"
        WeekNameEngS(6) = "Fri"
        WeekNameEngS(7) = "Sat"

        WeekNameEngL(0) = " * "
        WeekNameEngL(1) = "Sunday"
        WeekNameEngL(2) = "Monday"
        WeekNameEngL(3) = "Tuesday"
        WeekNameEngL(4) = "Wedesday"
        WeekNameEngL(5) = "Thursday"
        WeekNameEngL(6) = "Friday"
        WeekNameEngL(7) = "Saturday"
        '天干名称   
        TianGan(0) = "甲"
        TianGan(1) = "乙"
        TianGan(2) = "丙"
        TianGan(3) = "丁"
        TianGan(4) = "戊"
        TianGan(5) = "己"
        TianGan(6) = "庚"
        TianGan(7) = "辛"
        TianGan(8) = "壬"
        TianGan(9) = "癸"

        '地支名称   
        DiZhi(0) = "子"
        DiZhi(1) = "丑"
        DiZhi(2) = "寅"
        DiZhi(3) = "卯"
        DiZhi(4) = "辰"
        DiZhi(5) = "巳"
        DiZhi(6) = "午"
        DiZhi(7) = "未"
        DiZhi(8) = "申"
        DiZhi(9) = "酉"
        DiZhi(10) = "戌"
        DiZhi(11) = "亥"

        '属相名称   
        ShuXiang(0) = "鼠"
        ShuXiang(1) = "牛"
        ShuXiang(2) = "虎"
        ShuXiang(3) = "兔"
        ShuXiang(4) = "龙"
        ShuXiang(5) = "蛇"
        ShuXiang(6) = "马"
        ShuXiang(7) = "羊"
        ShuXiang(8) = "猴"
        ShuXiang(9) = "鸡"
        ShuXiang(10) = "狗"