关于农历的东西！

  2010-11-28

 

   这两天试做一个日历，包含农历数据，关于取农历的代码是在梅子论坛下载的，我是这样取农历数据的：

   QD='20101128' &&传递的日期

   TBNN=''  &&取回的农历日期

   SHEN=''  &&取回的生肖

   JIEQI=''  &&取回的节气

   JIERI=''  &&取回的节日

 

   DO NN WITH QD,TBNN,SHEN,JIEQI,JIERI

 

   发现一个月31天，全部取回要几秒时间，而看到别人的程序是瞬间就解决了，不知道是不是自己的方法有问题，看了一那个源码，发现每   次去取数据，都要建临时表，不知里面的代码能不能优化，准备在论坛发帖请教，记得论坛的发帖有字数限制，所以源码怕难发，就 放在这 里：

 

  PARA QD,TBNN,SHEN,JIEQI,JIERI

  = GetCalendar(QD)
  TBNN=cLunarY + [年 ] + iif(IsLeap,[闰],[  ]) + GetLunarMonthName(nLunarM) + [月 ] + GetLunarDayName(nLunarD) + [日]

  JIEQI=cJieQi
  JIERI=Subs(cJieRi,2)
  SHEN=cAniName

 

 RETU

 

*****************下面是源代码********************************

 

