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 StringDim d  As IntegerDim da As LongFor i = 3 To 7s = Mid(shuju, i, 1)Select Case iCase 3If s < "9" And s > "0" Thend = CInt(s)ElseIf s = "a" Then d = 10If s = "b" Then d = 11If s = "c" Then d = 12If s = "d" Then d = 13If s = "e" Then d = 14If s = "f" Then d = 15End Ifda = da + d * 16 ^ 4Case 4If s < "9" And s > "0" Thend = CInt(s)ElseIf s = "a" Then d = 10If s = "b" Then d = 11If s = "c" Then d = 12If s = "d" Then d = 13If s = "e" Then d = 14If s = "f" Then d = 15End Ifda = da + d * 16 ^ 3Case 5If s < "9" And s > "0" Thend = CInt(s)ElseIf s = "a" Then d = 10If s = "b" Then d = 11If s = "c" Then d = 12If s = "d" Then d = 13If s = "e" Then d = 14If s = "f" Then d = 15End Ifda = da + d * 16 ^ 2Case 6If s < "9" And s > "0" Thend = CInt(s)ElseIf s = "a" Then d = 10If s = "b" Then d = 11If s = "c" Then d = 12If s = "d" Then d = 13If s = "e" Then d = 14If s = "f" Then d = 15End Ifda = da + d * 16 ^ 1Case 7If s < "9" And s > "0" Thend = CInt(s)ElseIf s = "a" Then d = 10If s = "b" Then d = 11If s = "c" Then d = 12If s = "d" Then d = 13If s = "e" Then d = 14If s = "f" Then d = 15End Ifda = da + d * 1End SelectNext ic16to10 = da
End FunctionPrivate Sub read_data()Dim s1, s2, s3 As Strings1 = "小寒大寒立春雨水惊蛰春分清明谷雨立夏小满芒种夏至小暑大暑立秋处暑白露秋分寒露霜降立冬小雪大雪冬至"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 24SolarTerm(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 FunctionPrivate Sub riliLoad(curtime As Date)Dim mons        As StringDim Twftv       As StringDim TLftv       As StringDim Tsftv       As StringDim Twftv_s     As StringDim Tlftv_s     As StringDim TSftv_s     As StringDim s1          As StringDim s2          As StringDim ls1         As StringDim ls2         As StringDim Nonglis     As StringDim LTerm       As StringDim YMD         As StringDim days        As StringDim LDays       As StringDim Lmons       As StringDim shuxiangStr As StringDim tian        As IntegerDim ss          As StringDim ss1         As Stringread_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) = 0MonthAdd(1) = 31MonthAdd(2) = 59MonthAdd(3) = 90MonthAdd(4) = 120MonthAdd(5) = 151MonthAdd(6) = 181MonthAdd(7) = 212MonthAdd(8) = 243MonthAdd(9) = 273MonthAdd(10) = 304MonthAdd(11) = 334'农历数据NongliData(0) = 2635NongliData(1) = 333387NongliData(2) = 1701NongliData(3) = 1748NongliData(4) = 267701NongliData(5) = 694NongliData(6) = 2391NongliData(7) = 133423NongliData(8) = 1175NongliData(9) = 396438NongliData(10) = 3402NongliData(11) = 3749NongliData(12) = 331177NongliData(13) = 1453NongliData(14) = 694NongliData(15) = 201326NongliData(16) = 2350NongliData(17) = 465197NongliData(18) = 3221NongliData(19) = 3402NongliData(20) = 400202NongliData(21) = 2901NongliData(22) = 1386NongliData(23) = 267611NongliData(24) = 605NongliData(25) = 2349NongliData(26) = 137515NongliData(27) = 2709NongliData(28) = 464533NongliData(29) = 1738NongliData(30) = 2901NongliData(31) = 330421NongliData(32) = 1242NongliData(33) = 2651NongliData(34) = 199255NongliData(35) = 1323NongliData(36) = 529706NongliData(37) = 3733NongliData(38) = 1706NongliData(39) = 398762NongliData(40) = 2741NongliData(41) = 1206NongliData(42) = 267438NongliData(43) = 2647NongliData(44) = 1318NongliData(45) = 204070NongliData(46) = 3477NongliData(47) = 461653NongliData(48) = 1386NongliData(49) = 2413NongliData(50) = 330077NongliData(51) = 1197NongliData(52) = 2637NongliData(53) = 268877NongliData(54) = 3365NongliData(55) = 531109NongliData(56) = 2900NongliData(57) = 2922NongliData(58) = 398042NongliData(59) = 2395NongliData(60) = 1179NongliData(61) = 267415NongliData(62) = 2635NongliData(63) = 661067NongliData(64) = 1701NongliData(65) = 1748NongliData(66) = 398772NongliData(67) = 2742NongliData(68) = 2391NongliData(69) = 330031NongliData(70) = 1175NongliData(71) = 1611NongliData(72) = 200010NongliData(73) = 3749NongliData(74) = 527717NongliData(75) = 1452NongliData(76) = 2742NongliData(77) = 332397NongliData(78) = 2350NongliData(79) = 3222NongliData(80) = 268949NongliData(81) = 3402NongliData(82) = 3493NongliData(83) = 133973NongliData(84) = 1386NongliData(85) = 464219NongliData(86) = 605NongliData(87) = 2349NongliData(88) = 334123NongliData(89) = 2709NongliData(90) = 2890NongliData(91) = 267946NongliData(92) = 2773NongliData(93) = 592565NongliData(94) = 1210NongliData(95) = 2651NongliData(96) = 395863NongliData(97) = 1323NongliData(98) = 2707NongliData(99) = 265877'生成当前公历年、月、日 ==> GongliStr
curYear = Year(curtime)curMonth = Month(curtime)curDay = Day(curtime)YMD = curYear & "年" & curMonth & "月" & curDay & "日"If curMonth < 10 Then '月变成双字符mons = "0" & curMonthElsemons = curMonthEnd IfIf curDay < 10 Then '日变成双字符days = "0" & curDayElsedays = curDayEnd Ifs2 = mons & days '集合月日/-/MMDDGongliStr = curYear & "年"If (curMonth < 10) ThenGongliStr = GongliStr & "0" & curMonth & "月"ElseGongliStr = GongliStr & curMonth & "月"End IfIf (curDay < 10) ThenGongliStr = GongliStr & "0" & curDay & "日"ElseGongliStr = GongliStr & curDay & "日"End If'生成当前公历星期 ==> WeekdayStrcurWeekday = Weekday(curtime)WeekdayStr = WeekName(curWeekday)'计算到初始时间1921年2月8日的天数：1921-2-8(正月初一)TheDate = (curYear - 1921) * 365 + Int((curYear - 1921) / 4) + curDay + MonthAdd(curMonth - 1) - 38If ((curYear Mod 4) = 0 And curMonth > 2) ThenTheDate = TheDate + 1End If'计算农历天干、地支、月、日isEnd = 0m = 0DoIf (NongliData(m) < 4095) Thenk = 11Elsek = 12End Ifn = kDoIf (n < 0) ThenExit DoEnd If'获取NongliData(m)的第n个二进制位的值bit = NongliData(m)For i = 1 To n Step 1bit = Int(bit / 2)Nextbit = bit Mod 2If (TheDate <= 29 + bit) ThenisEnd = 1Exit DoEnd IfTheDate = TheDate - 29 - bitn = n - 1LoopIf (isEnd = 1) ThenExit DoEnd Ifm = m + 1LoopcurYear = 1921 + mcurMonth = k - n + 1curDay = TheDateIf curDay < 10 Then '农历日变成双字符LDays = "0" & curDayElseLDays = curDayEnd IfIf (k = 12) ThenIf (curMonth = (Int(NongliData(m) / 65536) + 1)) ThencurMonth = 1 - curMonthElseIf (curMonth > (Int(NongliData(m) / 65536) + 1)) ThencurMonth = curMonth - 1End IfEnd If'生成农历天干、地支、属相 ==> NongliStrNongliStr = TianGan(((curYear - 4) Mod 60) Mod 10) & DiZhi(((curYear - 4) Mod 60) Mod 12) & "年"shuxiangStr = ShuXiang(((curYear - 4) Mod 60) Mod 12)'生成农历月、日 ==> NongliDayStrIf curMonth = 12 Then tian = lMonthDays(curYear)If (curMonth < 1) ThenNongliDayStr = "闰" & MonName(-1 * curMonth)ElseNongliDayStr = MonName(curMonth)End IfIf curMonth < 10 Then '农历月变成双字符Lmons = "0" & curMonthElseLmons = curMonthEnd Ifls1 = Lmons & LDaysNongliDayStr = NongliDayStr & "月"NongliDayStr = NongliDayStr & DayName(curDay)Nonglis = NongliStr & NongliDayStr 'xu chuFor i = 1 To 11 '找以周计算的节日Twftv = Mid(wFtv(i), 1, 4)If Twftv = s1 ThenTwftv_s = Mid(wFtv(i), 5, 3)Exit ForEnd IfNext iFor i = 1 To 25 '找以公历的节日Tsftv = Mid(sFtv(i), 1, 4)If Tsftv = s2 ThenTSftv_s = Mid(sFtv(i), 5, 6)Exit ForEnd IfNext iFor i = 1 To 11 '找农历的节日TLftv = Mid(lFtv(i), 1, 4)If TLftv = ls1 ThenTlftv_s = Mid(lFtv(i), 5, 3)Exit ForEnd IfNext iIf 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_sIf Twftv_s <> "" Then ss1 = ss1 & Twftv_sIf TSftv_s <> "" Then ss1 = ss1 & TSftv_sIf LTerm <> "" Then ss1 = ss1 & LTermIf ss1 <> " " Then ss = ss & "今天是：" & ss1Label1.Caption = ss
End SubPrivate Sub Check1_Click()If Check1.Value = 1 ThenCombo1.Enabled = TrueCombo2.Enabled = TrueCombo3.Enabled = TrueElseCheck1.Value = 0Combo1.Enabled = FalseCombo2.Enabled = FalseCombo3.Enabled = FalseEnd IfEnd SubPrivate Sub Combo2_LostFocus()Combo3.ClearDim i As IntegerDim d As IntegerSelect Case CInt(Combo2.Text)Case 1, 3, 5, 7, 8, 10, 12For i = 1 To 31Combo3.AddItem i, i - 1Next iCase 4, 6, 9, 11For i = 1 To 30Combo3.AddItem i, i - 1Next iCase 2If Combo1.Text Mod 4 = 0 Thend = 29Elsed = 28End IfFor i = 1 To dCombo3.AddItem i, i - 1Next iEnd SelectEnd SubPrivate Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
settime = Combo1.Text & "-" & Combo2.Text & "-" & Combo3.Text
riliLoad (settime)
End SubPrivate Sub Form_Load()Check1.Value = 0Combo1.Enabled = FalseCombo2.Enabled = FalseCombo3.Enabled = FalseCombo1.Text = Year(Date)Combo2.Text = Month(Date)Combo3.Text = Day(Date)riliLoad (Date)
End SubPrivate Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)settime = Combo1.Text & "-" & Combo2.Text & "-" & Combo3.TextriliLoad (settime)
End Sub