datecn.pas

含阴历的中国式日历

      ResultDay := CnBeginDay + DaysCount;
    End
  Else
    Begin
      CnDaysCount := CnMonthDays[0] - CnBeginDay;
      I := 1;
      While (CnDaysCount < DaysCount) And
        (CnDaysCount + CnMonthDays[I] < DaysCount) Do
        Begin
          Inc(CnDaysCount, CnMonthDays[I]);
          Inc(I);
        End;
      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
  //  Date := StrToDate(FormatDateTime('yyyy/mm/dd', Date));
  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
  //  Date := StrToDate(FormatDateTime('yyyy/mm/dd', Date));
  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
  //  Date := StrToDate(FormatDateTime('yyyy/mm/dd', Date));
  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; {case}
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
        Begin
          If StrToInt(Copy(DateStr, 6, i)) < 4 Then
            Result := '巳'
          Else
            Result := '庚';
        End;
    7, -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;
    8, -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;
    9, -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;
  Result := Result + Copy(CnanimalOfYear(Date), 1, 3);
End;

Function CnSolarTerm(Date: TDate): String; //返回十大天干
Var
  Year, Month, Day, Hour: Word;
Begin
  DecodeDate(Date, Year, Month, Day);
  //  d:=( ( 31556925974.7*(Year-1900) + SolarTerm[Month]*60000) + Date(1900,0,6,2,5) );

End;