// Para algoritmo de férias, consulte "Comparação entre o calendário lunar e o calendário ocidental, calendário perpétuo"
unidade cnyear;
interface
usa sysutils;
TIPO TCNDATE = CARDINAL;
função decodegregTocNdate (dtgreg: tdateTime): tcndate;
function getGregDateFromcn (cnyear, cnmonth, CNAY: word; bleap: boolean = false): tdateTime;
função gregdatetocnstr (dtgreg: tdateTime): string;
função iscnleap (cndate: tcndate): boolean;
Implementação
Const Cstdateorg: Inteiro = 32900;
const cstcnyearorg = 1990;
const cstcntable: Array [cstcnyearorg..cstcnyearorg + 60] de word = (// não assinado 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 criação de tabela:
// 0101 111101010010 Os quatro dígitos altos são a posição do mês bissexto, os últimos 12 dígitos representam o grande e grande mês, o mês grande é de 30 dias e o pequeno mês é de 29 dias,
// O mês bissexto geralmente é considerado um pequeno mês, mas existem três casos especiais 2017/06, 2036/06, 2047/05
// Para casos especiais, o mais alto da representação da posição do mês bisseiro do mês salvo alto de quatro dígitos é definido como 1. Processamento especial usa a variável wleapnormal
// // 2017/06 28330-> 61098 2036/06 27947-> 60715 2047/05 23133-> 55901
// Se você deseja usar o Assembly, aqui está uma mensagem: o calendário lunar não ficará para trás do calendário gregoriano por 2 meses.
// converte o calendário gregoriano em calendário lunar
// Retorno: ano de 12 dígitos + mês de 4 dígitos + data de 5 dígitos
função decodegregTocNdate (dtgreg: tdateTime): tcndate;
var
IDAYLEAVE: Inteiro;
Wyear, Wmonth, wday: palavra;
I, J: Inteiro;
wbigsmalldist, wleap, wcount, wleapshift: word;
etiqueta ok;
Começar
resultado: = 0;
IDAYLEAVE: = trunc (dtgreg) - cstdateorg;
Decodificado (incmoth (dtgreg, -1), wyear, wmonth, wday);
if (iDayLeave <0) ou (IDAYLEAVE> 22295) e depois saia;
// Raise Exception.Create ('Atualmente contava apenas como 1990-01-27 depois de');
// Raise Exception.Create ('Atualmente, ele só pode ser contado como antes de 2051-02-11');
para i: = baixo (cstcntable) a alto (cstcntable)
wbigsmalldist: = cstcntable [i];
wleap: = wbigsmalldist shr 12;
Se wleap> 12 então comece
wleap: = wleap e 7;
wleapshift: = 1;
fim mais
wleapshift: = 0;
para j: = 1 a 12 começa
wcount: = (wbigsmalldist e 1) + 29;
Se j = wleap então wcount: = wcount - wleapshift;
Se IDAYLEAVE <wcount então comece
Resultados: = (i shl 9) + (j shl 5) + iDayLeave + 1;
Saída;
fim;
IDAYLEAVE: = IDAYLEAVE - WCOUNT;
Se J = wleap então comece
wcount: = 29 + wleapshift;
Se IDAYLEAVE <wcount então comece
Resultados: = (i shl 9) + (j shl 5) + iDayLeave + 1 + (1 shl 21);
Saída;
fim;
IDAYLEAVE: = IDAYLEAVE - WCOUNT;
fim;
wbigsmalldist: = wbigsmalldist shr 1;
fim;
fim;
// Valor de retorno:
// logotipo do mês de 1 dígito + 12 dígitos Ano + Mês de 4 dígitos + Data de 5 dígitos (total de 22 dígitos)
fim;
função iscnleap (cndate: tcndate): boolean;
Começar
Resultado: = (CNDATE e US $ 200000) <> 0;
fim;
function getGregDateFromcn (cnyear, cnmonth, CNAY: word; bleap: boolean = false): tdateTime;
var
I, J: Inteiro;
Daycount: Inteiro;
wbigsmalldist, wleap, wleapshift: word;
Começar
// 0101 0100101111 Os quatro dígitos altos são a posição do mês bissexto, os últimos 12 dígitos representam o grande e grande mês, o mês grande é de 30 dias e o pequeno mês é de 29 dias,
DayCount: = 0;
if (cnyear <1990) ou (cnyear> 2050) então comece
Resultados: = 0;
Saída;
fim;
para i: = cstcnyearorg para cnyear-1 começar
wbigsmalldist: = cstcntable [i];
if (wbigsmalldist e $ f000) <> 0 então crechount: = diado + 29;
DayCount: = DayCount + 12 * 29;
para j: = 1 a 12 começa
DayCount: = DayCount + WbigsMalldist e 1;
wbigsmalldist: = wbigsmalldist shr 1;
fim;
fim;
wbigsmalldist: = cstcntable [cnyear];
wleap: = wbigsmalldist shr 12;
Se wleap> 12 então comece
wleap: = wleap e 7;
wleapshift: = 1;
fim mais
wleapshift: = 0;
para j: = 1 a cnmonth-1 começar
DayCount: = DayCount + (wbigsmalldist e 1) + 29;
se j = wleap então diurna: = dia de dia + 29;
wbigsmalldist: = wbigsmalldist shr 1;
fim;
Se Bleap e (cnmonth = wleap), então // é um mês bissexto?
DayCount: = DayCount + 30 - WLEAPSHIFT;
Resultado: = cstdateorg + crechount + CNAY - 1;
fim;
// mostra datas em cordas lunares.
função gregdatetocnstr (dtgreg: tdateTime): string;
const hzNumber: Array [0..10] de String = ('Zero', 'One', 'Two', 'Three', 'Four', 'Five', 'Six', 'Seven', 'oito', 'noventa');
função convertymd (número: word; ymd: word): string;
var
WTMP: Word;
Começar
resultado: = '';
Se ymd = 1 então comece // ano
enquanto número> 0 começa
Resultado: = hzNumber [número mod 10] + resultado;
Número: = número div 10;
fim;
Saída;
fim;
Se o número <= 10, então inicie // apenas 1 dígito puder ser usado
Se YMD = 2 então // mês
Resultado: = hzNumber [número]
else // dia
resultado: = 'primeiro' + hzNumber [número];
Saída;
fim;
wtmp: = número mod 10;
Se wtmp <> 0, resultar: = hzNumber [wtmp];
WTMP: = Número Div 10;
Resultado: = 'Ten'+resultado;
Se wtmp> 1, resultado: = hzNumber [wtmp] + resultado;
fim;
var
CNYEAR, CNMONTH, CNAY: Word;
CNDATE: TCNDATE;
strleap: string;
Começar
cnDate: = decodegregTocNdate (dtgreg);
Se cndate = 0, então comece
resultado: = 'entrada fora dos limites';
Saída;
fim;
CNAY: = CNDATE e $ 1F;
CNMONTH: = (CNDATE SHR 5) e $ f;
cnyear: = (CNDATE SHR 9) e $ fff;
// A 22ª posição do teste é 1, o que significa um mês bisseiro
Se iScnleap (cNdate), então strleap: = '(Leap)' else strleap: = '';
Resultado: = 'Calendário lunar' + Convertymd (cnyear, 1) + 'ano' + convertymd (cnmonth, 2) + 'mês'
+ strleap + convertymd (CNAY, 3);
fim;
fim.
/////////////////////////////////////////////////////////Tipos ////////////////////////////////
usa cnyear;
Procedimento TForm1.Button1Click (remetente: TOBJECT);
Começar
edit1.Text: = GregDatetocnsTr (DateTimepicker1.date);
fim;