还是“农转非”的问题，400分了！UP有分！要代码！

VCXP(弱智,什么都不会) :确实急用。我在做一套软件，其它部分好说，这部分只有求救，绝对没开玩笑的意思，算法大家已经说了，只是时间和精力不够。

http://www.vbprobe.com/ocx/showdoc.asp?detail_id=768
这个有用

http://sanjianxia.myrice.com/delphi/19.htm

高手帮我提供一段实现类似windows资源管理器的代码如何？
谢谢！！！！

公历农历相互转换的算法及其VCL实现(C++写的)
http://www.yqzj.com/ssyd/jslw/jslw7.htm

http://expert.csdn.net/Expert/topic/1182/1182068.xml?temp=.9932367不知道这个能不能帮上你忙

很久以前找的
但还没用过
不知道行不行/*prototype: int calconv( struct convdate * );struct convdate
{
int source; ==0 则输入日期为西历, !=0 则输入为农历
int solaryear; 输出或输入之西历年份
int solarmonth; 西历月
int solardate; 西历日
int lunaryear; 输出或输入之农历年份
int lunarmonth; 农历月
int lunardate; 农历日
int weekday; 该日为星期几 ( 0==星期日, 1==星期一, ... )
int kan; 该日天干 ( 0==甲, 1==乙, ..., 9==癸 )
int chih; 该日地支 ( 0==子, 1==丑, ..., 11==亥 )
};呼叫时须设定 souce 的值, 若为 0 则为西历转农历, 否则为农历转西历. 然後视
输入为西历或农历来设定西历或农历的年月日. 转换後的年月日会填入结构中( 农
历或西历 ), 以及该日为星期几, 天干地支.
若函式的返回值为 0 表示没有错误, 1 为输入之年份错误, 2 为输入之月份错误,
3 为输入之日期错误.
输入之西历年须在 1937 - 2031 间
输入之农历年须在 1936 - 2030 间
若须扩充, 则增加 lunarcal[]*/#define firstyear 1936 /* the first year in lunarcal[] */struct convdate
{
int source;
int solaryear;
int solarmonth;
int solardate;
int lunaryear;
int lunarmonth;
int lunardate;
int weekday;
int kan;
int chih;
};struct taglunarcal
{
int basedays; /* 到西历 1 月 1 日到农历正月初一的累积日数 */
int intercalation; /* 闰月月份. 0==此年没有闰月 */
int baseweekday; /* 此年西历 1 月 1 日为星期几再减 1 */
int basekanchih; /* 此年西历 1 月 1 日之干支序号减 1 */
int monthdays[13]; /* 此农历年每月之大小, 0==小月(29日), 1==大月(30日)*/
};struct taglunarcal lunarcal[] = {
{ 23, 3, 2, 17, 1, 0, 0, 1, 0, 0, 1, 1, 0, 1, 1, 1, 0 }, /* 1936 */
{ 41, 0, 4, 23, 1, 0, 0, 1, 0, 0, 1, 0, 1, 1, 1, 0, 1 },
{ 30, 7, 5, 28, 1, 1, 0, 0, 1, 0, 0, 1, 0, 1, 1, 0, 1 },
{ 49, 0, 6, 33, 1, 1, 0, 0, 1, 0, 0, 1, 0, 1, 0, 1, 1 },
{ 38, 0, 0, 38, 1, 1, 0, 1, 0, 1, 0, 0, 1, 0, 1, 0, 1 }, /* 1940 */
{ 26, 6, 2, 44, 1, 1, 0, 1, 1, 0, 1, 0, 0, 1, 0, 1, 0 },
{ 45, 0, 3, 49, 1, 0, 1, 1, 0, 1, 0, 1, 0, 1, 0, 1, 0 },
{ 35, 0, 4, 54, 0, 1, 0, 1, 0, 1, 1, 0, 1, 0, 1, 0, 1 },
{ 24, 4, 5, 59, 1, 0, 1, 0, 1, 0, 1, 0, 1, 1, 0, 1, 1 }, /* 1944 */
{ 43, 0, 0, 5, 0, 0, 1, 0, 0, 1, 0, 1, 1, 1, 0, 1, 1 },
{ 32, 0, 1, 10, 1, 0, 0, 1, 0, 0, 1, 0, 1, 1, 0, 1, 1 },
{ 21, 2, 2, 15, 1, 1, 0, 0, 1, 0, 0, 1, 0, 1, 0, 1, 1 },
{ 40, 0, 3, 20, 1, 0, 1, 0, 1, 0, 0, 1, 0, 1, 0, 1, 1 }, /* 1948 */
{ 28, 7, 5, 26, 1, 0, 1, 1, 0, 1, 0, 0, 1, 0, 1, 0, 1 },
{ 47, 0, 6, 31, 0, 1, 1, 0, 1, 1, 0, 0, 1, 0, 1, 0, 1 },
{ 36, 0, 0, 36, 1, 0, 1, 1, 0, 1, 0, 1, 0, 1, 0, 1, 0 },
{ 26, 5, 1, 41, 0, 1, 0, 1, 0, 1, 0, 1, 1, 0, 1, 0, 1 }, /* 1952 */
{ 44, 0, 3, 47, 0, 1, 0, 0, 1, 1, 0, 1, 1, 0, 1, 0, 1 },
{ 33, 0, 4, 52, 1, 0, 1, 0, 0, 1, 0, 1, 1, 0, 1, 1, 0 },
{ 23, 3, 5, 57, 0, 1, 0, 1, 0, 0, 1, 0, 1, 0, 1, 1, 1 },
{ 42, 0, 6, 2, 0, 1, 0, 1, 0, 0, 1, 0, 1, 0, 1, 1, 1 }, /* 1956 */
{ 30, 8, 1, 8, 1, 0, 1, 0, 1, 0, 0, 1, 0, 1, 0, 1, 0 },
{ 48, 0, 2, 13, 1, 1, 1, 0, 1, 0, 0, 1, 0, 1, 0, 1, 0 },
{ 38, 0, 3, 18, 0, 1, 1, 0, 1, 0, 1, 0, 1, 0, 1, 0, 1 },
{ 27, 6, 4, 23, 1, 0, 1, 0, 1, 1, 0, 1, 0, 1, 0, 1, 0 }, /* 1960 */
{ 45, 0, 6, 29, 1, 0, 1, 0, 1, 0, 1, 1, 0, 1, 0, 1, 0 },
{ 35, 0, 0, 34, 0, 1, 0, 0, 1, 0, 1, 1, 0, 1, 1, 0, 1 },
{ 24, 4, 1, 39, 1, 0, 1, 0, 0, 1, 0, 1, 0, 1, 1, 1, 0 },
{ 43, 0, 2, 44, 1, 0, 1, 0, 0, 1, 0, 1, 0, 1, 1, 1, 0 }, /* 1964 */
{ 32, 0, 4, 50, 0, 1, 0, 1, 0, 0, 1, 0, 0, 1, 1, 0, 1 },
{ 20, 3, 5, 55, 1, 1, 1, 0, 1, 0, 0, 1, 0, 0, 1, 1, 0 },
{ 39, 0, 6, 0, 1, 1, 0, 1, 1, 0, 0, 1, 0, 1, 0, 1, 0 },
{ 29, 7, 0, 5, 0, 1, 0, 1, 1, 0, 1, 0, 1, 0, 1, 0, 1 }, /* 1968 */
{ 47, 0, 2, 11, 0, 1, 0, 1, 0, 1, 1, 0, 1, 0, 1, 0, 1 },
{ 36, 0, 3, 16, 1, 0, 0, 1, 0, 1, 1, 0, 1, 1, 0, 1, 0 },
{ 26, 5, 4, 21, 0, 1, 0, 0, 1, 0, 1, 0, 1, 1, 1, 0, 1 },
{ 45, 0, 5, 26, 0, 1, 0, 0, 1, 0, 1, 0, 1, 1, 0, 1, 1 }, /* 1972 */
{ 33, 0, 0, 32, 1, 0, 1, 0, 0, 1, 0, 0, 1, 1, 0, 1, 1 },
{ 22, 4, 1, 37, 1, 1, 0, 1, 0, 0, 1, 0, 0, 1, 1, 0, 1 },
{ 41, 0, 2, 42, 1, 1, 0, 1, 0, 0, 1, 0, 0, 1, 0, 1, 1 },
{ 30, 8, 3, 47, 1, 1, 0, 1, 0, 1, 0, 1, 0, 0, 1, 0, 1 }, /* 1976 */
{ 48, 0, 5, 53, 1, 0, 1, 1, 0, 1, 0, 1, 0, 1, 0, 0, 1 },
{ 37, 0, 6, 58, 1, 0, 1, 1, 0, 1, 1, 0, 1, 0, 1, 0, 1 },
{ 27, 6, 0, 3, 1, 0, 0, 1, 0, 1, 1, 0, 1, 1, 0, 1, 0 },
{ 46, 0, 1, 8, 1, 0, 0, 1, 0, 1, 0, 1, 1, 0, 1, 1, 0 }, /* 1980 */
{ 35, 0, 3, 14, 0, 1, 0, 0, 1, 0, 0, 1, 1, 0, 1, 1, 1 },
{ 24, 4, 4, 19, 1, 0, 1, 0, 0, 1, 0, 0, 1, 0, 1, 1, 1 },
{ 43, 0, 5, 24, 1, 0, 1, 0, 0, 1, 0, 0, 1, 0, 1, 1, 1 },
{ 32, 10, 6, 29, 1, 0, 1, 1, 0, 0, 1, 0, 0, 1, 0, 1, 1 }, /* 1984 */
{ 50, 0, 1, 35, 0, 1, 1, 0, 1, 0, 1, 0, 0, 1, 0, 1, 0 },
{ 39, 0, 2, 40, 0, 1, 1, 0, 1, 1, 0, 1, 0, 1, 0, 0, 1 },
{ 28, 6, 3, 45, 1, 0, 1, 0, 1, 1, 0, 1, 1, 0, 1, 0, 0 },
{ 47, 0, 4, 50, 1, 0, 1, 0, 1, 0, 1, 1, 0, 1, 1, 0, 1 }, /* 1988 */
{ 36, 0, 6, 56, 1, 0, 0, 1, 0, 0, 1, 1, 0, 1, 1, 1, 0 },
{ 26, 5, 0, 1, 0, 1, 0, 0, 1, 0, 0, 1, 0, 1, 1, 1, 1 },
{ 45, 0, 1, 6, 0, 1, 0, 0, 1, 0, 0, 1, 0, 1, 1, 1, 0 },
{ 34, 0, 2, 11, 0, 1, 1, 0, 0, 1, 0, 0, 1, 0, 1, 1, 0 }, /* 1992 */
{ 22, 3, 4, 17, 0, 1, 1, 0, 1, 0, 1, 0, 0, 1, 0, 1, 0 },
{ 40, 0, 5, 22, 1, 1, 1, 0, 1, 0, 1, 0, 0, 1, 0, 1, 0 },
{ 30, 8, 6, 27, 0, 1, 1, 0, 1, 0, 1, 1, 0, 0, 1, 0, 1 },
{ 49, 0, 0, 32, 0, 1, 0, 1, 1, 0, 1, 0, 1, 1, 0, 0, 1 }, /* 1996 */
{ 37, 0, 2, 38, 1, 0, 1, 0, 1, 0, 1, 1, 0, 1, 1, 0, 1 },
{ 27, 5, 3, 43, 1, 0, 0, 1, 0, 0, 1, 1, 0, 1, 1, 0, 1 },
{ 46, 0, 4, 48, 1, 0, 0, 1, 0, 0, 1, 0, 1, 1, 1, 0, 1 },
{ 35, 0, 5, 53, 1, 1, 0, 0, 1, 0, 0, 1, 0, 1, 1, 0, 1 }, /* 2000 */
{ 23, 4, 0, 59, 1, 1, 0, 1, 0, 1, 0, 0, 1, 0, 1, 0, 1 },
{ 42, 0, 1, 4, 1, 1, 0, 1, 0, 1, 0, 0, 1, 0, 1, 0, 1 },
{ 31, 0, 2, 9, 1, 1, 0, 1, 1, 0, 1, 0, 0, 1, 0, 1, 0 },
{ 21, 2, 3, 14, 0, 1, 0, 1, 1, 0, 1, 0, 1, 0, 1, 0, 1 }, /* 2004 */
{ 39, 0, 5, 20, 0, 1, 0, 1, 0, 1, 1, 0, 1, 0, 1, 0, 1 },
{ 28, 7, 6, 25, 1, 0, 1, 0, 1, 0, 1, 0, 1, 1, 0, 1, 1 },
{ 48, 0, 0, 30, 0, 0, 1, 0, 0, 1, 0, 1, 1, 1, 0, 1, 1 },
{ 37, 0, 1, 35, 1, 0, 0, 1, 0, 0, 1, 0, 1, 1, 0, 1, 1 }, /* 2008 */
{ 25, 5, 3, 41, 1, 1, 0, 0, 1, 0, 0, 1, 0, 1, 0, 1, 1 },
{ 44, 0, 4, 46, 1, 0, 1, 0, 1, 0, 0, 1, 0, 1, 0, 1, 1 },
{ 33, 0, 5, 51, 1, 0, 1, 1, 0, 1, 0, 0, 1, 0, 1, 0, 1 },
{ 22, 4, 6, 56, 1, 0, 1, 1, 0, 1, 0, 1, 0, 1, 0, 1, 0 }, /* 2012 */
{ 40, 0, 1, 2, 1, 0, 1, 1, 0, 1, 0, 1, 0, 1, 0, 1, 0 },
{ 30, 9, 2, 7, 0, 1, 0, 1, 0, 1, 0, 1, 1, 0, 1, 0, 1 },
{ 49, 0, 3, 12, 0, 1, 0, 0, 1, 0, 1, 1, 1, 0, 1, 0, 1 },
{ 38, 0, 4, 17, 1, 0, 1, 0, 0, 1, 0, 1, 1, 0, 1, 1, 0 }, /* 2016 */
{ 27, 6, 6, 23, 0, 1, 0, 1, 0, 0, 1, 0, 1, 0, 1, 1, 1 },
{ 46, 0, 0, 28, 0, 1, 0, 1, 0, 0, 1, 0, 1, 0, 1, 1, 0 },
{ 35, 0, 1, 33, 0, 1, 1, 0, 1, 0, 0, 1, 0, 0, 1, 1, 0 },
{ 24, 4, 2, 38, 0, 1, 1, 1, 0, 1, 0, 0, 1, 0, 1, 0, 1 }, /* 2020 */
{ 42, 0, 4, 44, 0, 1, 1, 0, 1, 0, 1, 0, 1, 0, 1, 0, 1 },
{ 31, 0, 5, 49, 1, 0, 1, 0, 1, 1, 0, 1, 0, 1, 0, 1, 0 },
{ 21, 2, 6, 54, 0, 1, 0, 1, 0, 1, 0, 1, 1, 0, 1, 0, 1 },
{ 40, 0, 0, 59, 0, 1, 0, 0, 1, 0, 1, 1, 0, 1, 1, 0, 1 }, /* 2024 */
{ 28, 6, 2, 5, 1, 0, 1, 0, 0, 1, 0, 1, 0, 1, 1, 1, 0 },
{ 47, 0, 3, 10, 1, 0, 1, 0, 0, 1, 0, 0, 1, 1, 1, 0, 1 },
{ 36, 0, 4, 15, 1, 1, 0, 1, 0, 0, 1, 0, 0, 1, 1, 0, 1 },
{ 25, 5, 5, 20, 1, 1, 1, 0, 1, 0, 0, 1, 0, 0, 1, 1, 0 }, /* 2028 */
{ 43, 0, 0, 26, 1, 1, 0, 1, 0, 1, 0, 1, 0, 0, 1, 0, 1 },
{ 32, 0, 1, 31, 1, 1, 0, 1, 1, 0, 1, 0, 1, 0, 1, 0, 0 },
{ 22, 3, 2, 36, 0, 1, 1, 0, 1, 0, 1, 1, 0, 1, 0, 1, 0 } };

