万年历.txt

大量Delphi开发资料

    $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 WeekDay(iYear,iMonth,iDay:Integer):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: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.