The algorithm of calculating lunar calendar by VB

Chinese Lunar | Algorithm ' The following is a lunar algorithm about VB


' Date data definition method is as follows

' The first 12 bytes represent January-December for Semi-rotary or Luna, 1 for semi-rotary 30 days, 0 for the Moon 29 days,

' 13th is the case of the leap month, 1 for semi-rotary 30 days, 0 for the Moon 29 days, and the 14th for leap months

' Part, if not the leap month is 0, otherwise give the month, 10, 11, 12, respectively, with a, B, C to table

' Shown, even with 16. The last 4 were the Lunar New year-the Gregorian calendar of the lunar January 1

' The date, such as 0131 represents January 31.

The ' getyldate function is used as follows tyear for the year to enter, Tmonth for month, Tday for

' Date, Ylyear is the return value, returning the year of the lunar calendar, such as the years of the year, ylshuxing return

' is a genus of elephants, like rats. ISGETGL is the setting is not to take the Gregorian value through the lunar calendar, if it is,

The top three returns the corresponding Gregorian date, and the return value is a Gregorian date.


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) 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 > Or tyear < 1901 Then exit Function ' if not valid have date, exit

' 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 + + 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 = + Mid (dalist (addyear), Addmonth, 1) Or (Runyue and addday = + Mid (dalist (addyear), 1)) Then

If Runyue = False and Addmonth = Val ("&h" & Mid (Dalist (addyear), 1) Then

Runyue = True

Else

Runyue = False

Addmonth = addmonth + 1

End If

Addday = 1

End If



Next



md$ = "First grade Hansi Duanwu arrest When初七because Day 1.,234,567,892,212,22e,+28"

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

mm$ = Mid ("234,567,890 cold Wax", addmonth, 1) + "Month"

Yougetdate = DateSerial (Addyear, Addmonth, Addday)

tiangan$ = "B-Butyl Xing"

dizhi$ = "Kaniko Chen has not Shin in the afternoon"

Dim Ganzhi (0 to) as String * 2

For i = 0 to 59

Ganzhi (i) = Mid (tiangan$, (i mod) + 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$ = "Rat ox tiger rabbit snake horse sheep monkey chicken Dog Pig"

ylshuxing = Mid (shu$, (AddYear-4) Mod 12) + 1, 1)

If Runyue Then mm$ = "leap" + mm$



Getyldate = mm$ + dd$


End Function


' Here's an example of using, you need to add a button on the form, name it Command1, and then copy the following code into the form's code

Private Sub Command1_Click ()

Dim ty As Integer, TM As Integer, TD As Integer, YL as String, SX as String

' Take the Gregorian calendar October 28, 1999 lunar Calendar date

ty = 1999

TM = 10

TD = 28

t = getyldate (Ty, TM, TD, YL, SX)

MsgBox T

MsgBox Ty & "-" & TM & "-" & TD & "" & Yl & "" & SX

' Take the Gregorian date of 1999 lunar October 28

t = getyldate (Ty, TM, TD, YL, SX, True)

MsgBox T

MsgBox Ty & "-" & TM & "-" & TD & "" & Yl & "" & SX



End Sub