[Delphi] The conversion method of the Gregorian calendar to the lunar calendar

Source: Internet
Author: User
Unit cnyear;
Interface
Uses sysutils;
Type tcndate = Cardinal;
function Decodegregtocndate (dtgreg:tdatetime): tcndate;
function GETGREGDATEFROMCN (cnyear,cnmonth,cnday:word;bleap:boolean=false):
Tdatetime;
function Gregdatetocnstr (dtgreg:tdatetime): String;
function Iscnleap (cndate:tcndate): boolean;
Implementation
Const cstdateorg:integer=32900; The tdatetime of the Gregorian calendar 1990-01-27 corresponds to the lunar 19
90-01-01
Const cstcnyearorg=1990;
Const cstcntable:array[cstcnyearorg. Cstcnyearorg +] of word= (//
unsigned 16-bit
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);
2050
How to build a table:
0101 111101010010 High Four bits is the leap month position, the latter 12 bits represent the size of the moon, Otsuki 30 days, Xiao Yue 29
Days
Leap month is generally counted as Xiao Yue, but there are three special cases 2017/06,2036/06,2047/05
For exceptions, the high four-bit leap month position notation is set to 1 for special handling with the Wleapnormal variable
Amount
2017/06 28330->61098 2036/06 27947->60715 2047/05 23133->55901
If you want to use the assembly, here is a message: The lunar calendar will not lag 2 months.
Convert the Gregorian calendar to lunar
Returns: 12-bit year + 4-bit month + 5-bit date
function Decodegregtocndate (dtgreg:tdatetime): tcndate;
Var
Idayleave:integer;
Wyear,wmonth,wday:word;
I,j:integer;
Wbigsmalldist,wleap,wcount,wleapshift:word;
Label OK;
Begin
Result: = 0;
Idayleave: = Trunc (Dtgreg)-cstdateorg;
Decodedate (Incmonth (dtgreg,-1), wyear,wmonth,wday);
if (Idayleave < 0) or (Idayleave > 22295) then Exit;
Raise exception.create (at present can only be counted after 1990-01-27);
Raise exception.create (at present can only be counted before 2051-02-11);
For I:=low (cstcntable) to High (cstcntable) DO begin
Wbigsmalldist: = Cstcntable[i];
Wleap: = wbigsmalldist shr 12;
If wleap > then BEGIN
Wleap: = Wleap and 7;
Wleapshift: = 1;
End Else
Wleapshift: = 0;
For j:=1 to + do begin
Wcount:= (Wbigsmalldist and 1) + 29;
If J=wleap then wcount: = Wcount-wleapshift;
If Idayleave < Wcount then BEGIN
Result: = (i SHL 9) + (J SHL 5) + Idayleave + 1;
Exit;
End
Idayleave: = Idayleave-wcount;
If J=wleap then BEGIN
wcount:=29 + wleapshift;
If Idayleave < Wcount then BEGIN
Result: = (i SHL 9) + (J SHL 5) + Idayleave + 1 + (1 shl)
21);
Exit;
End
Idayleave: = Idayleave-wcount;
End
Wbigsmalldist: = wbigsmalldist shr 1;
End
End
return value:
1-bit LEAP month flag + 12-bit year + 4-bit month + 5-bit date (total 22-bit)
End
function Iscnleap (cndate:tcndate): boolean;
Begin
Result: = (cndate and $200000) <> 0;
End
function GETGREGDATEFROMCN (cnyear,cnmonth,cnday:word;bleap:boolean=false):
Tdatetime;
Var
I,j:integer;
Daycount:integer;
Wbigsmalldist,wleap,wleapshift:word;
Begin
0101 010010101111 High Four bits is the leap month position, the latter 12 bits represent the size of the moon, Otsuki 30 days, Xiao Yue
29 Days,
Daycount: = 0;
if (Cnyear < 1990) or (Cnyear >2050) THEN BEGIN
Result: = 0;
Exit;
End
For i:= cstcnyearorg to CnYear-1 do begin
Wbigsmalldist: = Cstcntable[i];
if (Wbigsmalldist and $F) <> 0 Then Daycount: = Daycount + 29;
Daycount: = Daycount + 12 * 29;
For j:= 1 to + do begin
Daycount: = Daycount + wbigsmalldist and 1;
Wbigsmalldist: = wbigsmalldist shr 1;
End
End
Wbigsmalldist: = Cstcntable[cnyear];
Wleap: = wbigsmalldist shr 12;
If wleap > then BEGIN
Wleap: = Wleap and 7;
Wleapshift: = 1; Otsuki in leap month.
End Else
Wleapshift: = 0;
For j:= 1 to CnMonth-1 do begin
Daycount:=daycount + (Wbigsmalldist and 1) + 29;
If J=wleap then daycount: = Daycount + 29;
Wbigsmalldist: = wbigsmalldist shr 1;
End
If Bleap and (Cnmonth = wleap) then//Are you going to leap month?
Daycount: = Daycount + 30-wleapshift;
Result: = cstdateorg + Daycount + cnDay-1;
End
Displays the date as a lunar string.
function Gregdatetocnstr (dtgreg:tdatetime): String;
Const HZNUMBER:ARRAY[0..10] of string= (0, one, two, three, four, five, six,
Seven, eight, nine, ten);
function Convertymd (Number:word; Ymd:word): string;
Var
Wtmp:word;
Begin
Result: =;
If YMD = 1 THEN BEGIN//year
While number > 0 do begin
Result: = Hznumber[number Mod] + result;
Number: = number DIV 10;
End
Exit;
End
If number<=10 then BEGIN//can only be used with 1-bit
If YMD = 2 then//month
Result: = Hznumber[number]
else//day
Result: = beginning + Hznumber[number];
Exit;
End
WTMP: = number Mod 10; Bit
If WTMP <> 0 then result: = Hznumber[wtmp];
WTMP: = number Div 10; Ten
result:= 10 +result;
If WTMP > 1 then result: = hznumber[wtmp] + result;
End
Var
Cnyear,cnmonth,cnday:word;
Cndate:tcndate;
strleap:string;
Begin
cndate:= decodegregtocndate (Dtgreg);
If cndate = 0 THEN BEGIN
Result: = input out of bounds;
Exit;
End
Cnday: = Cndate and $1f;
Cnmonth: = (cndate shr 5) and $F;
Cnyear: = (cndate shr 9) and $FFF;
Test 22nd bit, 1 for leap month
If Iscnleap (cndate) then strleap:= (LEAP) Else strleap: =;
Result: = Lunar + convertymd (cnyear,1) + year + CONVERTYMD (cnmonth,2) +
Month
+ Strleap + convertymd (cnday,3);
End
End.

Contact Us

The content source of this page is from Internet, which doesn't represent Alibaba Cloud's opinion; products and services mentioned on that page don't have any relationship with Alibaba Cloud. If the content of the page makes you feel confusing, please write us an email, we will handle the problem within 5 days after receiving your email.

If you find any instances of plagiarism from the community, please send an email to: info-contact@alibabacloud.com and provide relevant evidence. A staff member will contact you within 5 working days.

A Free Trial That Lets You Build Big!

Start building with 50+ products and up to 12 months usage for Elastic Compute Service

  • Sales Support

    1 on 1 presale consultation

  • After-Sales Support

    24/7 Technical Support 6 Free Tickets per Quarter Faster Response

  • Alibaba Cloud offers highly flexible support services tailored to meet your exact needs.