VB計(jì)算農(nóng)歷的算法

2024-07-21 02:20:50

字體：大中小

供稿：網(wǎng)友

'下面是一個(gè)關(guān)于vb的農(nóng)歷算法

'日期數(shù)據(jù)定義方法如下

'前12個(gè)字節(jié)代表1-12月為大月或是小月，1為大月30天，0為小月29天，

'第13位為閏月的情況，1為大月30天，0為小月29天，第14位為閏月的月

'份，如果不是閏月為0，否則給出月份，10、11、12分別用a、b、c來表

'示，即使用16進(jìn)制。最后4位為當(dāng)年家農(nóng)歷新年-即農(nóng)歷1月1日所在公歷

'的日期，如0131代表1月31日。

'getyldate函數(shù)使用方式如下tyear為要輸入的年，tmonth為月，tday為

'日期，ylyear是返回值，返加農(nóng)歷的年份，如甲子年，ylshuxing返回

'的是屬象，如鼠。isgetgl是設(shè)置是不是通過農(nóng)歷取公歷值，如果是，

'前三個(gè)返回相應(yīng)的公歷日期，而且返回值是一個(gè)公歷日期。

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 next

dim dalist(1900 to 2011) as string * 18

dim condate as date, setdate as date

dim addmonth as integer, addday as integer, addyear as integer, getday as integer

dim runyue as boolean

if tyear > 2010 or tyear < 1901 then exit function '如果不是有效有日期，退出

'1900 to 1909

dalist(1900) = "010010110110180131"

dalist(1901) = "010010101110000219"

dalist(1902) = "101001010111000208"

dalist(1903) = "010100100110150129"

dalist(1904) = "110100100110000216"

dalist(1905) = "110110010101000204"

dalist(1906) = "011010101010140125"

dalist(1907) = "010101101010000213"

dalist(1908) = "100110101101000202"

dalist(1909) = "010010101110120122"

dalist(1910) = "010010101110000210"

dalist(1911) = "101001001101160130"

dalist(1912) = "101001001101000218"

dalist(1913) = "110100100101000206"

dalist(1914) = "110101010100150126"

dalist(1915) = "101101010101000214"

dalist(1916) = "010101101010000204"

dalist(1917) = "100101101101020123"

dalist(1918) = "100101011011000211"

dalist(1919) = "010010011011170201"

dalist(1920) = "010010011011000220"

dalist(1921) = "101001001011000208"

dalist(1922) = "101100100101150128"

dalist(1923) = "011010100101000216"

dalist(1924) = "011011010100000205"

dalist(1925) = "101011011010140124"

dalist(1926) = "001010110110000213"

dalist(1927) = "100101010111000202"

dalist(1928) = "010010010111120123"

dalist(1929) = "010010010111000210"

dalist(1930) = "011001001011060130"

dalist(1931) = "110101001010000217"

dalist(1932) = "111010100101000206"

dalist(1933) = "011011010100150126"

dalist(1934) = "010110101101000214"

dalist(1935) = "001010110110000204"

dalist(1936) = "100100110111030124"

dalist(1937) = "100100101110000211"

dalist(1938) = "110010010110170131"

dalist(1939) = "110010010101000219"

dalist(1940) = "110101001010000208"

dalist(1941) = "110110100101060127"

dalist(1942) = "101101010101000215"

dalist(1943) = "010101101010000205"

dalist(1944) = "101010101101140125"

dalist(1945) = "001001011101000213"

dalist(1946) = "100100101101000202"

dalist(1947) = "110010010101120122"

dalist(1948) = "101010010101000210"

dalist(1949) = "101101001010170129"

dalist(1950) = "011011001010000217"

dalist(1951) = "101101010101000206"

dalist(1952) = "010101011010150127"

dalist(1953) = "010011011010000214"

dalist(1954) = "101001011011000203"

dalist(1955) = "010100101011130124"

dalist(1956) = "010100101011000212"

dalist(1957) = "101010010101080131"

dalist(1958) = "111010010101000218"

dalist(1959) = "011010101010000208"

dalist(1960) = "101011010101060128"

dalist(1961) = "101010110101000215"

dalist(1962) = "010010110110000205"

dalist(1963) = "101001010111040125"

dalist(1964) = "101001010111000213"

dalist(1965) = "010100100110000202"

dalist(1966) = "111010010011030121"

dalist(1967) = "110110010101000209"

dalist(1968) = "010110101010170130"

dalist(1969) = "010101101010000217"

dalist(1970) = "100101101101000206"

