const
START_YEAR=1901;
END_YEAR=2050;
//Return the number of days in iMonth month of iYear year 1 year January---December 65535
functionMonthDays(iYear,iMonth:Word):Word;
//Returns the number of days in the lunar year iLunarYer year and the lunar month iLunarMonth. If iLunarMonth is a leap month,
//The high word is the number of days in the second iLunarMonth month, otherwise the high word is January 01901---December 2050
functionLunarMonthDays(iLunarYear,iLunarMonth:Word):Longword;
//Return the total number of days in the lunar calendar year iLunarYear from January 1901 to December 2050
functionLunarYearDays(iLunarYear:Word):Word;
//Return the leap month of the lunar calendar year iLunarYear, if not return January 01901---December 2050
functionGetLeapMonth(iLunarYear:Word):Word;
//Format iYear into a string represented by Tianqian notation method
PRocedureFormatLunarYear(iYear:Word;varpBuffer:string);overload;
functionFormatLunarYear(iYear:Word):string;overload;
//Format iMonth into Chinese string
procedureFormatMonth(iMonth:Word;varpBuffer:string;bLunar:Boolean=True);overload;
functionFormatMonth(iMonth:Word;bLunar:Boolean=True):string;overload;
//Format iDay into Chinese string
procedureFormatLunarDay(iDay:Word;varpBuffer:string);overload;
functionFormatLunarDay(iDay:Word):string;overload;
//Calculate the number of days between two dates in the Gregorian calendar: January 1, 1 year---December 31, 65535
functionCalcDateDiff(iEndYear,iEndMonth,iEndDay:Word;iStartYear:Word=START_YEAR;iStartMonth:Word=1;iStartDay:Word=1):Longword;overload;
functionCalcDateDiff(EndDate,StartDate:TDateTime):Longword;overload;
//Calculate the lunar date corresponding to iMonth month iDay in Gregorian calendar iYear, and return the corresponding lunar solar terms 0-24
//January 1, 1901---December 31, 2050
functionGetLunarHolDay(InDate:TDateTime):string;overload;
functionGetLunarHolDay(iYear,iMonth,iDay:Word):string;overload;
//privatefunction-----------------------------------------
//Calculate the lunar date after iSpanDays days from January 1, 1901
procedurel_CalcLunarDate(variYear,iMonth,iDay:Word;iSpanDays:Longword);
//Calculate the solar terms 0-24 corresponding to iMonth, iDay, iYear in the Gregorian calendar, 0 means not a solar term
functionl_GetLunarHolDay(iYear,iMonth,iDay:Word):Word;
implementation
var
//The array gLunarDay stores the number of months and days in each year from 1901 to 2100 in the lunar calendar,
//The lunar calendar can only have 29 or 30 days in a month, and a year is represented by 12 (or 13) binary digits. The corresponding digit is 1, which means 30 days, otherwise it is 29 days.
gLunarMonthDay:array[0..149]ofWord=(
//The test data is only 1901.1.1--2050.12.31
$4ae0,$a570,$5268,$d260,$d950,$6aa8,$56a0,$9ad0,$4ae8,$4ae0,//1910
$a4d8,$a4d0,$d250,$d548,$b550,$56a0,$96d0,$95b0,$49b8,$49b0,//1920
$a4b0,$b258,$6a50,$6d40,$ada8,$2b60,$9570,$4978,$4970,$64b0,//1930
$d4a0,$ea50,$6d48,$5ad0,$2b60,$9370,$92e0,$c968,$c950,$d4a0,//1940
$da50,$b550,$56a0,$aad8,$25d0,$92d0,$c958,$a950,$b4a8,$6ca0,//1950
$b550,$55a8,$4da0,$a5b0,$52b8,$52b0,$a950,$e950,$6aa0,$ad50,//1960
$ab50,$4b60,$a570,$a570,$5260,$e930,$d950,$5aa8,$56a0,$96d0,//1970
$4ae8,$4ad0,$a4d0,$d268,$d250,$d528,$b540,$b6a0,$96d0,$95b0,//1980
$49b0,$a4b8,$a4b0,$b258,$6a50,$6d40,$ada0,$ab60,$9370,$4978,//1990
$4970,$64b0,$6a50,$ea50,$6b28,$5ac0,$ab60,$9368,$92e0,$c960,//2000
$d4a8,$d4a0,$da50,$5aa8,$56a0,$aad8,$25d0,$92d0,$c958,$a950,//2010
$b4a0,$b550,$b550,$55a8,$4ba0,$a5b0,$52b8,$52b0,$a930,$74a8,//2020
$6aa0,$ad50,$4da8,$4b60,$9570,$a4e0,$d260,$e930,$d530,$5aa0,//2030
$6b50,$96d0,$4ae8,$4ad0,$a4d0,$d258,$d250,$d520,$daa0,$b5a0,//2040
$56d0,$4ad8,$49b0,$a4b8,$a4b0,$aa50,$b528,$6d20,$ada0,$55b0);//2050
//The array gLanarMonth stores the month of the leap month from 1901 to 2050 in the lunar calendar. If there is no leap month, it will be 0. Each byte is stored for two years.
gLunarMonth:array[0..74]ofByte=(
$00,$50,$04,$00,$20,//1910
$60,$05,$00,$20,$70,//1920
$05,$00,$40,$02,$06,//1930
$00,$50,$03,$07,$00,//1940
$60,$04,$00,$20,$70,//1950
$05,$00,$30,$80,$06,//1960
$00,$40,$03,$07,$00,//1970
$50,$04,$08,$00,$60,//1980
$04,$0a,$00,$60,$05,//1990
$00,$30,$80,$05,$00,//2000
$40,$02,$07,$00,$50,//2010
$04,$09,$00,$60,$04,//2020
$00,$20,$60,$05,$00,//2030
$30,$b0,$06,$00,$50,//2040
$02,$07,$00,$50,$03);//2050
//The array gLanarHoliDay stores the solar calendar dates corresponding to the twenty-four solar terms of each year.
//The solar calendar dates corresponding to the twenty-four solar terms of each year are almost fixed and evenly distributed in the twelve months.
//January, February, March, April, May, June
//Small Cold, Big Cold, Beginning of Spring, Rain, Spring Equinox, Qingming, Grain Rain, Beginning of Summer, Small Manchuria, Summer Solstice
//July, August, September, October, November, December
//Slight summer, big heat, beginning of autumn, summer, white dew, autumnal equinox, cold dew, frost, beginning of winter, light snow, heavy snow, winter solstice
{************************************************ *********************************
There are no fixed rules for solar terms, so I have to save tables to save space, so...
*************************************************** *********************************}
//Data format description:
//For example, the solar term in 1901 is
//January, February, March, April, May, June, July, August, September, October, November, December
//6,21,4,19,6,21,5,21,6,22,6,22,8,23,8,24,8,24,8,24,8,23,8,22
//9,6,11,4,9,6,10,6,9,7,9,7,7,8,7,9,7,9,7,9,7,8,7,15
//The first row of data above is the date corresponding to the monthly solar term, 15 minus the first solar term of each month, and the second solar term of each month minus 15 to get the second row
//In this way, the corresponding data of the two solar terms every month are less than 16, and each month is stored in one byte. The high bit stores the first solar term data, and the low bit stores it.
//The data of the second solar term can be obtained from the following table
gLunarHolDay:array[0..1799]ofByte=(
$96,$B4,$96,$A6,$97,$97,$78,$79,$79,$69,$78,$77,//1901
$96,$A4,$96,$96,$97,$87,$79,$79,$79,$69,$78,$78,//1902
$96,$A5,$87,$96,$87,$87,$79,$69,$69,$69,$78,$78,//1903
$86,$A5,$96,$A5,$96,$97,$88,$78,$78,$79,$78,$87,//1904
$96,$B4,$96,$A6,$97,$97,$78,$79,$79,$69,$78,$77,//1905
$96,$A4,$96,$96,$97,$97,$79,$79,$79,$69,$78,$78,//1906
$96,$A5,$87,$96,$87,$87,$79,$69,$69,$69,$78,$78,//1907
$86,$A5,$96,$A5,$96,$97,$88,$78,$78,$69,$78,$87,//1908
$96,$B4,$96,$A6,$97,$97,$78,$79,$79,$69,$78,$77,//1909
$96,$A4,$96,$96,$97,$97,$79,$79,$79,$69,$78,$78,//1910
$96,$A5,$87,$96,$87,$87,$79,$69,$69,$69,$78,$78,//1911
$86,$A5,$96,$A5,$96,$97,$88,$78,$78,$69,$78,$87,//1912
$95,$B4,$96,$A6,$97,$97,$78,$79,$79,$69,$78,$77,//1913
$96,$B4,$96,$A6,$97,$97,$79,$79,$79,$69,$78,$78,//1914
$96,$A5,$97,$96,$97,$87,$79,$79,$69,$69,$78,$78,//1915
$96,$A5,$96,$A5,$96,$97,$88,$78,$78,$79,$77,$87,//1916
$95,$B4,$96,$A6,$96,$97,$78,$79,$78,$69,$78,$87,//1917
$96,$B4,$96,$A6,$97,$97,$79,$79,$79,$69,$78,$77,//1918
$96,$A5,$97,$96,$97,$87,$79,$79,$69,$69,$78,$78,//1919
$96,$A5,$96,$A5,$96,$97,$88,$78,$78,$79,$77,$87,//1920
$95,$B4,$96,$A5,$96,$97,$78,$79,$78,$69,$78,$87,//1921
$96,$B4,$96,$A6,$97,$97,$79,$79,$79,$69,$78,$77,//1922
$96,$A4,$96,$96,$97,$87,$79,$79,$69,$69,$78,$78,//1923
$96,$A5,$96,$A5,$96,$97,$88,$78,$78,$79,$77,$87,//1924
$95,$B4,$96,$A5,$96,$97,$78,$79,$78,$69,$78,$87,//1925
$96,$B4,$96,$A6,$97,$97,$78,$79,$79,$69,$78,$77,//1926
$96,$A4,$96,$96,$97,$87,$79,$79,$79,$69,$78,$78,//1927
$96,$A5,$96,$A5,$96,$96,$88,$78,$78,$78,$87,$87,//1928
$95,$B4,$96,$A5,$96,$97,$88,$78,$78,$79,$77,$87,//1929
$96,$B4,$96,$A6,$97,$97,$78,$79,$79,$69,$78,$77,//1930
$96,$A4,$96,$96,$97,$87,$79,$79,$79,$69,$78,$78,//1931
$96,$A5,$96,$A5,$96,$96,$88,$78,$78,$78,$87,$87,//1932
$95,$B4,$96,$A5,$96,$97,$88,$78,$78,$69,$78,$87,//1933
$96,$B4,$96,$A6,$97,$97,$78,$79,$79,$69,$78,$77,//1934
$96,$A4,$96,$96,$97,$97,$79,$79,$79,$69,$78,$78,//1935
$96,$A5,$96,$A5,$96,$96,$88,$78,$78,$78,$87,$87,//1936
$95,$B4,$96,$A5,$96,$97,$88,$78,$78,$69,$78,$87,//1937
$96,$B4,$96,$A6,$97,$97,$78,$79,$79,$69,$78,$77,//1938
$96,$A4,$96,$96,$97,$97,$79,$79,$79,$69,$78,$78,//1939
$96,$A5,$96,$A5,$96,$96,$88,$78,$78,$78,$87,$87,//1940
$95,$B4,$96,$A5,$96,$97,$88,$78,$78,$69,$78,$87,//1941
$96,$B4,$96,$A6,$97,$97,$78,$79,$79,$69,$78,$77,//1942
$96,$A4,$96,$96,$97,$97,$79,$79,$79,$69,$78,$78,//1943
$96,$A5,$96,$A5,$A6,$96,$88,$78,$78,$78,$87,$87,//1944
$95,$B4,$96,$A5,$96,$97,$88,$78,$78,$79,$77,$87,//1945
$95,$B4,$96,$A6,$97,$97,$78,$79,$78,$69,$78,$77,//1946
$96,$B4,$96,$A6,$97,$97,$79,$79,$79,$69,$78,$78,//1947
$96,$A5,$A6,$A5,$A6,$96,$88,$88,$78,$78,$87,$87,//1948
$A5,$B4,$96,$A5,$96,$97,$88,$79,$78,$79,$77,$87,//1949
$95,$B4,$96,$A5,$96,$97,$78,$79,$78,$69,$78,$77,//1950
$96,$B4,$96,$A6,$97,$97,$79,$79,$79,$69,$78,$78,//1951
$96,$A5,$A6,$A5,$A6,$96,$88,$88,$78,$78,$87,$87,//1952
$A5,$B4,$96,$A5,$96,$97,$88,$78,$78,$79,$77,$87,//1953
$95,$B4,$96,$A5,$96,$97,$78,$79,$78,$68,$78,$87,//1954
$96,$B4,$96,$A6,$97,$97,$78,$79,$79,$69,$78,$77,//1955
$96,$A5,$A5,$A5,$A6,$96,$88,$88,$78,$78,$87,$87,//1956
$A5,$B4,$96,$A5,$96,$97,$88,$78,$78,$79,$77,$87,//1957
$95,$B4,$96,$A5,$96,$97,$88,$78,$78,$69,$78,$87,//1958
$96,$B4,$96,$A6,$97,$97,$78,$79,$79,$69,$78,$77,//1959
$96,$A4,$A5,$A5,$A6,$96,$88,$88,$88,$78,$87,$87,//1960
$A5,$B4,$96,$A5,$96,$96,$88,$78,$78,$78,$87,$87,//1961
$96,$B4,$96,$A5,$96,$97,$88,$78,$78,$69,$78,$87,//1962
$96,$B4,$96,$A6,$97,$97,$78,$79,$79,$69,$78,$77,//1963
$96,$A4,$A5,$A5,$A6,$96,$88,$88,$88,$78,$87,$87,//1964
$A5,$B4,$96,$A5,$96,$96,$88,$78,$78,$78,$87,$87,//1965
$95,$B4,$96,$A5,$96,$97,$88,$78,$78,$69,$78,$87,//1966
$96,$B4,$96,$A6,$97,$97,$78,$79,$79,$69,$78,$77,//1967
$96,$A4,$A5,$A5,$A6,$A6,$88,$88,$88,$78,$87,$87,//1968
$A5,$B4,$96,$A5,$96,$96,$88,$78,$78,$78,$87,$87,//1969
$95,$B4,$96,$A5,$96,$97,$88,$78,$78,$69,$78,$87,//1970
$96,$B4,$96,$A6,$97,$97,$78,$79,$79,$69,$78,$77,//1971
$96,$A4,$A5,$A5,$A6,$A6,$88,$88,$88,$78,$87,$87,//1972
$A5,$B5,$96,$A5,$A6,$96,$88,$78,$78,$78,$87,$87,//1973
$95,$B4,$96,$A5,$96,$97,$88,$78,$78,$69,$78,$87,//1974
$96,$B4,$96,$A6,$97,$97,$78,$79,$78,$69,$78,$77,//1975
$96,$A4,$A5,$B5,$A6,$A6,$88,$89,$88,$78,$87,$87,//1976
$A5,$B4,$96,$A5,$96,$96,$88,$88,$78,$78,$87,$87,//1977
$95,$B4,$96,$A5,$96,$97,$88,$78,$78,$79,$78,$87,//1978
$96,$B4,$96,$A6,$96,$97,$78,$79,$78,$69,$78,$77,//1979
$96,$A4,$A5,$B5,$A6,$A6,$88,$88,$88,$78,$87,$87,//1980
$A5,$B4,$96,$A5,$A6,$96,$88,$88,$78,$78,$77,$87,//1981
$95,$B4,$96,$A5,$96,$97,$88,$78,$78,$79,$77,$87,//1982
$95,$B4,$96,$A5,$96,$97,$78,$79,$78,$69,$78,$77,//1983
$96,$B4,$A5,$B5,$A6,$A6,$87,$88,$88,$78,$87,$87,//1984
$A5,$B4,$A6,$A5,$A6,$96,$88,$88,$78,$78,$87,$87,//1985
$A5,$B4,$96,$A5,$96,$97,$88,$78,$78,$79,$77,$87,//1986
$95,$B4,$96,$A5,$96,$97,$88,$79,$78,$69,$78,$87,//1987
$96,$B4,$A5,$B5,$A6,$A6,$87,$88,$88,$78,$87,$86,//1988
$A5,$B4,$A5,$A5,$A6,$96,$88,$88,$88,$78,$87,$87,//1989
$A5,$B4,$96,$A5,$96,$96,$88,$78,$78,$79,$77,$87,//1990
$95,$B4,$96,$A5,$86,$97,$88,$78,$78,$69,$78,$87,//1991
$96,$B4,$A5,$B5,$A6,$A6,$87,$88,$88,$78,$87,$86,//1992
$A5,$B3,$A5,$A5,$A6,$96,$88,$88,$88,$78,$87,$87,//1993
$A5,$B4,$96,$A5,$96,$96,$88,$78,$78,$78,$87,$87,//1994
$95,$B4,$96,$A5,$96,$97,$88,$76,$78,$69,$78,$87,//1995
$96,$B4,$A5,$B5,$A6,$A6,$87,$88,$88,$78,$87,$86,//1996
$A5,$B3,$A5,$A5,$A6,$A6,$88,$88,$88,$78,$87,$87,//1997
$A5,$B4,$96,$A5,$96,$96,$88,$78,$78,$78,$87,$87,//1998
$95,$B4,$96,$A5,$96,$97,$88,$78,$78,$69,$78,$87,//1999
$96,$B4,$A5,$B5,$A6,$A6,$87,$88,$88,$78,$87,$86,//2000
$A5,$B3,$A5,$A5,$A6,$A6,$88,$88,$88,$78,$87,$87,//2001
$A5,$B4,$96,$A5,$96,$96,$88,$78,$78,$78,$87,$87,//2002
$95,$B4,$96,$A5,$96,$97,$88,$78,$78,$69,$78,$87,//2003
$96,$B4,$A5,$B5,$A6,$A6,$87,$88,$88,$78,$87,$86,//2004
$A5,$B3,$A5,$A5,$A6,$A6,$88,$88,$88,$78,$87,$87,//2005
$A5,$B4,$96,$A5,$A6,$96,$88,$88,$78,$78,$87,$87,//2006
$95,$B4,$96,$A5,$96,$97,$88,$78,$78,$69,$78,$87,//2007
$96,$B4,$A5,$B5,$A6,$A6,$87,$88,$87,$78,$87,$86,//2008
$A5,$B3,$A5,$B5,$A6,$A6,$88,$88,$88,$78,$87,$87,//2009
$A5,$B4,$96,$A5,$A6,$96,$88,$88,$78,$78,$87,$87,//2010
$95,$B4,$96,$A5,$96,$97,$88,$78,$78,$79,$78,$87,//2011
$96,$B4,$A5,$B5,$A5,$A6,$87,$88,$87,$78,$87,$86,//2012
$A5,$B3,$A5,$B5,$A6,$A6,$87,$88,$88,$78,$87,$87,//2013
$A5,$B4,$96,$A5,$A6,$96,$88,$88,$78,$78,$87,$87,//2014
$95,$B4,$96,$A5,$96,$97,$88,$78,$78,$79,$77,$87,//2015
$95,$B4,$A5,$B4,$A5,$A6,$87,$88,$87,$78,$87,$86,//2016
$A5,$C3,$A5,$B5,$A6,$A6,$87,$88,$88,$78,$87,$87,//2017
$A5,$B4,$A6,$A5,$A6,$96,$88,$88,$78,$78,$87,$87,//2018
$A5,$B4,$96,$A5,$96,$96,$88,$78,$78,$79,$77,$87,//2019
$95,$B4,$A5,$B4,$A5,$A6,$97,$87,$87,$78,$87,$86,//2020
$A5,$C3,$A5,$B5,$A6,$A6,$87,$88,$88,$78,$87,$86,//2021
$A5,$B4,$A5,$A5,$A6,$96,$88,$88,$88,$78,$87,$87,//2022
$A5,$B4,$96,$A5,$96,$96,$88,$78,$78,$79,$77,$87,//2023
$95,$B4,$A5,$B4,$A5,$A6,$97,$87,$87,$78,$87,$96,//2024
$A5,$C3,$A5,$B5,$A6,$A6,$87,$88,$88,$78,$87,$86,//2025
$A5,$B3,$A5,$A5,$A6,$A6,$88,$88,$88,$78,$87,$87,//2026
$A5,$B4,$96,$A5,$96,$96,$88,$78,$78,$78,$87,$87,//2027
$95,$B4,$A5,$B4,$A5,$A6,$97,$87,$87,$78,$87,$96,//2028
$A5,$C3,$A5,$B5,$A6,$A6,$87,$88,$88,$78,$87,$86,//2029
$A5,$B3,$A5,$A5,$A6,$A6,$88,$88,$88,$78,$87,$87,//2030
$A5,$B4,$96,$A5,$96,$96,$88,$78,$78,$78,$87,$87,//2031
$95,$B4,$A5,$B4,$A5,$A6,$97,$87,$87,$78,$87,$96,//2032
$A5,$C3,$A5,$B5,$A6,$A6,$88,$88,$88,$78,$87,$86,//2033
$A5,$B3,$A5,$A5,$A6,$A6,$88,$78,$88,$78,$87,$87,//2034
$A5,$B4,$96,$A5,$A6,$96,$88,$88,$78,$78,$87,$87,//2035
$95,$B4,$A5,$B4,$A5,$A6,$97,$87,$87,$78,$87,$96,//2036
$A5,$C3,$A5,$B5,$A6,$A6,$87,$88,$88,$78,$87,$86,//2037
$A5,$B3,$A5,$A5,$A6,$A6,$88,$88,$88,$78,$87,$87,//2038
$A5,$B4,$96,$A5,$A6,$96,$88,$88,$78,$78,$87,$87,//2039
$95,$B4,$A5,$B4,$A5,$A6,$97,$87,$87,$78,$87,$96,//2040
$A5,$C3,$A5,$B5,$A5,$A6,$87,$88,$87,$78,$87,$86,//2041
$A5,$B3,$A5,$B5,$A6,$A6,$88,$88,$88,$78,$87,$87,//2042
$A5,$B4,$96,$A5,$A6,$96,$88,$88,$78,$78,$87,$87,//2043
$95,$B4,$A5,$B4,$A5,$A6,$97,$87,$87,$88,$87,$96,//2044
$A5,$C3,$A5,$B4,$A5,$A6,$87,$88,$87,$78,$87,$86,//2045
$A5,$B3,$A5,$B5,$A6,$A6,$87,$88,$88,$78,$87,$87,//2046
$A5,$B4,$96,$A5,$A6,$96,$88,$88,$78,$78,$87,$87,//2047
$95,$B4,$A5,$B4,$A5,$A5,$97,$87,$87,$88,$86,$96,//2048
$A4,$C3,$A5,$A5,$A5,$A6,$97,$87,$87,$78,$87,$86,//2049
$A5,$C3,$A5,$B5,$A6,$A6,$87,$88,$78,$78,$87,$87);//2050
functionMonthDays(iYear,iMonth:Word):Word;
begin
caseiMonthof
1,3,5,7,8,10,12:Result:=31;
4,6,9,11:Result:=30;
2://If it is a leap year
ifIsLeapYear(iYear)then
Result:=29
else
Result:=28
else
Result:=0;
end;
end;
functionGetLeapMonth(iLunarYear:Word):Word;
var
Flag:Byte;
begin
Flag:=gLunarMonth[(iLunarYear-START_YEAR)div2];
if(iLunarYear-START_YEAR)mod2=0then
Result:=Flagshr4
else
Result:=Flagand$0F;
end;
functionLunarMonthDays(iLunarYear,iLunarMonth:Word):Longword;
var
Height,Low:Word;
iBit:Integer;
begin
ifiLunarYear<START_YEARthen
begin
Result:=30;
Exit;
end;
Height:=0;
Low:=29;
iBit:=16-iLunarMonth;
if(iLunarMonth>GetLeapMonth(iLunarYear))and(GetLeapMonth(iLunarYear)>0)then
Dec(iBit);
if(gLunarMonthDay[iLunarYear-START_YEAR]and(1shliBit))>0then
Inc(Low);
ifiLunarMonth=GetLeapMonth(iLunarYear)then
if(gLunarMonthDay[iLunarYear-START_YEAR]and(1shl(iBit-1)))>0then
Height:=30
else
Height:=29;
Result:=MakeLong(Low,Height);
end;
functionLunarYearDays(iLunarYear:Word):Word;
var
Days,i:Word;
tmp:Longword;
begin
Days:=0;
fori:=1to12do
begin
tmp:=LunarMonthDays(iLunarYear,i);
Days:=Days+HiWord(tmp);
Days:=Days+LoWord(tmp);
end;
Result:=Days;
end;
procedureFormatLunarYear(iYear:Word;varpBuffer:string);
var
szText1,szText2,szText3:string;
begin
szText1:='A, B, C, D, Wu, Ji, Geng, Xin Rengui';
szText2:='Zichou Yinmaochen Siwu has not applied for Youxuhai';
szText3:='Rat, ox, tiger, dragon, snake, horse, sheep, monkey, chicken, dog, and pig';
pBuffer:=Copy(szText1,((iYear-4)mod10)*2+1,2);
pBuffer:=pBuffer+Copy(szText2,((iYear-4)mod12)*2+1,2);
pBuffer:=pBuffer+'';
pBuffer:=pBuffer+Copy(szText3,((iYear-4)mod12)*2+1,2);
pBuffer:=pBuffer+'year';
end;
functionFormatLunarYear(iYear:Word):string;
var
pBuffer:string;
begin
FormatLunarYear(iYear,pBuffer);
Result:=pBuffer;
end;
procedureFormatMonth(iMonth:Word;varpBuffer:string;bLunar:Boolean);
var
szText:string;
begin
if(notbLunar)and(iMonth=1)then
begin
pBuffer:='January';
Exit;
end;
szText:='positive two, three, four, five, six, seven, eight, ninety';
ifiMonth<=10then
begin
pBuffer:='';
pBuffer:=pBuffer+Copy(szText,(iMonth-1)*2+1,2);
pBuffer:=pBuffer+'month';
Exit;
end;
ifiMonth=11then
pBuffer:='Eleven'
else
pBuffer:='twelve';
pBuffer:=pBuffer+'month';
end;
functionFormatMonth(iMonth:Word;bLunar:Boolean):string;
var
pBuffer: string;
begin
FormatMonth(iMonth,pBuffer,bLunar);
Result:=pBuffer;
end;
procedureFormatLunarDay(iDay:Word;varpBuffer:string);
var
szText1,szText2:string;
begin
szText1:='The twenty-third day of the lunar month';
szText2:='One, two, three, four, five, six, seven, eight, ninety';
if(iDay<>20)and(iDay<>30)then
begin
pBuffer:=Copy(szText1,((iDay-1)div10)*2+1,2);
pBuffer:=pBuffer+Copy(szText2,((iDay-1)mod10)*2+1,2);
end
else
begin
pBuffer:=Copy(szText1,(iDaydiv10)*2+1,2);
pBuffer:=pBuffer+'十';
end;
end;
functionFormatLunarDay(iDay:Word):string;
var
pBuffer: string;
begin
FormatLunarDay(iDay,pBuffer);
Result:=pBuffer;
end;
functionCalcDateDiff(iEndYear,iEndMonth,iEndDay:Word;iStartYear:Word;iStartMonth:Word;iStartDay:Word):Longword;
begin
Result:=Trunc(EncodeDate(iEndYear,iEndMonth,iEndDay)-EncodeDate(iStartYear,iStartMonth,iStartDay));
end;
functionCalcDateDiff(EndDate,StartDate:TDateTime):Longword;
begin
Result:=Trunc(EndDate-StartDate);
end;
procedurel_CalcLunarDate(variYear,iMonth,iDay:Word;iSpanDays:Longword);
var
tmp:Longword;
begin
//February 19, 1901 in the Gregorian calendar is the first day of the first lunar month in 1901
//There are 49 days in the Gregorian calendar from January 1 to February 19, 1901
ifiSpanDays<49then
begin
iYear:=START_YEAR-1;
ifiSpanDays<19then
begin
iMonth:=11;
iDay:=11+Word(iSpanDays);
end
else
begin
iMonth:=12;
iDay:=Word(iSpanDays)-18;
end;
Exit;
end;
//The following calculations start from the first day of the first lunar month of 1901
iSpanDays:=iSpanDays-49;
iYear:=START_YEAR;
iMonth:=1;
iDay:=1;
//calculate year
tmp:=LunarYearDays(iYear);
whileiSpanDays>=tmpdo
begin
iSpanDays:=iSpanDays-tmp;
Inc(iYear);
tmp:=LunarYearDays(iYear);
end;
//Calculate month
tmp:=LoWord(LunarMonthDays(iYear,iMonth));
whileiSpanDays>=tmpdo
begin
iSpanDays:=iSpanDays-tmp;
ifiMonth=GetLeapMonth(iYear)then
begin
tmp:=HiWord(LunarMonthDays(iYear,iMonth));
ifiSpanDays<tmpthenBreak;
iSpanDays:=iSpanDays-tmp;
end;
Inc(iMonth);
tmp:=LoWord(LunarMonthDays(iYear,iMonth));
end;
//Calculate day
iDay:=iDay+Word(iSpanDays);
end;
functionl_GetLunarHolDay(iYear,iMonth,iDay:Word):Word;
var
Flag:Byte;
Day:Word;
begin
Flag:=gLunarHolDay[(iYear-START_YEAR)*12+iMonth-1];
ifiDay<15then
Day:=15-((Flagshr4)and$0f)
else
Day:=(Flagand$0f)+15;
ifiDay=Daythen
ifiDay>15then
Result:=(iMonth-1)*2+2
else
Result:=(iMonth-1)*2+1
else
Result:=0;
end;
functionGetLunarHolDay(InDate:TDateTime):string;
var
i,iYear,iMonth,iDay:Word;
begin
DecodeDate(InDate,iYear,iMonth,iDay);
i:=l_GetLunarHolDay(iYear,iMonth,iDay);
caseiof
1:Result:='Xiaohan';
2:Result:='Big Cold';
3:Result:='The Beginning of Spring';
4:Result:='Rain';
5:Result:='Jingzhe';
6:Result:='Vernal Equinox';
7:Result:='Qingming';
8:Result:='Gu Yu';
9:Result:='Start of Summer';
10:Result:='Xiaoman';
11:Result:='awn';
12:Result:='Summer Solstice';
13:Result:='Little Heat';
14:Result:='Great Heat';
15:Result:='The Beginning of Autumn';
16:Result:='End of Heat';
17:Result:='White Dew';
18:Result:='Autumnal Equinox';
19:Result:='Cold Dew';
20:Result:='Frost';
21:Result:='Beginning of Winter';
22:Result:='Xiaoxue';
23:Result:='Heavy Snow';
24:Result:='Winter Solstice';
else
l_CalcLunarDate(iYear,iMonth,iDay,CalcDateDiff(InDate,EncodeDate(START_YEAR,1,1)));
Result:=trim(FormatMonth(iMonth)+FormatLunarDay(iDay));
end;
end;
functionGetLunarHolDay(iYear,iMonth,iDay:Word):string;
begin
Result:=GetLunarHolDay(EncodeDate(iYear,iMonth,iDay));
end;
end.