Método de cálculo del calendario lunar VB

'El siguiente es un algoritmo de calendario lunar en VB

'Proporciona métodos de cálculo básicos y puedes complementarlos con aplicaciones específicas

'La definición de datos de fecha El método es el siguiente

'Los primeros 12 bytes representan si de enero a diciembre es un mes grande o un mes pequeño, 1 es un mes grande con 30 días, 0 es un mes pequeño con 29 días,

' p>

'El dígito 13 es un mes bisiesto. En este caso, 1 es un mes grande con 30 días, 0 es un mes pequeño con 29 días y el dígito 14 es el mes bisiesto. no es un mes bisiesto, es 0. De lo contrario, se da el mes, 10, 11 y 12 respectivamente. Use A, B, C para expresar

', es decir, use hexadecimal. Los últimos 4 dígitos son la fecha del Año Nuevo Lunar de ese año, es decir, la fecha del 1 de enero del calendario lunar en el calendario gregoriano. Por ejemplo, 0131 representa el 31 de enero.

'La función GetYLDate se utiliza de la siguiente manera: tYear es el año que se ingresará, tMonth es el mes, tDay es

'la fecha, YLyear es el valor de retorno y el Se devuelve el año más el calendario lunar, como el año Jiazi, YLShuXing devuelve

' pertenece al género de los elefantes, como las ratas. IsGetGl establece si se debe obtener el valor del calendario gregoriano a través del calendario lunar. Si es así,

'Los primeros tres devuelven la fecha del calendario gregoriano correspondiente y el valor de retorno es una fecha del calendario gregoriano.

Función GetYLDate(tYear como entero, tMonth como entero, tDay como entero, _

YLyear como cadena, YLShuXing como cadena, _

Opcional IsGetGl como booleano ) Como cadena

En caso de error, reanudar siguiente

Dim daList(1900 a 2011) Como cadena * 18

Dim conDate como fecha, setDate como fecha

Dim AddMonth como entero, AddDay como entero, AddYear como entero, getDay como entero

Dim RunYue como booleano

Si tYear gt 2010 o tYear lt; Función 'Si no es válida y tiene fecha, sal

'1900 a 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) = "101001001101160 130"

daList(1912) = "101001001101000218"

daList(1913) = "110100100101000206"

daList(1914) = "11010101010015012 6"

daList(1915) = "101101010101000214"

daList(1916) = "010101101010000204"

daList(1917) = "100101101101020123"

daList(1918 ) = "100101011011000211"

daList(1919) = "0100100

11011170201"

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) = "11101010010100020 6"

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) = "10110101010100021 "

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) = "10100101101100020" < / p>

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) = "10100101011100021 "

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) = "11010010011014012 3 "

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) = "0110110101 00000209 "

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) = " 0101101011 00000219 "

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) = "1010101011 01170129 "

daList(2007) = "001001011101000218"

daList(2008) = "100100101101000207"

daList(2009) = "110010010101150126"

daList(2010) = "101010010101000214"

daList(2011) = "101101001010000214"

AddYear = tYear

RunYue = False

Si IsGetGl Entonces

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

AddDay

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

conDate = DateSerial(AddYear, AddMonth, AddDay)

AddDay = tDay

Para i = 1 a tMes - 1

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

Siguiente i

'MsgBox DateDiff("d", conDate, Date)

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

GetYLDate = setDate

tAño = Año(setDate)

tMes = Mes(setDate)

tDay = Día(setDate)

Función de salida

Finalizar si

CHUSHIHUA:

AgregarMes = 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)

Si getDay lt; 0 Entonces AddYear = AddYear - 1: GoTo CHUSHIHUA

' addday = NearDay

AddDay = 1: AddMonth = 1

For i = 1 To getDay

AddDay = AddDay 1

Si AddDay = 30 Mid(daList(AddYear), AddMonth, 1) O ( RunYue y AddDay = 30 Mid(daList(AddYear), 13, 1)) Entonces

Si RunYue = False y AddMonth = Val("amp;H" amp; Mid(daList(AddYear), 14, 1)) Entonces

RunYue = True

Else

RunYue = False

AddMonth = AddMonth 1

End If

AddDay = 1

End If

Next

md$ = "Primer grado, segundo grado, tercer grado, cuarto grado, quinto grado El sexto día, el séptimo día, el octavo día, el noveno día, el undécimo día y el vigésimo tercer día.

Catorce quince dieciséis diecisiete dieciocho diecinueve veintiuno veintidós veintitrés veinticuatro veinticinco veintiséis veintisiete veintiocho veintinueve treinta"

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

mm$ = Mid("正二三四五六七八九十Han拉", AddMonth, 1) "mes"

YouGetDate = DateSerial(AddYear, AddMonth, AddDay)

tiangan$ = "A, B, C, Ding, Wu, Geng, Xin, Rengui"

dizhi$ = "Zi Chou Yin Mao Chen Si Wu Wei Shen You Xu Hai"

Dim ganzhi(0 a 59) como cadena * 2

Para i = 0 a 59

ganzhi(i) = Medio( tiangan$, (i Mod 10) 1, 1) Mid(dizhi$, (i Mod 12) 1, 1)

'ff$ = ff$ ganzhi(i)

Siguiente i

'MsgBox ff$, , Len(ff$)

YLyear = ganzhi((AddYear - 4) Mod 60)

shu$ = " Rata, Buey, Tigre, Conejo, Dragón y Serpiente Caballo, oveja, mono, gallina, perro, cerdo"

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

Si RunYue Entonces mm$ = "Leap" mm$

GetYLDate = mm$ dd$

Función final

'Lo siguiente es un ejemplo de uso. Debe agregar un botón al formulario, nombrarlo Comando1 y luego copiar el siguiente código en el código del formulario

Private Sub Command1_Click()

. Dim ty As Integer, tm As Integer, td As Integer, yl As String, sx As String

'Obtener la fecha lunar del 28 de octubre de 1999

ty = 1999

tm = 10

td = 28

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

MsgBox t

MsgBox ty amp; "-" amp ; tm amp; "-" td amp; " " amp; " " sx; 28 de octubre del calendario lunar de 1999

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

MsgBox t

MsgBox ty amp ; "-" amplificador; tm amplificador; "-" amplificador td; " " amplificador " " sx;