Option Explicit Private LunarInfo(1 To 150) As Double '从1900-2049年这150年的农历信息码 Private SolarMonth(1 To 12) As Integer '阳历12个月的天数 Private Gan(1 To 10) As String '农历的天干 Private Zhi(1 To 12) As String '农历的地支 Private Animals(1 To 12) As String '农历的属象 Private SolarTerm(1 To 24) As String '阳历的节气 Private sTermInfo(1 To 24) As Double '阳历节气的信息码 Private nStr1(1 To 11) As String '从日一到十 Private nStr2(1 To 5) As String '初十廿卅 ' Private MonthName(1 To 12) As String '每个月的英文名称 Private sFtv(1 To 30) As String '阳历的节日 Private lFtv(1 To 30) As String '农历的节日 Private wFtv(1 To 30) As String '西方的节日 Dim WeekName(7), MonthAdd(11), NongliData(99), TianGan(9), DiZhi(11), ShuXiang(11), DayName(30), MonName(12) Dim curtime, curYear, curMonth, curDay, curWeekday Dim GongliStr, WeekdayStr, NongliStr, NongliDayStr Dim i, m, n, k, isEnd, bit, TheDate Dim settime As Date '--将农历信息从16进制转换成10进制 Public Function c16to10(shuju As String) Dim s As String Dim d As Integer Dim da As Long For i = 3 To 7 s = Mid(shuju, i, 1) Select Case i Case 3 If s < "9" And s > "0" Then d = CInt(s) Else If s = "a" Then d = 10 If s = "b" Then d = 11 If s = "c" Then d = 12 If s = "d" Then d = 13 If s = "e" Then d = 14 If s = "f" Then d = 15 End If da = da + d * 16 ^ 4 Case 4 If s < "9" And s > "0" Then d = CInt(s) Else If s = "a" Then d = 10 If s = "b" Then d = 11 If s = "c" Then d = 12 If s = "d" Then d = 13 If s = "e" Then d = 14 If s = "f" Then d = 15 End If da = da + d * 16 ^ 3 Case 5 If s < "9" And s > "0" Then d = CInt(s) Else If s = "a" Then d = 10 If s = "b" Then d = 11 If s = "c" Then d = 12 If s = "d" Then d = 13 If s = "e" Then d = 14 If s = "f" Then d = 15 End If da = da + d * 16 ^ 2 Case 6 If s < "9" And s > "0" Then d = CInt(s) Else If s = "a" Then d = 10 If s = "b" Then d = 11 If s = "c" Then d = 12 If s = "d" Then d = 13 If s = "e" Then d = 14 If s = "f" Then d = 15 End If da = da + d * 16 ^ 1 Case 7 If s < "9" And s > "0" Then d = CInt(s) Else If s = "a" Then d = 10 If s = "b" Then d = 11 If s = "c" Then d = 12 If s = "d" Then d = 13 If s = "e" Then d = 14 If s = "f" Then d = 15 End If da = da + d * 1 End Select Next i c16to10 = da End Function Private Sub read_data() Dim s1, s2, s3 As String s1 = "小寒大寒立春雨水惊蛰春分清明谷雨立夏小满芒种夏至小暑大暑立秋处暑白露秋分寒露霜降立冬小雪大雪冬至" s2 = "000000,021208,042467,063836,085337,107014,128867,150921,173149,195551,218072,240693,263343,285989,308563,331033,353350,375494,397447,419210,440795,462224,483532,504758" s3 = "JAN,FEB,MAR,APR,MAY,JUN,JUL,AUG,SEP,OCT,NOV,DEC" For i = 1 To 24 SolarTerm(i) = Mid(s1, (i - 1) * 2 + 1, 2) '节气 sTermInfo(i) = Val(Mid(s2, (i - 1) * 7 + 1, 6)) If i <= 12 Then MonthName(i) = Mid(s3, (i - 1) * 4 + 1, 3) Next i '阳历节日：前四位数字为阳历的MMDD（月日），后面的文字为意义 sFtv(1) = "0101元旦" sFtv(2) = "0214情人节" sFtv(3) = "0308国际劳动妇女节" sFtv(4) = "0312中国植树节" sFtv(5) = "0315权益日" sFtv(6) = "" sFtv(7) = "0401国际愚人节" sFtv(8) = "0501国际劳动节" sFtv(9) = "0504五四青年节" sFtv(10) = "0512护士节" sFtv(11) = "0601儿童节" sFtv(12) = "0701中国建党节,香港回归" sFtv(13) = "0718托普诞辰" sFtv(14) = "0801中国建军节" sFtv(15) = "0808父亲节" sFtv(16) = "0909毛逝世纪念" sFtv(17) = "0910教师节" 'sFtv(17) ="0918九·一八事变(中国国耻日)" sFtv(18) = "0928孔子诞辰" sFtv(19) = "1001中国国庆节" sFtv(20) = "1006老人节" sFtv(21) = "1024联合国日" 'sFtv(21) = "1031万圣节" sFtv(22) = "1112孙中山诞辰" 'sFtv(21) = "1212西安事变纪念日" 'sFtv(21) = "南京大屠杀纪念日" sFtv(23) = "1220澳门回归" 'sFtv(21) = "平安夜" sFtv(24) = "1225圣诞节" sFtv(25) = "1226毛诞辰纪念" '农历的节日：日期表示的是农历的某月某日 lFtv(1) = "0101春节" lFtv(2) = "0115元宵节" lFtv(3) = "0505端午节" lFtv(4) = "0707七夕节" lFtv(5) = "0715中元节" lFtv(6) = "0815中秋节" lFtv(7) = "0909重阳节" lFtv(8) = "" lFtv(9) = "1208腊八节" lFtv(10) = "1224小年" lFtv(11) = "0100除夕" '按星期计算的节日：如0231表示阳历02月份的第三个星期一 wFtv(1) = "" wFtv(2) = "0231总统日" wFtv(3) = "0520母亲节" wFtv(4) = "0637父亲节" wFtv(5) = "0531胜利日" wFtv(6) = "0716合作节" wFtv(7) = "0730被奴周" wFtv(8) = "" wFtv(9) = "" wFtv(10) = "1021哥伦布日" wFtv(11) = "1144感恩节" LunarInfo(1) = c16to10("ox04bd8") LunarInfo(2) = c16to10("ox04ae0") LunarInfo(3) = c16to10("ox0a570") LunarInfo(4) = c16to10("ox054d5") LunarInfo(5) = c16to10("ox0d260") LunarInfo(6) = c16to10("ox0d950") LunarInfo(7) = c16to10("ox16554") LunarInfo(8) = c16to10("ox056a0") LunarInfo(9) = c16to10("ox09ad0") LunarInfo(10) = c16to10("ox055d2") LunarInfo(11) = c16to10("ox04ae0") LunarInfo(12) = c16to10("ox0a5b6") LunarInfo(13) = c16to10("ox0a4d0") LunarInfo(14) = c16to10("ox0d250") LunarInfo(15) = c16to10("ox1d255") LunarInfo(16) = c16to10("ox0b540") LunarInfo(17) = c16to10("ox0d6a0") LunarInfo(18) = c16to10("ox0ada2") LunarInfo(19) = c16to10("ox095b0") LunarInfo(20) = c16to10("ox14977") LunarInfo(21) = c16to10("ox04970") LunarInfo(22) = c16to10("ox0a4b0") LunarInfo(23) = c16to10("ox0b4b5") LunarInfo(24) = c16to10("ox06a50") LunarInfo(25) = c16to10("ox06d40") LunarInfo(26) = c16to10("ox1ab54") LunarInfo(27) = c16to10("ox02b60") LunarInfo(28) = c16to10("ox09570") LunarInfo(29) = c16to10("ox052f2") LunarInfo(30) = c16to10("ox04970") LunarInfo(31) = c16to10("ox06566") LunarInfo(32) = c16to10("ox0d4a0") LunarInfo(33) = c16to10("ox0ea50") LunarInfo(34) = c16to10("ox06e95") LunarInfo(35) = c16to10("ox05ad0") LunarInfo(36) = c16to10("ox02b60") LunarInfo(37) = c16to10("ox186e3") LunarInfo(38) = c16to10("ox092e0") LunarInfo(39) = c16to10("ox1c8d7") LunarInfo(40) = c16to10("ox0c950") LunarInfo(41) = c16to10("ox0d4a0") LunarInfo(42) = c16to10("ox1d8a6") LunarInfo(43) = c16to10("ox0b550") LunarInfo(44) = c16to10("ox056a0") LunarInfo(45) = c16to10("ox1a5b4") LunarInfo(46) = c16to10("ox025d0") LunarInfo(47) = c16to10("ox092d0") LunarInfo(48) = c16to10("ox0d2b2") LunarInfo(49) = c16to10("ox0a950") LunarInfo(50) = c16to10("ox0b557") LunarInfo(51) = c16to10("ox06ca0") LunarInfo(52) = c16to10("ox0b550") LunarInfo(53) = c16to10("ox15355") LunarInfo(54) = c16to10("ox04da0") LunarInfo(55) = c16to10("ox0a5d0") LunarInfo(56) = c16to10("ox14573") LunarInfo(57) = c16to10("ox052d0") LunarInfo(58) = c16to10("ox0a9a8") LunarInfo(59) = c16to10("ox0e950") LunarInfo(60) = c16to10("ox06aa0") LunarInfo(61) = c16to10("ox0aea6") LunarInfo(62) = c16to10("ox0ab50") LunarInfo(63) = c16to10("ox04b60") LunarInfo(64) = c16to10("ox0aae4") LunarInfo(65) = c16to10("ox0a570") LunarInfo(66) = c16to10("ox05260") LunarInfo(67) = c16to10("ox0f263") LunarInfo(68) = c16to10("ox0d950") LunarInfo(69) = c16to10("ox05b57") LunarInfo(70) = c16to10("ox056a0") LunarInfo(71) = c16to10("ox096d0") LunarInfo(72) = c16to10("ox04dd5") LunarInfo(73) = c16to10("ox04ad0") LunarInfo(74) = c16to10("ox0a4d0") LunarInfo(75) = c16to10("ox0d4d4") LunarInfo(76) = c16to10("ox0d250") LunarInfo(77) = c16to10("ox0d558") LunarInfo(78) = c16to10("ox0b540") LunarInfo(79) = c16to10("ox0b5a0") LunarInfo(80) = c16to10("ox195a6") LunarInfo(81) = c16to10("ox095b0") LunarInfo(82) = c16to10("ox049b0") LunarInfo(83) = c16to10("ox0a974") LunarInfo(84) = c16to10("ox0a4b0") LunarInfo(85) = c16to10("ox0b27a") LunarInfo(86) = c16to10("ox06a50") LunarInfo(87) = c16to10("ox06d40") LunarInfo(88) = c16to10("ox0af46") LunarInfo(89) = c16to10("ox0ab60") LunarInfo(90) = c16to10("ox09570") LunarInfo(91) = c16to10("ox04af5") LunarInfo(92) = c16to10("ox04970") LunarInfo(93) = c16to10("ox064b0") LunarInfo(94) = c16to10("ox074a3") LunarInfo(95) = c16to10("ox0ea50") LunarInfo(96) = c16to10("ox06b58") LunarInfo(97) = c16to10("ox055c0") LunarInfo(98) = c16to10("ox0ab60") LunarInfo(99) = c16to10("ox096d5") LunarInfo(100) = c16to10("ox092e0") LunarInfo(101) = c16to10("ox0c960") LunarInfo(102) = c16to10("ox0d954") LunarInfo(103) = c16to10("ox0d4a0") LunarInfo(104) = c16to10("ox0da50") LunarInfo(105) = c16to10("ox07552") LunarInfo(106) = c16to10("ox056a0") LunarInfo(107) = c16to10("ox0abb7") LunarInfo(108) = c16to10("ox025d0") LunarInfo(109) = c16to10("ox092d0") LunarInfo(110) = c16to10("ox0cab5") LunarInfo(111) = c16to10("ox0a950") LunarInfo(112) = c16to10("ox0b4a0") LunarInfo(113) = c16to10("ox0baa4") LunarInfo(114) = c16to10("ox0ad50") LunarInfo(115) = c16to10("ox055d9") LunarInfo(116) = c16to10("ox04ba0") LunarInfo(117) = c16to10("ox0a5b0") LunarInfo(118) = c16to10("ox15176") LunarInfo(119) = c16to10("ox052b0") LunarInfo(120) = c16to10("ox0a930") LunarInfo(121) = c16to10("ox07954") LunarInfo(122) = c16to10("ox06aa0") LunarInfo(123) = c16to10("ox0ad50") LunarInfo(124) = c16to10("ox05b52") LunarInfo(125) = c16to10("ox04b60") LunarInfo(126) = c16to10("ox0a6e6") LunarInfo(127) = c16to10("ox0a4e0") LunarInfo(128) = c16to10("ox0d260") LunarInfo(129) = c16to10("ox0ea65") LunarInfo(130) = c16to10("ox0d530") LunarInfo(131) = c16to10("ox05aa0") LunarInfo(132) = c16to10("ox076a3") LunarInfo(133) = c16to10("ox096d0") LunarInfo(134) = c16to10("ox04bd7") LunarInfo(135) = c16to10("ox04ad0") LunarInfo(136) = c16to10("ox0a4d0") LunarInfo(137) = c16to10("ox1d0b6") LunarInfo(138) = c16to10("ox0d250") LunarInfo(139) = c16to10("ox0d520") LunarInfo(140) = c16to10("ox0dd45") LunarInfo(141) = c16to10("ox0b5a0") LunarInfo(142) = c16to10("ox056d0") LunarInfo(143) = c16to10("ox055b2") LunarInfo(144) = c16to10("ox049b0") LunarInfo(145) = c16to10("ox0a577") LunarInfo(146) = c16to10("ox0a4b0") LunarInfo(147) = c16to10("ox0aa50") LunarInfo(148) = c16to10("ox1b255") LunarInfo(149) = c16to10("ox06d20") LunarInfo(150) = c16to10("ox0ada0") End Sub '传回农历 y年m月的总天数 Function lMonthDays(ByVal Y As Integer) As Integer If Y < 1900 Then Y = 1900 If (LunarInfo(Y - 1900 + 1) And Int(&H10000 / (2 ^ 12))) = 0 Then lMonthDays = 29 Else lMonthDays = 30 End If End Function '某y年的第n个节气的日期(从1小寒起算) Function sTerm(ByVal Y, n As Integer) As Date Dim D1, D2 As Double D1 = (31556925.9747 * (Y - 1900) + sTermInfo(n) * 60#) D2 = DateDiff("s", "1970-1-1 0:0", "1900-1-6 2:5") + D1 D1 = D2 / 2 sTerm = DateAdd("s", D2 - D1, DateAdd("s", D1, "1970-1-1 0:0")) sTerm = Format(sTerm, "yyyy/mm/dd") End Function '根据阳历返回其节气，若不是则返回空 Function GetTerm(ByVal sDate As Date) As String Dim Y, m As Integer Y = Year(sDate) m = Month(sDate) GetTerm = " " If sTerm(Y, m * 2 - 1) = sDate Then GetTerm = SolarTerm(m * 2 - 1) ElseIf sTerm(Y, m * 2) = sDate Then GetTerm = SolarTerm(m * 2) End If End Function '返回阳历是该月的第几个星期几的字符串，如:0520表示5月份第2个星期日 Function GetMonthWeek(ByVal sDate As Date) As String Dim D0 As Date D0 = CDate(Year(sDate) & "-" & Month(sDate) & "-1") GetMonthWeek = Format(Month(sDate), "00") & (Int((Day(sDate) - 1 + Weekday(D0) - 1) / 7) + 1) & Weekday(sDate) - 1 End Function Private Sub riliLoad(curtime As Date) Dim mons As String Dim Twftv As String Dim TLftv As String Dim Tsftv As String Dim Twftv_s As String Dim Tlftv_s As String Dim TSftv_s As String Dim s1 As String Dim s2 As String Dim ls1 As String Dim ls2 As String Dim Nonglis As String Dim LTerm As String Dim YMD As String Dim days As String Dim LDays As String Dim Lmons As String Dim shuxiangStr As String Dim tian As Integer Dim ss As String Dim ss1 As String read_data '获取当前系统时间 s1 = GetMonthWeek(curtime) LTerm = GetTerm(curtime) 'curTime = "2004-05-01" '星期名 WeekName(0) = " * " WeekName(1) = "星期日" WeekName(2) = "星期一" WeekName(3) = "星期二" WeekName(4) = "星期三" WeekName(5) = "星期四" WeekName(6) = "星期五" WeekName(7) = "星期六" '天干名称 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) = "狗" ShuXiang(11) = "猪" '农历日期名 DayName(0) = "*" DayName(1) = "初一" DayName(2) = "初二" DayName(3) = "初三" DayName(4) = "初四" DayName(5) = "初五" DayName(6) = "初六" DayName(7) = "初七" DayName(8) = "初八" DayName(9) = "初九" DayName(10) = "初十" DayName(11) = "十一" DayName(12) = "十二" DayName(13) = "十三" DayName(14) = "十四" DayName(15) = "十五" DayName(16) = "十六" DayName(17) = "十七" DayName(18) = "十八" DayName(19) = "十九" DayName(20) = "二十" DayName(21) = "廿一" DayName(22) = "廿二" DayName(23) = "廿三" DayName(24) = "廿四" DayName(25) = "廿五" DayName(26) = "廿六" DayName(27) = "廿七" DayName(28) = "廿八" DayName(29) = "廿九" DayName(30) = "三十" '农历月份名 MonName(0) = "*" MonName(1) = "正" MonName(2) = "二" MonName(3) = "三" MonName(4) = "四" MonName(5) = "五" MonName(6) = "六" MonName(7) = "七" MonName(8) = "八" MonName(9) = "九" MonName(10) = "十" MonName(11) = "十一" MonName(12) = "腊" '公历每月前面的天数 MonthAdd(0) = 0 MonthAdd(1) = 31 MonthAdd(2) = 59 MonthAdd(3) = 90 MonthAdd(4) = 120 MonthAdd(5) = 151 MonthAdd(6) = 181 MonthAdd(7) = 212 MonthAdd(8) = 243 MonthAdd(9) = 273 MonthAdd(10) = 304 MonthAdd(11) = 334 '农历数据 NongliData(0) = 2635 NongliData(1) = 333387 NongliData(2) = 1701 NongliData(3) = 1748 NongliData(4) = 267701 NongliData(5) = 694 NongliData(6) = 2391 NongliData(7) = 133423 NongliData(8) = 1175 NongliData(9) = 396438 NongliData(10) = 3402 NongliData(11) = 3749 NongliData(12) = 331177 NongliData(13) = 1453 NongliData(14) = 694 NongliData(15) = 201326 NongliData(16) = 2350 NongliData(17) = 465197 NongliData(18) = 3221 NongliData(19) = 3402 NongliData(20) = 400202 NongliData(21) = 2901 NongliData(22) = 1386 NongliData(23) = 267611 NongliData(24) = 605 NongliData(25) = 2349 NongliData(26) = 137515 NongliData(27) = 2709 NongliData(28) = 464533 NongliData(29) = 1738 NongliData(30) = 2901 NongliData(31) = 330421 NongliData(32) = 1242 NongliData(33) = 2651 NongliData(34) = 199255 NongliData(35) = 1323 NongliData(36) = 529706 NongliData(37) = 3733 NongliData(38) = 1706 NongliData(39) = 398762 NongliData(40) = 2741 NongliData(41) = 1206 NongliData(42) = 267438 NongliData(43) = 2647 NongliData(44) = 1318 NongliData(45) = 204070 NongliData(46) = 3477 NongliData(47) = 461653 NongliData(48) = 1386 NongliData(49) = 2413 NongliData(50) = 330077 NongliData(51) = 1197 NongliData(52) = 2637 NongliData(53) = 268877 NongliData(54) = 3365 NongliData(55) = 531109 NongliData(56) = 2900 NongliData(57) = 2922 NongliData(58) = 398042 NongliData(59) = 2395 NongliData(60) = 1179 NongliData(61) = 267415 NongliData(62) = 2635 NongliData(63) = 661067 NongliData(64) = 1701 NongliData(65) = 1748 NongliData(66) = 398772 NongliData(67) = 2742 NongliData(68) = 2391 NongliData(69) = 330031 NongliData(70) = 1175 NongliData(71) = 1611 NongliData(72) = 200010 NongliData(73) = 3749 NongliData(74) = 527717 NongliData(75) = 1452 NongliData(76) = 2742 NongliData(77) = 332397 NongliData(78) = 2350 NongliData(79) = 3222 NongliData(80) = 268949 NongliData(81) = 3402 NongliData(82) = 3493 NongliData(83) = 133973 NongliData(84) = 1386 NongliData(85) = 464219 NongliData(86) = 605 NongliData(87) = 2349 NongliData(88) = 334123 NongliData(89) = 2709 NongliData(90) = 2890 NongliData(91) = 267946 NongliData(92) = 2773 NongliData(93) = 592565 NongliData(94) = 1210 NongliData(95) = 2651 NongliData(96) = 395863 NongliData(97) = 1323 NongliData(98) = 2707 NongliData(99) = 265877 '生成当前公历年、月、日 ==> GongliStr curYear = Year(curtime) curMonth = Month(curtime) curDay = Day(curtime) YMD = curYear & "年" & curMonth & "月" & curDay & "日" If curMonth < 10 Then '月变成双字符 mons = "0" & curMonth Else mons = curMonth End If If curDay < 10 Then '日变成双字符 days = "0" & curDay Else days = curDay End If s2 = mons & days '集合月日/-/MMDD GongliStr = curYear & "年" If (curMonth < 10) Then GongliStr = GongliStr & "0" & curMonth & "月" Else GongliStr = GongliStr & curMonth & "月" End If If (curDay < 10) Then GongliStr = GongliStr & "0" & curDay & "日" Else GongliStr = GongliStr & curDay & "日" End If '生成当前公历星期 ==> WeekdayStr curWeekday = Weekday(curtime) WeekdayStr = WeekName(curWeekday) '计算到初始时间1921年2月8日的天数：1921-2-8(正月初一) TheDate = (curYear - 1921) * 365 + Int((curYear - 1921) / 4) + curDay + MonthAdd(curMonth - 1) - 38 If ((curYear Mod 4) = 0 And curMonth > 2) Then TheDate = TheDate + 1 End If '计算农历天干、地支、月、日 isEnd = 0 m = 0 Do If (NongliData(m) < 4095) Then k = 11 Else k = 12 End If n = k Do If (n < 0) Then Exit Do End If '获取NongliData(m)的第n个二进制位的值 bit = NongliData(m) For i = 1 To n Step 1 bit = Int(bit / 2) Next bit = bit Mod 2 If (TheDate <= 29 + bit) Then isEnd = 1 Exit Do End If TheDate = TheDate - 29 - bit n = n - 1 Loop If (isEnd = 1) Then Exit Do End If m = m + 1 Loop curYear = 1921 + m curMonth = k - n + 1 curDay = TheDate If curDay < 10 Then '农历日变成双字符 LDays = "0" & curDay Else LDays = curDay End If If (k = 12) Then If (curMonth = (Int(NongliData(m) / 65536) + 1)) Then curMonth = 1 - curMonth ElseIf (curMonth > (Int(NongliData(m) / 65536) + 1)) Then curMonth = curMonth - 1 End If End If '生成农历天干、地支、属相 ==> NongliStr NongliStr = TianGan(((curYear - 4) Mod 60) Mod 10) & DiZhi(((curYear - 4) Mod 60) Mod 12) & "年" shuxiangStr = ShuXiang(((curYear - 4) Mod 60) Mod 12) '生成农历月、日 ==> NongliDayStr If curMonth = 12 Then tian = lMonthDays(curYear) If (curMonth < 1) Then NongliDayStr = "闰" & MonName(-1 * curMonth) Else NongliDayStr = MonName(curMonth) End If If curMonth < 10 Then '农历月变成双字符 Lmons = "0" & curMonth Else Lmons = curMonth End If ls1 = Lmons & LDays NongliDayStr = NongliDayStr & "月" NongliDayStr = NongliDayStr & DayName(curDay) Nonglis = NongliStr & NongliDayStr 'xu chu For i = 1 To 11 '找以周计算的节日 Twftv = Mid(wFtv(i), 1, 4) If Twftv = s1 Then Twftv_s = Mid(wFtv(i), 5, 3) Exit For End If Next i For i = 1 To 25 '找以公历的节日 Tsftv = Mid(sFtv(i), 1, 4) If Tsftv = s2 Then TSftv_s = Mid(sFtv(i), 5, 6) Exit For End If Next i For i = 1 To 11 '找农历的节日 TLftv = Mid(lFtv(i), 1, 4) If TLftv = ls1 Then Tlftv_s = Mid(lFtv(i), 5, 3) Exit For End If Next i If ls1 = "12" & tian Then Tlftv_s = Mid(lFtv(11), 5, 3) ss = "今天是" & YMD & Chr(13) & "农历:" & Nonglis & Chr(13) & "属象:" & shuxiangStr & "年" & Chr(13) ss1 = "" If Tlftv_s <> "" Then ss1 = ss1 & Tlftv_s If Twftv_s <> "" Then ss1 = ss1 & Twftv_s If TSftv_s <> "" Then ss1 = ss1 & TSftv_s If LTerm <> "" Then ss1 = ss1 & LTerm If ss1 <> " " Then ss = ss & "今天是：" & ss1 Label1.Caption = ss End Sub Private Sub Check1_Click() If Check1.Value = 1 Then Combo1.Enabled = True Combo2.Enabled = True Combo3.Enabled = True Else Check1.Value = 0 Combo1.Enabled = False Combo2.Enabled = False Combo3.Enabled = False End If End Sub Private Sub Combo2_LostFocus() Combo3.Clear Dim i As Integer Dim d As Integer Select Case CInt(Combo2.Text) Case 1, 3, 5, 7, 8, 10, 12 For i = 1 To 31 Combo3.AddItem i, i - 1 Next i Case 4, 6, 9, 11 For i = 1 To 30 Combo3.AddItem i, i - 1 Next i Case 2 If Combo1.Text Mod 4 = 0 Then d = 29 Else d = 28 End If For i = 1 To d Combo3.AddItem i, i - 1 Next i End Select End Sub Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer) settime = Combo1.Text & "-" & Combo2.Text & "-" & Combo3.Text riliLoad (settime) End Sub Private Sub Form_Load() Check1.Value = 0 Combo1.Enabled = False Combo2.Enabled = False Combo3.Enabled = False Combo1.Text = Year(Date) Combo2.Text = Month(Date) Combo3.Text = Day(Date) riliLoad (Date) End Sub Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) settime = Combo1.Text & "-" & Combo2.Text & "-" & Combo3.Text riliLoad (settime) End Sub