'*****************************************************************************
'日期资料
'*****************************************************************************/
Dim lunarInfo As Variant
lunarInfo = Array(19416, 19168, 42352, 21717, 53856, 55632, 91476, 22176, 39632, 21970, 19168, 42422, 42192, 53840, 119381, 46400, 54944, 44450, 38320, 84343, 18800, 42160, 46261, 27216, 27968, 109396, 11104, 38256, 21234, 18800, _
25958, 54432, 59984, 28309, 23248, 11104, 100067, 37600, 116951, 51536, 54432, 120998, 46416, 22176, 107956, 9680, 37584, 53938, 43344, 46423, 27808, 46416, 86869, 19872, 42416, 83315, 21168, 43432, 59728, 27296, _
44710, 43856, 19296, 43748, 42352, 21088, 62051, 55632, 23383, 22176, 38608, 19925, 19152, 42192, 54484, 53840, 54616, 46400, 46752, 103846, 38320, 18864, 43380, 42160, 45690, 27216, 27968, 44870, 43872, 38256, _
19189, 18800, 25776, 29859, 59984, 27480, 21952, 43872, 38613, 37600, 51552, 55636, 54432, 55888, 30034, 22176, 43959, 9680, 37584, 51893, 43344, 46240, 47780, 44368, 21977, 19360, 42416, 86390, 21168, 43312, _
31060, 27296, 44368, 23378, 19296, 42726, 42208, 53856, 60005, 54576, 23200, 30371, 38608, 19415, 19152, 42192, 118966, 53840, 54560, 56645, 46496, 22224, 21938, 18864, 42359, 42160, 43600, 111189, 27936, 44448, 84835)
Dim solarMonth, Gan, Animals, solarTerm, sTermInfo, nStr1, nStr2, monthName As Variant
solarMonth = Array(31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31)
Gan = Array("甲", "乙", "丙", "丁", "戊", "己", "庚", "辛", "壬", "癸")
Zhi = Array("子", "丑", "寅", "卯", "辰", "巳", "午", "未", "申", "酉", "戌", "亥")
Animals = Array("鼠", "牛", "虎", "兔", "龙", "蛇", "马", "羊", "猴", "鸡", "狗", "猪")
solarTerm = Array("小寒", "大寒", "立春", "雨水", "惊蛰", "春分", "清明", "谷雨", "立夏", "小满", "芒种", "夏至", "小暑", "大暑", "立秋", "处暑", "白露", "秋分", "寒露", "霜降", "立冬", "小雪", "大雪", "冬至")
sTermInfo = Array(0, 21208, 42467, 63836, 85337, 107014, 128867, 150921, 173149, 195551, 218072, 240693, 263343, 285989, 308563, 331033, 353350, 375494, 397447, 419210, 440795, 462224, 483532, 504758)
nStr1 = Array("日", "一", "二", "三", "四", "五", "六", "七", "八", "九", "十")
nStr2 = Array("初", "十", "廿", "卅", "□")
monthName = Array("JAN", "FEB", "MAR", "APR", "MAY", "JUN", "JUL", "AUG", "SEP", "OCT", "NOV", "DEC")
'国历节日 *表示放假日
Dim sFtv As Variant
sFtv = Array("0101*元旦节", "0202 世界湿地日", "0210 国际气象节", "0214 情人节", "0301 国际海豹日", "0303 全国爱耳日", "0305 学雷锋纪念日", "0308 妇女节", "0312 植树节 孙中山逝世纪念日", "0314 国际警察日", "0315 消费者权益日", _
"0317 中国国医节 国际航海日", "0321 世界森林日 消除种族歧视国际日 世界儿歌日", "0322 世界水日", "0323 世界气象日", "0324 世界防治结核病日", "0325 全国中小学生安全教育日", "0330 巴勒斯坦国土日", "0401 愚人节 全国爱国卫生运动月(四月) 税收宣传月(四月)", "0407 世界卫生日", _
"0422 世界地球日", "0423 世界图书和版权日", "0424 亚非新闻工作者日", "0501*劳动节", "0502*劳动节假日", "0503*劳动节假日", "0504 青年节", "0505 碘缺乏病防治日", "0508 世界红十字日", "0512 国际护士节", "0515 国际家庭日", "0517 国际电信日", _
"0518 国际博物馆日", "0520 全国学生营养日", "0523 国际牛奶日", "0531 世界无烟日", "0601 国际儿童节", "0605 世界环境保护日", "0606 全国爱眼日", "0617 防治荒漠化和干旱日", "0623 国际奥林匹克日", "0625 全国土地日", "0626 国际禁毒日", "0701 香港回归纪念日 中共诞辰 世界建筑日", _
"0702 国际体育记者日", "0707 抗日战争纪念日", "0711 世界人口日", "0730 非洲妇女日", "0801 建军节", "0808 中国男子节(爸爸节)", "0815 抗日战争胜利纪念", "0908 国际扫盲日 国际新闻工作者日", "0909 毛泽东逝世纪念", "0910 中国教师节", _
"0914 世界清洁地球日", "0916 国际臭氧层保护日", "0918 九·一八事变纪念日", "0920 国际爱牙日", "0927 世界旅游日", "0928 孔子诞辰", "1001*国庆节 世界音乐日 国际老人节", "1002*国庆节假日 国际和平与民主自由斗争日", "1003*国庆节假日", "1004 世界动物日", _
"1006 老人节", "1008 全国高血压日 世界视觉日", "1009 世界邮政日 万国邮联日", "1010 辛亥革命纪念日 世界精神卫生日", "1013 世界保健日 国际教师节", "1014 世界标准日", _
"1015 国际盲人节(白手杖节)", "1016 世界粮食日", "1017 世界消除贫困日", "1022 世界传统医药日", "1024 联合国日", "1031 世界勤俭日", "1107 十月社会主义革命纪念日", "1108 中国记者日", _
"1109 全国消防安全宣传教育日", "1110 世界青年节", "1111 国际科学与和平周(本日所属的一周)", "1112 孙中山诞辰纪念日", "1114 世界糖尿病日", "1117 国际大学生节 世界学生节", "1120*彝族年", "1121*彝族年 世界问候日 世界电视日", "1122*彝族年", "1129 国际声援巴勒斯坦人民国际日", _
"1201 世界艾滋病日", "1203 世界残疾人日", "1205 国际经济和社会发展志愿人员日", "1208 国际儿童电视日", "1209 世界足球日", "1210 世界人权日", "1212 西安事变纪念日", "1213 南京大屠杀(1937年)纪念日！紧记血泪史！", "1220 澳门回归纪念", "1221 国际篮球日", "1224 平安夜", "1225 圣诞节", "1226 毛泽东诞辰纪念")
'农历节日 *表示放假日
Dim lFtv As Variant
lFtv = Array("0101*春节", "0102*初二", "0103*初三", "0115 元宵节", "0505 端午节", "0707 七夕情人节", "0715 中元节", "0815 中秋节", "0909 重阳节", "1208 腊八节", "1223 小年", "0100 除夕")
'某月的第几个星期几
Dim wFtv As Variant
wFtv = Array("0150 世界麻风日", "0520 国际母亲节", "0530 全国助残日", "0630 父亲节", "0730 被奴役国家周", "0932 国际和平日", "0940 国际聋人节 世界儿童日", "0950 世界海事日", "1011 国际住房日", "1013 国际减轻自然灾害日(减灾日)", "1144 感恩节")
'*****************************************************************************/
'日期计算
'*****************************************************************************/
'====================================== 返回农历 y年的总天数
Function lYearDays(y)
Dim i, Sum, lxp As Long
i = 32768: Sum = 348
Do While i > 8
If lxp = (lunarInfo(y - 1900) And i) Then
lxp = 1
Else
lxp = 0
End
Sum = Sum + lxp
i = i / 2
Loop
lYearDays = Sum + leapDays(y)
End Function
'====================================== 返回农历 y年闰月的天数
Function leapDays(y)
Dim lxp As Long
'if(leapMonth(y)) return((lunarInfo[y-1900] & 0x10000)? 30: 29);
'else return(0);
If leapMonth(y) Then
If lxp = (lunarInfo(y - 1900) And 65536) Then
leapDays = 30
Else
leapDays = 29
End
Else
leapDays = 0
End If
End Function
'====================================== 返回农历 y年闰哪个月 1-12 , 没闰返回 0
Function leapMonth(y)
'return(lunarInfo[y-1900] & 0xf)
leapMonth = (lunarInfo(y - 1900) And 15)
End Function
'====================================== 返回农历 y年m月的总天数
Function monthDays(y, m)
Dim lxp As Long
'return( (lunarInfo[y-1900] & (0x10000>>m))? 30: 29 )
lxp = 65536 / (2 ^ m)
If lunarInfo(y - 1900) And lxp Then
monthDays = 30
Else
monthDays = 29
End
End Function
'====================================== 算出农历, 传入日期控件, 返回农历日期控件
' 该控件属性有 .year .month .day .isLeap
function Lunar(objDate) {
var i, leap=0, temp=0;
var offset = (Date.UTC(objDate.getFullYear(),objDate.getMonth(),objDate.getDate()) - Date.UTC(1900,0,31))/86400000;
for(i=1900; i<2050 && offset>0; i++) { temp=lYearDays(i); offset-=temp; }
if(offset<0) { offset+=temp; i--; }
this.year = i;
leap = leapMonth(i); //闰哪个月
this.isLeap = false;
for(i=1; i<13 && offset>0; i++) {
//闰月
if(leap>0 && i==(leap+1) && this.isLeap==false)
{ --i; this.isLeap = true; temp = leapDays(this.year); }
Else
{ temp = monthDays(this.year, i); }
//解除闰月
if(this.isLeap==true && i==(leap+1)) this.isLeap = false;
offset -= temp;
}
if(offset==0 && leap>0 && i==leap+1)
if(this.isLeap)
{ this.isLeap = false; }
Else
{ this.isLeap = true; --i; }
if(offset<0){ offset += temp; --i; }
this.month = i;
this.day = offset + 1;
}
//==============================返回公历 y年某m+1月的天数
function solarDays(y,m) {
if(m==1)
return(((y%4 == 0) && (y%100 != 0) || (y%400 == 0))? 29: 28);
Else
return(solarMonth[m]);
}
//============================== 传入 offset 返回干支, 0=甲子
万年历（带农历） VB源码
4星 · 超过85%的资源 需积分: 50 53 浏览量
2009-08-10
10:43:21
上传
评论
收藏 75KB RAR 举报 
万年历（带农历）.rar （12个子文件） 
万年历工程 
lunarInfo_txt.txt 2KB
Module1.bas 7KB Day_Data.frm 486B 万年历.frm 46KB 工程1.vbp 666B lunarInfo_原始数据.txt 1KB 代码.txt 19KB 记算公历 y年m月d日的农历数据.txt 3KB
HugeCalc-2.xls 143KB 万年历.frx 14B 工程1.vbw 81B solarFestival_txt.txt 2KB资源评论
fengcailu2012-03-24很好。。希望描述详细一些，很多人不知道是控件。
