datecn.pas

这是一个DELPHI编写的万年历小软件里面包含了农历

    ResultMonth := CnMonth[I];
    ResultDay := DaysCount - CnDaysCount;
  end;
  if ResultMonth > 0 then
    Result := ResultMonth * 100 + ResultDay
  else
    Result := ResultMonth * 100 - ResultDay
end;

function CnMonth(Date: TDate): Integer;
begin
  Result := Abs(CnDateOfDate(Date) div 100);
end;

function CnMonthOfDate(Date: TDate; Days: Integer): string;
var
  Year, Month, Day: word;
begin
  DecodeDate(Date, Year, Month, Day);
  Result := CnMonthOfDate(EncodeDate(Year, Month, Days));

end;

function CnMonthOfDate(Date: TDate): string;
const
  CnMonthStr: array[1..12] of string = ('正', '二', '三', '四', '五', '六', '七', '八', '九', '十','冬', '腊');
var
  Month: Integer;
begin
  Month := CnDateOfDate(Date) div 100;
  if Month < 0 then
    Result := '闰' + CnMonthStr[-Month]
  else
    Result := CnMonthStr[Month] + '月';
end;

function CnDayOfDatePH(Date: TDate): string;
const
  CnDayStr: array[1..30] of string = (
    '初一', '初二', '初三', '初四', '初五',
    '初六', '初七', '初八', '初九', '初十',
    '十一', '十二', '十三', '十四', '十五',
    '十六', '十七', '十八', '十九', '二十',
    '廿一', '廿二', '廿三', '廿四', '廿五',
    '廿六', '廿七', '廿八', '廿九', '三十');
var
  Day: Integer;
begin
  Day := Abs(CnDateOfDate(Date)) mod 100;
  Result := CnDayStr[Day];
end;

function CnDateOfDateStr(Date: TDate): string;
begin
  Result := CnMonthOfDate(Date) + CnDayOfDatePH(Date);
end;

function CnDayOfDate(Date: TDate; Days: integer; ShowDate: Boolean = false): string; //指定日期的农历日包括节日
var
  Year, Month, Day: word;
begin
  DecodeDate(Date, Year, Month, Day);
  Result := CnDayOfDate(EncodeDate(Year, Month, Days));
end;

function CnDayOfDate(Year, Month, Day: integer): string; overload; //指定日期的农历日包括节日
begin
  Result := CnDayOfDate(EncodeDate(Year, Month, Day));
end;


function CnDay(Date: TDate): Integer;
begin
  Result := Abs(CnDateOfDate(Date)) mod 100;
end;

function CnDayOfDate(Date: TDate): string;
const
  CnDayStr: array[1..30] of string = (
    '初一', '初二', '初三', '初四', '初五',
    '初六', '初七', '初八', '初九', '初十',
    '十一', '十二', '十三', '十四', '十五',
    '十六', '十七', '十八', '十九', '二十',
    '廿一', '廿二', '廿三', '廿四', '廿五',
    '廿六', '廿七', '廿八', '廿九', '三十');
var
  Day: Integer;
begin
  Day := Abs(CnDateOfDate(Date)) mod 100;
  Result := CnDayStr[Day];
end;

function CnDateOfDateStrPH(Date: TDate): string;
begin
  Result := CnMonthOfDate(Date) + CnDayOfDate(Date);
end;

function CnDayOfDateJr(Date: TDate; Days: Integer): string;
var
  Year, Month, Day: word;
begin
  DecodeDate(Date, Year, Month, Day);
  Result := CnDayOfDateJr(EncodeDate(Year, Month, Days));

end;

function CnDayOfDateJr(Date: TDate): string;
var
  Day: Integer;
begin
  Result := '';
  Day := Abs(CnDateOfDate(Date)) mod 100;
  case Day of
    1:  if (CnMonthOfDate(Date) = '正月') then  Result := '春节';
    5:  if CnMonthOfDate(Date) = '五月' then    Result := '端午节';
    7:  if CnMonthOfDate(Date) = '七月' then    Result := '七夕节';
    15: if CnMonthOfDate(Date) = '八月' then    Result := '中秋节' else  if (CnMonthOfDate(Date) = '正月') then Result := '元宵节';
    9:  if CnMonthOfDate(Date) = '九月' then    Result := '重阳节';
    8:  if CnMonthOfDate(Date) = '腊月' then    Result := '腊八节';
  else
    if (CnMonthOfDate(Date + 1) = '正月') and (CnMonthOfDate(Date) <> '正月') then
      Result := '除夕';
  end; {case}
