// For holiday algorithm, please refer to "Comparison between the Lunar calendar and the Western calendar, Perpetual Calendar"
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 indicates the corresponding lunar calendar 1990-01-01
const cstCNYearOrg=1990;
const cstCNTable:array[cstCNYearOrg..cstCNYearOrg + 60] 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
//Table creation method:
// 0101 111101010010 The high four digits are the position of the leap month, the last 12 digits represent the large and large month, the large month is 30 days, and the small month is 29 days,
//The leap month is generally considered a small month, but there are three special cases 2017/06, 2036/06, 2047/05
//For special cases, the highest in the leap month position representation of the four-digit high leap month is set to 1. Special processing uses wLeapNormal variable
// //2017/06 28330->61098 2036/06 27947->60715 2047/05 23133->55901
//If you want to use assembly, here is a message: the lunar calendar will not lag behind the Gregorian calendar for 2 months.
//Convert Gregorian calendar to lunar calendar
//Return: 12-digit year + 4-digit month + 5-digit 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('Currently only counted as 1990-01-27 after ');
//Raise Exception.Create('Currently, it can only be counted as before 2051-02-11');
for i:=Low(cstCNTable) to High(cstCNTable) do begin
wBigSmallDist := cstCNTable[i];
wLeap := wBigSmallDist shr 12;
if wLeap > 12 then begin
wLeap := wLeap and 7;
wLeapShift := 1;
end else
wLeapShift := 0;
for j:=1 to 12 do begin
wCount:=(wBigSmallDist and 1) + 29;
if j=wLeap then wCount := wCount - wLeapShift;
if iDayLeave < wCount then begin
Results := (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
Results := (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 digit leap month logo + 12 digit year + 4 digit month + 5 digit date (total 22 digits)
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 0100101111 The high four digits are the position of the leap month, the last 12 digits represent the large and large month, the large month is 30 days, and the small month is 29 days,
DayCount := 0;
if (cnYear < 1990) or (cnYear >2050) then begin
Results := 0;
Exit;
end;
for i:= cstCNYearOrg to cnYear-1 do begin
wBigSmallDist := cstCNTable[i];
if (wBIgSmallDist and $F000) <> 0 then DayCount := DayCount + 29;
DayCount := DayCount + 12 * 29;
for j:= 1 to 12 do begin
DayCount := DayCount + wBigSmallDist and 1;
wBigSmallDist := wBigSmallDist shr 1;
end;
end;
wBigSmallDist := cstCNTable[cnYear];
wLeap := wBigSmallDist shr 12;
if wLeap > 12 then begin
wLeap := wLeap and 7;
wLeapShift := 1; //The big month is in the 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 //Is it a leap month?
DayCount := DayCount + 30 - wLeapShift;
result := cstDateOrg + DayCount + cnDay - 1;
end;
//Show dates into lunar strings.
function GregDateToCNStr(dtGreg:TDateTime):String;
const hzNumber:array[0..10] of string=('zero','one','two','three','four','five','six','seven','eight', 'ninety');
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 10] + result;
Number := Number DIV 10;
end;
Exit;
end;
if Number<=10 then begin //Only 1 digit can be used
if YMD = 2 then //month
result := hzNumber[Number]
else //day
result := 'first' + hzNumber[Number];
Exit;
end;
wTmp := Number Mod 10; //Single bits
if wTmp <> 0 then result := hzNumber[wTmp];
wTmp := Number Div 10; //Ten digits
result:='ten'+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;
//The 22nd position of the test is 1, which means a leap month
if isCNLeap(cnDate) then strLeap:='(leap)' else strLeap := '';
result := 'Lunar calendar' + ConvertYMD(cnYear,1) + 'Year' + ConvertYMD(cnMonth,2) + 'month'
+ strLeap + ConvertYMD(cnDay,3);
end;
end.
////////////////////////////////////////////////////////////////// //////////////
uses CNYear;
PRocedure TForm1.Button1Click(Sender: TObject);
Begin
edit1.text:=GregDateToCNStr(DateTimePicker1.date);
end;