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: 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;

function GetLunarDate(iYear, iMonth, iDay: Word; var iLunarYear, iLunarMonth, iLunarDay: Word): Word;
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: Word);
begin
  l_CalcLunarDate(iLunarYear, iLunarMonth, iLunarDay, CalcDateDiff(InDate, EncodeDate(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, iMont

上一页  [1] [2] [3] [4]  下一页