在下将一段关于农历的代码改进为能显现农历年、月、日、时的天干地支的代码,但太繁了,求朋友指点如何能够精炼一点?再就是里面还有一点小地方未能完全完善,如何完善?还有,就是如何能将输出的结果适用到表单的TEXT1上,试过几次用函数调用的方法,均不成功,向各位朋友请教,谢谢了!
SET TALK OFF
CLEAR
ACCEPT "请按“yy/mm/dd hh:mm:ss a|p”的方式输入你要变换的年、月、日、时、分、秒: " to date
DATE=CTOT(ALLTRIM(DATE))
?nongli(date,1)
?nongli(DATE,2)
?nongli(DATE,3)
?nongli(DATE,4)
?nongli(DATE,5)
?nongli(DATE,6)
?nongli(DATE,7)
?nongli(DATE,8)
?nongli(DATE,9)     &&节气  节气的算法由《真正的公农历转换类for?VB》转换而来的
?nongli(DATE,10)    &&公历节日
?NONGLI(DATE,11)    &&农历节日
?NONGLI(DATE,12)    &&某月某周第几天节日
PROC nongli
 LPARAMETERS Ddate,Can
 PUBLIC HZMonth
 PUBLIC HZday
 PUBLIC C1
 PUBLIC C2
 PUBLIC InterMonth
 PUBLIC NlMonth
 PUBLIC NlDay
 PUBLIC SLRangeDay
 PUBLIC LMDAY
 PUBLIC interdays
 PUBLIC sTermInfo
 PUBLIC SolarTerm
 PUBLIC LongLife
 PUBLIC sTermInfo1
 PUBLIC C3
 PUBLIC C4
 SET DATE TO JAPAN
 SET HOUR TO 24
 SET CENT ON
*!* 中文月份名
 DIMENSION HZMonth(12)
 HZMonth(1)  = '正月'
 HZMonth[2]  = '二月'
 HZMonth[3]  = '三月'
 HZMonth[4]  = '四月'
 HZMonth[5]  = '五月'
 HZMonth[6]  = '六月'
 HZMonth[7]  = '七月'
 HZMonth[8]  = '八月'
 HZMonth[9]  = '九月'
 HZMonth[10] = '十月'
 HZMonth[11] = '冬月'
 HZMonth[12] = '腊月'
 DIMENSION HZday(30)
**农历日中文名称
 HZday[1]  = '初一'
 HZday[2]  = '初二'
 HZday[3]  = '初三'
 HZday[4]  = '初四'
 HZday[5]  = '初五'
 HZday[6]  = '初六'
 HZday[7]  = '初七'
 HZday[8]  = '初八'
 HZday[9]  = '初九'
 HZday[10] = '初十'
 HZday[11] = '十一'
 HZday[12] = '十二'
 HZday[13] = '十三'
 HZday[14] = '十四'
 HZday[15] = '十五'
 HZday[16] = '十六'
 HZday[17] = '十七'
 HZday[18] = '十八'
 HZday[19] = '十九'
 HZday[20] = '二十'
 HZday[21] = '廿一'
 HZday[22] = '廿二'
 HZday[23] = '廿三'
 HZday[24] = '廿四'
 HZday[25] = '廿五'
 HZday[26] = '廿六'
 HZday[27] = '廿七'
 HZday[28] = '廿八'
 HZday[29] = '廿九'
 HZday[30] = '三十'
 DIMENSION C1(10)
**天干
 C1[1]  = "甲"
 C1[2]  = "乙"
 C1[3]  = "丙"
 C1[4]  = "丁"
 C1[5]  = "戊"
 C1[6]  = "己"
 C1[7]  = "庚"
 C1[8]  = "辛"
 C1[9]  = "壬"
 C1[10] = "癸"
 DIMENSION C2(12,2)
