¡El programa para convertir calendarios lunisolar y solar se escribe mejor como una función y debe escribirse en lenguaje VB!
Crear una clase de datos
Opción explícita
Dim DayName(30) As String 'Todas las fechas del calendario lunar son como el primer día del calendario lunar
Dim MovthName (12) As String 'Nombre del mes
Dim NongliData(99) As Long 'Datos del calendario lunar
Dim TianGan(9) As String 'Nombre del tallo celestial
Dim DiZhi(11) As String 'Nombre de las ramas terrestres
Dim ShuXiang(11) As String 'Nombre del signo del zodíaco
Dim MonthAdd(11) As Long 'Número de días antes de cada mes en el calendario gregoriano
'SetDayName da el valor al calendario lunar
Private Sub SetDayName()
Atenuar li_i siempre
NombreDía(0) = "*"
Para li_i = 1 a 30
NombreDía(li_i) = Elija(li_i \ 10 1, "", "十", "VEINTE", "TREINTA") amp _
Medio("Uno Dos Tres Cuatro Cinco Seis Siete Ocho Nueve", li_i Mod 10 2, 1) 'El valor de la matriz es un valor en mayúscula
Siguiente
'Agrega la palabra "chu" delante del uno al diez. Añade "vigésimo" delante de. veintiuno a veintinueve para estar más en línea con los hábitos de las personas
Para li_i = 1 a 10 'Agregue el carácter "Chu" delante del carácter inicial anterior del uno al diez
<. p> DayName(li_i) = "Chu" amp; DayName(li_i)Siguiente
Para li_i = 21 a 29 'Utilice veinte caracteres Reemplace veintidós caracteres
DayName(li_i) = "Veinte" amp; Mid(DayName(li_i), 3, 1)
Siguiente
Fin Sub
Sub privado SetMovthName() 'El nombre del mes
Dim li_i As Long
MovthName(0) = "*"
Para li_i = 1 a 12
MovthName(li_i) = Elegir(li_i \ 10 1, "", "十") amp; Mid(" 一二三四五六七八九", li_i Mod 10 2, 1)
Siguiente
End Sub
Private Sub SetTinaGan()
TianGan(0) = "A"
TianGan( 1) = "B"
TianGan(2) = "C"
TianGan(3) = "D"
TianGan(4) = "五"
TianGan(5) = "九"
TianGan(6) = "庚"
TianGan
(7) = "心"
TianGan(8) = "嬣"
TianGan(9) = "癸"
End Sub
Subconjunto privadoDiZhi()
DiZhi(0) = "子"
DiZhi(1) = "Feo"
DiZhi(2) = "寅"
DiZhi(3) = "卯"
DiZhi(4) = "陈"
DiZhi(5) = "巳"
DiZhi(6) = "Wu"
DiZhi(7) = "Wei"
DiZhi(8) = "Shen"
DiZhi(9) = "酉"
DiZhi(10) = "戌"
DiZhi(11) = "海"
End Sub
Conjuntos secundarios privadosshuxiang()
ShuXiang(0) = "Rata"
ShuXiang(1) = "Vaca"
ShuXiang(2) = "Tigre"
ShuXiang(3) = "Conejo"
ShuXiang(4) = "Dragón"
ShuXiang(5) = "Serpiente"
ShuXiang(6) = "Caballo"
ShuXiang(7) = "Oveja"
ShuXiang(8) = "Mono"
ShuXiang(9) = "Pollo"
ShuXiang(10) = "Perro"
ShuXiang(11) = "Cerdo"
Fin Sub
Private Sub SetMonthAdd() 'El número de días antes de cada mes en el calendario gregoriano
MonthAdd(0) = 0
MonthAdd(1) = 31
AgregarMes(2) = 59
AgregarMes(3) = 90
AgregarMes(4) = 120
AgregarMes(5) = 151
AddMes(6) = 181
AddMes(7) = 212
AddMes(8) = 243
AddMes(9) = 273
MonthAdd(10) = 304
MonthAdd(11) = 334
End Sub
Subconjunto privadoNongliData()
'Datos del calendario lunar
NongliData(0) = 2635
NongliData(1) = 333387
NongliData(2) = 1701
NongliData(3) = 1748
NongliData(4) = 267701
NongliData(5) = 694
NongliData(6) = 2391
NongliData(7) = 1
33423
NongliData(8) = 1175
NongliData(9) = 396438
NongliData(10) = 3402
NongliData(11 ) = 3749
NongliData(12) = 331177
NongliData(13) = 1453
NongliData(14) = 694
NongliData (15) = 201326
NongliData(16) = 2350
NongliData(17) = 465197
NongliData(18) = 3221
NongliData(19) = 3402
NongliData(20) = 400202
NongliData(21) = 2901
NongliData(22) = 1386
NongliData(23) = 267611
NongliData(24) = 605
NongliData(25) = 2349
NongliData(26) = 137515
NongliData(27) = 2709
NongliData(28) = 464533
NongliData(29) = 1738
NongliData(30) = 2901
NongliData(31) = 330421
NongliData(32) = 1242
NongliData(33) = 2651
NongliData(34) = 199255
NongliData(35) = 1323
NongliData(36) = 529706
NongliData(37) = 3733
NongliData( 38) = 1706
NongliData(39) = 398762
NongliData(40) = 2741
NongliData(41) = 1206
NongliData(42) = 267438
NongliData(43) = 2647
NongliData(44) = 1318
NongliData(45) = 204070
NongliData(46) = 3477
NongliData(47) = 461653
NongliData(48) = 1386
NongliData(49) = 2413
NongliData(50) = 330077
NongliData(51) = 1197
NongliData(52) = 2637
NongliDa
ta(53) = 268877
NongliData(54) = 3365
NongliData(55) = 531109
NongliData(56) = 2900
NongliData(57) = 2922
NongliData(58) = 398042
NongliData(59) = 2395
NongliData(60) = 1179
NongliData(61) = 267415
NongliData(62) = 2635
NongliData(63) = 661067
NongliData(64) = 1701
NongliData(65) = 1748
NongliData(66) = 398772
NongliData(67) = 2742
NongliData(68) = 2391
NongliData(69) = 330031
NongliData(70) = 1175
NongliData(71) = 1611
NongliData(72 ) = 200010
NongliData(73) = 3749
NongliData(74) = 527717
NongliData(75) = 1452
NongliData (76) = 2742
NongliData(77) = 332397
NongliData(78) = 2350
NongliData(79) = 3222
NongliData(80) = 268949
NongliData(81) = 3402
NongliData(82) = 3493
NongliData(83) = 133973
NongliData(84) = 1386
NongliData(85) = 464219
NongliData(86) = 605
NongliData(87) = 2349
NongliData(88) = 334123
NongliData(89) = 2709
NongliData(90) = 2890
NongliData(91) = 267946
NongliData(92) = 2773
NongliData(93) = 592565
NongliData(94) = 1210
NongliData(95) = 2651
NongliData(96) = 395863
NongliData(97) = 1323
NongliData(98) = 2707
NongliData(99) = 265877
End Sub
Función privada l(ByVal Data As String) As String 'Devuelve el número de días en cada mes bisiesto
Atenuar ll_Year Mientras
Atenuar ll_Movth Mientras
Atenuar ll_Day Mientras
Atenuar ll_TheDate Mientras
Atenuar ll_isEnd Como Largo
Atenuar ll_m mientras dure
Atenuar ll_k mientras dure
Atenuar ll_n mientras dure
Atenuar un poco mientras dure
Atenuar i mientras
Atenuar ls_DataNow como cadena
Atenuar ls_conn como cadena
ls_DataNow = Datos
ll_Year = Año(ls_DataNow )
ll_Movth = Month(ls_DataNow)
ll_Day = Day(ls_DataNow)
'Generar el año, mes y día actual del calendario gregoriano==gt; ls_conn
ls_conn = CStr(ll_Year) amp; "Año"
ls_conn = ls_conn amp; IIf(ll_Movth lt; 10, "0" amp; CStr(ll_Movth) amp; " Mes", CStr(ll_Movth) y "mes")
ls_conn = ls_conn y; IIf(ll_Day lt; 10, "0" y CStr(ll_Day) y "día", CStr(ll_Day ) amp; "día ")
'Calcule el número de días hasta la hora inicial del 8 de febrero de 1921: 1921-2-8 (el primer día del primer mes lunar)
ll_TheDate = (ll_Year - 1921) * 365 Int ((ll_Year - 1921) / 4) ll_Day MonthAdd(ll_Movth - 1) - 38
If ((ll_Year Mod 4) = 0 And ll_Movth gt; 2) Entonces ll_TheDate = ll_TheDate 1
'Calcula los tallos celestes, las ramas terrestres, los meses y los días del calendario lunar
ll_isEnd = 0
ll_m = 0
Hacer
ll_k = IIf (NongliData(ll_m) lt; 4095, 11, 12)
ll_n = ll_k
Hacer
Si (ll_n lt; 0) Entonces salga Do
bit = NongliDat
a(ll_m) 'Obtiene el valor del enésimo bit binario de NongliData(ll_m)
'Bit de MsgBox
Para i = 1 a ll_n Paso 1
bit = Int(bit / 2)
Siguiente
bit = bit Mod 2
Si (ll_TheDate lt; = 29 bit) Entonces
ll_isEnd = 1
Salir Do
Finalizar si
ll_TheDate = ll_TheDate - 29 - bit
ll_n = ll_n - 1
Bucle
Si (ll_isEnd = 1) Entonces salga Do
ll_m = ll_m 1
Bucle
ll_Year = 1921 ll_m
ll_Movth = ll_k - ll_n 1
ll_Day = ll_TheDate
Si (ll_k = 12) Entonces
Si (ll_Movth = (Int(NongliData(ll_m) / 65536) 1)) Entonces
ll_Movth = 1 - ll_Movth
ElseIf (ll_Movth gt; (Int(NongliData(ll_m) / 65536) 1 )) Entonces
ll_Movth = ll_Movth - 1
Finalizar si
Finalizar si
Si (ll_Movth lt; 1) Entonces
l = ll_Year amp; "-" amp; Abs(ll_Movth) amp; "-" amp; / p>
l = ll_Year amp; "-" amp; Abs(ll_Movth) amp; "-" amp; >
Función final
Función pública GetLunarData(datos ByVal como cadena) como cadena
Dim ls_NongliDayStr como cadena
Dim ll_data() como cadena
Si es Fecha(Datos) Entonces
ll_data = Split(l(Datos), "-")
ls_NongliDayStr = ll_data(0) amp "Año"
If (CInt(ll_data(3)) = 1) Luego 'Generar mes y día lunar==gt NongliDayStr
ls_NongliDayStr = ls_NongliDayStr amp "Leap" amp; MovthName(CInt(ll_data(1)))
Else
ls_NongliDayStr = ls_NongliDayStr amp; ls_NongliDayStr = ls_NongliDayStr amp; DayName(CInt(ll_data(2)))
GetLunarData = ls_NongliDayStr
Else
GetLunarData = ""
Finalizar si
Borrar ll_data
Finalizar función
'Nombre de función: getTianGan
'Parámetros de entrada
'----Los datos son una fecha
'Parámetro de salida:
' -----Devuelve el nombre de un tallo celestial y una rama terrestre
'Función: Obtener nombres de los tallos celestiales y las ramas terrestres en el año especificado
'Fecha de redacción: 2006 12 24
'Fecha de la última modificación: 2006 12 24
'Autor: Yang Rui
Función pública getTianGan(ByVal Data As String) As String 'Generar tallos celestiales del calendario lunar, ramas terrestres y signos del zodíaco==gt NongliStr
<; p> Dim ls_NongliStr como cadenaDim ll_data() como cadena
Si IsDate(Data) Then
ll_data = Split(l(Data), "- ") '"Calendario Lunar" y
ls_NongliStr = TianGan(((CInt(ll_data(0)) - 4) Mod 60) Mod 10) y DiZhi(((CInt(ll_data(0) ) - 4) Mod 60) Mod 12) amp "年"
ls_NongliStr = ls_NongliStr amp; "(" amp; ShuXiang(((CInt(ll_data(0)) - 4) Mod 60) Mod 12) amplificador ")"
getTianGan = ls_NongliStr
De lo contrario
getTianGan = "
"
Finalizar si
Borrar ll_data
Finalizar función
'Nombre de función: GetWeekNmae
'Parámetros de entrada
' ----Los datos son una fecha
'Parámetro de salida:
' -----Si la entrada de fecha es ilegal, devolverá vacío De lo contrario Devuelve el nombre de la semana
'Función: Obtener el nombre de la semana
'Fecha de escritura: 2006 12 23
'Fecha de. última modificación: 2006 12 23
'Autor: Yang Rui
Función pública getWeekName(ByVal Data As String) As String
Dim ls_WeekName As String
Si esFecha(Datos) Entonces
ls_WeekName = WeekdayName(Weekday(Data))
getWeekName = ls_WeekName
De lo contrario
getWeekName = ""
Fin si
Fin de función
'Nombre de función readData
'Parámetros de entrada: ---- Datos el tipo de carácter es del 1 de enero de cada año Cálculo de inicio del día
'---- El tipo de carácter lunar es una cadena que convierte la fecha del calendario lunar en una cadena china
' Valor de retorno: es una cadena compuesta por el calendario solar
'Idea de programación: Calcular del 1 de enero al 31 de diciembre de cada año. Cada vez que se compara el valor de retorno con el valor lunar entrante, si ambos son iguales.
' significa que se encuentra la fecha correspondiente al calendario lunar
'Fecha de redacción: 2006 12 23
'Fecha de última modificación: 2006 12 23
'Autor: Yang Rui
Función privada readData(ByVal Data como cadena, ByVal Lunar como cadena) Como cadena
Dim li_i As Long, li_j As Long
Dim l_day() como cadena, ll_count mientras
Dim ls_DataTime como cadena
Dim ls_newdata como cadena
l_day = Split( Datos, "-")
Para li_i = 1 a 12
ll_count = 0
Si li_i = 1 O li_i = 3 O li_i = 5 O li_i = 7 O li_i = 9 O li_i = 10 O li_i = 12 Entonces 'Si el mes es mayor, son 31 días
ll_count = 31
ElseIf li_i = 2 Y bissextile( l_day(0)) Entonces 'Si es año bisiesto, es 29
Días
ll_count = 29
De lo contrario, si li_i = 2 y bissextile(l_day(0)) = False Entonces 'los años bisiestos son 28 días
ll_count = 28
Else
ll_count = 30 'El mes mínimo es 30 días
End If
For li_j = 1 To ll_count 'De cada mes Se repite desde el día 1 hasta el final de cada mes
ls_DataTime = DateSerial(l_day(0), li_i, li_j)
ls_newdata = GetLunarData(ls_DataTime)
Si Trim(ls_newdata) = Trim(Lunar) Entonces 'Juzga si el valor devuelto del calendario solar, el calendario lunar, es igual al valor lunar
readData = ls_DataTime
Salir Función
Finalizar si
Siguiente
Siguiente
Borrar l_day()
Finalizar función
Función privada bissextile (datos ByVal como cadena) como booleano 'Determinar si es un año bisiesto
Dim lb_fag como booleano
lb_fag = False
Si Data Mod 400 = 0 o (Data Mod 4 = 0 y Data Mod 100 lt;gt; 0) entonces
lb_fag = True
De lo contrario
lb_fag = False
Finalizar si
bissextile = lb_fag
Finalizar función
'Nombre de función: rgetLunarData
' Parámetro de entrada: Tipo de carácter de datos
'Valor de retorno: Cadena
'Función: Obtener el calendario solar correspondiente al calendario lunar
'Autor: Yang Rui
'Tiempo de finalización: 2006 12 26
'Última modificación en 2006 12 26
Función pública rgetLunarData(ByVal Data As String) As String
Dim l_day() As String
Dim ls_data As String 'El tipo de carácter ls_data se utiliza para guardar la cadena china generada por el calendario lunar entrante
Dim ls_newdata As String
Si no es Fecha(Datos) entonces
rgetLunarD
ata = ""
Salir de la función
Finalizar si
ls_newdata = ""
l_day = Split(Data, "-")
ls_data = l_day(0) & "Año" & MovthName(l_day(1)) & "Mes" & DayName(l_day(2))
ls_newdata = readData(Datos, ls_data)
Si Len(ls_newdata) = 0 Entonces 'Si el valor de retorno de readData está vacío, indica que el calendario solar correspondiente al calendario lunar está en el próximo año No en el año actual<. /p>
ls_newdata = readData(DateSerial(l_day(0) 1, 1, 1), ls_data)
'DateSerial(l_day(0) 1, 1, 1) genera el próximo año como un parámetro
rgetLunarData = ls_newdata
Else
rgetLunarData = ls_newdata
Finalizar si
Borrar l_day()
Función final
Subclase privada_Initialize()
Llamar a SetDayName
Llamar a SetMovthName
Llamar a SetTinaGan
Llamar a SetDiZhi
Llamar a Setshuxiang
Llamar a SetNongliData
Llamar a SetMonthAdd
End Sub
Private Sub Class_Terminate()
End Sub
Agrega 2 botones y un cuadro de texto al formulario
Código de formulario:
Private Sub Command1_Click()
Atenuar como datos nuevos
Atenuar s como cadena
s = a.GetLunarData(Trim(Me.Text1.Text))
Atenuar b como datos nuevos
MsgBox s
End Sub
Subcomando privado2_Click()
Atenuar a como Nuevos datos
Atenuar s como cadena
s = a.rgetLunarData(Me.Text1.Text)
MsgBox s
End Sub
Función privada b(ByVal Data As String) Como booleano
Si Data Mod 400 = 0 o (Data Mod 4 = 0 y Data Mod 100 lt；gt； 0) Th
es
MsgBox "sadf"
Finalizar si
Función final
Private Sub ab(ByVal Data As String)
Dim ls_date() As String
ls_date = Split(Date, "-") 'Generar una matriz
MsgBox ls_date(0)
Si ls_date(0) Mod 4 = 0 Y ls_date(0) Mod 100 lt;gt 0 O ls_date(0) Mod 400 = 0 Entonces
MsgBox "To"
Si no
MsgBox "No"
Finalizar si
MsgBox "2002 mod 4=" amp 2002 Mod 4
MsgBox "2002 mod 400 =" amp; 2002 Mod 400
MsgBox "2002 mod 100=" amp; 2002 Mod 100
End Sub
Sub privado Form_Load()
Me.Text1.Text = Fecha
Fin Sub