const
START_YEAR=1901;
END_YEAR=2050;
//返回iYear年iMonth月的天数1年1月---65535年12月
functionMonthDays(iYear,iMonth:Word):Word;
//返回阴历iLunarYer年阴历iLunarMonth月的天数，如果iLunarMonth为闰月，
//高字为第二个iLunarMonth月的天数，否则高字为01901年1月---2050年12月
functionLunarMonthDays(iLunarYear,iLunarMonth:Word):Longword;
//返回阴历iLunarYear年的总天数1901年1月---2050年12月
functionLunarYearDays(iLunarYear:Word):Word;
//返回阴历iLunarYear年的闰月月份，如没有返回01901年1月---2050年12月
functionGetLeapMonth(iLunarYear:Word):Word;
//把iYear年格式化成天干记年法表示的字符串
PRocedureFormatLunarYear(iYear:Word;varpBuffer:string);overload;
functionFormatLunarYear(iYear:Word):string;overload;
//把iMonth格式化成中文字符串
procedureFormatMonth(iMonth:Word;varpBuffer:string;bLunar:Boolean=True);overload;
functionFormatMonth(iMonth:Word;bLunar:Boolean=True):string;overload;
//把iDay格式化成中文字符串
procedureFormatLunarDay(iDay:Word;varpBuffer:string);overload;
functionFormatLunarDay(iDay:Word):string;overload;
//计算公历两个日期间相差的天数1年1月1日---65535年12月31日
functionCalcDateDiff(iEndYear,iEndMonth,iEndDay:Word;iStartYear:Word=START_YEAR;iStartMonth:Word=1;iStartDay:Word=1):Longword;overload;
functionCalcDateDiff(EndDate,StartDate:TDateTime):Longword;overload;
//计算公历iYear年iMonth月iDay日对应的阴历日期,返回对应的阴历节气0-24
//1901年1月1日---2050年12月31日
functionGetLunarHolDay(InDate:TDateTime):string;overload;
functionGetLunarHolDay(iYear,iMonth,iDay:Word):string;overload;
//privatefunction--------------------------------------
//计算从1901年1月1日过iSpanDays天后的阴历日期
procedurel_CalcLunarDate(variYear,iMonth,iDay:Word;iSpanDays:Longword);
//计算公历iYear年iMonth月iDay日对应的节气0-24，0表不是节气
functionl_GetLunarHolDay(iYear,iMonth,iDay:Word):Word;
implementation
var
//数组gLunarDay存入阴历1901年到2100年每年中的月天数信息，
//阴历每月只能是29或30天，一年用12（或13）个二进制位表示，对应位为1表30天，否则为29天
gLunarMonthDay:array[0..149]ofWord=(
//测试数据只有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
//数组gLanarMonth存放阴历1901年到2050年闰月的月份，如没有则为0，每字节存两年
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
//数组gLanarHoliDay存放每年的二十四节气对应的阳历日期
//每年的二十四节气对应的阳历日期几乎固定，平均分布于十二个月中
//1月2月3月4月5月6月
//小寒大寒立春雨水惊蛰春分清明谷雨立夏小满芒种夏至
//7月8月9月10月11月12月
//小暑大暑立秋处暑白露秋分寒露霜降立冬小雪大雪冬至
{*********************************************************************************
节气无任何确定规律,所以只好存表,要节省空间,所以....
**********************************************************************************}
//数据格式说明:
//如1901年的节气为
//1月2月3月4月5月6月7月8月9月10月11月12月
//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
//上面第一行数据为每月节气对应日期,15减去每月第一个节气,每月第二个节气减去15得第二行
//这样每月两个节气对应数据都小于16,每月用一个字节存放,高位存放第一个节气数据,低位存放
//第二个节气的数据,可得下表
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://如果是闰年
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:='甲乙丙丁戊己庚辛壬癸';
szText2:='子丑寅卯辰巳午未申酉戌亥';
szText3:='鼠牛虎免龙蛇马羊猴鸡狗猪';
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+'年';
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:='一月';
Exit;
end;
szText:='正二三四五六七八九十';
ifiMonth<=10then
begin
pBuffer:='';
pBuffer:=pBuffer+Copy(szText,(iMonth-1)*2+1,2);
pBuffer:=pBuffer+'月';
Exit;
end;
ifiMonth=11then
pBuffer:='十一'
else
pBuffer:='十二';
pBuffer:=pBuffer+'月';
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:='初十廿三';
szText2:='一二三四五六七八九十';
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
//阳历1901年2月19日为阴历1901年正月初一
//阳历1901年1月1日到2月19日共有49天
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;
//下面从阴历1901年正月初一算起
iSpanDays:=iSpanDays-49;
iYear:=START_YEAR;
iMonth:=1;
iDay:=1;
//计算年
tmp:=LunarYearDays(iYear);
whileiSpanDays>=tmpdo
begin
iSpanDays:=iSpanDays-tmp;
Inc(iYear);
tmp:=LunarYearDays(iYear);
end;
//计算月
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;
//计算日
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:='小寒';
2:Result:='大寒';
3:Result:='立春';
4:Result:='雨水';
5:Result:='惊蛰';
6:Result:='春分';
7:Result:='清明';
8:Result:='谷雨';
9:Result:='立夏';
10:Result:='小满';
11:Result:='芒种';
12:Result:='夏至';
13:Result:='小暑';
14:Result:='大暑';
15:Result:='立秋';
16:Result:='处暑';
17:Result:='白露';
18:Result:='秋分';
19:Result:='寒露';
20:Result:='霜降';
21:Result:='立冬';
22:Result:='小雪';
23:Result:='大雪';
24:Result:='冬至';
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.