**中文农历年份名称
 C2[1 ,1] ="子"
 C2[2 ,1] ="丑"
 C2[3 ,1] ="寅"
 C2[4 ,1] ="卯"
 C2[5 ,1] ="辰"
 C2[6 ,1] ="巳"
 C2[7 ,1] ="午"
 C2[8 ,1] ="未"
 C2[9 ,1] ="申"
 C2[10,1] ="酉"
 C2[11,1] ="戌"
 C2[12,1] ="亥"
 C2[1 ,2] ="鼠"
 C2[2 ,2] ="牛"
 C2[3 ,2] ="虎"
 C2[4 ,2] ="兔"
 C2[5 ,2] ="龙"
 C2[6 ,2] ="蛇"
 C2[7 ,2] ="马"
 C2[8 ,2] ="羊"
 C2[9 ,2] ="猴"
 C2[10,2] ="鸡"
 C2[11,2] ="狗"
 C2[12,2] ="猪"
 DIMENSION hzweek(7)
**星期名称
 hzweek[1] = "日"
 hzweek[2] = "一"
 hzweek[3] = "二"
 hzweek[4] = "三"
 hzweek[5] = "四"
 hzweek[6] = "五"
 hzweek[7] = "六"
 DIMENSION SMDay(12)
**公历各月天数
 SMDay[1]  = 31
 SMDay[2]  = 28
 SMDay[3]  = 31
 SMDay[4]  = 30
 SMDay[5]  = 31
 SMDay[6]  = 30
 SMDay[7]  = 31
 SMDay[8]  = 31
 SMDay[9]  = 30
 SMDay[10] = 31
 SMDay[11] = 30
 SMDay[12] = 31
 DIMENSION LongLife(102)
**农历计算参数
 LongLife[1]   = '132637048'    &&1911
 LongLife[2]   = '133365036'
 LongLife[3]   = '053365225'
 LongLife[4]   = '132900044'
 LongLife[5]   = '131386034'
 LongLife[6]   = '022778122' && &&6
 LongLife[7]   = '132395041'
 LongLife[8]   = '071175231'
 LongLife[9]   = '131175050'
 LongLife[10]  = '132635038'
 LongLife[11]  = '052891127'
 LongLife[12]  = '131701046'  &&&&12
 LongLife[13]  = '131748035'
 LongLife[14]  = '042741223'
 LongLife[15]  = '130694043'
 LongLife[16]  = '132391032'
 LongLife[17]  = '021327122'
 LongLife[18]  = '131175040'  &&&&18
 LongLife[19]  = '061623129'
 LongLife[20]  = '133402047'
 LongLife[21]  = '133402036'
 LongLife[22]  = '051769125'
 LongLife[23]  = '131453044'
 LongLife[24]  = '130694034'     &&&&24
 LongLife[25]  = '032158223'
 LongLife[26]  = '132350041'
 LongLife[27]  = '073213230'
 LongLife[28]  = '133221049'
 LongLife[29]  = '133402038'
 LongLife[30]  = '063466226'  && &&30
 LongLife[31]  = '132901045'
 LongLife[32]  = '131130035'
 LongLife[33]  = '042651224'
 LongLife[34]  = '130605043'
 LongLife[35]  = '132349032'
 LongLife[36]  = '023371121'  &&&&36
 LongLife[37]  = '132709040'
 LongLife[38]  = '072901128'
 LongLife[39]  = '131738047'
 LongLife[40]  = '132901036'
 LongLife[41]  = '051333226'
 LongLife[42]  = '131210044'  && &&42
 LongLife[43]  = '132651033'
 LongLife[44]  = '031111223'
 LongLife[45]  = '131323042'
 LongLife[46]  = '082714130'
 LongLife[47]  = '133733048'
 LongLife[48]  = '131706038'     &&, &&48
 LongLife[49]  = '062794127'
 LongLife[50]  = '132741045'
 LongLife[51]  = '131206035'
 LongLife[52]  = '042734124'
 LongLife[53]  = '132647043'
 LongLife[54]  = '131318032'       && &&54
 LongLife[55]  = '033878120'
 LongLife[56]  = '133477039'
 LongLife[57]  = '071461129'
 LongLife[58]  = '131386047'
 LongLife[59]  = '132413036'
 LongLife[60]  = '051245126'      && &&60
 LongLife[61]  = '131197045'
 LongLife[62]  = '132637033'
 LongLife[63]  = '043405122'
 LongLife[64]  = '133365041'
 LongLife[65]  = '083413130'
 LongLife[66]  = '132900048'    && &&66
 LongLife[67]  = '132922037'
 LongLife[68]  = '062394227'
 LongLife[69]  = '132395046'
 LongLife[70]  = '131179035'
 LongLife[71]  = '042711124'
 LongLife[72]  = '132635043'      &&&&72
 LongLife[73]  = '102855132'
 LongLife[74]  = '131701050'
 LongLife[75]  = '131748039'
 LongLife[76]  = '062804128'
 LongLife[77]  = '132742047'
 LongLife[78]  = '132359036'      &&&&78
 LongLife[79]  = '051199126'
 LongLife[80]  = '131175045'
 LongLife[81]  = '131611034'
 LongLife[82]  = '031866122'
 LongLife[83]  = '133749040'
 LongLife[84]  = '081717130'  && &&84
 LongLife[85]  = '131452049'
 LongLife[86]  = '132742037'
 LongLife[87]  = '052413127'
 LongLife[88]  = '132350046'
 LongLife[89]  = '133222035'       &&2000
 LongLife[90]  = '043477123'        &&2001
 LongLife[91]  = '133402042'
 LongLife[92]  = '133493031'
 LongLife[93]  = '021877121'
 LongLife[94]  = '131386039'
 LongLife[95]  = '072747128'
 LongLife[96]  = '130605048'
 LongLife[97]  = '132349037'
 LongLife[98]  = '053243125'
 LongLife[99]  = '132709044'
 LongLife[100] = '132890033'
 LongLife[101] = '052858222'
 LongLife[102] = '132773240' &&2013
 DIMENSION LMDAY(13)
