const START_YEAR=1901; END_YEAR=2050;//返回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;//计算公历iYear年iMonth月iDay日对应的阴历日期,返回对应的阴历节气 0-24 //1901年1月1日---2050年12月31日function GetLunarHolDay(InDate:TDateTime):string;overload; function GetLunarHolDay(iYear,iMonth,iDay:Word):string;overload;//private function--------------------------------------//计算从1901年1月1日过iSpanDays天后的阴历日期 procedure l_CalcLunarDate(var iYear,iMonth,iDay:Word;iSpanDays:Longword);//计算公历iYear年iMonth月iDay日对应的节气 0-24,0表不是节气 function l_GetLunarHolDay(iYear,iMonth,iDay:Word):Word;
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.
主题:农历的算法。
发信人: kingron(金龍)
整理人: kingron(2001-01-04 20:13:29) 站内信件
unit DateCn;
interface
uses Windows SysUtils Controls;
const
//农历月份数据,每年4字节,从1901年开始,共150年
//数据来源:UCDOS 6.0 UCT.COM
//分析整理:Copyright (c) 1996-1998 Randolph
//数据解析:
//如果第一字节的bit7为1,则该年1月1日位于农历12月,否则位于11月
//第一字节去除bit7为该年1月1日的农历日期
// 第二字节 第三字节
//bit: 7 6 5 4 3 2 1 0 7 6 5 4 3 2 1 0
//农历月份:16 15 14 13 12 11 10 9 8 7 6 5 4 3 2 1
//农历月份指的是从该年1月1日的农历月份算起的顺序号
//农历月份对应的bit为1则该月为30日,否则为29日
//第四字节为闰月月份
CnData: array[0..599] of Byte = (
$0b $52 $ba $00 $16 $a9 $5d $00 $83 $a9 $37 $05 $0e $74 $9b $00
$1a $b6 $55 $00 $87 $b5 $55 $04 $11 $55 $aa $00 $1c $a6 $b5 $00
$8a $a5 $75 $02 $14 $52 $ba $00 $81 $52 $6e $06 $0d $e9 $37 $00
$18 $74 $97 $00 $86 $ea $96 $05 $10 $6d $55 $00 $1a $35 $aa $00
$88 $4b $6a $02 $13 $a5 $6d $00 $1e $d2 $6e $07 $0b $d2 $5e $00
$17 $e9 $2e $00 $84 $d9 $2d $05 $0f $da $95 $00 $19 $5b $52 $00
$87 $56 $d4 $04 $11 $4a $da $00 $1c $a5 $5d $00 $89 $a4 $bd $02
$15 $d2 $5d $00 $82 $b2 $5b $06 $0d $b5 $2b $00 $18 $ba $95 $00
$86 $b6 $a5 $05 $10 $56 $b4 $00 $1a $4a $da $00 $87 $49 $ba $03
$13 $a4 $bb $00 $1e $b2 $5b $07 $0b $72 $57 $00 $16 $75 $2b $00
$84 $6d $2a $06 $0f $ad $55 $00 $19 $55 $aa $00 $86 $55 $6c $04
$12 $c9 $76 $00 $1c $64 $b7 $00 $8a $e4 $ae $02 $15 $ea $56 $00
$83 $da $55 $07 $0d $5b $2a $00 $18 $ad $55 $00 $85 $aa $d5 $05
$10 $53 $6a $00 $1b $a9 $6d $00 $88 $a9 $5d $03 $13 $d4 $ae $00
$81 $d4 $ab $08 $0c $ba $55 $00 $16 $5a $aa $00 $83 $56 $aa $06
$0f $aa $d5 $00 $19 $52 $da $00 $86 $52 $ba $04 $11 $a9 $5d $00
$1d $d4 $9b $00 $8a $74 $9b $03 $15 $b6 $55 $00 $82 $ad $55 $07
$0d $55 $aa $00 $18 $a5 $b5 $00 $85 $a5 $75 $05 $0f $52 $b6 $00
$1b $69 $37 $00 $89 $e9 $37 $04 $13 $74 $97 $00 $81 $ea $96 $08
$0c $6d $52 $00 $16 $2d $aa $00 $83 $4b $6a $06 $0e $a5 $6d $00
$1a $d2 $6e $00 $87 $d2 $5e $04 $12 $e9 $2e $00 $1d $ec $96 $0a
$0b $da $95 $00 $15 $5b $52 $00 $82 $56 $d2 $06 $0c $2a $da $00
$18 $a4 $dd $00 $85 $a4 $bd $05 $10 $d2 $5d $00 $1b $d9 $2d $00
$89 $b5 $2b $03 $14 $ba $95 $00 $81 $b5 $95 $08 $0b $56 $b2 $00
$16 $2a $da $00 $83 $49 $b6 $05 $0e $64 $bb $00 $19 $b2 $5b $00
$87 $6a $57 $04 $12 $75 $2b $00 $1d $b6 $95 $00 $8a $ad $55 $02
$15 $55 $aa $00 $82 $55 $6c $07 $0d $c9 $76 $00 $17 $64 $b7 $00
$86 $e4 $ae $05 $11 $ea $56 $00 $1b $6d $2a $00 $88 $5a $aa $04
$14 $ad $55 $00 $81 $aa $d5 $09 $0b $52 $ea $00 $16 $a9 $6d $00
$84 $a9 $5d $06 $0f $d4 $ae $00 $1a $ea $4d $00 $87 $ba $55 $04
$12 $5a $aa $00 $1d $ab $55 $00 $8a $a6 $d5 $02 $14 $52 $da $00
$82 $52 $ba $06 $0d $a9 $3b $00 $18 $b4 $9b $00 $85 $74 $9b $05
$11 $b5 $4d $00 $1c $d6 $a9 $00 $88 $35 $aa $03 $13 $a5 $b5 $00
$81 $a5 $75 $0b $0b $52 $b6 $00 $16 $69 $37 $00 $84 $e9 $2f $06
$10 $f4 $97 $00 $1a $75 $4b $00 $87 $6d $52 $05 $11 $2d $69 $00
$1d $95 $b5 $00 $8a $a5 $6d $02 $15 $d2 $6e $00 $82 $d2 $5e $07
$0e $e9 $2e $00 $19 $ea $96 $00 $86 $da $95 $05 $10 $5b $4a $00
$1c $ab $69 $00 $88 $2a $d8 $03);
function CnMonthOfDate(Date: TDate): String;//指定日期的农历月
function CnDayOfDate(Date: TDate): String;//指定日期的农历日
function CnDateOfDateStr(Date: TDate): String;//指定日期的农历日期
implementation
//日期是该年的第几天,1月1日为第一天
function DaysNumberOfDate(Date: TDate): Integer;
var
DaysNumber: Integer;
I: Integer;
yyyy mm dd: Word;
begin
DecodeDate(Date yyyy mm dd);
DaysNumber := 0;
for I := 1 to mm - 1 do
Inc(DaysNumber MonthDays[IsLeapYear(yyyy) I]);
Inc(DaysNumber dd);
Result := DaysNumber;
end;
//日期的农历日期,返回农历格式:月份*100 + 日,负数为闰月
//超出范围则返回0
function CnDateOfDate(Date: TDate): Integer;
var
CnMonth CnMonthDays: array[0..15] of Integer;
CnBeginDay LeapMonth: Integer;
yyyy mm dd: Word;
Bytes: array[0..3] of Byte;
I: Integer;
CnMonthData: Word;
DaysCount CnDaysCount ResultMonth ResultDay: Integer;
begin
DecodeDate(Date yyyy mm dd);
if (yyyy < 1901) or (yyyy > 2050) then
begin
Result := 0;
Exit;
end;
Bytes[0] := CnData[(yyyy - 1901) * 4];
Bytes[1] := CnData[(yyyy - 1901) * 4 + 1];
Bytes[2] := CnData[(yyyy - 1901) * 4 + 2];
Bytes[3] := CnData[(yyyy - 1901) * 4 + 3];
if (Bytes[0] and $80) <> 0 then CnMonth[0] := 12
else CnMonth[0] := 11;
CnBeginDay := (Bytes[0] and $7f);
CnMonthData := Bytes[1];
CnMonthData := CnMonthData shl 8;
CnMonthData := CnMonthData or Bytes[2];
LeapMonth := Bytes[3];
for I := 15 downto 0 do
begin
CnMonthDays[15 - I] := 29;
if ((1 shl I) and CnMonthData) <> 0 then
Inc(CnMonthDays[15 - I]);
if CnMonth[15 - I] = LeapMonth then
CnMonth[15 - I + 1] := - LeapMonth
else
begin
if CnMonth[15 - I] < 0 then //上月为闰月
CnMonth[15 - I + 1] := - CnMonth[15 - I] + 1
else CnMonth[15 - I + 1] := CnMonth[15 - I] + 1;
if CnMonth[15 - I + 1] > 12 then CnMonth[15 - I + 1] := 1;
end;
end;
DaysCount := DaysNumberOfDate(Date) - 1;
if DaysCount <= (CnMonthDays[0] - CnBeginDay) then
begin
if (yyyy > 1901) and
(CnDateOfDate(EncodeDate(yyyy - 1 12 31)) < 0) then
ResultMonth := - CnMonth[0]
else ResultMonth := CnMonth[0];
ResultDay := CnBeginDay + DaysCount;
end
else
begin
CnDaysCount := CnMonthDays[0] - CnBeginDay;
I := 1;
while (CnDaysCount < DaysCount) and
(CnDaysCount + CnMonthDays[I] < DaysCount) do
begin
Inc(CnDaysCount CnMonthDays[I]);
Inc(I);
end;
ResultMonth := CnMonth[I];
ResultDay := DaysCount - CnDaysCount;
end;
if ResultMonth > 0 then
Result := ResultMonth * 100 + ResultDay
else Result := ResultMonth * 100 - ResultDay
end;
function CnMonthOfDate(Date: TDate): String;
const
CnMonthStr: array[1..12] of String = (
'一' '二' '三' '四' '五' '六' '七' '八' '九' '十'
'冬' '蜡');
var
Month: Integer;
begin
Month := CnDateOfDate(Date) div 100;
if Month < 0 then Result := '闰' + CnMonthStr[-Month]
else Result := CnMonthStr[Month] + '月';
end;
function CnDayOfDate(Date: TDate): String;
const
CnDayStr: array[1..30] of String = (
'初一' '初二' '初三' '初四' '初五'
'初六' '初七' '初八' '初九' '初十'
'十一' '十二' '十三' '十四' '十五'
'十六' '十七' '十八' '十九' '二十'
'廿一' '廿二' '廿三' '廿四' '廿五'
'廿六' '廿七' '廿八' '廿九' '三十');
var
Day: Integer;
begin
Day := Abs(CnDateOfDate(Date)) mod 100;
Result := CnDayStr[Day];
end;
function CnDateOfDateStr(Date: TDate): String;
begin
Result := CnMonthOfDate(Date) + CnDayOfDate(Date);
end;
end.
START_YEAR=1901;
END_YEAR=2050;//返回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;//计算公历iYear年iMonth月iDay日对应的阴历日期,返回对应的阴历节气 0-24
//1901年1月1日---2050年12月31日function GetLunarHolDay(InDate:TDateTime):string;overload;
function GetLunarHolDay(iYear,iMonth,iDay:Word):string;overload;//private function--------------------------------------//计算从1901年1月1日过iSpanDays天后的阴历日期
procedure l_CalcLunarDate(var iYear,iMonth,iDay:Word;iSpanDays:Longword);//计算公历iYear年iMonth月iDay日对应的节气 0-24,0表不是节气
function l_GetLunarHolDay(iYear,iMonth,iDay:Word):Word;
unit calfunc;interfaceuses SysUtils,Windows;const
START_YEAR=1901;
END_YEAR=2050;//返回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;//计算公历iYear年iMonth月iDay日对应的阴历日期,返回对应的阴历节气 0-24
//1901年1月1日---2050年12月31日function GetLunarHolDay(InDate:TDateTime):string;overload;
function GetLunarHolDay(iYear,iMonth,iDay:Word):string;overload;//private function--------------------------------------//计算从1901年1月1日过iSpanDays天后的阴历日期
procedure l_CalcLunarDate(var iYear,iMonth,iDay:Word;iSpanDays:Longword);//计算公历iYear年iMonth月iDay日对应的节气 0-24,0表不是节气
function l_GetLunarHolDay(iYear,iMonth,iDay:Word):Word;implementationvar
//数组gLunarDay存入阴历1901年到2100年每年中的月天数信息,
//阴历每月只能是29或30天,一年用12(或13)个二进制位表示,对应位为1表30天,否则为29天
gLunarMonthDay:array[0..149] of Word=(
//测试数据只有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] of Byte=(
$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,每月用一个字节存放,高位存放第一个节气数据,低位存放
//第二个节气的数据,可得下表
$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
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.
没公式的,都是靠查表的http://lysoft.7u7.net