dalist(1971) = "010010101110150127"

dalist(1972) = "010010101101000215"

dalist(1973) = "101001001101000203"

dalist(1974) = "110100100110140123"

dalist(1975) = "110100100101000211"

dalist(1976) = "110101010010180131"

dalist(1977) = "101101010100000218"

dalist(1978) = "101101101010000207"

dalist(1979) = "100101101101060128"

dalist(1980) = "100101011011000216"

dalist(1981) = "010010011011000205"

dalist(1982) = "101001001011140125"

dalist(1983) = "101001001011000213"

dalist(1984) = "1011001001011a0202"

dalist(1985) = "011010100101000220"

dalist(1986) = "011011010100000209"

dalist(1987) = "101011011010060129"

dalist(1988) = "101010110110000217"

dalist(1989) = "100100110111000206"

dalist(1990) = "010010010111150127"

dalist(1991) = "010010010111000215"

dalist(1992) = "011001001011000204"

dalist(1993) = "011010100101030123"

dalist(1994) = "111010100101000210"

dalist(1995) = "011010110010180131"

dalist(1996) = "010110101100000219"

dalist(1997) = "101010110110000207"

dalist(1998) = "100100110110150128"

dalist(1999) = "100100101110000216"

dalist(2000) = "110010010110000205"

dalist(2001) = "110101001010140124"

dalist(2002) = "110101001010000212"

dalist(2003) = "110110100101000201"

dalist(2004) = "010110101010120122"

dalist(2005) = "010101101010000209"

dalist(2006) = "101010101101170129"

dalist(2007) = "001001011101000218"

dalist(2008) = "100100101101000207"

dalist(2009) = "110010010101150126"

dalist(2010) = "101010010101000214"

dalist(2011) = "101101001010000214"

addyear = tyear

runyue = false

if isgetgl then

addmonth = val(mid(dalist(addyear), 15, 2))

addday = val(mid(dalist(addyear), 17, 2))

condate = dateserial(addyear, addmonth, addday)

addday = tday

for i = 1 to tmonth - 1

addday = addday + 29 + val(mid(dalist(tyear), i, 1))

next i

'msgbox datediff("d", condate, date)

setdate = dateadd("d", addday - 1, condate)

getyldate = setdate

tyear = year(setdate)

tmonth = month(setdate)

tday = day(setdate)

exit function

end if

chushihua:

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 = nearday

addday = 1: addmonth = 1

for i = 1 to getday

addday = addday + 1

if addday = 30 + mid(dalist(addyear), addmonth, 1) or (runyue and addday = 30 + mid(dalist(addyear), 13, 1)) then

if runyue = false and addmonth = val("&h" & mid(dalist(addyear), 14, 1)) then

runyue = true

else

runyue = false

addmonth = addmonth + 1

end if

addday = 1

end if

next

md$ = "初一初二初三初四初五初六初七初八初九初十十一十二十三十四十五十六十七十八十九二十廿一廿二廿三廿四廿五廿六廿七廿八廿九三十"

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 * 2

for i = 0 to 59

ganzhi(i) = mid(tiangan$, (i mod 10) + 1, 1) + mid(dizhi$, (i mod 12) + 1, 1)

'ff$ = ff$ + ganzhi(i)

next i

'msgbox ff$, , len(ff$)

ylyear = ganzhi((addyear - 4) mod 60)

shu$ = "鼠牛虎兔龍蛇馬羊猴雞狗豬"

ylshuxing = mid(shu$, ((addyear - 4) mod 12) + 1, 1)

if runyue then mm$ = "閏" + mm$

getyldate = mm$ + dd$

end function

'下面是一個(gè)使用的例子，你需要在窗體上加上一個(gè)按扭，并命名為command1，然后將下列代碼復(fù)制到窗體的代碼中

private sub command1_click()

dim ty as integer, tm as integer, td as integer, yl as string, sx as string

'取公歷1999年10月28日的農(nóng)歷日期

ty = 1999

tm = 10

td = 28

t = getyldate(ty, tm, td, yl, sx)

msgbox t

msgbox ty & "-" & tm & "-" & td & " " & yl & " " & sx

'取1999年農(nóng)歷十月28的公歷日期

t = getyldate(ty, tm, td, yl, sx, true)

msgbox t

msgbox ty & "-" & tm & "-" & td & " " & yl & " " & sx

end sub

收集最實(shí)用的網(wǎng)頁(yè)特效代碼！

上一篇：VB中判斷數(shù)組維數(shù)

下一篇：VB的API編程精粹