VB编程计算农历的计算方法

核心提示：'下面是一个关于VB的农历算法'日期数据定义方法如下'前12个字节代表1-12月为大月或是小月，1为大月30天，VB编程计算农历的计算方法，0为小月29天，'第13位为闰月的情况，退出'1900to1909daList(1900)="010010110110180131

'下面是一个关于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是设置是不是通过农历取公历值，如果是，

'前三个返回相应的公历日期，而且返回值是一个公历日期。


FunctionGetYLDate(tYearAsInteger,tMonthAsInteger,tDayAsInteger,_

YLyearAsString,YLShuXingAsString,_

OptionalIsGetGlAsBoolean)AsString


OnErrorResumeNext

DimdaList(1900To2011)AsString*18

DimconDateAsDate,setDateAsDate

DimAddMonthAsInteger,AddDayAsInteger,AddYearAsInteger,getDayAsInteger

DimRunYueAsBoolean

IftYear＞2010OrtYear＜1901ThenExitFunction'如果不是有效有日期，退出

'1900to1909

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



IfIsGetGlThen

AddMonth=Val(Mid(daList(AddYear),15,2))

AddDay=Val(Mid(daList(AddYear),17,2))

conDate=DateSerial(AddYear,AddMonth,AddDay)

AddDay=tDay

Fori=1TotMonth-1

AddDay=AddDay 29 Val(Mid(daList(tYear),i,1))

Nexti

'MsgBoxDateDiff("d",conDate,Date)

setDate=DateAdd("d",AddDay-1,conDate)

GetYLDate=setDate

tYear=Year(setDate)

tMonth=Month(setDate)

tDay=Day(setDate)

ExitFunction

EndIf

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)

IfgetDay<0ThenAddYear=AddYear-1:GoToCHUSHIHUA

'addday=NearDay

AddDay=1:AddMonth=1

Fori=1TogetDay

AddDay=AddDay 1

IfAddDay=30 Mid(daList(AddYear),AddMonth,1)Or(RunYueAndAddDay=30 Mid(daList(AddYear),13,1))Then

IfRunYue=FalseAndAddMonth=Val("&H"&Mid(daList(AddYear),14,1))Then

RunYue=True

Else

RunYue=False

AddMonth=AddMonth 1

EndIf

AddDay=1

EndIf



Next



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

dd$=Mid(md$,(AddDay-1)*2 1,2)

mm$=Mid("正二三四五六七八九十寒腊",AddMonth,1) "月"

YouGetDate=DateSerial(AddYear,AddMonth,AddDay)

tiangan$="甲乙丙丁戊已庚辛壬癸"

dizhi$="子丑寅卯辰巳午未申酉戌亥"

Dimganzhi(0To59)AsString*2

Fori=0To59

ganzhi(i)=Mid(tiangan$,(iMod10) 1,1) Mid(dizhi$,(iMod12) 1,1)

'ff$=ff$ ganzhi(i)

Nexti

'MsgBoxff$,,Len(ff$)

YLyear=ganzhi((AddYear-4)Mod60)

shu$="鼠牛虎兔龙蛇马羊猴鸡狗猪"

YLShuXing=Mid(shu$,((AddYear-4)Mod12) 1,1)

IfRunYueThenmm$="闰" mm$



GetYLDate=mm$ dd$


EndFunction



'下面是一个使用的例子，你需要在窗体上加上一个按扭，并命名为Command1，然后将下列代码复制到窗体的代码中

PRivateSubCommand1_Click()

DimtyAsInteger,tmAsInteger,tdAsInteger,ylAsString,sxAsString

'取公历1999年10月28日的农历日期

ty=1999

tm=10

td=28

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

MsgBoxt

MsgBoxty&"-"&tm&"-"&td&""&yl&""&sx

'取1999年农历十月28的公历日期

t=GetYLDate(ty,tm,td,yl,sx,True)

MsgBoxt

MsgBoxty&"-"&tm&"-"&td&""&yl&""&sx



EndSub->