datecn.pas

一个很漂亮的农历控件

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;

Function GetLunarHolDay(InDate: TDateTime; Days: Integer): String;
Var
  Year, Month, Day, Hour: Word;
Begin
  DecodeDate(Date, Year, Month, Day);
  Result := GetLunarHolDay(EncodeDate(Year, Month, Days));

End;

Function GetLunarHolDay(InDate: TDateTime): String;
Var
  i, iYear, iMonth, iDay: Word;
Begin
  //  InDate := StrToDate(FormatDateTime('yyyy/mm/dd', InDate));

  Result := '';
  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 := '冬至';
  End;
End;

Function l_GetLunarHolDay(iYear, iMonth, iDay: Word): Word;
Var
  Flag: Byte;
  Day: Word;
Begin
  //  var offDate = new Date( ( 31556925974.7*(y-1900) + sTermInfo[n]*60000  ) + Date.UTC(1900,0,6,2,5) )
  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 OtherHoliday(Month, Day: integer): String;
Begin
  //五月的第二个星期日庆祝母亲节
  //將每年6月的第3個星期天定為父親節      ?
  {

  新年元旦[01/01] 腊八节[农历十二月初八]


   世界湿地日[02/02] 国际气象节[02/10] 情人节[02/14]
  除夕[农历十二月三十] 春节[农历正月初一] 元宵节[农历正月十五]


   全国爱耳日[03/03] 妇女节[03/08] 植树节[03/12]
  国际警察日[03/14] 国际消费日[03/15] 世界森林日[03/21]
  世界水日[03/22] 世界气象日[03/23] 世界防治结核病日[03/24]


   愚人节[04/01] 清明[04/05] 世界卫生日[04/07]
  世界地球日[04/22]


   国际劳动节[05/01] 中国青年节[05/04] 全国碘缺乏病日[05/05]
  世界红十字日[05/08] 国际护士节[05/12] 国际家庭日[05/15]
  世界电信日[05/17] 国际博物馆日[05/18] 全国助残日[05/19]
  全国学生营养日[05/20] 国际生物多样性日[05/22] 国际牛奶日[05/23]
  世界无烟日[05/31] 端午节[农历五月初五] 母亲节[第二个星期日]


   国际儿童节[06/01] 世界环境日[06/05] 全国爱眼日[06/06]
  端午节[06/15] 父亲节[第三个星期日] 防治荒漠化和干旱日[06/17]
  国际奥林匹克日[06/23] 全国土地日[06/25] 国际反毒品日[06/26]


   香港回归日[07/01] 七夕情人节[农历七月初七] 建党日[07/01]　
  中国人民抗日战争纪念日[07/07] 世界人口日[07/11]　


   八一建军节[08/01]　　


   劳动节[09/02]　 国际扫盲日[09/08] 教师节[09/10]
  国际臭氧层保护日[09/16] 国际和平日[09/17] 国际爱牙日[09/20]
  中秋节[农历八月十五] 国际聋人节[09/22] 世界旅游日[09/27]
  重阳节[农历九月九日]


   国庆节[10/01]　 国际音乐节[10/01] 国际减轻自然灾害日[10/02]
  世界动物日[10/04] 国际住房日[10/07] 全国高血压日[10/08]
  世界视觉日[10/08] 世界邮政日[10/09] 世界精神卫生日[10/10]
  国际盲人节[10/15] 世界粮食节[10/16] 世界消除贫困日[10/17]
  世界传统医药日[10/22] 联合国日[10/24] 万圣节[10/31]



   中国记者日[11/08]　 消防宣传日[11/09] 世界糖尿病日[11/14]
  国际大学生节[11/17] 感恩节[11/28]


   冬至节[农历12月22日] 世界艾滋病日[12/01] 世界残疾人日[12/03]
  世界足球日[12/09] 圣诞节[12/25]





  }
  result := '';

  Case Month Of
    1:
      Begin
      End;

    2:
      Begin

        If day = 2 Then
          result := '湿地日';

        If day = 10 Then
          result := '气象节';

      End;
    3:
      Begin
        If day = 3 Then
          result := '爱耳日';


        If day = 12 Then
          result := '植树节';

        If day = 14 Then
          result := '警察日';

        If day = 15 Then
          result := '消费节';

        If day = 21 Then
          result := '森林日';

        If day = 22 Then
          result := '水日';

        If day = 23 Then
          result := '气象日';

      End;
    4:
      Begin

        If day = 7 Then
          result := '卫生日';

        If day = 22 Then
          result := '地球日';

      End;
    5:
      Begin
        If day = 8 Then
          result := '红十字';

        If day = 12 Then
          result := '护士节';

        If day = 15 Then
          result := '家庭日';

        If day = 17 Then
          result := '电信日';

        If day = 18 Then
          result := '博物馆';

        If day = 19 Then
          result := '助残日';

        If day = 23 Then
          result := '牛奶日';

        If day = 31 Then
          result := '无烟日';

        // 母亲节[第二个星期日]
      End;
    6:
      Begin

        If day = 5 Then
          result := '环境日';

        If day = 6 Then
          result := '爱眼日';

        If day = 23 Then
          result := '体育日';

        If day = 25 Then
          result := '土地日';

        If day = 26 Then
          result := '反毒品';

        // 父亲节[第三个星期日]
      End;
    7:
      Begin