⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 wnl.txt

📁 这本来是我为一个商业PDA产品开发的日历程序,最近移植于PC机上, 所以算法和数据部分是用纯C++写的,不涉及MFC,所有的代码都是以短节省存储空间为主要 目的.很高兴你对这些代码有兴趣,你可以随意
💻 TXT
📖 第 1 页 / 共 2 页
字号:
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:Integer):Word;
begin
Result:=WeekNum(EncodeDate(iYear,iMonth,iDay));
end;

function MonthDays(iYear,iMonth:Integer):Integer;
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:Integer):Integer;
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:Integer):Integer;
var
Height,Low,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:Integer):Integer;
var
Days,i,tmp:Integer;
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:Integer;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:Integer):string;
var
pBuffer:string;
begin
FormatLunarYear(iYear,pBuffer);
Result:=pBuffer;
end;

procedure FormatMonth(iMonth:Integer;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:Integer;bLunar:Boolean):string;
var
pBuffer:string;
begin
FormatMonth(iMonth,pBuffer,bLunar);
Result:=pBuffer;
end;

procedure FormatLunarDay(iDay:Integer;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:Integer):string;
var
pBuffer:string;
begin
FormatLunarDay(iDay,pBuffer);
Result:=pBuffer;
end;

function
CalcDateDiff(iEndYear,iEndMonth,iEndDay:Integer;iStartYear:Integer;iStartM
onth:Integer;iStartDay:Integer):Integer;
begin

Result:=Trunc(EncodeDate(iEndYear,iEndMonth,iEndDay)-EncodeDate(iStartYear
,iStartMonth,iStartDay));
end;

function CalcDateDiff(EndDate,StartDate:TDateTime):Integer;
begin
Result:=Trunc(EndDate-StartDate);
end;

function GetLunarDate(iYear,iMonth,iDay:Integer;var
iLunarYear,iLunarMonth,iLunarDay:Integer):Integer;
begin

l_CalcLunarDate(iLunarYear,iLunarMonth,iLunarDay,CalcDateDiff(iYear,iMonth
,iDay));
Result:=l_GetLunarHolDay(iYear,iMonth,iDay);
end;

procedure GetLunarDate(InDate:TDateTime;var
iLunarYear,iLunarMonth,iLunarDay:Integer);
begin

l_CalcLunarDate(iLunarYear,iLunarMonth,iLunarDay,CalcDateDiff(InDate,Encod
eDate(START_YEAR,1,1)));
end;

procedure l_CalcLunarDate(var
iYear,iMonth,iDay:Integer;iSpanDays:Longint);
var
tmp:Longint;
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:Integer):Integer;
var
Flag:Byte;
Day:Integer;
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:Integer;
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:Integer):string;
begin
Result:=GetLunarHolDay(EncodeDate(iYear,iMonth,iDay));
end;

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -