datecn.pas

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

      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);
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
  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
  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
end;

function Holiday(Date: TDateTime; Day: integer): string; //由公历日期决定的节假日
var
  dDate: TDate;
begin
  result := '';
  case Month(Date) of
    1:
      begin
        if day = 1 then result := '元旦节';
      end;
    2:
      begin
        if day = 2 then  result := '湿地日';
        if day = 10 then result := '气象节';
        if day = 14 then result := '情人节';
      end;
    3:
      begin
        if day = 3 then  result := '爱耳日';
        if day = 8 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 = 1 then  result := '愚人节';
        if day = 7 then  result := '卫生日';
        if day = 22 then result := '地球日';
      end;
    5:
      begin
        if day = 1 then  result := '劳动节';
        if day = 4 then  result := '青年节';
        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 := '无烟日';
        dDate := EnCodeDate(Year(Date), Month(Date), Day);
        if (DayOfWeek(dDate) = 1) then if (Trunc((Day - 1) / 7) = 1) then result := '母亲节';
      end;
    6:
      begin
        if day = 1 then  result := '儿童节';
        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 := '反毒品';
        dDate := EnCodeDate(Year(Date), Month(Date), Day);
        if (DayOfWeek(dDate) = 1) then if (Trunc((Day - 1) / 7) = 2) then result := '父亲节';
      end;
    7:
      begin
        if day = 1 then  result := '建党节';
        if day = 11 then result := '人口日';
      end;
    8:
      begin
        if day = 1 then result := '建军节';
      end;
    9:
      begin
        if day = 8 then  result := '扫盲日';
        if day = 10 then result := '教师节';
        if day = 17 then result := '和平日';
        if day = 20 then result := '爱牙日';
        if day = 22 then result := '聋人节';
        if day = 27 then result := '旅游日';
      end;
    10:
      begin
        if day = 1 then  result := '国庆节';
        if day = 4 then  result := '动物日';
        if day = 6 then  result := '老人节';
        if day = 7 then  result := '住房日';
        if day = 9 then  result := '邮政日';
        if day = 15 then result := '盲人节';
        if day = 16 then result := '粮食日';
        if day = 31 then result := '万圣节';
      end;
    11:
      begin
        if day = 8 then  result := '记者日';
        if day = 9 then  result := '消防日';
        if day = 17 then result := '大学生';
        dDate := EnCodeDate(Year(Date), Month(Date), Day);
        if (DayOfWeek(dDate) = 5) then if (Trunc((Day - 1) / 7) = 3) then result := '感恩节';
      end;
    12:
      begin
        if day = 9 then  result := '足球日';
        if day = 24 then result := '平安夜';
        if day = 25 then result := '圣诞节';
      end;
  end;
end;

function GetCnDateToDate(dDate: TDateTime): TDateTime;
begin
  Result := GetCnDateToDate(Year(Now), CnMonth(dDate), CnDay(dDate));
end;

function GetCnDateToDate(cYear, cMonth, cDay: word): TDateTime;
var
  tempDate: TDateTime;
  tempDay, tempMonth: Integer;

begin
  if cMonth > 11 then
    tempDate := EnCodeDate(cYear - 1, cMonth, cDay)
  else
    tempDate := EnCodeDate(cYear, cMonth, cDay);
  Result := 0;
  tempMonth := 0;
  tempDay := 0;
  while Result = 0 do
  begin
    tempDate := tempDate + 1;
    if CnMonth(tempDate) = cMonth then
      if CnDay(tempDate) = cDay then
      begin
        Result := tempDate;
        exit;
      end
      else
        if (cDay = 30) and (CnDay(tempDate) = 29)
          and (CnDay(tempDate + 1) <> 30) then
        begin
          Result := tempDate;
          exit;
        end;

  end;
end;

function GetDays(ADate: TDate): Extended;
var
  FirstOfYear: TDateTime;
begin
  FirstOfYear := EncodeDate(StrToInt(FormatDateTime('yyyy', now)) - 1, 12, 31);
  Result := ADate - FirstOfYear;
end;

function Constellation(Date: TDateTime; Day: integer): string; overload;
var
  Year, Month, Days, Hour: Word;
begin
  DecodeDate(Date, Year, Month, Days);
  Result := Constellation(EncodeDate(Year, Month, Day));
end;

function Constellation(ADate: TDate): string;  //由公历日期求得星座名
begin
  case Month(ADate) of
    1:
      begin
        if day(ADate) <= 19 then result := '摩羯座';
        if day(ADate) >= 20 then result := '水瓶座';
      end;
    2:
      begin
        if day(ADate) <= 18 then result := '水瓶座';
        if day(ADate) >= 19 then result := '双鱼座';
      end;
    3:
      begin
        if day(ADate) <= 20 then result := '双鱼座';
        if day(ADate) >= 21 then result := '白羊座';
      end;
    4:
      begin
        if day(ADate) <= 19 then result := '白羊座';
        if day(ADate) >= 20 then result := '金牛座';
      end;
    5:
      begin
        if day(ADate) <= 20 then result := '金牛座';
        if day(ADate) >= 21 then result := '双子座';
      end;
    6:
      begin
        if day(ADate) <= 21 then result := '双子座';
        if day(ADate) >= 22 then result := '巨蟹座';
      end;
    7:
      begin
        if day(ADate) <= 22 then result := '巨蟹座';
        if day(ADate) >= 23 then result := '狮子座';
      end;
    8:
      begin
        if day(ADate) <= 22 then result := '狮子座';
        if day(ADate) >= 24 then result := '处女座';
      end;

    9:
      begin
        if day(ADate) <= 22 then result := '处女座';
        if day(ADate) >= 23 then result := '天秤座';
      end;
    10:
      begin
        if day(ADate) <= 23 then result := '天秤座';
        if day(ADate) >= 24 then result := '天蝎座';
      end;
    11:
      begin
        if day(ADate) <= 21 then result := '天蝎座';
        if day(ADate) >= 22 then result := '射手座';
      end;
    12:
      begin
        if day(ADate) <= 21 then result := '射手座';
        if day(ADate) >= 22 then result := '摩羯座';
      end;
  end;
end;

end.