**农历年月份数
 LMDAY[1] = 1
 LMDAY[2] = 2
 LMDAY[3] = 3
 LMDAY[4] = 4
 LMDAY[5] = 5
 LMDAY[6] = 6
 LMDAY[7] = 7
 LMDAY[8] = 8
 LMDAY[9] = 9
 LMDAY[10] = 10
 LMDAY[11] = 11
 LMDAY[12] = 12
 LMDAY[13] = 13
 DIMENSION sTermInfo(24)
 sTermInfo[1]=0
 sTermInfo[2]=21208
 sTermInfo[3]=42467
 sTermInfo[4]=63836
 sTermInfo[5]=85337
 sTermInfo[6]=107014
 sTermInfo[7]=128867
 sTermInfo[8]=150921
 sTermInfo[9]=173149
 sTermInfo[10]=195551
 sTermInfo[11]=218072
 sTermInfo[12]=240693
 sTermInfo[13]=263343
 sTermInfo[14]=285989
 sTermInfo[15]=308563
 sTermInfo[16]=331033
 sTermInfo[17]=353350
 sTermInfo[18]=375494
 sTermInfo[19]=397447
 sTermInfo[20]=419210
 sTermInfo[21]=440795
 sTermInfo[22]=462224
 sTermInfo[23]=483532
 sTermInfo[24]=525948.76      &&此处的数据原来是504758,现根据全年365天多一点重新计算的
* sTermInfo[25]=525948.76
*以下由许进典增加
 DIMENSION SolarTerm(24)
 SolarTerm[1]="小寒"
 SolarTerm[2]="大寒"
 SolarTerm[3]="立春"
 SolarTerm[4]="雨水"
 SolarTerm[5]="惊蛰"
 SolarTerm[6]="春分"
 SolarTerm[7]="清明"
 SolarTerm[8]="谷雨"
 SolarTerm[9]="立夏"
 SolarTerm[10]="小满"
 SolarTerm[11]="芒种"
 SolarTerm[12]="夏至"
 SolarTerm[13]="小暑"
 SolarTerm[14]="大暑"
 SolarTerm[15]="立秋"
 SolarTerm[16]="处暑"
 SolarTerm[17]="白露"
 SolarTerm[18]="秋分"
 SolarTerm[19]="寒露"
 SolarTerm[20]="霜降"
 SolarTerm[21]="立冬"
 SolarTerm[22]="小雪"
 SolarTerm[23]="大雪"
 SolarTerm[24]="冬至"
