// Festival algorithm, please refer to "Lunar calendar and the contradictory control, the end of the year" 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; // 公历 1990-01-27 TDATETIME indicates the corresponding lunar calendar 1990-01-01 Const cstcnyearorg = 1990; const cstractcntable: array [cstcnyearorg..cstcnyearorg 60] of word = (// unsigned 16 -BIT 24402, 3730, 3366, 13614, 2647, 35542, 858, 1749, / / 1993, 19099, 1323, 2651, 10923, 1386, // 2005 32213, 2980, 2889, 23891, 2709, 1325, 17757, 2741, // 2013 39850, 1490, 3493, 61098, 3402, 3221, 19102, 1366, // 2021 2773, 10970, 1611, 22103, 3243, // 2029 1370, 13678 , 2902, 48978, 2898, 2853, 60715, 2635, // 2037, 2922, 11690, 3474, 32421, 3365, //2045 2645, 55901, 1206, 1461, 14038); // 2050 / / Construction Method: // 0101 111101010010 High Fourth is the luminous position, the latter 12 points indicate the size of the month, the month is 30 days, the month is 29 days, and the month is generally small month, but there are three special examples 2017/06,2036 / 06, 2047/05 // For special cases, the highest level in the high four-digit position representation is set to 1 special treatment WLEAPNORMAL variable /// 2017/06 28330-> 61098 2036/06 27947-> 60715 2047 / 05 23133-> 55901
// If you want to use compilation, there is a message here: Lunar calendar will not lag the gift calendar 2 months. // Convert the Queen calendar to Lunar Calendar // Back: 12 years 4-game 5-bit Date Function DecodegRegtate (DTGREG: TDATIME) : Tcndate; var iDayleave: Integer; Wyear, WMONTH, WDAY: WORD; I, J: Inteder; WbigsmallDist, Wleap, WCOUNT, WLEAPSHIFT: WORD; Label OK; Begin Result: = 0; IDAYLEAVE: = Trunc (DTGREG) - CSTDATEORG DECODEDATE (IncOdedate); IF (iDayleave <0) or (iDayleave> 22295) THEN EXIT; // raise exception.create ('Currently only 1990-01-27 In the future '); // raise exception.create (' currently only 2051-02-11 "); for i: = low (cstcntable) to high (cstcntable) Do Begin wbigsmalldist: = cstcntable [i]; WLEAP: = WbigsmallDist SHR 12; if WLLAP> 12 THEN BEGIN WLEAP: = WLEAP AND 7; WLSE WLEAPSHIFT: = 0; for j: = 1 to 12 do begin wcount: = (WbigsmallDist and 1) 29; if j = WLLAP THEN WCOUNT: = Wcount - Wleapshift; if iDayleave 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: TDATETIME INTEGER; DAYCOUNT: INTEGER; WBIGSMALLDIST, WLEAP, WLEAPSHIFT: WORD; Begin // 0101 010010101111 High four is the launch moon position, the latter 12 indicates size, the month is 30 days, Xiayue 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 $ 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; // Dali Month in the month. Else Wleapshift: = 0; f OR 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 BLLAP AND (CNMONTH) = WLEAP) THEN / 是 是 月? Daycount: = daycount 30 - wleapshift; result: = cstdateorg daycount cnDay - 1; // Display the date as a lunar string. Function GregDateTocnstr (DTGREG: TDATETIME): String; const hznumber: array [0..10] of string = ('zero', 'one', 'two', 'three', '4', '5', 'Six', 'Seven', 'Eight', 'Nine', 'Ten'); Function Convertymd (Number: Word; YMD: Word): String; Var WTMP: Word; Begin Result : = '; If YMD = 1 Then Begin // While Number> 0 Do Begin Result: = Hznumber [Number MOD 10] Result; Number: = Number Div 10; End; End; End; if Number <= 10 Then Begin // can only use 1 bit if YMD = 2 Then / / month Result: = hznumber [Number] else // 天 天 = = 初 ' hznumber [number]; exit; end; wtmp: = Number MOD 10 / 个 i = hznumber [wtmp]; wtmp: = Number Div 10; // Ten Result: = 'Ten' Result; if wtmp> 1 Then Result: = hznumber [WTMP ] Result; End; var CNYear, cnmonth, cnday: word; cndate: tcndate; string: string; begin cndate: = decodeGREGTOCNDATE (DTGREG); if cndate = 0 THEN BEGIN RESULT: = 'input crossthes'; exit; End; cnDay: = cndate and $ 1f; cnmonth: = (cndate shr 5) And $ f; cnyear: = (cndate shr 9) and $ fff; // Test the 22nd, 1 means the month IF iscnleap (cndate) Then strLleap: = '()' else strleap: = ''; result: = 'Lunar " Convertymd (CNMONTH, 2) ' Month (CNDAY) (CNDAY) , 3); end; end. // Application / Usess CNYEAR;
