陽曆轉陰曆

'下面是一個關於VB的農曆演算法<br />'日期資料定義方法如下<br />'前12個位元組代表1-12月為大月或是小月，1為大月30天，0為小月29天，<br />'第13位為閏月的情況，1為大月30天，0為小月29天，第14位為閏月的月<br />'份，如果不是閏月為0，否則給出月份，10、11、12分別用A、B、C來表<br />'示，即使用16進位。最後4位為當年家農曆新年-即農曆1月1日所在西曆<br />'的日期，如0131代表1月31日。<br />'GetYLDate函數使用方式如下tYear為要輸入的年，tMonth為月，tDay為<br />'日期，YLyear是傳回值，返加農曆的年份，如甲子年，YLShuXing返回<br />'的是屬象，如鼠。IsGetGl是設定是不是通過農曆取西曆值，如果是，<br />'前三個返回相應的西曆日期，而且傳回值是一個西曆日期。</p><p>Function GetYLDate(tYear As Integer, tMonth As Integer, tDay As Integer, _<br /> YLyear As String, YLShuXing As String, _<br /> Optional IsGetGl As Boolean) As String</p><p> On Error Resume Next<br /> Dim daList(1900 To 2011) As String * 18<br /> Dim conDate As Date, setDate As Date<br /> Dim AddMonth As Integer, AddDay As Integer, AddYear As Integer, getDay As Integer<br /> Dim RunYue As Boolean<br /> If tYear > 2010 Or tYear < 1901 Then Exit Function '如果不是有效有日期，退出<br /> '1900 to 1909<br /> daList(1900) = "010010110110180131"<br /> daList(1901) = "010010101110000219"<br /> daList(1902) = "101001010111000208"<br /> daList(1903) = "010100100110150129"<br /> daList(1904) = "110100100110000216"<br /> daList(1905) = "110110010101000204"<br /> daList(1906) = "011010101010140125"<br /> daList(1907) = "010101101010000213"<br /> daList(1908) = "100110101101000202"<br /> daList(1909) = "010010101110120122"<br /> daList(1910) = "010010101110000210"<br /> daList(1911) = "101001001101160130"<br /> daList(1912) = "101001001101000218"<br /> daList(1913) = "110100100101000206"<br /> daList(1914) = "110101010100150126"<br /> daList(1915) = "101101010101000214"<br /> daList(1916) = "010101101010000204"<br /> daList(1917) = "100101101101020123"<br /> daList(1918) = "100101011011000211"<br /> daList(1919) = "010010011011170201"<br /> daList(1920) = "010010011011000220"<br /> daList(1921) = "101001001011000208"<br /> daList(1922) = "101100100101150128"<br /> daList(1923) = "011010100101000216"<br /> daList(1924) = "011011010100000205"<br /> daList(1925) = "101011011010140124"<br /> daList(1926) = "001010110110000213"<br /> daList(1927) = "100101010111000202"<br /> daList(1928) = "010010010111120123"<br /> daList(1929) = "010010010111000210"<br /> daList(1930) = "011001001011060130"<br /> daList(1931) = "110101001010000217"<br /> daList(1932) = "111010100101000206"<br /> daList(1933) = "011011010100150126"<br /> daList(1934) = "010110101101000214"<br /> daList(1935) = "001010110110000204"<br /> daList(1936) = "100100110111030124"<br /> daList(1937) = "100100101110000211"<br /> daList(1938) = "110010010110170131"<br /> daList(1939) = "110010010101000219"<br /> daList(1940) = "110101001010000208"<br /> daList(1941) = "110110100101060127"<br /> daList(1942) = "101101010101000215"<br /> daList(1943) = "010101101010000205"<br /> daList(1944) = "101010101101140125"<br /> daList(1945) = "001001011101000213"<br /> daList(1946) = "100100101101000202"<br /> daList(1947) = "110010010101120122"<br /> daList(1948) = "101010010101000210"<br /> daList(1949) = "101101001010170129"<br /> daList(1950) = "011011001010000217"<br /> daList(1951) = "101101010101000206"<br /> daList(1952) = "010101011010150127"<br /> daList(1953) = "010011011010000214"<br /> daList(1954) = "101001011011000203"<br /> daList(1955) = "010100101011130124"<br /> daList(1956) = "010100101011000212"<br /> daList(1957) = "101010010101080131"<br /> daList(1958) = "111010010101000218"<br /> daList(1959) = "011010101010000208"<br /> daList(1960) = "101011010101060128"<br /> daList(1961) = "101010110101000215"<br /> daList(1962) = "010010110110000205"<br /> daList(1963) = "101001010111040125"<br /> daList(1964) = "101001010111000213"<br /> daList(1965) = "010100100110000202"<br /> daList(1966) = "111010010011030121"<br /> daList(1967) = "110110010101000209"<br /> daList(1968) = "010110101010170130"<br /> daList(1969) = "010101101010000217"<br /> daList(1970) = "100101101101000206"<br /> daList(1971) = "010010101110150127"<br /> daList(1972) = "010010101101000215"<br /> daList(1973) = "101001001101000203"<br /> daList(1974) = "110100100110140123"<br /> daList(1975) = "110100100101000211"<br /> daList(1976) = "110101010010180131"<br /> daList(1977) = "101101010100000218"<br /> daList(1978) = "101101101010000207"<br /> daList(1979) = "100101101101060128"<br /> daList(1980) = "100101011011000216"<br /> daList(1981) = "010010011011000205"<br /> daList(1982) = "101001001011140125"<br /> daList(1983) = "101001001011000213"<br /> daList(1984) = "1011001001011A0202"<br /> daList(1985) = "011010100101000220"<br /> daList(1986) = "011011010100000209"<br /> daList(1987) = "101011011010060129"<br /> daList(1988) = "101010110110000217"<br /> daList(1989) = "100100110111000206"<br /> daList(1990) = "010010010111150127"<br /> daList(1991) = "010010010111000215"<br /> daList(1992) = "011001001011000204"<br /> daList(1993) = "011010100101030123"<br /> daList(1994) = "111010100101000210"<br /> daList(1995) = "011010110010180131"<br /> daList(1996) = "010110101100000219"<br /> daList(1997) = "101010110110000207"<br /> daList(1998) = "100100110110150128"<br /> daList(1999) = "100100101110000216"<br /> daList(2000) = "110010010110000205"<br /> daList(2001) = "110101001010140124"<br /> daList(2002) = "110101001010000212"<br /> daList(2003) = "110110100101000201"<br /> daList(2004) = "010110101010120122"<br /> daList(2005) = "010101101010000209"<br /> daList(2006) = "101010101101170129"<br /> daList(2007) = "001001011101000218"<br /> daList(2008) = "100100101101000207"<br /> daList(2009) = "110010010101150126"<br /> daList(2010) = "101010010101000214"<br /> daList(2011) = "101101001010000214"<br /> AddYear = tYear<br /> RunYue = False</p><p> If IsGetGl Then<br /> AddMonth = Val(Mid(daList(AddYear), 15, 2))<br /> AddDay = Val(Mid(daList(AddYear), 17, 2))<br /> conDate = DateSerial(AddYear, AddMonth, AddDay)<br /> AddDay = tDay<br /> For i = 1 To tMonth - 1<br /> AddDay = AddDay + 29 + Val(Mid(daList(tYear), i, 1))<br /> Next i<br /> 'MsgBox DateDiff("d", conDate, Date)<br /> setDate = DateAdd("d", AddDay - 1, conDate)<br /> GetYLDate = setDate<br /> tYear = Year(setDate)<br /> tMonth = Month(setDate)<br /> tDay = Day(setDate)<br /> Exit Function<br /> End If<br />CHUSHIHUA:<br /> AddMonth = Val(Mid(daList(AddYear), 15, 2))<br /> AddDay = Val(Mid(daList(AddYear), 17, 2))<br /> conDate = DateSerial(AddYear, AddMonth, AddDay)<br /> setDate = DateSerial(tYear, tMonth, tDay)<br /> getDay = DateDiff("d", conDate, setDate)<br /> If getDay < 0 Then AddYear = AddYear - 1: GoTo CHUSHIHUA<br /> ' addday = NearDay<br /> AddDay = 1: AddMonth = 1<br /> For i = 1 To getDay<br /> AddDay = AddDay + 1<br /> If AddDay = 30 + Mid(daList(AddYear), AddMonth, 1) Or (RunYue And AddDay = 30 + Mid(daList(AddYear), 13, 1)) Then<br /> If RunYue = False And AddMonth = Val("&H" & Mid(daList(AddYear), 14, 1)) Then<br /> RunYue = True<br /> Else<br /> RunYue = False<br /> AddMonth = AddMonth + 1<br /> End If<br /> AddDay = 1<br /> End If</p><p> Next</p><p> md$ = "初一初二初三初四初五初六初七初八初九初十十一十二十三十四十五十六十七十八十九二十廿一廿二廿三廿四廿五廿六廿七廿八廿九三十"<br /> dd$ = Mid(md$, (AddDay - 1) * 2 + 1, 2)<br /> mm$ = Mid("正二三四五六七八九十寒臘", AddMonth, 1) + "月"<br /> YouGetDate = DateSerial(AddYear, AddMonth, AddDay)<br /> tiangan$ = "甲乙丙丁戊已庚辛壬癸"<br /> dizhi$ = "子醜寅卯辰巳午未申酉戌亥"<br /> Dim ganzhi(0 To 59) As String * 2<br /> For i = 0 To 59<br /> ganzhi(i) = Mid(tiangan$, (i Mod 10) + 1, 1) + Mid(dizhi$, (i Mod 12) + 1, 1)<br /> 'ff$ = ff$ + ganzhi(i)<br /> Next i<br /> 'MsgBox ff$, , Len(ff$)<br /> YLyear = ganzhi((AddYear - 4) Mod 60)<br /> shu$ = "鼠牛虎兔龍蛇馬羊猴雞狗豬"<br /> YLShuXing = Mid(shu$, ((AddYear - 4) Mod 12) + 1, 1)<br /> If RunYue Then mm$ = "閏" + mm$</p><p> GetYLDate = mm$ + dd$</p><p>End Function<br />

 

http://www.cx66.com/cxgzs/program/vb/953.htm