在下将一段关于农历的代码改进为能显现农历年、月、日、时的天干地支的代码,但太繁了,求朋友指点如何能够精炼一点?再就是里面还有一点小地方未能完全完善,如何完善?还有,就是如何能将输出的结果适用到表单的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
*********************************************
未完,贴子长,一次发不上去,待续。