全文预览已结束
下载本文档
版权说明:本文档由用户提供并上传,收益归属内容提供方,若内容存在侵权,请进行举报或认领
文档简介
VB计算农历的算法发表日期:2002-09-13 作者:李立华原创 出处:下面是一个关于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 NextDim daList(1900 To 2011) As String * 18Dim conDate As Date, setDate As DateDim AddMonth As Integer, AddDay As Integer, AddYear As Integer, getDay As IntegerDim RunYue As BooleanIf tYear 2010 Or tYear 1901 Then Exit Function 如果不是有效有日期,退出1900 to 1909 daList(1900) = 010010110110180131daList(1901) = 010010101110000219daList(1902) = 101001010111000208daList(1903) = 010100100110150129daList(1904) = 110100100110000216daList(1905) = 110110010101000204daList(1906) = 011010101010140125daList(1907) = 010101101010000213daList(1908) = 100110101101000202daList(1909) = 010010101110120122daList(1910) = 010010101110000210daList(1911) = 101001001101160130daList(1912) = 101001001101000218daList(1913) = 110100100101000206daList(1914) = 110101010100150126daList(1915) = 101101010101000214daList(1916) = 010101101010000204daList(1917) = 100101101101020123daList(1918) = 100101011011000211daList(1919) = 010010011011170201daList(1920) = 010010011011000220daList(1921) = 101001001011000208daList(1922) = 101100100101150128daList(1923) = 011010100101000216daList(1924) = 011011010100000205daList(1925) = 101011011010140124daList(1926) = 001010110110000213daList(1927) = 100101010111000202daList(1928) = 010010010111120123daList(1929) = 010010010111000210daList(1930) = 011001001011060130daList(1931) = 110101001010000217daList(1932) = 111010100101000206daList(1933) = 011011010100150126daList(1934) = 010110101101000214daList(1935) = 001010110110000204daList(1936) = 100100110111030124daList(1937) = 100100101110000211daList(1938) = 110010010110170131daList(1939) = 110010010101000219daList(1940) = 110101001010000208daList(1941) = 110110100101060127daList(1942) = 101101010101000215daList(1943) = 010101101010000205daList(1944) = 101010101101140125daList(1945) = 001001011101000213daList(1946) = 100100101101000202daList(1947) = 110010010101120122daList(1948) = 101010010101000210daList(1949) = 101101001010170129daList(1950) = 011011001010000217daList(1951) = 101101010101000206daList(1952) = 010101011010150127daList(1953) = 010011011010000214daList(1954) = 101001011011000203daList(1955) = 010100101011130124daList(1956) = 010100101011000212daList(1957) = 101010010101080131daList(1958) = 111010010101000218daList(1959) = 011010101010000208daList(1960) = 101011010101060128daList(1961) = 101010110101000215daList(1962) = 010010110110000205daList(1963) = 101001010111040125daList(1964) = 101001010111000213daList(1965) = 010100100110000202daList(1966) = 111010010011030121daList(1967) = 110110010101000209daList(1968) = 010110101010170130daList(1969) = 010101101010000217daList(1970) = 100101101101000206daList(1971) = 010010101110150127daList(1972) = 010010101101000215daList(1973) = 101001001101000203daList(1974) = 110100100110140123daList(1975) = 110100100101000211daList(1976) = 110101010010180131daList(1977) = 101101010100000218daList(1978) = 101101101010000207daList(1979) = 100101101101060128daList(1980) = 100101011011000216daList(1981) = 010010011011000205daList(1982) = 101001001011140125daList(1983) = 101001001011000213daList(1984) = 1011001001011A0202daList(1985) = 011010100101000220daList(1986) = 011011010100000209daList(1987) = 101011011010060129daList(1988) = 101010110110000217daList(1989) = 100100110111000206daList(1990) = 010010010111150127daList(1991) = 010010010111000215daList(1992) = 011001001011000204daList(1993) = 011010100101030123daList(1994) = 111010100101000210daList(1995) = 011010110010180131daList(1996) = 010110101100000219daList(1997) = 101010110110000207daList(1998) = 100100110110150128daList(1999) = 100100101110000216daList(2000) = 110010010110000205daList(2001) = 110101001010140124daList(2002) = 110101001010000212daList(2003) = 110110100101000201daList(2004) = 010110101010120122daList(2005) = 010101101010000209daList(2006) = 101010101101170129daList(2007) = 001001011101000218daList(2008) = 100100101101000207daList(2009) = 110010010101150126daList(2010) = 101010010101000214daList(2011) = 101101001010000214AddYear = tYearRunYue = FalseIf IsGetGl ThenAddMonth = Val(Mid(daList(AddYear), 15, 2)AddDay = Val(Mid(daList(AddYear), 17, 2)conDate = DateSerial(AddYear, AddMonth, AddDay)AddDay = tDayFor i = 1 To tMonth - 1AddDay = AddDay + 29 + Val(Mid(daList(tYear), i, 1)Next iMsgBox DateDiff(d, conDate, Date)setDate = DateAdd(d, AddDay - 1, conDate)GetYLDate = setDatetYear = Year(setDate)tMonth = Month(setDate)tDay = Day(setDate)Exit FunctionEnd IfCHUSHIHUA: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 = NearDayAddDay = 1: AddMonth = 1For i = 1 To getDayAddDay = AddDay + 1If AddDay = 30 + Mid(daList(AddYear), AddMonth, 1) Or (RunYue And AddDay = 30 + Mid(daList(AddYear), 13, 1) ThenIf RunYue = False And AddMonth = Val(&H & Mid(daList(AddYear), 14, 1) ThenRunYue = TrueElseRunYue = FalseAddMonth = AddMonth + 1End IfAddDay = 1End IfNextmd$ = 初一初二初三初四初五初六初七初八初九初十十一十二十三十四十五十六十七十八十九二十廿一廿二廿三廿四廿五廿六廿七廿八廿九三十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 * 2For i = 0 To 59ganzhi(i) = Mid(tiangan$, (i Mod 10)
温馨提示
- 1. 本站所有资源如无特殊说明,都需要本地电脑安装OFFICE2007和PDF阅读器。图纸软件为CAD,CAXA,PROE,UG,SolidWorks等.压缩文件请下载最新的WinRAR软件解压。
- 2. 本站的文档不包含任何第三方提供的附件图纸等,如果需要附件,请联系上传者。文件的所有权益归上传用户所有。
- 3. 本站RAR压缩包中若带图纸,网页内容里面会有图纸预览,若没有图纸预览就没有图纸。
- 4. 未经权益所有人同意不得将文件中的内容挪作商业或盈利用途。
- 5. 人人文库网仅提供信息存储空间,仅对用户上传内容的表现方式做保护处理,对用户上传分享的文档内容本身不做任何修改或编辑,并不能对任何下载内容负责。
- 6. 下载文件中如有侵权或不适当内容,请与我们联系,我们立即纠正。
- 7. 本站不保证下载资源的准确性、安全性和完整性, 同时也不承担用户因使用这些下载资源对自己和他人造成任何形式的伤害或损失。
最新文档
- 古玩字画图书典籍
- 武汉市江夏区2020年高二上学期期中联考语文试题(人教版)
- 青海省西宁市市级名校2023-2024学年中考冲刺卷语文试题含解析
- 怒江市重点中学2023-2024学年中考化学全真模拟试卷含解析
- 宁波市鄞州区2024届中考押题化学预测卷含解析
- 2024年分步重复光刻机合作协议书
- 2024年木质纤维合作协议书
- 内蒙古自治区乌海市第三中学2023-2024学年十校联考最后物理试题含解析
- 内蒙古自治区呼伦贝尔市、兴安盟2024年中考一模化学试题含解析
- 内蒙古自治区赤峰市翁牛特旗乌丹第三中学2024年中考数学模拟试题含解析
- 在线网课学习智慧知道《游戏原画场景设计(基础)(川音)》单元测试考核答案
- 2024届浙江省宁波江东区重点名校中考历史对点突破模拟试卷含解析
- 2024-分期付款车辆转让协议书
- 建筑消防设施检测投标方案
- 浙江温州市文物考古研究所招聘历年高频考题难、易错点模拟试题(共500题)附带答案详解
- 放射诊疗许可申请表
- 2024年湖北省荆州职业技术学院事业单位招聘20人历年高频考题难、易错点模拟试题(共500题)附带答案详解
- 新保密法修订及影响专题讲座课件
- 2023年广州市公安局越秀区分局招聘辅警考试真题及答案
- 高速压力机设计
- 国际金融中心弱电深化设计投标文件(技术部分)
评论
0/150
提交评论