注册 登录  
 加关注
   显示下一条  |  关闭
温馨提示!由于新浪微博认证机制调整,您的新浪微博帐号绑定已过期,请重新绑定!立即重新绑定新浪微博》  |  关闭

鑫淼梦园的博客

圆你的梦想 从这里开始

 
 
 

日志

 
 

Delphi 万年历 程序源码下部分(包括:农历计算、24节气、星期计算、属相)  

2012-10-26 00:59:52|  分类: delphi xe2 |  标签: |举报 |字号 订阅

  下载LOFTER 我的照片书  |
Delphi 万年历 程序源码下部分(包括:农历计算、24节气、星期计算、属相)
发表于:2012年09月05日 11:23 0


原文地址:Delphi 万年历 程序源码下部分(包括:农历计算、24节气、星期计算、属相)作者:近猪者痴

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.


  评论这张
 
阅读(358)| 评论(0)
推荐 转载

历史上的今天

在LOFTER的更多文章

评论

<#--最新日志,群博日志--> <#--推荐日志--> <#--引用记录--> <#--博主推荐--> <#--随机阅读--> <#--首页推荐--> <#--历史上的今天--> <#--被推荐日志--> <#--上一篇,下一篇--> <#-- 热度 --> <#-- 网易新闻广告 --> <#--右边模块结构--> <#--评论模块结构--> <#--引用模块结构--> <#--博主发起的投票-->
 
 
 
 
 
 
 
 
 
 
 
 
 
 

页脚

网易公司版权所有 ©1997-2017