end;

function CnanimalOfYear(Date: TDate): string;
var
  i: integer;
  DateStr: string;
begin
  DateStr := FormatDateTime('yyyy/mm/dd', Date);
  i := length(inttostr(month(date)));
  case (StrToInt(Copy(DateStr, 1, 4)) - StrToInt(BaseAnimalDate))
    mod 12 of
    0:
      if (StrToInt(Copy(DateStr, 6, i)) < 4) and ((Pos('腊', CnMonthOfDate(Date)) = 0) and (Pos('冬', CnMonthOfDate(Date)) = 0)) then
        Result := '子鼠'
      else
      begin
        if StrToInt(Copy(DateStr, 6, i)) < 4 then
          Result := '亥猪'
        else
          Result := '子鼠';
      end;
    1, -11:
      if (StrToInt(Copy(DateStr, 6, i)) < 4) and ((Pos('腊',
        CnMonthOfDate(Date)) = 0) and (Pos('冬', CnMonthOfDate(Date)) = 0)) then
        Result := '丑牛'
      else
      begin
        if StrToInt(Copy(DateStr, 6, i)) < 4 then
          Result := '子鼠'
        else
          Result := '丑牛';
      end;
    2, -10:
      if (StrToInt(Copy(DateStr, 6, i)) < 4) and ((Pos('腊',
        CnMonthOfDate(Date)) = 0) and (Pos('冬', CnMonthOfDate(Date)) = 0)) then
        Result := '寅虎'
      else
      begin
        if StrToInt(Copy(DateStr, 6, i)) < 4 then
          Result := '丑牛'
        else
          Result := '寅虎';
      end;
    3, -9:
      if (StrToInt(Copy(DateStr, 6, i)) < 4) and ((Pos('腊',
        CnMonthOfDate(Date)) = 0) and (Pos('冬', CnMonthOfDate(Date)) = 0)) then
        Result := '卯兔'
      else
      begin
        if StrToInt(Copy(DateStr, 6, i)) < 4 then
          Result := '寅虎'
        else
          Result := '卯兔';
      end;
    4, -8:
      if (StrToInt(Copy(DateStr, 6, i)) < 4) and ((Pos('腊',
        CnMonthOfDate(Date)) = 0) and (Pos('冬', CnMonthOfDate(Date)) = 0)) then
        Result := '辰龙'
      else
      begin
        if StrToInt(Copy(DateStr, 6, i)) < 4 then
          Result := '卯兔'
        else
          Result := '辰龙';
      end;
    5, -7:
      if (StrToInt(Copy(DateStr, 6, i)) < 4) and ((Pos('腊',
        CnMonthOfDate(Date)) = 0) and (Pos('冬', CnMonthOfDate(Date)) = 0)) then
        Result := '巳蛇'
      else
      begin
        if StrToInt(Copy(DateStr, 6, i)) < 4 then
          Result := '辰龙'
        else
          Result := '巳蛇';
      end;
    6, -6:
      if (StrToInt(Copy(DateStr, 6, i)) < 4) and ((Pos('腊',
        CnMonthOfDate(Date)) = 0) and (Pos('冬', CnMonthOfDate(Date)) = 0)) then
        Result := '午马'
      else
      begin
        if StrToInt(Copy(DateStr, 6, i)) < 4 then
          Result := '巳蛇'
        else
          Result := '午马';
      end;
    7, -5:
      if (StrToInt(Copy(DateStr, 6, i)) < 4) and ((Pos('腊',
        CnMonthOfDate(Date)) = 0) and (Pos('冬', CnMonthOfDate(Date)) = 0)) then
        Result := '未羊'
      else
      begin
        if StrToInt(Copy(DateStr, 6, i)) < 4 then
          Result := '午马'
        else
          Result := '未羊';
      end;
    8, -4:
      if (StrToInt(Copy(DateStr, 6, i)) < 4) and ((Pos('腊',
        CnMonthOfDate(Date)) = 0) and (Pos('冬', CnMonthOfDate(Date)) = 0)) then
        Result := '申猴'
      else
      begin
        if StrToInt(Copy(DateStr, 6, i)) < 4 then
          Result := '未羊'
        else
          Result := '申猴';
      end;
    9, -3:
      if (StrToInt(Copy(DateStr, 6, i)) < 4) and ((Pos('腊',
        CnMonthOfDate(Date)) = 0) and (Pos('冬', CnMonthOfDate(Date)) = 0)) then
        Result := '酉鸡'
      else
      begin
        if StrToInt(Copy(DateStr, 6, i)) < 4 then
          Result := '申猴'
        else
          Result := '酉鸡';
      end;
    10, -2:
      if (StrToInt(Copy(DateStr, 6, i)) < 4) and ((Pos('腊',
        CnMonthOfDate(Date)) = 0) and (Pos('冬', CnMonthOfDate(Date)) = 0)) then
        Result := '戌狗'
      else
      begin
        if StrToInt(Copy(DateStr, 6, i)) < 4 then
          Result := '酉鸡'
        else
          Result := '戌狗';
      end;
    11, -1:
      if (StrToInt(Copy(DateStr, 6, i)) < 4) and ((Pos('腊',
        CnMonthOfDate(Date)) = 0) and (Pos('冬', CnMonthOfDate(Date)) = 0)) then
        Result := '亥猪'
      else
      begin
        if StrToInt(Copy(DateStr, 6, i)) < 4 then
          Result := '戌狗'
        else
          Result := '亥猪';
      end;
  end;
end;

function CnSkyStemOfYear(Date: TDate): string;
var
  i: integer;
  DateStr: string;
begin
  DateStr := FormatDateTime('yyyy/mm/dd', Date);
  i := length(inttostr(month(date)));
  case (StrToInt(Copy(DateStr, 1, 4)) - StrToInt(BaseSkyStemDate))
    mod 10 of
    0:
      if (StrToInt(Copy(DateStr, 6, i)) < 4) and ((Pos('腊',
        CnMonthOfDate(Date)) = 0) and (Pos('冬', CnMonthOfDate(Date)) = 0)) then
        Result := '甲'
      else
      begin
        if StrToInt(Copy(DateStr, 6, i)) < 4 then
          Result := '癸'
        else
          Result := '甲';
      end;
    1, -9:
      if (StrToInt(Copy(DateStr, 6, i)) < 4) and ((Pos('腊',
        CnMonthOfDate(Date)) = 0) and (Pos('冬', CnMonthOfDate(Date)) = 0)) then
        Result := '乙'
      else
      begin
        if StrToInt(Copy(DateStr, 6, i)) < 4 then
          Result := '甲'
        else
          Result := '乙';
      end;
    2, -8:
      if (StrToInt(Copy(DateStr, 6, i)) < 4) and ((Pos('腊',
        CnMonthOfDate(Date)) = 0) and (Pos('冬', CnMonthOfDate(Date)) = 0)) then
        Result := '丙'
      else
      begin
        if StrToInt(Copy(DateStr, 6, i)) < 4 then
          Result := '乙'
        else
          Result := '丙';
      end;
    3, -7:
      if (StrToInt(Copy(DateStr, 6, i)) < 4) and ((Pos('腊',
        CnMonthOfDate(Date)) = 0) and (Pos('冬', CnMonthOfDate(Date)) = 0)) then
        Result := '丁'
      else
      begin
        if StrToInt(Copy(DateStr, 6, i)) < 4 then
          Result := '丙'
        else
          Result := '丁';
      end;
    4, -6:
      if (StrToInt(Copy(DateStr, 6, i)) < 4) and ((Pos('腊',
        CnMonthOfDate(Date)) = 0) and (Pos('冬', CnMonthOfDate(Date)) = 0)) then
        Result := '戊'
      else
      begin
        if StrToInt(Copy(DateStr, 6, i)) < 4 then
          Result := '丁'
        else
          Result := '戊';
      end;
    5, -5:
      if (StrToInt(Copy(DateStr, 6, i)) < 4) and ((Pos('腊',
        CnMonthOfDate(Date)) = 0) and (Pos('冬', CnMonthOfDate(Date)) = 0)) then
        Result := '巳'
      else
      begin
        if StrToInt(Copy(DateStr, 6, i)) < 4 then
          Result := '戊'
        else
          Result := '巳';
      end;
    6, -4:
      if (StrToInt(Copy(DateStr, 6, i)) < 4) and ((Pos('腊',
        CnMonthOfDate(Date)) = 0) and (Pos('冬', CnMonthOfDate(Date)) = 0)) then
        Result := '庚'
      else