DIMENSION sTermInfo1(12)
 sTermInfo1[1]=0
 sTermInfo1[2]=42868.8
 sTermInfo1[3]=86400
 sTermInfo1[4]=130680
 sTermInfo1[5]=175608
 sTermInfo1[6]=220881.6
 sTermInfo1[7]=266097.6
 sTermInfo1[8]=310881.6
 sTermInfo1[9]=354974.4
 sTermInfo1[10]=398332.8
 sTermInfo1[11]=441073
 sTermInfo1[12]=483484.16
 
DIMENSION C3(12)
**中文农历年份名称
 C3[1] ="丑"
 C3[2] ="寅"
 C3[3] ="卯"
 C3[4] ="辰"
 C3[5] ="巳"
 C3[6] ="午"
 C3[7] ="未"
 C3[8] ="申"
 C3[9] ="酉"
 C3[10] ="戌"
 C3[11] ="亥"
 C3[12] ="子"
 
 DIMENSION C4(10)
**天干
 
 C4[1] = "丙"
 C4[2] = "丁"
 C4[3] = "戊"
 C4[4] = "己"
 C4[5] = "庚"
 C4[6] = "辛"
 C4[7] = "壬"
 C4[8] = "癸"
 C4[9] = "甲"
 C4[10]= "乙"
 solar2lunar(year(Ddate),month(Ddate),day(Ddate))
 IF NlMonth < 0
  NlMonth=-NlMonth
  nllian=YearName(Ddate)+"年"
  nlyue='闰'+HZMonth[NlMonth]
  nlyue2='闰'+HZMonth[NlMonth]+nldxy(year(Ddate),NlMonth)
  nll=HZday[NlDay]
  sx=shengxiao(Ddate)
  xq="星期"+hzweek[DOW(DATE)]
  nl1=YearName(Ddate)+"["+sx+"]"+"年"
  lll=lSolarTerm(Ddate)
  llll=lSolarTerm1(Ddate)
 ELSE
  nllian=YearName(Ddate)+"年"
  nlyue=HZMonth[NlMonth]
  nlyue2=HZMonth[NlMonth]+nldxy(year(Ddate),NlMonth)
  nll=HZday[NlDay]
  sx=shengxiao(Ddate)
  xq="星期"+hzweek[DOW(DATE)]
  nl1=YearName(Ddate)+"["+sx+"]"+"年"
  lll=lSolarTerm(Ddate)
  llll=lSolarTerm1(Ddate)
 ENDIF
 DO case
  CASE Can = 1
   m_nl= nllian+nlyue+nll
  CASE Can = 2
   m_nl= lll
  CASE Can=  3
   m_nl= nlyue2
  CASE Can=  4
   m_nl= nll
  CASE Can=  5
   m_nl= sx
  CASE Can=  6
   m_nl= xq
  CASE Can=  7
   m_nl= nl1+nlyue+nll
  CASE Can=  8
   m_nl= ALLTRIM(str(year(date))+"年"+alltrim(str(month(date)))+"月"+alltrim(str(day(date)))+"日")
  CASE Can = 9
   m_nl =nllian
  CASE Can = 10
   m_nl=llll
        CASE can=11
            m_nl =DAYNAME(Ddate)
        CASE can=12
            m_nl=HOURNAME(Ddate)
 ENDCASE
 RETU m_nl
*************************************************************
FUNC YearName(Ddate)
 lyear=year(Ddate)
 sx1=val(subs(LongLife[lyear-1911],8,2))
 Ndate=CTOT(ALLTRIM(str(Year(Ddate))+"/01/01"))
 Ndate=Ddate-Ndate
 IF Ndate<sx1
  lyear=year(Ddate)-1
 ENDIF
 STORE 0 TO xiaoshi, y, ya
 ya = lyear - 1911
 IF ya < 1
  ya = ya + 1
 ENDIF
 IF ya < 12
  ya = ya + 60
 ENDIF
 x= ya + 8 - int((ya + 7) / 10) * 10
 Y = ya - int((ya-1)/ 12) * 12
RETURN C1[x] + C2[y,1]
***********************************************************
FUNC  lSolarTerm1(date)
 LOCAL baseDateAndTime1
 LOCAL newDate1
 LOCAL num1
 LOCAL tempStr1
 LOCAL y1
 local z1
 local z2
 Y1=year(date)
 baseDateAndTime1 = ctod("1900/02/04")
 tempStr1=""
 FOR I=1 To 12
  num1=(365.24219444444444*(y1-1900))+(sTermInfo1[i]/60/24)
  xiaoshi1=num1-int(num1)
  IF xiaoshi1>=0.91319444444444
   num1=int(num1+1)
  ELSE
   num1=int(num1)
  ENDIF
  newDate1=baseDateAndTime1+num1
  
     Z1=((y1-1900)*12+NMONTH(date))%10+1
