| 网站首页 | 业界新闻 | 小组 | 威客 | 人才 | 下载频道 | 博客 | 代码贴 | 在线编程 | 编程论坛
欢迎加入我们,一同切磋技术
用户名:   
 
密 码:  
共有 1383 人关注过本帖
标题:[求助]续:一段关于万年历的代码,如何精简?
只看楼主 加入收藏
南方闲人
Rank: 1
等 级:新手上路
帖 子:12
专家分:0
注 册:2007-7-17
收藏
 问题点数:0 回复次数:6 
[求助]续:一段关于万年历的代码,如何精简?


接前面发出的贴子,代码也接前。
FUNC DaysPerLunarMonth(lyear,lmonth)
ProcessMagicStr(lyear)
IF lmonth < 0
RETURN interdays
ELSE
RETURN LMDAY[LMonth]
ENDIF

**************************************
FUNC solar2lunar(syear,smonth,sday)
STORE 0 to I, nDay
nDay= 0
IF IsLeapYear(syear)
SMDay[2] = 29
ELSE
* SMDay[2] = 28
ENDIF
ProcessMagicStr(syear)
IF (smonth == 1)
nDay = sday
ELSE
FOR I=1 to smonth-1 step 1
nDay = nDay + SMDay[i]
ENDFOR
nDay = nDay + sday
ENDIF
IF nDay <= SLRangeDay
nDay = nDay - SLRangeDay
ProcessMagicStr(syear-1)
FOR I=12 to 1 step -1
nDay = nDay + LMDAY[i]
IF nDay > 0
EXIT
ENDIF
ENDFOR
lyear = syear - 1
lmonth= I
lday = nDay
ELSE
nDay = nDay - SLRangeDay
FOR I=1 to InterMonth-1 step 1
nDay = nDay - LMDAY[i]
IF nDay <= 0
EXIT
ENDIF
ENDFOR
IF nDay <= 0
lyear = syear
lmonth = I
lday = nDay + LMDAY[i]
ELSE
nDay = nDay - LMDAY[InterMonth]
IF nDay <= 0
lyear = syear
lmonth = InterMonth
lday = nDay + LMDAY[InterMonth]
ELSE
LMDAY[InterMonth] = interdays
FOR I=InterMonth to 12 step 1
nDay = nDay - LMDAY[i]
IF nDay <= 0
EXIT
ENDIF
ENDFOR

IF I= InterMonth
lmonth= 0 - InterMonth
lyear = syear
lday = nDay + LMDAY[i]
ELSE
lmonth =I
lyear = syear
lday = nDay + LMDAY[i]
ENDIF
* LYear = SYear
* LDay = nDay + ThisForm.LMDay[i]
ENDIF
ENDIF
ENDIF

nlYear=lyear
NlMonth=lmonth
NlDay=lday
IF lmonth<0
lmonth=-lmonth
RETURN "闰"+HZMonth[LMonth]+HZday[LDay]
ELSE
RETURN HZMonth[LMonth]+HZday[LDay]
ENDIF
********************************************************
FUNC lSolarTerm(date)
LOCAL baseDateAndTime
LOCAL newDate
LOCAL num
LOCAL tempStr
LOCAL y
LOCAL AAA1
LOCAL AAA2   
Y=year(date)
baseDateAndTime=ctod("1900/01/06")
tempStr=""
FOR I=1 To 24
num=365.24219444444444*(y-1900)+(sTermInfo[i]/60/24)
xiaoshi=num-int(num)
IF xiaoshi>=0.91319444444444
num=int(num+1)
ELSE
num=int(num)
ENDIF
newDate=baseDateAndTime+num
AAA1=dtoc(date)
AAA2=ctod(AAA1)
IF newDate=AAA2
tempStr=SolarTerm[i]
EXIT
ENDIF
ENDFOR
RETU tempStr
*********************************************
FUNCTION NMONTH(date)
LOCAL baseDateAndTime2
LOCAL newDate2
LOCAL num2
LOCAL tempStr2
LOCAL y2
Y2=year(date)
baseDateAndTime2=ctod("1900/02/04")
tempStr2 = ""
FOR x= 1 To 12
num2 = 365.24219444444444*(y2-1900)+(sTermInfo1[x]/60/24)
xiaoshi2=num2-int(num2)
IF xiaoshi2>= 0.91319444444444
num2=int(num2+1)
ELSE
num2=int(num2)
ENDIF
newDate2=baseDateAndTime2+num2
IF newDate2>=date

EXIT
ENDIF
ENDFOR
RETURN x
*********************************************

CANCEL

搜索更多相关主题的帖子: 万年历 代码 syear nDay 精简 
2007-07-20 22:15
南方闲人
Rank: 1
等 级:新手上路
帖 子:12
专家分:0
注 册:2007-7-17
收藏
得分:0 
在下经数日动脑,已经将其中一个问题解决,即如何将结果输出到TEXT1之中?方法是:将NONGLI()赋给一个变量,再将其在TETURN中返回即可。程序中虽然有10多个NONGLI(),可以用“+”连接即可以了。不知是否还有更佳的解法?盼望指正。
2007-07-24 22:53
Tiger5392
Rank: 12Rank: 12Rank: 12
等 级:贵宾
威 望:88
帖 子:2775
专家分:2237
注 册:2006-5-17
收藏
得分:0 
好像有类似的日历控件,拿来使用即可。真不知道楼主哪里找来这个运算程序,好多的数据怎么来的,一点也不懂,除非是天文学家。

感言:学以致用。 博客:http://www./blog/user14/65009/index.shtml email:Tiger5392@
2007-07-24 23:12
hu9jj
Rank: 20Rank: 20Rank: 20Rank: 20Rank: 20
来 自:红土地
等 级:贵宾
威 望:400
帖 子:11857
专家分:43421
注 册:2006-5-13
收藏
得分:0 
我以前在袖珍计算机上用BASEC语言编制过一个日历打印程序.我是用笨办法:给公元元年1月1日一个固定的星期几(通过推算得到),然后在此基础上计算之后的日历.打印公元后的日历没有问题(但没有农历).

活到老,学到老!http://www.(该域名已经被ISP盗卖了)E-mail:hu-jj@
2007-07-25 20:37
南方闲人
Rank: 1
等 级:新手上路
帖 子:12
专家分:0
注 册:2007-7-17
收藏
得分:0 
在下是从网上一个将公历简单地转为农历的代码改编而成,原代码不涉及到农历中的天干与地支计算,在下全部重新配置了一下,但尚不完善,盼望能得到各位朋友指点,下一步,在下想以此为基础,编一个有关玄学的小软件,不知最终能如愿否?
2007-07-25 20:40
Tiger5392
Rank: 12Rank: 12Rank: 12
等 级:贵宾
威 望:88
帖 子:2775
专家分:2237
注 册:2006-5-17
收藏
得分:0 
建议你编制完成以后封装,或者用VB改编成OCX调用。

感言:学以致用。 博客:http://www./blog/user14/65009/index.shtml email:Tiger5392@
2007-07-26 00:31
南方闲人
Rank: 1
等 级:新手上路
帖 子:12
专家分:0
注 册:2007-7-17
收藏
得分:0 

谢谢楼上的Tigre5392朋友!

2007-07-29 20:09
快速回复:[求助]续:一段关于万年历的代码,如何精简?
数据加载中...
 
   



关于我们 | 广告合作 | 编程中国 | 清除Cookies | TOP | 手机版

编程中国 版权所有,并保留所有权利。
Powered by Discuz, Processed in 0.108406 second(s), 7 queries.
Copyright©2004-2024, BCCN.NET, All Rights Reserved