* ------------------------------------------------ * 程序: 获取 年历、月历、日历 到临时表 * 字段: d公历,n星期,l闰月,n农历年,n农历月,n农历日,c年柱,c月柱,c日柱,c节气,c生肖,c星座,c节日 * 设计: 红雨 * 日期: 2003年10月30日 * 修改: 2003年11月01日 * 感谢: lukapp、BN * ------------------------------------------------ * 调用示例: * ------------------------------------------------ *Clear * 1、农历 -> 公历 *? [农历 2050.03.10 = 公历], GetSolarFromLunar( 2050, 03, 10, .F. ) *? [农历 闰2050.03.10 = 公历], GetSolarFromLunar( 2050, 03, 10, .T. ) * 2、公历 -> 农历 Local lnLunarY, lnLunarM, lnLunarD, llIsLeap lnLunarY = 2050 lnLunarM = 04 lnLunarD = 01 llIsLeap = .F. *If GetLunarFromSolar( @lnLunarY, @lnLunarM, @lnLunarD, @llIsLeap ) * ? [公历 2050.04.01 = 农历 ] + iif(llIsLeap,[闰],[ ]) + padl(lnLunarY,4,[0])+[.]+padl(lnLunarM,2,[0])+[.]+padl(lnLunarD,2,[0]) *Endif lnLunarY = 2050 lnLunarM = 04 lnLunarD = 30 llIsLeap = .F. *If GetLunarFromSolar( @lnLunarY, @lnLunarM, @lnLunarD, @llIsLeap ) *? [公历 2050.04.30 = 农历 ] + iif(llIsLeap,[闰],[ ]) + padl(lnLunarY,4,[0])+[.]+padl(lnLunarM,2,[0])+[.]+padl(lnLunarD,2,[0]) *Endif * 3、获取日历 *? [----------------------------] *? [ 公历: ] + Transform(DToS(dSolar)+[ ],[@R 9999年99月99日]) *? [ 星座: ] + cStarName *? [ 星期: ] + subs( [一二三四五六日], nWeek*2-1, 2 ) *? [ 农历: ] + cLunarY + [年 ] + iif(IsLeap,[闰],[ ]) + GetLunarMonthName(nLunarM) + [月 ] + GetLunarDayName(nLunarD) + [日] *? [ 干支. ] + cLunarY + [年 ] + cLunarM + [月 ] + cLunarD + [日] *? [ 节气: ] + cJieQi *? [ 生肖: ] + cAniName *? [ 节日: ] + Subs(cJieRi,2) *? [----------------------------] *TBNN=cLunarY + [年 ] + iif(IsLeap,[闰],[ ]) + GetLunarMonthName(nLunarM) + [月 ] + GetLunarDayName(nLunarD) + [日] *TBCC=cJieQi+' '+Subs(cJieRi,2) *JIEQI=cJieQi *JIERI=Subs(cJieRi,2) *TBNN=LTRI(TRIM(TBNN))+' '+LTRI(TRIM(TBCC)) **@ 10,20 SAY TBNN *@ 12,20 SAY QD+'...' *K=INKEY(0) *USE ZJE *REPL 农历 WITH TBNN,公历 WITH QD * 4、获取月历 *= GetCalendar(QD) * 5、获取年历 *= GetCalendar( [2003] ) *SHEN=cAniName *Return *------------------------------------------------- * 程序: 添加日历到临时表 * 示例: ? GetCalendar( [200310] ) *------------------------------------------------- Function GetCalendar( tcYYYYMMDD, tcCursName ) Local lcYYYYMMDD, lcCursName, ldEasterDate lcYYYYMMDD = [] lcYYYYMMDD = iif(Type([tcYYYYMMDD])$[DT], DToS(tcYYYYMMDD), lcYYYYMMDD ) lcYYYYMMDD = iif(Type([tcYYYYMMDD])==[C], Allt(tcYYYYMMDD), lcYYYYMMDD ) If empt(lcYYYYMMDD) Return .F. Else lcCursName = iif(Type([tcCursName])=[C] and !empt(tcCursName), tcCursName, [TCalendar_]+lcYYYYMMDD ) If Used(lcCursName) Use in (lcCursName) Endif If len(lcYYYYMMDD) >= 4 ldEasterDate = GetEasterDate(Val(Left(lcYYYYMMDD,4))) * 字段: d公历,n星期,l闰月,n农历年,n农历月,n农历日,c农历年,c农历月,c农历日,c节气,c生肖,c节日 Crea Curs (lcCursName) ( dSolar D, nWeek N(1), IsLeap L, ; nLunarY N(4), nLunarM N(2), nLunarD N(2), ; cLunarY C(4), cLunarM C(4), cLunarD C(4), ; cJieQi C(4), cAniName C(2), cStarName C(6), cJieRi C(100) ) Do case Case len(lcYYYYMMDD) = 4 = InsCalendarFromYear( lcCursName, lcYYYYMMDD, ldEasterDate ) Case len(lcYYYYMMDD) = 6 = InsCalendarFromMonth( lcCursName, lcYYYYMMDD, ldEasterDate ) Case len(lcYYYYMMDD) = 8 = InsCalendarFromDate( lcCursName, lcYYYYMMDD, ldEasterDate ) Other Endcase Endif Return Used(lcCursName) and Recc(lcCursName)>0 Endif Endfunc *------------------------------------------------- * 程序: 添加日历年份记录 * 示例: ? InsCalendarFromYear( [TempCalendar], [2003] ) *------------------------------------------------- Function InsCalendarFromYear( tcCursName, tcYYYY, tdEasterDate ) If Type([tcCursName])=[C] and Used(tcCursName) If Type([tcYYYY])=[C] and !empt(tcYYYY) ldEasterDate = iif( Type([tdEasterDate])=[D], tdEasterDate, GetEasterDate(Val(Left(tcYYYY,4))) ) Local lcYYYY, ldDate If Type([tcYYYY])=[C] lcYYYY = Padl(tcYYYY,4,[0]) Else If Type([tcYYYY])=[N] lcYYYY = Padl(allt(str(cYYYY)),4,[0]) Endif Endif ldDate = CToD( lcYYYY + [.01.01] ) If !empt(ldDate) Local liYear, liMonth, liDay Local lnLunarY, lnLunarM, lnLunarD, lnLunarDays liYear = Year(ldDate) Store 0 To lnLunarY, lnLunarM, lnLunarD, lnLunarDays Do While liYear = Year(ldDate) liMonth = Month(ldDate) lnLunarD = lnLunarD + 1 If lnLunarDays < lnLunarD = InsCalendarFromDate( tcCursName, ldDate, ldEasterDate ) Sele (tcCursName) lnLunarY = nLunarY lnLunarM = nLunarM lnLunarD = nLunarD llIsLeap = IsLeap If llIsLeap lnLunarDays = GetLunarLeapDays( lnLunarY ) Else lnLunarDays = GetLunarMonthDays( lnLunarY, lnLunarM ) Endif Else = InsCalendar( tcCursName, ldDate, llIsLeap, lnLunarY, lnLunarM, lnLunarD, ldEasterDate ) Endif ldDate = ldDate + 1 Enddo Endif Endif Endif Endfunc *------------------------------------------------- * 程序: 添加日历月份记录 * 示例: ? InsCalendarFromMonth( [TempCalendar], [200310] ) *------------------------------------------------- Function InsCalendarFromMonth( tcCursName, tcYYYYMM, tdEasterDate ) If Type([tcCursName])=[C] and Used(tcCursName) If Type([tcYYYYMM])=[C] and !empt(tcYYYYMM) ldEasterDate = iif( Type([tdEasterDate])=[D], tdEasterDate, GetEasterDate(Val(Left(tcYYYYMM,4))) ) Local ldDate, liYear, liMonth, liDay ldDate = CToD( subs(tcYYYYMM,1,4) + [.] + subs(tcYYYYMM,5,2) + [.01] ) If !empt(ldDate) liYear = Year(ldDate) liMonth = Month(ldDate) lnSolarDays = GetSolarMonthDays( ldDate ) Local lnLunarY, lnLunarM, lnLunarD, llIsLeap, lnLunarDays Store 0 To lnLunarY, lnLunarM, lnLunarD, lnLunarDays Do While liMonth = Month(ldDate) lnLunarD = lnLunarD + 1 If lnLunarDays < lnLunarD = InsCalendarFromDate( tcCursName, ldDate, ldEasterDate ) Sele (tcCursName) lnLunarY = nLunarY lnLunarM = nLunarM lnLunarD = nLunarD llIsLeap = IsLeap If llIsLeap lnLunarDays = GetLunarLeapDays( lnLunarY ) Else lnLunarDays = GetLunarMonthDays( lnLunarY, lnLunarM ) Endif Else = InsCalendar( tcCursName, ldDate, llIsLeap, lnLunarY, lnLunarM, lnLunarD, ldEasterDate ) Endif ldDate = ldDate + 1 Enddo Endif Endif Endif Endfunc *------------------------------------------------- * 程序: 添加日历日期记录 * 示例: ? InsCalendarFromDate( [TempCalendar], Date(2003,10,01) ) * ? InsCalendarFromDate( [TempCalendar], [20031001] ) *------------------------------------------------- Function InsCalendarFromDate( tcCursName, tdDate, tdEasterDate ) If Type([tcCursName])=[C] and Used(tcCursName) Local ldDate, lnLunarY, lnLunarM, lnLunarD, llIsLeap If Type([tdDate])=[D] ldDate = tdDate Else If Type([tdDate])=[C] ldDate = CToD( subs(tdDate,1,4) + [.] + subs(tdDate,5,2) + [.] + subs(tdDate,7,2) ) Endif Endif If Type([ldDate])=[D] and !empt(ldDate) ldEasterDate = iif( Type([tdEasterDate])=[D], tdEasterDate, GetEasterDate(Year(tdDate)) ) lnLunarY = Year (ldDate) lnLunarM = Month(ldDate) lnLunarD = Day (ldDate) llIsLeap = .F. = GetLunarFromSolar( @lnLunarY, @lnLunarM, @lnLunarD, @llIsLeap ) = InsCalendar( tcCursName, ldDate, llIsLeap, lnLunarY, lnLunarM, lnLunarD, ldEasterDate ) Endif Endif Endfunc *------------------------------------------------- * 程序: 添加日期记录 * 示例: ? InsCalendar( [TempCalendar], Date(2003,10,01), .F., 2003, 09, 06 ) *------------------------------------------------- Function InsCalendar( tcCursName, tdDate, tlIsLeap, tnLunarY, tnLunarM, tnLunarD, tdEasterDate ) If Type([tcCursName])=[C] and Used(tcCursName) ; and Type([tdDate])=[D] and Type([tlIsLeap])=[L] ; and Type([tnLunarY])=[N] and Type([tnLunarM])=[N] and Type([tnLunarD])=[N] ldEasterDate = iif( Type([tdEasterDate])=[D], tdEasterDate, GetEasterDate(Year(tdDate)) ) Insert Into (tcCursName) values ( ; tdDate, DOW(tdDate,2), tlIsLeap, tnLunarY, tnLunarM, tnLunarD, ; GetGanZhiYear(tdDate), GetGanZhiMonth(tdDate), GetGanZhiDay(tdDate), ; GetLunarJieQi(tdDate), GetLunarAniName(Mod(tnLunarY-4,12)), GetSolarStarName(tdDate), ; GetSolarGalaName(tdDate,ldEasterDate) + GetLunarGalaName(tnLunarY,tnLunarM,tnLunarD,tlIsLeap) ) Endif Endfunc *------------------------------------------------- * 程序: 求某公历日是否节日 * 示例: ? GetSolarGalaName( Date(2003,10,01) ) *------------------------------------------------- Function GetSolarGalaName( tdDate, tdEasterDate ) Local lcRetu, lnInfo, lcSolarInfo, lcSolarGala lcRetu = [] lcSolarInfo = [] lcSolarGala = [] If Type([tdDate])=[D] and !empt(tdDate) ldEasterDate = iif( Type([tdEasterDate])=[D], tdEasterDate, GetEasterDate(Year(tdDate)) ) * 日期节日 lcSolarInfo = lcSolarInfo + [,0101] lcSolarInfo = lcSolarInfo + [,0214] lcSolarInfo = lcSolarInfo + [,0308,0312,0315,0321,0322,0323] lcSolarInfo = lcSolarInfo + [,0401,0404,0407,0422] lcSolarInfo = lcSolarInfo + [,0501,0504,0508,0509,0512,0515,0517,0531] lcSolarInfo = lcSolarInfo + [,0601,0605,0606,0621,0626] lcSolarInfo = lcSolarInfo + [,0701,0704,0707,0711] lcSolarInfo = lcSolarInfo + [,0801,0815,0816] lcSolarInfo = lcSolarInfo + [,0908,0909,0910,0911,0928] lcSolarInfo = lcSolarInfo + [,1001,1004,1006,1009,1010,1016,1024,1028,1031] lcSolarInfo = lcSolarInfo + [,1109,1112,1114,1116,1119] lcSolarInfo = lcSolarInfo + [,1201,1203,1205,1208,1210,1211,1213,1220,1225,1226,] lnInfo = at( subs(DToS(tdDate),5,4), lcSolarInfo ) If lnInfo > 0 lnInfo = occu( [,], left(lcSolarInfo,lnInfo) ) lcSolarGala = lcSolarGala + [,元旦] lcSolarGala = lcSolarGala + [,情人节] lcSolarGala = lcSolarGala + [,国际妇女节,中国植树节,国际消费者权益日,世界林业节.国际反种族歧视日,世界水日,世界气象日] lcSolarGala = lcSolarGala + [,愚人节.香港会计年度始,台湾儿童节,世界卫生日,世界地球日] lcSolarGala = lcSolarGala + [,国际劳动节,中国青年节,世界红十字日,郝维节,国际护士节,世界助残日.国际家庭日,世界电信日,世界无烟日] lcSolarGala = lcSolarGala + [,国际儿童节,世界环境日,台湾教师节,国际反毒品日,国际戒毒日] lcSolarGala = lcSolarGala + [,中国共产党成立纪念日(1921年).香港回归纪念日(1997年),美国国庆(1776年Independence Day),卢沟桥事变(1937年中日战争爆发),世界人口日] lcSolarGala = lcSolarGala + [,中国人民解放军建军纪念日(1927年南昌起义),日本投降日(1945年中日战争结束),燕衔泥节] lcSolarGala = lcSolarGala + [,国际扫盲日,毛泽东逝世纪念(1976年),中国教师节,纽约世贸中心遇袭(2001年),孔子诞辰] lcSolarGala = lcSolarGala + [,中华人民共和国建国纪念日(1949年).国际老人日,世界动物日,中国老人节,辛亥革命周年纪念(1911年),世界粮食日,世界邮政日,联合国成立纪念日(1945年),万国儿童日(澳洲),万盛节(Halloween西洋鬼节)] lcSolarGala = lcSolarGala + [,泰国四面佛祖诞(正诞),孙中山诞辰(1866年),国际糖尿病日,国际宽容日,无线电视台庆(1967年)] lcSolarGala = lcSolarGala + [,世界艾滋病日,国际康复日(残疾人),国际义工日,香港沦陷日(1941年),国际人权日,世界哮喘日,南京大屠杀悼念日(1937年),澳门回归纪念日(1999年),圣诞节(Christmas),毛泽东诞辰纪念,] lnBeg = at( [,], lcSolarGala, lnInfo ) + 1 lnEnd = at( [,], lcSolarGala, lnInfo + 1 ) lcRetu = [.] + subs( lcSolarGala, lnBeg, lnEnd-lnBeg ) Endif * 星期节日 If Month(tdDate) = 05 and tdDate = GetDateFromYMandWeekNo( subs(DToS(tdDate),1,4)+[05], 2, 7 ) lcRetu = lcRetu + [.母亲节] Endif If Month(tdDate) = 06 and tdDate = GetDateFromYMandWeekNo( subs(DToS(tdDate),1,4)+[06], 3, 6 ) lcRetu = lcRetu + [.香港赛马季暑假] Endif If Month(tdDate) = 06 and tdDate = GetDateFromYMandWeekNo( subs(DToS(tdDate),1,4)+[06], 3, 7 ) lcRetu = lcRetu + [.父亲节] Endif If Month(tdDate) = 07 and tdDate = GetDateFromYMandWeekNo( subs(DToS(tdDate),1,4)+[06], 3, 1 ) lcRetu = lcRetu + [.香港学生暑假开始] Endif If Month(tdDate) = 07 and tdDate = GetDateFromYMandWeekNo( subs(DToS(tdDate),1,4)+[06], 3, 6 ) lcRetu = lcRetu + [.合作节] Endif If Month(tdDate) = 07 and tdDate = GetDateFromYMandWeekNo( subs(DToS(tdDate),1,4)+[06], 3, 7 ) lcRetu = lcRetu + [.被奴役国家周] Endif If Month(tdDate) = 09 and tdDate = GetDateFromYMandWeekNo( subs(DToS(tdDate),1,4)+[06], 1, 1 ) lcRetu = lcRetu + [.香港赛马季开锣] Endif If Month(tdDate) = 09 and tdDate = GetDateFromYMandWeekNo( subs(DToS(tdDate),1,4)+[06], 1, 6 ) lcRetu = lcRetu + [.香港开学日] Endif If Month(tdDate) = 11 and tdDate = GetDateFromYMandWeekNo( subs(DToS(tdDate),1,4)+[11], 3, 7 ) lcRetu = lcRetu + [.长者日] Endif If Month(tdDate) = 11 and tdDate = GetDateFromYMandWeekNo( subs(DToS(tdDate),1,4)+[11], 4, 4 ) lcRetu = lcRetu + [.感恩节] Endif If Month(tdDate) = 12 and Betw(Day(tdDate),11,20) and DOW(tdDate,2) = 7 and Betw(Day(tdDate-7),1,10) lcRetu = lcRetu + [.香港计算机节] && 12月中旬第一个星期日 Endif * 忌日 If Day(tdDate)=13 and DOW(tdDate,2)=5 lcRetu = lcRetu + [.黑色星期五] Endif If ldEasterDate = tdDate * 春分后第一次满月(月圆农历15日)后的第一个星期日 lcRetu = lcRetu + [.复活节] Else If ldEasterDate = tdDate + 2 * 复活节前的第一个星期五 lcRetu = lcRetu + [.耶稣受难日] Endif Endif Endif Return lcRetu Endfunc *------------------------------------------------- * 程序: 求某年 复活节(Easter) 日期 * 示例: ? GetEasterDate( 2003 ) *------------------------------------------------- Function GetEasterDate( tnYear ) Local ldRetu ldRetu = CToD([]) If Type([tnYear])=[N] and Betw(tnYear,1,9999) * 复活节(Easter) = 春分后第一次满月(月圆农历15日)后的第一个星期日,只出现在3或4月 * 奇怪 - 洋鬼子耶稣也懂中国农历节气 Local ldSolarChunFeng, lnLunarChunFenY, lnLunarChunFenM, lnLunarChunFenD, llChunFenIsLeap Local lnDiffDays, ldSolar15 ldSolarChunFeng = TtoD(GetTermDateTime(tnYear,6-1)) && 取得春分公历日期 lnLunarChunFenY = Year (ldSolarChunFeng) lnLunarChunFenM = Month(ldSolarChunFeng) lnLunarChunFenD = Day (ldSolarChunFeng) llChunFenIsLeap = .F. && 取得春分农历日期 = GetLunarFromSolar( @lnLunarChunFenY, @lnLunarChunFenM, @lnLunarChunFenD, @llChunFenIsLeap ) If lnLunarChunFenD > 0 If lnLunarChunFenD < 15 && 取得春分后下一个月圆的相差天数 lnDiffDays = 15 - lnLunarChunFenD Else lnDiffDays = iif( llChunFenIsLeap, GetLunarLeapDays(lnLunarChunFenY), GetLunarMonthDays(lnLunarChunFenY,lnLunarChunFenM) ) - lnLunarChunFenD + 15 Endif ldSolar15 = ldSolarChunFeng + lnDiffDays && 取得春分后下一个月圆的公历日期 ldRetu = ldSolar15 + 7 - Mod(DOW(ldSolar15,2),7) && 取得月圆后的下一个星期日的日期 Endif Endif Return ldRetu Endfunc *------------------------------------------------- * 程序: 求某农历日是否节日 * 示例: ? GetLunarGalaName( 2003, 12, 30 ) *------------------------------------------------- Function GetLunarGalaName( tnYear, tnMonth, tnDay, tlIsLeap ) Local lcRetu, IsLeap, lnInfo, lcLunarInfo, lcLunarGala lcLunarInfo = [] lcLunarGala = [] lcRetu = [] If Type([tnYear])=[N] and Type([tnMonth])=[N] and Type([tnDay])=[N] If Betw(tnYear,1,9999) and Betw(tnMonth,1,12) and Betw(tnDay,1,30) IsLeap = GetLunarleapMonth( tnYear ) = tnMonth tlIsLeap = iif(Type([tlIsLeap])=[L], tlIsLeap, .F.) If !IsLeap or !tlIsLeap * 非闰月节日 lcLunarInfo = lcLunarInfo + [,0101,0103,0105,0106,0107,0109,0111,0115,0126] lcLunarInfo = lcLunarInfo + [,0202,0208,0209,0213,0215,0219,0221] lcLunarInfo = lcLunarInfo + [,0303,0316,0323] lcLunarInfo = lcLunarInfo + [,0404,0408,0425] lcLunarInfo = lcLunarInfo + [,0505,0513] lcLunarInfo = lcLunarInfo + [,0603,0613,0616,0619] lcLunarInfo = lcLunarInfo + [,0707,0711,0713,0715,0721,0724,0730] lcLunarInfo = lcLunarInfo + [,0815,0816,0822,0823,0824,0828] lcLunarInfo = lcLunarInfo + [,0909,0919,0930] lcLunarInfo = lcLunarInfo + [,1005] lcLunarInfo = lcLunarInfo + [,1107] lcLunarInfo = lcLunarInfo + [,1208,1229,] lnInfo = at( Padl(allt(str(tnMonth)),2,[0]) + Padl(allt(str(tnDay)),2,[0]), lcLunarInfo ) If lnInfo > 0 lnInfo = occu( [,], left(lcLunarInfo,lnInfo) ) lcLunarGala = lcLunarGala + [,春节.弥勒佛圣诞,车公诞(赤口),接财神,定光佛圣诞,人日,玉皇大帝圣诞,日,元宵节,观音开库] lcLunarGala = lcLunarGala + [,土地公诞,释迦牟尼佛出家,海空上师生日,洪圣诞,释迦牟尼佛涅槃,观世音菩萨圣诞(生日),普贤菩萨圣诞] lcLunarGala = lcLunarGala + [,北帝诞,准提菩萨圣诞,天后诞] lcLunarGala = lcLunarGala + [,文殊菩萨圣诞,释迦牟尼佛诞生、成道、涅槃,日] lcLunarGala = lcLunarGala + [,端午节,关帝诞辰.伽蓝菩萨圣诞] lcLunarGala = lcLunarGala + [,护法韦驮尊天菩萨圣诞,鲁班师傅诞,侯王诞,观世音菩萨成道] lcLunarGala = lcLunarGala + [,七夕乞巧节.日,日,大势至菩萨圣诞,中元普渡节.盂兰鬼节,日,龙树菩萨圣诞,地藏菩萨圣诞] lcLunarGala = lcLunarGala + [,中秋节,秀茂坪齐天大圣诞,黄大仙诞,燃灯佛圣诞,日,孔子诞] lcLunarGala = lcLunarGala + [,重阳节,观世音菩萨出家纪念日,药师琉璃光如来圣诞] lcLunarGala = lcLunarGala + [,达摩祖师圣诞] lcLunarGala = lcLunarGala + [,阿弥陀佛圣诞] lcLunarGala = lcLunarGala + [,释迦如来成道日,华严菩萨圣诞,] lnBeg = at( [,], lcLunarGala, lnInfo ) + 1 lnEnd = at( [,], lcLunarGala, lnInfo + 1 ) lcRetu = [.] + subs( lcLunarGala, lnBeg, lnEnd-lnBeg ) Endif Endif If !IsLeap or (IsLeap and tlIsLeap) If tnMonth=12 Do Case Case tnDay=8 lcRetu = lcRetu + [.腊八节] Case tnDay=16 lcRetu = lcRetu + [.尾禡] Case tnDay=28 lcRetu = lcRetu + [.洗邋遢] Case tnDay=24 lcRetu = lcRetu + [.小年.灶君节(还神日)] Case InList(tnDay,29,30) If GetLunarMonthDays( tnYear, tnMonth ) = tnDay lcRetu = lcRetu + [.除夕] Endif Endcase Endif Endif Endif Endif Return lcRetu Endfunc *------------------------------------------------- * 程序: 求某年农历特征码数 * 示例: ? GetLunarInfo( 2003 ) *------------------------------------------------- Function GetLunarInfo( tnYear ) Local lnRetu lnRetu = 0 tnYear = iif( Type([tnYear])=[N], tnYear, 0 ) If Betw(tnYear,1900,2050) Local lcYearInfo, lnNum, lnBeg, lnEnd lcYearInfo = [,] ; + [0x04bd8,0x04ae0,0x0a570,0x054d5,0x0d260,0x0d950,0x16554,0x056a0,0x09ad0,0x055d2,] ; + [0x04ae0,0x0a5b6,0x0a4d0,0x0d250,0x1d255,0x0b540,0x0d6a0,0x0ada2,0x095b0,0x14977,] ; + [0x04970,0x0a4b0,0x0b4b5,0x06a50,0x06d40,0x1ab54,0x02b60,0x09570,0x052f2,0x04970,] ; + [0x06566,0x0d4a0,0x0ea50,0x06e95,0x05ad0,0x02b60,0x186e3,0x092e0,0x1c8d7,0x0c950,] ; + [0x0d4a0,0x1d8a6,0x0b550,0x056a0,0x1a5b4,0x025d0,0x092d0,0x0d2b2,0x0a950,0x0b557,] ; + [0x06ca0,0x0b550,0x15355,0x04da0,0x0a5d0,0x14573,0x052b0,0x0a9a8,0x0e950,0x06aa0,] ; + [0x0aea6,0x0ab50,0x04b60,0x0aae4,0x0a570,0x05260,0x0f263,0x0d950,0x05b57,0x056a0,] ; + [0x096d0,0x04dd5,0x04ad0,0x0a4d0,0x0d4d4,0x0d250,0x0d558,0x0b540,0x0b5a0,0x195a6,] ; + [0x095b0,0x049b0,0x0a974,0x0a4b0,0x0b27a,0x06a50,0x06d40,0x0af46,0x0ab60,0x09570,] ; + [0x04af5,0x04970,0x064b0,0x074a3,0x0ea50,0x06b58,0x055c0,0x0ab60,0x096d5,0x092e0,] ; + [0x0c960,0x0d954,0x0d4a0,0x0da50,0x07552,0x056a0,0x0abb7,0x025d0,0x092d0,0x0cab5,] ; + [0x0a950,0x0b4a0,0x0baa4,0x0ad50,0x055d9,0x04ba0,0x0a5b0,0x15176,0x052b0,0x0a930,] ; + [0x07954,0x06aa0,0x0ad50,0x05b52,0x04b60,0x0a6e6,0x0a4e0,0x0d260,0x0ea65,0x0d530,] ; + [0x05aa0,0x076a3,0x096d0,0x04bd7,0x04ad0,0x0a4d0,0x1d0b6,0x0d250,0x0d520,0x0dd45,] ; + [0x0b5a0,0x056d0,0x055b2,0x049b0,0x0a577,0x0a4b0,0x0aa50,0x1b255,0x06d20,0x0ada0,] ; + [0x14b63,] lnNum = tnYear - 1900 + 1 lnBeg = at( [,], lcYearInfo, lnNum ) + 1 lnEnd = at( [,], lcYearInfo, lnNum + 1 ) lnRetu = EVALUATE( subs( lcYearInfo, lnBeg, lnEnd-lnBeg ) ) Endif Return lnRetu Endfunc *------------------------------------------------- * 程序: 根据 公历日期 求 年柱(以立春日期为界) * 1900年 立春后为庚子年(60进制36) * 示例: ? GetGanZhiYear( Date(2003,04,20) ) *------------------------------------------------- Function GetGanZhiYear( tdDate ) Local lnYear, lcLunarYear lcLunarYear = [] If Type([tdDate])=[D] and !empt(tdDate) lnYear = Year( tdDate) If tdDate < TtoD(GetTermDateTime(lnYear,3-1)) lcLunarYear = GetLunarGanZhiName( lnYear-1900+36-1 ) Else lcLunarYear = GetLunarGanZhiName( lnYear-1900+36 ) Endif Endif Return lcLunarYear Endfunc *------------------------------------------------- * 程序: 根据 公历日期 求 月柱 (以节气日期为界) * 1900年01月 小寒以前为 丙子月(60进制12) * 示例: ? GetGanZhiMonth( Date(2003,04,20) ) *------------------------------------------------- Function GetGanZhiMonth( tdDate ) Local lnYear, lnMonth, lcLunarMonth lcLunarMonth = [] If Type([tdDate])=[D] and !empt(tdDate) lnYear = Year( tdDate) lnMonth = Month(tdDate) If tdDate < TToD( GetTermDateTime( lnYear, (lnMonth-1)*2) ) lcLunarMonth = GetLunarGanZhiName( (lnYear-1900)*12 + lnMonth + 11 ) Else lcLunarMonth = GetLunarGanZhiName( (lnYear-1900)*12 + lnMonth + 12 ) Endif Endif Return lcLunarMonth Endfunc *------------------------------------------------- * 程序: 根据 公历日期 求 日柱 * 1900年01月01日 为甲戌日(60进制10) * 示例: ? GetGanZhiDay( Date(2003,04,20) ) *------------------------------------------------- Function GetGanZhiDay( tdDate ) Local lcLunarDay lcLunarDay = [] If Type([tdDate])=[D] and !empt(tdDate) lcLunarDay = GetLunarGanZhiName( tdDate - Date(1900,01,01) + 10 ) Endif Return lcLunarDay Endfunc *------------------------------------------------- * 程序: 根据 公历日期 求 节气 * 示例: ? GetLunarJieQi( Date(2003,04,20) ) *------------------------------------------------- Function GetLunarJieQi( tdDate ) Local lnYear, lnMonth, lcLunarJieQi lcLunarJieQi = [] If Type([tdDate])=[D] and !empt(tdDate) lnYear = Year( tdDate) lnMonth = Month(tdDate) If TToD( GetTermDateTime(lnYear,(lnMonth-1)*2) ) = tdDate lcLunarJieQi = GetLunarJieQiName((lnMonth-1)*2) + Time( GetTermDateTime(lnYear,(lnMonth-1)*2) ) Else If TToD( GetTermDateTime(lnYear,(lnMonth-1)*2+1) ) = tdDate lcLunarJieQi = GetLunarJieQiName((lnMonth-1)*2+1) + Time( GetTermDateTime(lnYear,(lnMonth-1)*2+1) ) Endif Endif Endif Return lcLunarJieQi Endfunc *------------------------------------------------- * 程序: 求农历干支, 0=甲子 * 示例: ? GetLunarGanZhiName( 0 ) *------------------------------------------------- Function GetLunarGanZhiName( tnNum ) Return GetLunarGanName(Mod(tnNum,10)) + GetLunarZhiName(Mod(tnNum,12)) Endfunc *------------------------------------------------- * 程序: 求农历干支的 干 * 示例: ? GetLunarGanName( 1 ) *------------------------------------------------- Function GetLunarGanName( tnGanNo ) Local lcRetu lcRetu = [] tnGanNo = iif( Type([tnGanNo])=[N], tnGanNo+1, 0 ) If Betw(tnGanNo,1,10) Local lcGanInfo, lnBeg, lnEnd lcGanInfo = [,甲,乙,丙,丁,戊,己,庚,辛,壬,癸,] lnBeg = at( [,], lcGanInfo, tnGanNo ) + 1 lnEnd = at( [,], lcGanInfo, tnGanNo + 1 ) lcRetu = subs( lcGanInfo, lnBeg, lnEnd-lnBeg ) Endif Return lcRetu Endfunc *------------------------------------------------- * 程序: 求农历干支的 支 * 示例: ? GetLunarZhiName( 1 ) *------------------------------------------------- Function GetLunarZhiName( tnZhiNo ) Local lcRetu lcRetu = [] tnZhiNo = iif( Type([tnZhiNo])=[N], tnZhiNo+1, 0 ) If Betw(tnZhiNo,1,12) Local lcZhiInfo, lnBeg, lnEnd lcZhiInfo = [,子,丑,寅,卯,辰,巳,午,未,申,酉,戌,亥,] lnBeg = at( [,], lcZhiInfo, tnZhiNo ) + 1 lnEnd = at( [,], lcZhiInfo, tnZhiNo + 1 ) lcRetu = subs( lcZhiInfo, lnBeg, lnEnd-lnBeg ) Endif Return lcRetu Endfunc *------------------------------------------------- * 程序: 求农历属相 * 示例: ? GetLunarAniName( 1 ) *------------------------------------------------- Function GetLunarAniName( tnAniNo ) Local lcRetu lcRetu = [] tnAniNo = iif( Type([tnAniNo])=[N], tnAniNo+1, 0 ) If Betw(tnAniNo,1,12) Local lcAniInfo, lnBeg, lnEnd lcAniInfo = [,鼠,牛,虎,兔,龙,蛇,马,羊,猴,鸡,狗,猪,] lnBeg = at( [,], lcAniInfo, tnAniNo ) + 1 lnEnd = at( [,], lcAniInfo, tnAniNo + 1 ) lcRetu = subs( lcAniInfo, lnBeg, lnEnd-lnBeg ) Endif Return lcRetu Endfunc *------------------------------------------------- * 程序: 求农历节气 * 示例: ? GetLunarJieQiName( 0 ) *------------------------------------------------- Function GetLunarJieQiName( tnJieNo ) Local lcRetu lcRetu = [] tnJieNo = iif( Type([tnJieNo])=[N], tnJieNo+1, 0 ) If Betw(tnJieNo,1,24) Local lcJieInfo, lnBeg, lnEnd lcJieInfo = [,小寒,大寒,立春,雨水,惊蛰,春分,清明,谷雨,立夏,小满,芒种,夏至,小暑,大暑,立秋,处暑,白露,秋分,寒露,霜降,立冬,小雪,大雪,冬至,] lnBeg = at( [,], lcJieInfo, tnJieNo ) + 1 lnEnd = at( [,], lcJieInfo, tnJieNo + 1 ) lcRetu = subs( lcJieInfo, lnBeg, lnEnd-lnBeg ) Endif Return lcRetu Endfunc *------------------------------------------------- * 程序: 某年的第 N 个节气的公历日期(从0小寒起算) * 示例: ? GetTermDateTime( 2003, 2 ) && 立春公历日期时间 *------------------------------------------------- Function GetTermDateTime( tnYear, tnTerm ) Return Datetime(1900,1,6,2,5,0) + (31556925974.7*(tnYear-1900)+GetLunarTermInfo(tnTerm)*60000)/1000 Endfunc *------------------------------------------------- * 程序: 农历年的第N个节气为几日(从0小寒起算) * 示例: ? GetLunarTermInfo( 2 ) *------------------------------------------------- Function GetLunarTermInfo( tnTermNo ) Local lnRetu lnRetu = [] tnTermNo = iif( Type([tnTermNo])=[N], tnTermNo+1, 0 ) If Betw(tnTermNo,1,24) Local lcTermInfo, lnBeg, lnEnd lcTermInfo = [,0,21208,42467,63836,85337,107014,128867,150921,173149,195551,218072,240693,263343,285989,308563,331033,353350,375494,397447,419210,440795,462224,483532,504758,] lnBeg = at( [,], lcTermInfo, tnTermNo ) + 1 lnEnd = at( [,], lcTermInfo, tnTermNo + 1 ) lnRetu = Val( subs( lcTermInfo, lnBeg, lnEnd-lnBeg ) ) Endif Return lnRetu Endfunc *------------------------------------------------- * 程序: 求农历中文日期 * 示例: ? GetLunarDayName( 1 ) *------------------------------------------------- Function GetLunarDayName( tnDay1No ) Local lcRetu lcRetu = [] tnDay1No = iif( Type([tnDay1No])=[N], tnDay1No, 0 ) If Betw(tnDay1No,1,30) Local lcDay1Info, lnBeg, lnEnd lcDay1Info = [,初一,初二,初三,初四,初五,初六,初七,初八,初九,初十,十一,十二,十三,十四,十五] ; + [,十六,十七,十八,十九,二十,廿一,廿二,廿三,廿四,廿五,廿六,廿七,廿八,廿九,三十,] lnBeg = at( [,], lcDay1Info, tnDay1No ) + 1 lnEnd = at( [,], lcDay1Info, tnDay1No + 1 ) lcRetu = subs( lcDay1Info, lnBeg, lnEnd-lnBeg ) Endif Return lcRetu Endfunc *------------------------------------------------- * 程序: 求农历中文月份 * 示例: ? GetLunarMonthName( 1 ) *------------------------------------------------- Function GetLunarMonthName( tnMonthNo ) Local lcRetu lcRetu = [] tnMonthNo = iif( Type([tnMonthNo])=[N], tnMonthNo, 0 ) If Betw(tnMonthNo,1,12) Local lcMonthInfo, lnBeg, lnEnd lcMonthInfo = [,元,二,三,四,五,六,七,八,九,十,冬,腊,] lnBeg = at( [,], lcMonthInfo, tnMonthNo ) + 1 lnEnd = at( [,], lcMonthInfo, tnMonthNo + 1 ) lcRetu = subs( lcMonthInfo, lnBeg, lnEnd-lnBeg ) Endif Return lcRetu Endfunc *------------------------------------------------- * 程序: 求英文月份 * 示例: ? GetEnglishMonthName( 1 ) *------------------------------------------------- Function GetEnglishMonthName( tnMonthNo, tlIsShort ) Local lcRetu lcRetu = [] tnMonthNo = iif( Type([tnMonthNo])=[N], tnMonthNo, 0 ) tlIsShort = iif( Type([tlIsShort])=[L], tlIsShort, .F. ) If Betw(tnMonthNo,1,12) Local lcMonthInfo, lnBeg, lnEnd lcMonthInfo = [,January,February,March,April,May,June,July,August,September,October,November,December,] lnBeg = at( [,], lcMonthInfo, tnMonthNo ) + 1 lnEnd = at( [,], lcMonthInfo, tnMonthNo + 1 ) lcRetu = subs( lcMonthInfo, lnBeg, lnEnd-lnBeg ) If tlIsShort lcRetu = left(lcRetu,3) Endif Endif Return lcRetu Endfunc *------------------------------------------------- * 程序: 求公历中文 年.月.日.星期 汉字 * 示例: ? GetChineseDateName( 1 ) *------------------------------------------------- Function GetChineseDateName( tnDay0No ) Local lcRetu lcRetu = [] tnDay0No = iif( Type([tnDay0No])=[N], tnDay0No, 0 ) If Betw(tnDay0No,1,11) Local lcDay0Info, lnBeg, lnEnd lcDay0Info = [,一,二,三,四,五,六,七,八,九,十,日,] lnBeg = at( [,], lcDay0Info, tnDay0No ) + 1 lnEnd = at( [,], lcDay0Info, tnDay0No + 1 ) lcRetu = subs( lcDay0Info, lnBeg, lnEnd-lnBeg ) Endif Return lcRetu Endfunc *------------------------------------------------- * 程序: 求农历 Y 年的总天数 * 示例: ? GetLunarYearDays( 2003 ) *------------------------------------------------- Function GetLunarYearDays( tnYear ) Local lnRetu, lnTemp, lnInfo, lnI lnRetu = 348 For lnI = 1 To 12 lnTemp = 0x8 * 2^(12-lnI+1) lnInfo = GetlunarInfo(tnYear) lnRetu = lnRetu + iif( bitor(lnInfo, lnTemp)=lnInfo, 1, 0 ) Endfor Return lnRetu + GetLunarLeapDays(tnYear) Endfunc *------------------------------------------------- * 程序: 求农历 Y 年闰月的天数 * 示例: ? GetLunarLeapDays( 2003 ) *------------------------------------------------- Function GetLunarLeapDays( tnYear ) Local lnRetu, lnInfo lnRetu = 0 If GetLunarleapMonth(tnYear) > 0 lnInfo = GetlunarInfo(tnYear) lnRetu = iif( bitor(lnInfo, 0x10000)=lnInfo, 30, 29 ) Endif Return lnRetu Endfunc *------------------------------------------------- * 程序: 求农历 Y 年 M 月的总天数 * 示例: ? GetLunarMonthDays( 2003, 10 ) *------------------------------------------------- Function GetLunarMonthDays( tnYear, tnMonth ) Local lnRetu, lnTemp, lnInfo lnRetu = 0 lnTemp = 0x8 * 2^(12-tnMonth+1) lnInfo = GetlunarInfo(tnYear) Return iif( bitor(lnInfo, lnTemp)=lnInfo, 30, 29 ) Endfunc *------------------------------------------------- * 程序: 求农历 Y 年闰哪个月 1-12 , 没闰返回 0 * 示例: ? GetLunarleapMonth( 2003 ) *------------------------------------------------- Function GetLunarleapMonth( tnYear ) Local lnInfo lnInfo = GetlunarInfo(tnYear) Return bitand( lnInfo, 0xF ) Endfunc *------------------------------------------------- * 程序: 由农历算出公历 * 示例: ? GetSolarFromLunar( 2003, 06, 05, .F. ) *------------------------------------------------- Function GetSolarFromLunar( tnYear, tnMonth, tnDay, tlLeap ) Local ldRetu ldRetu = CToD([]) If Type([tnYear])=[N] and Type([tnMonth])=[N] and Type([tnDay])=[N] If Betw(tnYear,1900,2050) and Betw(tnMonth,1,12) and Betw(tnDay,1,30) Local IsLeap, lnDiffDays, liYear, liMonth tlLeap = iif(Type([tlLeap])=[L], tlLeap, .F.) IsLeap = GetLunarleapMonth( tnYear ) = tnMonth tlLeap = IsLeap and tlLeap lnDiffDays = 0 If tnYear > 1900 && 农历以前年份距 1900.01.01 总天数 For liYear = 1900 To tnYear - 1 lnDiffDays = lnDiffDays + GetLunarYearDays( liYear ) Endfor Endif If tnMonth = 1 and tlLeap && 当月为闰元月 lnDiffDays = lnDiffDays + GetLunarMonthDays( tnYear, 1 ) Else If tnMonth > 1 && 农历当年以前月份距 当年1月1日 总天数 For liMonth = 1 To iif(tlLeap, tnMonth, tnMonth-1 ) lnDiffDays = lnDiffDays + GetLunarMonthDays( tnYear, liMonth ) Endfor Endif If Betw( GetLunarleapMonth(tnYear), 1, tnMonth-1 ) * 农历当年以前月份有闰月 lnDiffDays = lnDiffDays + GetLunarLeapDays( tnYear ) Endif Endif lnDiffDays = lnDiffDays + tnDay - 1 * 农历 1900.01.01 = 公历 1900.01.31 ldRetu = Date(1900,01,31) + lnDiffDays Endif Endif Return ldRetu Endfunc *------------------------------------------------- * 程序: 由公历算出农历 * 示例: * ldDate = Date(2003,10,01) * lnYear = Year (ldDate) * lnMonth = Month(ldDate) * lnDay = Day (ldDate) * lIsLeap = .F. * If GetLunarFromSolar( @lnYear, @lnMonth, @lnDay, @lIsLeap ) * ? [公历:] + DToC(ldDate) + [ -> 农历:] ; * + padl(allt(str(lnYear)),4,[0]) +[.]+ padl(allt(str(lnMonth)),2,[0]) +[.]+ padl(allt(str(lnDay)),2,[0]) ; * + iif(lIsLeap,[(闰)],[]) * Endif *------------------------------------------------- Function GetLunarFromSolar( tnYear, tnMonth, tnDay, tlLeap ) Local liYear, liMonth, lnLeap, lnTemp, lnDays lnLeap = 0 lnTemp = 0 lnDays = Date(tnYear, tnMonth, tnDay) - Date(1900,01,31) liYear = 1900 Do While liYear<2050 and lnDays > 0 lnTemp = GetLunarYearDays(liYear) lnDays = lnDays - lnTemp liYear = liYear + 1 Enddo If lnDays < 0 lnDays = lnDays + lnTemp liYear = liYear - 1 Endif lnLeap = GetLunarleapMonth(liYear) && 闰哪个月 tlLeap = .F. liMonth = 1 Do While liMonth<13 and lnDays > 0 * 闰月 If lnLeap>0 and liMonth=lnLeap+1 and !tlLeap liMonth = liMonth - 1 tlLeap = .T. lnTemp = GetLunarLeapDays(liYear) Else lnTemp = GetLunarMonthDays(liYear, liMonth) Endif If tlLeap and liMonth=lnLeap+1 tlLeap = .F. && 解除闰月 Endif lnDays = lnDays - lnTemp liMonth = liMonth + 1 Enddo If lnDays=0 and lnLeap>0 and liMonth=lnLeap+1 If tlLeap tlLeap = .F. Else tlLeap = .T. liMonth = liMonth - 1 Endif Endif If lnDays < 0 lnDays = lnDays + lnTemp liMonth = liMonth - 1 Endif tnYear = iif( Betw(liMonth,1,12), liYear, 0 ) tnMonth = iif( Betw(liMonth,1,12), liMonth, 0 ) tnDay = iif( Betw(liMonth,1,12), lnDays+1, 0 ) Return Betw(liMonth,1,12) Endfunc *------------------------------------------------- * 程序: 求公历某日西洋星座 * 示例: ? GetSolarStarName( Date(2003,10,31) ) *----------------------------------------------------- Function GetSolarStarName( tdDate ) Local lcRetn, lnMonth, lnDay lcRetn = [] If Type([tdDate])=[D] and !empt(tdDate) lnMonth = Month(tdDate) lnDay = Day( tdDate) Do Case Case (lnMonth=12 and lnDay>20) or (lnMonth=01 and lnDay<20) lcRetn = [山羊座] Case (lnMonth=01 and lnDay>19) or (lnMonth=02 and lnDay<19) lcRetn = [水瓶座] Case (lnMonth=02 and lnDay>18) or (lnMonth=03 and lnDay<21) lcRetn = [双鱼座] Case (lnMonth=03 and lnDay>20) or (lnMonth=04 and lnDay<21) lcRetn = [白羊座] Case (lnMonth=04 and lnDay>20) or (lnMonth=05 and lnDay<21) lcRetn = [金牛座] Case (lnMonth=05 and lnDay>20) or (lnMonth=06 and lnDay<21) lcRetn = [双子座] Case (lnMonth=06 and lnDay>20) or (lnMonth=07 and lnDay<21) lcRetn = [天蟹座] Case (lnMonth=07 and lnDay>20) or (lnMonth=08 and lnDay<22) lcRetn = [狮子座] Case (lnMonth=08 and lnDay>21) or (lnMonth=09 and lnDay<23) lcRetn = [处女座] Case (lnMonth=09 and lnDay>22) or (lnMonth=10 and lnDay<23) lcRetn = [天秤座] Case (lnMonth=10 and lnDay>22) or (lnMonth=11 and lnDay<23) lcRetn = [天蝎座] Case (lnMonth=11 and lnDay>22) or (lnMonth=12 and lnDay<21) lcRetn = [人马座] Endcase Endif Retu lcRetn Endfunc *------------------------------------------------- * 程序: 求公历某日所在月的天数 * 示例: ? [本月共 ], GetSolarMonthDays( date() ), [ 天] *----------------------------------------------------- Function GetSolarMonthDays( lpDdate ) lpDdate = iif(Type([lpDdate])$[DT],lpDdate,date()) Return GoMonth(lpDdate,1)-lpDdate Endfunc *------------------------------------------------- * 程序: 求公历某日所在月的最后一天 * 示例: ? [本月最后一天 ], GetSolarMonthLastDate( date() ) *----------------------------------------------------- Function GetSolarMonthLastDate( lpDdate ) Local lnThisY, lnThisM, lnNextY, lnNextM lpDdate = iif(Type([lpDdate])$[DT],lpDdate,date()) lnThisY = Year (lpDdate) && 本月年份 lnThisM = Month(lpDdate) && 本月月份 lnNextY = IIF( lnThisM=12, lnThisY+1, lnThisY ) && 下月年份 lnNextM = IIF( lnThisM=12, 01, lnThisM+1 ) && 下月月份 Return Date(lnNextY, lnNextM, 01)-1 Endfunc *----------------------------------------------------- * 程序: 求公历某日上个月的最后一天 * 示例: ? [上月最后一天 ], GetSolarMonthPassDate( date() ) *----------------------------------------------------- Function GetSolarMonthPassDate( lpDdate ) lpDdate = iif(Type([lpDdate])$[DT],lpDdate,date()) Local lnThisY, lnThisM lnThisY = Year (lpDdate) && 本月年份 lnThisM = Month(lpDdate) && 本月月份 Return Date(lnThisY, lnThisM, 01)-1 Endfunc *----------------------------------------------------- * 程序: 求公历某年某月第几个星期几的日期 * 参数: 1、tcYYYYMM - 公元年月([200310]) * 2、tnNumWeek - 该月第几个星期 * 其中: 1,2,3,4,5 表示顺数第 1,2,3,4,5 个星期 * 6,7,8,9,0 表示倒数第 1,2,3,4,5 个星期 * 3、tnWeekDay - 星期几(1-7)(其中7=星期日) * 示例: ? [2003年感恩节:], GetDateFromYMandWeekNo([200311],4,4) *----------------------------------------------------- Function GetDateFromYMandWeekNo( tcYYYYMM, tnNumWeek, tnWeekDay ) Local ldRetuDate, ldFirstDate, ldLastDate, lnDiffDay ldRetuDate = CToD([]) If Type([tcYYYYMM])=[C] and Type([tnNumWeek])=[N] and Type([tnWeekDay])=[N] If Betw(tnWeekDay,1,7) ldFirstDate = CToD(subs(tcYYYYMM,1,4)+[.]+subs(tcYYYYMM,5,2)+[.01]) ldLastDate = GoMonth( ldFirstDate,1) - Day(ldFirstDate) If InList(tnNumWeek,1,2,3,4,5) lnDiffDay = tnWeekDay - DOW(ldFirstDate,2) lnDiffDay = iif(lnDiffDay<0, 7+lnDiffDay, lnDiffDay) ldRetuDate = ldFirstDate + (tnNumWeek - 1) * 7 + lnDiffDay Endif If InList(tnNumWeek,6,7,8,9,0) tnNumWeek = iif(tnNumWeek=0,10,tnNumWeek) - 5 lnDiffDay = DOW(ldLastDate,2) - tnWeekDay lnDiffDay = iif(lnDiffDay<0, 7+lnDiffDay, lnDiffDay) ldRetuDate = ldLastDate - (tnNumWeek - 1) * 7 - lnDiffDay Endif ldRetuDate = iif( left(DToS(ldRetuDate),6)#tcYYYYMM, CToD([]), ldRetuDate ) Endif Endif Return ldRetuDate Endfunc * -------------------------------------------------