//返回iYear年iMonth月的天数 1年1月 --- 65535年12月 function MonthDays(iYear,iMonth:Word):Word;
//返回阴历iLunarYer年阴历iLunarMonth月的天数，如果iLunarMonth为闰月， //高字为第二个iLunarMonth月的天数，否则高字为0 1901年1月---2050年12月 function LunarMonthDays(iLunarYear,iLunarMonth:Word):Longword;
//返回阴历iLunarYear年的总天数 1901年1月---2050年12月 function LunarYearDays(iLunarYear:Word):Word;
//返回阴历iLunarYear年的闰月月份，如没有返回0 1901年1月---2050年12月 function GetLeapMonth(iLunarYear:Word):Word;
//把iYear年格式化成天干记年法表示的字符串 PRocedure FormatLunarYear(iYear:Word;var pBuffer:string);overload; function FormatLunarYear(iYear:Word):string;overload;
//把iMonth格式化成中文字符串 procedure FormatMonth(iMonth:Word;var pBuffer:string;bLunar:Boolean=True);overload; function FormatMonth(iMonth:Word;bLunar:Boolean=True):string;overload;
//把iDay格式化成中文字符串 procedure FormatLunarDay(iDay:Word;var pBuffer:string);overload; function FormatLunarDay(iDay:Word):string;overload;
//计算公历两个日期间相差的天数 1年1月1日 --- 65535年12月31日 function CalcDateDiff(iEndYear,iEndMonth,iEndDay:Word;iStartYear:Word=START_YEAR;iStartMonth:Word=1;iStartDay:Word=1):Longword;overload; function CalcDateDiff(EndDate,StartDate:TDateTime):Longword;overload;
function MonthDays(iYear,iMonth:Word):Word; begin case iMonth of 1,3,5,7,8,10,12: Result:=31; 4,6,9,11: Result:=30; 2://如果是闰年 if IsLeapYear(iYear) then Result:=29 else Result:=28 else Result:=0; end; end;
function GetLeapMonth(iLunarYear:Word):Word; var Flag:Byte; begin Flag:=gLunarMonth[(iLunarYear-START_YEAR) div 2]; if (iLunarYear-START_YEAR) mod 2=0 then Result:=Flag shr 4 else Result:=Flag and $0F; end;
function LunarMonthDays(iLunarYear,iLunarMonth:Word):Longword; var Height,Low:Word; iBit:Integer; begin if iLunarYear<START_YEAR then 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 (1 shl iBit))>0 then Inc(Low); if iLunarMonth=GetLeapMonth(iLunarYear) then if (gLunarMonthDay[iLunarYear-START_YEAR] and (1 shl (iBit-1)))>0 then Height:=30 else Height:=29; Result:=MakeLong(Low,Height); end;
function LunarYearDays(iLunarYear:Word):Word; var Days,i:Word; tmp:Longword; begin Days:=0; for i:=1 to 12 do begin tmp:=LunarMonthDays(iLunarYear,i); Days:=Days+HiWord(tmp); Days:=Days+LoWord(tmp); end; Result:=Days; end;
procedure FormatLunarYear(iYear:Word;var pBuffer:string); var szText1,szText2,szText3:string; begin szText1:='甲乙丙丁戊己庚辛壬癸'; szText2:='子丑寅卯辰巳午未申酉戌亥'; szText3:='鼠牛虎免龙蛇马羊猴鸡狗猪'; pBuffer:=Copy(szText1,((iYear-4) mod 10)*2+1,2); pBuffer:=pBuffer+Copy(szText2,((iYear-4) mod 12)*2+1,2); pBuffer:=pBuffer+' '; pBuffer:=pBuffer+Copy(szText3,((iYear-4) mod 12)*2+1,2); pBuffer:=pBuffer+'年'; end;
function FormatLunarYear(iYear:Word):string; var pBuffer:string; begin FormatLunarYear(iYear,pBuffer); Result:=pBuffer; end;
procedure FormatMonth(iMonth:Word;var pBuffer:string;bLunar:Boolean); var szText:string; begin if (not bLunar) and (iMonth=1) then begin pBuffer:=' 一月'; Exit; end; szText:='正二三四五六七八九十'; if iMonth<=10 then begin pBuffer:=' '; pBuffer:=pBuffer+Copy(szText,(iMonth-1)*2+1,2); pBuffer:=pBuffer+'月'; Exit; end; if iMonth=11 then pBuffer:='十一' else pBuffer:='十二'; pBuffer:=pBuffer+'月'; end;
function FormatMonth(iMonth:Word;bLunar:Boolean):string; var pBuffer:string; begin FormatMonth(iMonth,pBuffer,bLunar); Result:=pBuffer; end;
procedure FormatLunarDay(iDay:Word;var pBuffer:string); var szText1,szText2:string; begin szText1:='初十廿三'; szText2:='一二三四五六七八九十'; if (iDay<>20) and (iDay<>30) then begin pBuffer:=Copy(szText1,((iDay-1) div 10)*2+1,2); pBuffer:=pBuffer+Copy(szText2,((iDay-1) mod 10)*2+1,2); end else begin pBuffer:=Copy(szText1,(iDay div 10)*2+1,2); pBuffer:=pBuffer+'十'; end; end;
function FormatLunarDay(iDay:Word):string; var pBuffer:string; begin FormatLunarDay(iDay,pBuffer); Result:=pBuffer; end;
function CalcDateDiff(iEndYear,iEndMonth,iEndDay:Word;iStartYear:Word;iStartMonth:Word;iStartDay:Word):Longword; begin Result:=Trunc(EncodeDate(iEndYear,iEndMonth,iEndDay)-EncodeDate(iStartYear,iStartMonth,iStartDay)); end;
function CalcDateDiff(EndDate,StartDate:TDateTime):Longword; begin Result:=Trunc(EndDate-StartDate); end;
procedure l_CalcLunarDate(var iYear,iMonth,iDay:Word;iSpanDays:Longword); var tmp:Longword; begin //阳历1901年2月19日为阴历1901年正月初一 //阳历1901年1月1日到2月19日共有49天 if iSpanDays<49 then begin iYear:=START_YEAR-1; if iSpanDays<19 then 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); while iSpanDays>=tmp do begin iSpanDays:=iSpanDays-tmp; Inc(iYear); tmp:=LunarYearDays(iYear); end; //计算月 tmp:=LoWord(LunarMonthDays(iYear,iMonth)); while iSpanDays>=tmp do begin iSpanDays:=iSpanDays-tmp; if iMonth=GetLeapMonth(iYear) then begin tmp:=HiWord(LunarMonthDays(iYear,iMonth)); if iSpanDays<tmp then Break; iSpanDays:=iSpanDays-tmp; end; Inc(iMonth); tmp:=LoWord(LunarMonthDays(iYear,iMonth)); end; //计算日 iDay:=iDay+Word(iSpanDays); end;
function l_GetLunarHolDay(iYear,iMonth,iDay:Word):Word; var Flag:Byte; Day:Word; begin Flag:=gLunarHolDay[(iYear-START_YEAR)*12+iMonth-1]; if iDay<15 then Day:=15-((Flag shr 4) and $0f) else Day:=(Flag and $0f)+15; if iDay=Day then if iDay>15 then Result:=(iMonth-1)*2+2 else Result:=(iMonth-1)*2+1 else Result:= 0; end;
function GetLunarHolDay(InDate:TDateTime):string; var i,iYear,iMonth,iDay:Word; begin DecodeDate(InDate,iYear,iMonth,iDay); i:=l_GetLunarHolDay(iYear,iMonth,iDay); case i of 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;
function GetLunarHolDay(iYear,iMonth,iDay:Word):string; begin Result:=GetLunarHolDay(EncodeDate(iYear,iMonth,iDay)); end; end.