*     Z2=INT(ROUND(I,0))
*     Z2=I       
     IF newDate1>=date
        tempStr1=C4[Z1]+C3[i]+"月"
*       tempStr1=C3[i]
  EXIT
  ENDIF
  
 ENDFOR 
  RETU tempStr1
***********************************************************
FUNC dayNAME(DDD)
*lyear=day(ddate)
LOCAL ddd1,ddd2
ddd1=dtoc(date)
ddd2=ctod(ddd1)
 ABC=0
 ABC=ddd2-{^1911/02/23}
 x=ABC%10+1
 Y=ABC%12+1
 RETURN C1[X]+C2[Y,1]+"日"
***********************************************************
FUNCTION HOURNAME(JJJ)
LOCAL BBB1,BBB2
BBB1=dtoc(date)
BBB2=ctod(BBB1)
STORE 1 TO NDATE,DHOUR
NDATE=(BBB2-{^1911/02/23})*12
*DATE1=CTOT(alltrim(date1))
*DHOUR=(HOUR(DATE1)-int(hour({^1911/02/23 00:00:00AM})-1))/2
DHOUR=(HOUR(DATE)-int(hour({^1911/02/23 00:00:00AM})-1))/2
*DHOUR=1
DSCN=NDATE+DHOUR
N1=DSCN%10+1
N2=DSCN%12+1
RETURN C1[N1]+C2[N2,1]+"时。"
***********************************************************
FUNC ProcessMagicStr(yy)
 magicstr=""
 STORE 1 TO dsize, LunarMonth
 magicstr = LongLife[yy-1911]
 InterMonth = VAL(SUBS(magicstr,1,2))
 LunarMonth = VAL(SUBS(magicstr,3,4))
 CovertLunarMonth(LunarMonth)
 dsize = VAL(SUBS(magicstr,7,1))
 DO CASE
  CASE dsize =0
   interdays = 0
  CASE dsize =1
   interdays = 29
  CASE dsize =2
   interdays = 30
 ENDCASE
 SLRangeDay = VAL(SUBS(magicstr,8,2))
 RETU
*************************************************************
FUNC CovertLunarMonth(magicno)
 STORE 1 TO i, size, m
 m= magicno
 FOR i= 12 TO 1 STEP -1
  SIZE = MOD(m,2)
  IF size = 0
   LMDAY[i]=29
  ELSE
   LMDAY[i]=30
  ENDIF
  m=INT(m/2)
 ENDFOR
 RETU
*****************************************************************
FUNC IsLeapYear(ayear)
 IF MOD(ayear,4)= 0.and.((MOD(ayear,100)<>0).or.(MOD(ayear,400)= 0))
  RETURN .T.
 ELSE
  RETURN .F.
 ENDIF
********************************************************************
FUNC shengxiao(Ddate)
 lyear=year(Ddate)
 lmonth=month(Ddate)
 lday=day(Ddate)
 STORE 0 TO xiaoshi, y, ya
 sx1=val(subs(LongLife[lyear-1911],8,2))
 Ndate=CTOT(ALLTRIM(str(Year(Ddate))+"/01/01"))
 Ndate=Ddate-Ndate
 IF Ndate<sx1
  lyear=year(Ddate)-1
 ENDIF
 ya = lyear - 1911
 IF ya < 1
  ya = ya + 1
 ENDIF
 IF ya < 12
  ya = ya + 60
 ENDIF
 Y = ya - int((ya-1) / 12) * 12
 RETURN C2[y,2]
********************************************************************
FUNC nldxy(lyear,lmonth)
 iii=DaysPerLunarMonth(lyear,lmonth)
 IF iii=30
  RETURN "大"
 ENDIF
 IF iii=29
  RETURN "小"
 ENDIF
*********************************************
未完,贴子长,一次发不上去,待续。



 
											





 
	    

 
	