VB计算农历的算法

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)