本文整理自网络，侵删。
作者：近猪者痴
function WeekDay(iYear,iMonth,iDay:Word):Integer;
begin
Result:=DayOfWeek(EncodeDate(iYear,iMonth,iDay));
end;
function WeekNum(const TDT:TDateTime):Word;
var
Y,M,D:Word;
dtTmp:TDateTime;
begin
DecodeDate(TDT,Y,M,D);
dtTmp:=EnCodeDate(Y,1,1);
Result:=(Trunc(TDT-dtTmp) (DayOfWeek(dtTmp)-1)) div 7;
if Result=0 then
Result:=51
else
Result:=Result-1;
end;
function WeekNum(const iYear,iMonth,iDay:Word):Word;
begin
Result:=WeekNum(EncodeDate(iYear,iMonth,iDay));
end;
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:Wor
d;iStartDay:Word):Longword;
begin
Result:=Trunc(EncodeDate(iEndYear,iEndMonth,iEndDay)-EncodeDate(iStartYear,i
StartMonth,iStartDay));
end;
function CalcDateDiff(EndDate,StartDate:TDateTime):Longword;
begin
Result:=Trunc(EndDate-StartDate);
end;
function GetLunarDate(iYear,iMonth,iDay:Word;var
iLunarYear,iLunarMonth,iLunarDay:Word):Word;
begin
l_CalcLunarDate(iLunarYear,iLunarMonth,iLunarDay,CalcDateDiff(iYear,iMonth,i
Day));
Result:=l_GetLunarHolDay(iYear,iMonth,iDay);
end;
procedure GetLunarDate(InDate:TDateTime;var
iLunarYear,iLunarMonth,iLunarDay:Word);
begin
l_CalcLunarDate(iLunarYear,iLunarMonth,iLunarDay,CalcDateDiff(InDate,EncodeD
ate(START_YEAR,1,1)));
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
Result:='';
end;
end;
function GetLunarHolDay(iYear,iMonth,iDay:Word):string;
begin
Result:=GetLunarHolDay(EncodeDate(iYear,iMonth,iDay));
end;
end. 相关阅读 >>
Delphi+access错误"不正常地定义参数对象。提供了不一致或不完整的信息。"
更多相关阅读请进入《Delphi》频道 >>
