// Para el algoritmo de vacaciones, consulte "Comparación entre el calendario lunar y el calendario occidental, calendario perpetuo"
Unidad Cnyear;
interfaz
usa sysutils;
tipo tcndate = cardinal;
función decodegregTocndate (dtgreg: tdateTime): tcndate;
función getGregDateFromCn (cnyear, cnmonth, cnday: word; bleap: boolean = false): tdateTime;
function gregDateTocnstr (dtgreg: tDateTime): string;
función iScnLeap (cndate: tcndate): boolean;
Implementación
const cstdateorg: entero = 32900;
const cstcnyearorg = 1990;
const cstcntable: array [cstcnyearorg..cstcnyearorg + 60] de word = (// sin firmar 16 bits
24402, 3730, 3366, 13614, 2647, 35542, 858, 1749, // 1997
23401, 1865, 1683, 19099, 1323, 2651, 10926, 1386, // 2005
32213, 2980, 2889, 23891, 2709, 1325, 17757, 2741, // 2013
39850, 1490, 3493, 61098, 3402, 3221, 19102, 1366, // 2021
2773, 10970, 1746, 26469, 1829, 1611, 22103, 3243, // 2029
1370, 13678, 2902, 48978, 2898, 2853, 60715, 2635, // 2037
1195, 21179, 1453, 2922, 11690, 3474, 32421, 3365, // 2045
2645, 55901, 1206, 1461, 14038);
// Método de creación de tabla:
// 0101 111101010010 Los cuatro dígitos altos son la posición del mes salto, los últimos 12 dígitos representan el mes grande y grande, el mes grande es de 30 días y el mes pequeño es de 29 días,
// El mes salto generalmente se considera un mes pequeño, pero hay tres casos especiales 2017/06, 2036/06, 2047/05
// Para casos especiales, la representación de posición más alta en el mes de salto del mes de salto alto de cuatro dígitos se establece en 1. El procesamiento especial utiliza la variable wleapnormal
// // 2017/06 28330-> 61098 2036/06 27947-> 60715 2047/05 23133-> 55901
// Si desea usar el ensamblaje, aquí hay un mensaje: el calendario lunar no se retrasará detrás del calendario gregoriano durante 2 meses.
// Convierta el calendario gregoriano al calendario lunar
// Devolución: año de 12 dígitos + mes de 4 dígitos + Fecha de 5 dígitos
función decodegregTocndate (dtgreg: tdateTime): tcndate;
varilla
idayleaave: entero;
Wyear, Wmonth, Wday: Palabra;
I, J: entero;
wbigsmalldist, wleap, wcount, wleapshift: word;
etiqueta ok;
Comenzar
resultado: = 0;
idayleaave: = trunc (dtgreg) - cstdateorg;
Decodato (inconth (dtgreg, -1), wyear, wmonth, wday);
if (idayleeave <0) o (idayleave> 22295) luego salga;
// elevar excepcion.create ('actualmente solo se contó como 1990-01-27 después');
// recaudar excepcion.create ('Actualmente, solo se puede contar como antes 2051-02-11');
para i: = bajo (cstcntable) a alto (cstcntable) comience
wbigsmalldist: = cstcntable [i];
WLEAP: = wbigsmalldist shR 12;
Si WLEAP> 12 entonces comience
WLEAP: = WLEAP y 7;
wleapshift: = 1;
fin
WLEAPSHIFT: = 0;
para j: = 1 a 12 comience
wcount: = (wbigsmalldist y 1) + 29;
Si j = wleap entonces wcount: = wcount - wleapshift;
Si idayleave <wcount entonces comience
Resultados: = (i shl 9) + (j shl 5) + idayleave + 1;
Salida;
fin;
idayleaave: = idayleeave - wcount;
Si j = wleap entonces comienza
wcount: = 29 + wleapshift;
Si idayleave <wcount entonces comience
Resultados: = (i shl 9) + (j shl 5) + idayleave + 1 + (1 shl 21);
Salida;
fin;
idayleaave: = idayleeave - wcount;
fin;
wbigsmalldist: = wbigsmalldist shr 1;
fin;
fin;
// Valor de retorno:
// Logotipo de 1 mes de salto de 1 dígito + año de 12 dígitos + 4 mes de dígitos + 5 dígitos (total 22 dígitos)
fin;
función iScnLeap (cndate: tcndate): boolean;
Comenzar
resultado: = (cndate y $ 200000) <> 0;
fin;
función getGregDateFromCn (cnyear, cnmonth, cnday: word; bleap: boolean = false): tdateTime;
varilla
I, J: entero;
Daycount: entero;
wbigsmalldist, wleap, wleapshift: word;
Comenzar
// 0101 0100101111 Los cuatro dígitos altos son la posición del mes bisiesto, los últimos 12 dígitos representan el mes grande y grande, el mes grande es de 30 días y el mes pequeño es de 29 días,
Daycount: = 0;
if (cnyear <1990) o (cnyear> 2050) entonces comience
Resultados: = 0;
Salida;
fin;
para i: = cstcnyearorg a cnyear-1 comience
wbigsmalldist: = cstcntable [i];
if (wbigsmalldist y $ f000) <> 0 luego daycount: = daycount + 29;
DayCount: = DayCount + 12 * 29;
para j: = 1 a 12 comience
DayCount: = DayCount + WBigSmallDist y 1;
wbigsmalldist: = wbigsmalldist shr 1;
fin;
fin;
wbigsmalldist: = cstcntable [cnyear];
WLEAP: = wbigsmalldist shR 12;
Si WLEAP> 12 entonces comience
WLEAP: = WLEAP y 7;
WLEAPSHIFT: = 1;
fin
WLEAPSHIFT: = 0;
para j: = 1 a cnmonth-1 comienza
DayCount: = DayCount + (wbigsmalldist y 1) + 29;
si j = wleap entonces daycount: = daycount + 29;
wbigsmalldist: = wbigsmalldist shr 1;
fin;
Si Bleap y (cnmonth = wLeap) entonces // ¿Es un mes salto?
DayCount: = DayCount + 30 - WLeapShift;
resultado: = cstdateorg + daycount + cnday - 1;
fin;
// Mostrar fechas en cuerdas lunares.
function gregDateTocnstr (dtgreg: tDateTime): string;
const hznumber: array [0..10] de string = ('cero', 'one', 'dos', 'tres', 'cuatro', 'cinco', 'Six', 'siete', 'ocho', 'noventa');
función convertymd (número: word; ymd: word): string;
varilla
WTMP: palabra;
Comenzar
resultado: = '';
Si ymd = 1 entonces comienza // año
Mientras que el número> 0 comience
Resultado: = HzNumber [número mod 10] + resultado;
Número: = número div 10;
fin;
Salida;
fin;
Si el número <= 10 entonces comience // solo se puede usar 1 dígito
Si YMD = 2 entonces // mes
Resultado: = HzNumber [número]
más // día
resultado: = 'primero' + HzNumber [número];
Salida;
fin;
WTMP: = Número Mod 10;
si wtmp <> 0 entonces resultado: = hzNumber [wtmp];
WTMP: = Número Div 10;
Resultado: = 'diez'+resultado;
Si wtmp> 1 entonces resultado: = hznumber [wtmp] + resultado;
fin;
varilla
Cnyear, Cnmonth, Cnday: Word;
cndate: tcndate;
strleap: cadena;
Comenzar
cndate: = DecodeGregTocnDate (dtgreg);
Si cndate = 0 entonces comienza
Resultado: = 'Entrada de límites';
Salida;
fin;
cnday: = cndate y $ 1F;
cnmonth: = (cndate shr 5) y $ f;
cnyear: = (cndate shr 9) y $ fff;
// La posición 22 de la prueba es 1, lo que significa un mes de salto
if iscnleap (cndate) entonces strleap: = '(salto)' else strleap: = '';
Resultado: = 'calendario lunar' + convertymd (cnyear, 1) + 'año' + convertymd (cnmonth, 2) + 'mes'
+ strleap + convertymd (cnday, 3);
fin;
fin.
/////////////////////////////////////////////// ////////////// ////////////
usa cnyear;
Procedimiento tForm1.Button1Click (remitente: tobject);
Comenzar
edit1.text: = GregDateTocnStr (DatetImepicker1.Date);
fin;