#define lastyear (firstyear+sizeof(lunarcal)/sizeof(struct taglunarcal)-1)/* 西历年每月之日数 */
int solarcal[12] = { 31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31 };/* 西历年每月之累积日数, 平年与闰年 */
int solardays[2][14] = {
{ 0, 31, 59, 90, 120, 151, 181, 212, 243, 273, 304, 334, 365, 396 },
{ 0, 31, 60, 91, 121, 152, 182, 213, 244, 274, 305, 335, 366, 397 } };/* 求此西历年是否为闰年, 返回 0 为平年, 1 为闰年 */
int getleap( int year )
{
if ( year % 400 == 0 )
return 1;
else if ( year % 100 == 0 )
return 0;
else if ( year % 4 == 0 )
return 1;
else
return 0;
}/* 西历农历转换 */
int calconv( struct convdate *cd )
{
int leap, d, sm, y, im, l1, l2, acc, i, lm, kc;
if ( cd->source == 0 ) /* solar */
{
if ( cd->solaryear <= firstyear || cd->solaryear > lastyear )
return 1;
sm = cd->solarmonth - 1;
if ( sm < 0 || sm > 11 )
return 2;
leap = getleap( cd->solaryear );
if ( sm == 1 )
d = leap + 28;
else
d = solarcal[sm];
if ( cd->solardate < 1 || cd->solardate > d )
return 3;
y = cd->solaryear - firstyear;
acc = solardays[leap][sm] + cd->solardate;
cd->weekday = ( acc + lunarcal[y].baseweekday ) % 7;
kc = acc + lunarcal[y].basekanchih;
cd->kan = kc % 10;
cd->chih = kc % 12;
if ( acc <= lunarcal[y].basedays )
{
y--;
cd->lunaryear = cd->solaryear - 1;
leap = getleap( cd->lunaryear );
sm += 12;
acc = solardays[leap][sm] + cd->solardate;
}
else
cd->lunaryear = cd->solaryear;
l1 = lunarcal[y].basedays;
for ( i=0; i<13; i++ )
{
l2 = l1 + lunarcal[y].monthdays[i] + 29;
if ( acc <= l2 )
break;
l1 = l2;
}
cd->lunarmonth = i + 1;
cd->lunardate = acc - l1;
im = lunarcal[y].intercalation;
if ( im != 0 && cd->lunarmonth > im )
{
cd->lunarmonth--;
if ( cd->lunarmonth == im )
cd->lunarmonth = -im;
}
if ( cd->lunarmonth > 12 )
cd->lunarmonth -= 12;
}
else /* lunar */
{
if ( cd->lunaryear < firstyear || cd->lunaryear >= lastyear )
return 1;
y = cd->lunaryear - firstyear;
im = lunarcal[y].intercalation;
lm = cd->lunarmonth;
if ( lm < 0 )
{
if ( lm != -im )
return 2;
}
else if ( lm < 1 || lm > 12 )
return 2;
if ( im != 0 )
{
if ( lm > im )
lm++;
else if ( lm == -im )
lm = im + 1;
}
lm--;
if ( cd->lunardate > lunarcal[y].monthdays[lm] + 29 )
return 3;
acc = lunarcal[y].basedays;
for ( i=0; i acc += lunarcal[y].monthdays[i] + 29;
acc += cd->lunardate;
leap = getleap( cd->lunaryear );
for ( i=13; i>=0; i-- )
if ( acc > solardays[leap][i] )
break;
cd->solardate = acc - solardays[leap][i];
if ( i <= 11 )
{
cd->solaryear = cd->lunaryear;
cd->solarmonth = i + 1;
}
else
{
cd->solaryear = cd->lunaryear + 1;
cd->solarmonth = i - 11;
}
leap = getleap( cd->solaryear );
y = cd->solaryear - firstyear;
acc = solardays[leap][cd->solarmonth-1] + cd->solardate;
cd->weekday = ( acc + lunarcal[y].baseweekday ) % 7;
kc = acc + lunarcal[y].basekanchih;
cd->kan = kc % 10;
cd->chih = kc % 12;
}
return 0;
}

以前一个贴子里我COPY下来的，希望对你有用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'星期名
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'获取当前系统时间
curTime = Now()'生成当前公历年、月、日 ==> GongliStr
curYear = Year(curTime)
curMonth = Month(curTime)
curDay = Day(curTime)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 = 0Do
　　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
LoopcurYear = 1921 + m
curMonth = k - n + 1
curDay = TheDateIf (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 ifEnd If

Private Sub Command1_Click()
    '写个代码，只是一个较笨的思路，没来得及仔细检查，有些误差


    '1931-2-27: 农历羊年/辛未/正月初一
    '说明：
    '农历小月以0表示，大月以1表示
    '闰月小月以2表示，闰月大月以3表示
    Dim Noli(119) As String    Noli(0) = "110101001010"    '1931
    Noli(1) = "111010100101"    '1932
    Noli(2) = "0110130101001"    '1933
    Noli(3) = "010110101101"    '1934
    Noli(4) = "001010110110"    '1935
    Noli(5) = "1003001101110"    '1936
    Noli(6) = "100100101110"    '1937
    Noli(7) = "1100100301101"    '1938
    Noli(8) = "110010010101"    '1939
    Noli(9) = "110101001010"    '1940
    Noli(10) = "1101103001010"    '1941
    Noli(11) = "101101010101"    '1942
    Noli(12) = "010101101010"    '1943
    Noli(13) = "1013101011011"    '1944
    Noli(14) = "001001011101"    '1945
    Noli(15) = "100100101101"    '1946
    Noli(16) = "1100102101011"    '1947
    Noli(17) = "101010010101"    '1948
    Noli(18) = "1011010210101"    '1949
    Noli(19) = "011011001010"    '1950
    Noli(20) = "101101010101"    '1951
    Noli(21) = "0101030110101"    '1952
    Noli(22) = "010011011010"    '1953
    Noli(23) = "101001011011"    '1954
    Noli(24) = "0103001010111"    '1955
    Noli(25) = "010100101011"    '1956
    Noli(26) = "1010100121010"    '1957
    Noli(27) = "111010010101"    '1958
    Noli(28) = "011010101010"    '1959
    Noli(29) = "1010112101010"    '1960
    Noli(30) = "101010110101"    '1961
    Noli(31) = "010010110110"    '1962
    Noli(32) = "1012010101110"    '1963
    Noli(33) = "101001010111"    '1964
    Noli(34) = "010100100110"    '1965
    Noli(35) = "1112100100110"    '1966
    Noli(36) = "110110010101"    '1967
    Noli(37) = "0101101210101"    '1968
    Noli(38) = "010101101010"    '1969
    Noli(39) = "100101101101"    '1970
    Noli(40) = "0100121011101"    '1971
    Noli(41) = "010010101101"    '1972
    Noli(42) = "101001001101"    '1973
    Noli(43) = "1101201001101"    '1974
    Noli(44) = "110100100101"    '1975
    Noli(45) = "1101010120101"    '1976
    Noli(46) = "101101010100"    '1977
    Noli(47) = "101101101010"    '1978
    Noli(48) = "1001013011010"    '1979
    Noli(49) = "100101011011"    '1980
    Noli(50) = "010010011011"    '1981
    Noli(51) = "1010210010111"    '1982
    Noli(52) = "101001001011"    '1983
    Noli(53) = "1011001001211"    '1984
    Noli(54) = "011010100101"    '1985
    Noli(55) = "011011010100"    '1986
    Noli(56) = "1010112110100"    '1987
    Noli(57) = "101010110110"    '1988
    Noli(58) = "100101010111"    '1989
    Noli(59) = "0100120101111"    '1990
    Noli(60) = "010010010111"    '1991
    Noli(61) = "011001001011"    '1992
    Noli(62) = "0112101001010"    '1993
    Noli(63) = "111010100101"    '1994
    Noli(64) = "0110101120101"    '1995
    Noli(65) = "010110101100"    '1996
    Noli(66) = "101010110110"    '1997
    Noli(67) = "1001021101101"    '1998
    Noli(68) = "100100101110"    '1999
    Noli(69) = "110010010110"    '2000
    Noli(70) = "1101210010101"    '2001
    Noli(71) = "110101001010"    '2002
    Noli(72) = "110110100101"    '2003
    Noli(73) = "0121101010101"    '2004
    Noli(74) = "010101101010"    '2005
    Noli(75) = "1010101211011"    '2006
    Noli(76) = "001001011101"    '2007
    Noli(77) = "100100101101"    '2008
    Noli(78) = "1100120101011"    '2009
    Noli(79) = "101010010101"    '2010
    Noli(80) = "101101001010"    '2011
    Noli(81) = "1011210101010"    '2012
    Noli(82) = "101101010101"    '2013
    Noli(83) = "0101010112101"    '2014
    Noli(84) = "010010111010"    '2015
    Noli(85) = "101001011011"    '2016
    Noli(86) = "0101003010111"    '2017
    Noli(87) = "010100101011"    '2018
    Noli(88) = "101010010011"    '2019
    Noli(89) = "0111210010101"    '2020
    Noli(90) = "011010101010"    '2021
    Noli(91) = "101011010101"    '2022
    Noli(92) = "0120110110101"    '2023
    Noli(93) = "010010110110"    '2024
    Noli(94) = "1010012101110"    '2025
    Noli(95) = "101001001110"    '2026
    Noli(96) = "110100100110"    '2027
    Noli(97) = "1110120100110"    '2028
    Noli(98) = "110101010011"    '2029
    Noli(99) = "010110101010"    '2030
    Noli(100) = "0112101101010"    '2031
    Noli(101) = "100101101101"    '2032
    Noli(102) = "0100101211101"    '2033
    Noli(103) = "010011101101"    '2034
    Noli(104) = "101001001101"    '2035
    Noli(105) = "1101003001011"    '2036
    Noli(106) = "110100100101"    '2037
    Noli(107) = "110101010010"    '2038
    Noli(108) = "1101121010100"    '2039
    Noli(109) = "101101011010"    '2040
    Noli(110) = "010101101101"    '2041
    Noli(111) = "0120101011101"    '2042
    Noli(112) = "101000011011"    '2043
    Noli(113) = "1010010210111"    '2044
    Noli(114) = "101001001011"    '2045
    Noli(115) = "101010100101"    '2046
    Noli(116) = "1011030100101"    '2047
    Noli(117) = "011011010010"    '2048
    Noli(118) = "101011011010"    '2049
    Noli(119) = "0103010110110"    '2050

'计算农历当前日期到公历1931-1-1的天数
    Dim iYear As Integer, iMon As Integer, iDay As Integer

    '农历的年，如癸未年对应2003
    iYear = 2003
    '农历的月，如正月对应1，冬月第对应11，闰月用负数，如闰三月就是-3
    iMon = 7
    '农历的日，如初一对应1，廿五对应25
    iDay = 1

    Dim logDay As Long
    Dim i As Integer
    Dim ii As Integer
    Dim s As String

    If iYear < 1931 Or iYear > 2050 Then MsgBox "年份超出范围！"

    For i = 0 To (iYear - 1932) Step 1
        For ii = 1 To Len(Noli(i))
            s = Mid(Noli(i), ii, 1)
            logDay = logDay + 29 + (CInt(s) Mod 2)
        Next ii
    Next i

    '闰月数
    If Len(Noli(iYear - 1931)) = 13 Then
        For i = 1 To 13
            s = Mid(Noli(iYear - 1931), i, 1)
            If CInt(s) > 1 Then
                ii = i - 1
                Exit For
            Else
                ii = 0
            End If
        Next
    End If

    If iMon < 0 Then
        If Abs(iMon) = ii Then
            iMon = Abs(iMon) + 1
        Else
            MsgBox "本年度农历无此闰月！"
            Exit Sub
        End If
    ElseIf iMon > ii Then
        iMon = iMon + 1
    End If

    If iMon > 1 Then
        For i = 1 To iMon - 1
            s = Mid(Noli(iYear - 1931), i, 1)
            logDay = logDay + 29 + (CInt(s) Mod 2)
        Next
    End If

    If CInt(Mid(Noli(iYear - 1931), iMon, 1)) Mod 2 = 0 And _
        iDay > 29 Or iDay < 1 Then

        MsgBox "本月没有这一天！"
    End If

    logDay = logDay + iDay + 42

    '----------------------------------------------------
    iYear = 1931
    iMon = 0
    iDay = 0

    Do Until logDay < 365
        If iYear Mod 4 = 0 Then
            i = 366
        Else
            i = 365
        End If
        logDay = logDay - i
        iYear = iYear + 1
    Loop

    If logDay > 31 Then
        logDay = logDay - 31
        iMon = 2
    End If
    If logDay > 28 Then
        logDay = logDay - 28
        iMon = 3
    End If
    If logDay > 31 Then
        logDay = logDay - 31
        iMon = 4
    End If
    If logDay > 30 Then
        logDay = logDay - 28
        iMon = 5
    End If
    If logDay > 31 Then
        logDay = logDay - 31
        iMon = 6
    End If
    If logDay > 30 Then
        logDay = logDay - 28
        iMon = 7
    End If
    If logDay > 31 Then
        logDay = logDay - 31
        iMon = 8
    End If
    If logDay > 31 Then
        logDay = logDay - 31
        iMon = 9
    End If
    If logDay > 30 Then
        logDay = logDay - 31
        iMon = 10
    End If
    If logDay > 31 Then
        logDay = logDay - 31
        iMon = 11
    End If
    If logDay > 30 Then
        logDay = logDay - 31
        iMon = 12
    End If

    MsgBox "公历日期：" & iYear & "年" & iMon & "月" & logDay & "日"

End Sub

VB计算农历的算法
'下面是一个关于VB的农历算法
'日期数据定义方法如下
'前12个字节代表1-12月为大月或是小月，1为大月30天，0为小月29天，
'第13位为闰月的情况，1为大月30天，0为小月29天，第14位为闰月的月
'份，如果不是闰月为0，否则给出月份，10、11、12分别用A、B、C来表
'示，即使用16进制。最后4位为当年家农历新年-即农历1月1日所在公历
'的日期，如0131代表1月31日。
'GetYLDate函数使用方式如下tYear为要输入的年，tMonth为月，tDay为
'日期，YLyear是返回值，返加农历的年份，如甲子年，YLShuXing返回
'的是属象，如鼠。IsGetGl是设置是不是通过农历取公历值，如果是，
'前三个返回相应的公历日期，而且返回值是一个公历日期。Function GetYLDate(tYear As Integer, tMonth As Integer, tDay As Integer, _
                    YLyear As String, YLShuXing As String, _
                    Optional IsGetGl As Boolean) As String    On Error Resume Next
    Dim daList(1900 To 2011) As String * 18
    Dim conDate As Date, setDate As Date
    Dim AddMonth As Integer, AddDay As Integer, AddYear As Integer, getDay As Integer
    Dim RunYue As Boolean
    If tYear > 2010 Or tYear < 1901 Then Exit Function '如果不是有效有日期，退出
    '1900 to 1909
    daList(1900) = "010010110110180131"
    daList(1901) = "010010101110000219"
    daList(1902) = "101001010111000208"
    daList(1903) = "010100100110150129"
    daList(1904) = "110100100110000216"
    daList(1905) = "110110010101000204"
    daList(1906) = "011010101010140125"
    daList(1907) = "010101101010000213"
    daList(1908) = "100110101101000202"
    daList(1909) = "010010101110120122"
    daList(1910) = "010010101110000210"
    daList(1911) = "101001001101160130"
    daList(1912) = "101001001101000218"
    daList(1913) = "110100100101000206"
    daList(1914) = "110101010100150126"
    daList(1915) = "101101010101000214"
    daList(1916) = "010101101010000204"
    daList(1917) = "100101101101020123"
    daList(1918) = "100101011011000211"
    daList(1919) = "010010011011170201"
    daList(1920) = "010010011011000220"
    daList(1921) = "101001001011000208"
    daList(1922) = "101100100101150128"
    daList(1923) = "011010100101000216"
    daList(1924) = "011011010100000205"
    daList(1925) = "101011011010140124"
    daList(1926) = "001010110110000213"
    daList(1927) = "100101010111000202"
    daList(1928) = "010010010111120123"
    daList(1929) = "010010010111000210"
    daList(1930) = "011001001011060130"
    daList(1931) = "110101001010000217"
    daList(1932) = "111010100101000206"
    daList(1933) = "011011010100150126"
    daList(1934) = "010110101101000214"
    daList(1935) = "001010110110000204"
    daList(1936) = "100100110111030124"
    daList(1937) = "100100101110000211"
    daList(1938) = "110010010110170131"
    daList(1939) = "110010010101000219"
    daList(1940) = "110101001010000208"
    daList(1941) = "110110100101060127"
    daList(1942) = "101101010101000215"
    daList(1943) = "010101101010000205"
    daList(1944) = "101010101101140125"
    daList(1945) = "001001011101000213"
    daList(1946) = "100100101101000202"
    daList(1947) = "110010010101120122"
    daList(1948) = "101010010101000210"
    daList(1949) = "101101001010170129"
    daList(1950) = "011011001010000217"
    daList(1951) = "101101010101000206"
    daList(1952) = "010101011010150127"
    daList(1953) = "010011011010000214"
    daList(1954) = "101001011011000203"
    daList(1955) = "010100101011130124"
    daList(1956) = "010100101011000212"
    daList(1957) = "101010010101080131"
    daList(1958) = "111010010101000218"
    daList(1959) = "011010101010000208"
    daList(1960) = "101011010101060128"
    daList(1961) = "101010110101000215"
    daList(1962) = "010010110110000205"
    daList(1963) = "101001010111040125"
    daList(1964) = "101001010111000213"
    daList(1965) = "010100100110000202"
    daList(1966) = "111010010011030121"
    daList(1967) = "110110010101000209"
    daList(1968) = "010110101010170130"
    daList(1969) = "010101101010000217"
    daList(1970) = "100101101101000206"
    daList(1971) = "010010101110150127"
    daList(1972) = "010010101101000215"
    daList(1973) = "101001001101000203"
    daList(1974) = "110100100110140123"
    daList(1975) = "110100100101000211"
    daList(1976) = "110101010010180131"
    daList(1977) = "101101010100000218"
    daList(1978) = "101101101010000207"
    daList(1979) = "100101101101060128"
    daList(1980) = "100101011011000216"
    daList(1981) = "010010011011000205"
    daList(1982) = "101001001011140125"
    daList(1983) = "101001001011000213"
    daList(1984) = "1011001001011A0202"
    daList(1985) = "011010100101000220"
    daList(1986) = "011011010100000209"
    daList(1987) = "101011011010060129"
    daList(1988) = "101010110110000217"
    daList(1989) = "100100110111000206"
    daList(1990) = "010010010111150127"
    daList(1991) = "010010010111000215"
    daList(1992) = "011001001011000204"
    daList(1993) = "011010100101030123"
    daList(1994) = "111010100101000210"
    daList(1995) = "011010110010180131"
    daList(1996) = "010110101100000219"
    daList(1997) = "101010110110000207"
    daList(1998) = "100100110110150128"
    daList(1999) = "100100101110000216"
    daList(2000) = "110010010110000205"
    daList(2001) = "110101001010140124"
    daList(2002) = "110101001010000212"
    daList(2003) = "110110100101000201"
    daList(2004) = "010110101010120122"
    daList(2005) = "010101101010000209"
    daList(2006) = "101010101101170129"
    daList(2007) = "001001011101000218"
    daList(2008) = "100100101101000207"
    daList(2009) = "110010010101150126"
    daList(2010) = "101010010101000214"
    daList(2011) = "101101001010000214"
    AddYear = tYear
    RunYue = False

    If IsGetGl Then
        AddMonth = Val(Mid(daList(AddYear), 15, 2))
        AddDay = Val(Mid(daList(AddYear), 17, 2))
        conDate = DateSerial(AddYear, AddMonth, AddDay)
        AddDay = tDay
        For i = 1 To tMonth - 1
            AddDay = AddDay + 29 + Val(Mid(daList(tYear), i, 1))
        Next i
        'MsgBox DateDiff("d", conDate, Date)
        setDate = DateAdd("d", AddDay - 1, conDate)
        GetYLDate = setDate
        tYear = Year(setDate)
        tMonth = Month(setDate)
        tDay = Day(setDate)
        Exit Function
    End If
CHUSHIHUA:
    AddMonth = Val(Mid(daList(AddYear), 15, 2))
    AddDay = Val(Mid(daList(AddYear), 17, 2))
    conDate = DateSerial(AddYear, AddMonth, AddDay)
    setDate = DateSerial(tYear, tMonth, tDay)
    getDay = DateDiff("d", conDate, setDate)
    If getDay < 0 Then AddYear = AddYear - 1: GoTo CHUSHIHUA
   ' addday = NearDay
   AddDay = 1: AddMonth = 1
    For i = 1 To getDay
        AddDay = AddDay + 1
        If AddDay = 30 + Mid(daList(AddYear), AddMonth, 1) Or (RunYue And AddDay = 30 + Mid(daList(AddYear), 13, 1)) Then
            If RunYue = False And AddMonth = Val("&H" & Mid(daList(AddYear), 14, 1)) Then
                RunYue = True
            Else
                RunYue = False
                AddMonth = AddMonth + 1
            End If
            AddDay = 1
        End If

    Next

    md$ = "初一初二初三初四初五初六初七初八初九初十十一十二十三十四十五十六十七十八十九二十廿一廿二廿三廿四廿五廿六廿七廿八廿九三十"
    dd$ = Mid(md$, (AddDay - 1) * 2 + 1, 2)
    mm$ = Mid("正二三四五六七八九十寒腊", AddMonth, 1) + "月"
    YouGetDate = DateSerial(AddYear, AddMonth, AddDay)
    tiangan$ = "甲乙丙丁戊已庚辛壬癸"
    dizhi$ = "子丑寅卯辰巳午未申酉戌亥"
    Dim ganzhi(0 To 59) As String * 2
    For i = 0 To 59
     ganzhi(i) = Mid(tiangan$, (i Mod 10) + 1, 1) + Mid(dizhi$, (i Mod 12) + 1, 1)
    'ff$ = ff$ + ganzhi(i)
    Next i
    'MsgBox ff$, , Len(ff$)
    YLyear = ganzhi((AddYear - 4) Mod 60)
    shu$ = "鼠牛虎兔龙蛇马羊猴鸡狗猪"
    YLShuXing = Mid(shu$, ((AddYear - 4) Mod 12) + 1, 1)
    If RunYue Then mm$ = "闰" + mm$

    GetYLDate = mm$ + dd$End Function

调试易

还是“农转非”的问题，400分了！UP有分！要代码！

解决方案 »