原创: 农历相关函数单元。有多个处理中国农历的函数。

作者: 陆岛工作室



在完成 陆岛桌面工具 时，需要对农历进行一些处理。以前有很多这方面的函数，这次利用写 陆岛桌面工具 的机会就重新整理了一下，并将以前所掌握的知识全部集合到一个单元文件里。不过，这些函数还只是应付 陆岛桌面工具 时的需要完成的。其实还有很多其他方面的农历相关的函数，没有时间整理了，还是那句话，够用就行。等以后需要用的时间再来收集整理下。

虽然是用 DELPHI 写的，其他编程语言也是相通的。相信对需要的朋友有点帮助的。贴出来，大家共同学习交流一下。我的想法是:自己知道的，让国人尽量有机会都知道，免得走弯路，这样相信有可能为别人节省了时间来做更好的*西。大家如果都这样，国内的软件发展岂不加速起来。见笑见笑。
其实这个单元中的很多知识也是通过网上得来的，有的代码也是COPY过来的，不过，基本上本人都处理过，主要是使语言代码高效简洁实用，而且尽量的只做了一些常用的实用的函数。

{*******************************************************************************

   XOtecExpress Visual Component Library [陆岛工作室]
   Copyright (c) 2008 XOtec Studio.  [PengJunli]

   By: PengJunLi Build: 2008-05
   E-mail: iinsnian@126.com  XOtec@vip.QQ.com  QQ:442801172

*******************************************************************************}

unit xtDateUtils;

interface

{$R-,T-,H+,X+}

uses
  Windows, Classes, SysUtils, Dialogs;

const
  NullDate             = 0;
  LunarBaseDate        = 32; //1900-1-31
  LunarYears           = [0..200];
  LunarMonths          = [1..12];
  LunarDays            = [1..30];

  //星期
  sWeekText: array[0..6] of string = ('日', '一','二','三','四','五','六');

  //农历日期
  sChineseDayStr1: array[0..12] of string =('日','一','二','三','四','五','六','七','八','九','十', '十一', '十二');
  sChineseDayStr2: array[0..4] of string =('初','十','廿','卅','');

  //天干地支
  sChineseEra1: array[0..9] of string = ('甲','乙','丙','丁','戊','己','庚','辛','壬','癸');
  sChineseEra2: array[0..11] of string = ('子','丑','寅','卯','辰','巳','午','未','申','酉','戌','亥');
  //属相
  sChineseAnimalSigns: array[0..11] of string = ('鼠','牛','虎','兔','龙','蛇', '马','羊','猴','鸡','狗','猪');


  //农历数据对应表  1900-2100
  LunarTables: array[0..200] of Longint = (
    $4bd8,$4ae0,$a570,$54d5,$d260,$d950,$5554,$56af,$9ad0,$55d2,
    $4ae0,$a5b6,$a4d0,$d250,$d295,$b54f,$d6a0,$ada2,$95b0,$4977,
    $497f,$a4b0,$b4b5,$6a50,$6d40,$ab54,$2b6f,$9570,$52f2,$4970,
    $6566,$d4a0,$ea50,$6a95,$5adf,$2b60,$86e3,$92ef,$c8d7,$c95f,
    $d4a0,$d8a6,$b55f,$56a0,$a5b4,$25df,$92d0,$d2b2,$a950,$b557,
    $6ca0,$b550,$5355,$4daf,$a5b0,$4573,$52bf,$a9a8,$e950,$6aa0,
    $aea6,$ab50,$4b60,$aae4,$a570,$5260,$f263,$d950,$5b57,$56a0,
    $96d0,$4dd5,$4ad0,$a4d0,$d4d4,$d250,$d558,$b540,$b6a0,$95a6,
    $95bf,$49b0,$a974,$a4b0,$b27a,$6a50,$6d40,$af46,$ab60,$9570,
    $4af5,$4970,$64b0,$74a3,$ea50,$6b58,$5ac0,$ab60,$96d5,$92e0, //1999
    $c960,$d954,$d4a0,$da50,$7552,$56a0,$abb7,$25d0,$92d0,$cab5,
    $a950,$b4a0,$baa4,$ad50,$55d9,$4ba0,$a5b0,$5176,$52bf,$a930,
    $7954,$6aa0,$ad50,$5b52,$4b60,$a6e6,$a4e0,$d260,$ea65,$d530,
    $5aa0,$76a3,$96d0,$4afb,$4ad0,$a4d0,$d0b6,$d25f,$d520,$dd45,
    $b5a0,$56d0,$55b2,$49b0,$a577,$a4b0,$aa50,$b255,$6d2f,$ada0,
    $4b63,$937f,$49f8,$4970,$64b0,$68a6,$ea5f,$6b20,$a6c4,$aaef,
    $92e0,$d2e3,$c960,$d557,$d4a0,$da50,$5d55,$56a0,$a6d0,$55d4,
    $52d0,$a9b8,$a950,$b4a0,$b6a6,$ad50,$55a0,$aba4,$a5b0,$52b0,
    $b273,$6930,$7337,$6aa0,$ad50,$4b55,$4b6f,$a570,$54e4,$d260,
    $e968,$d520,$daa0,$6aa6,$56df,$4ae0,$a9d4,$a4d0,$d150,$f252,
    $d520);


  //节气数据对应表
  SolarTermTables: array[0..23] of Integer=
    (     0, 21208, 42467, 63836, 85337,107014,128867,150921, 173149,195551,218072,240693,
     263343,285989,308563,331033,353350,375494,397447,419210, 440795,462224,483532,504758);


  {节日在某月的第几个星期几}
  WeekHolidays: array[0..12] of TIdentMapEntry = (
    (Value: 0110; Name: '黑人日'),
    (Value: 0150; Name: '世界麻风日'),        //一月的最后一个星期日（月倒数第一个星期日）
    (Value: 0520; Name: '国际母亲节'),
    (Value: 0530; Name: '全国助残日'),
    (Value: 0630; Name: '父亲节'),
    (Value: 0911; Name: '劳动节'),           //..5
    (Value: 0932; Name: '国际和平日'),
    (Value: 0940; Name: '国际聋人节'),
    (Value: 0940; Name: '世界儿童日'),
    (Value: 0950; Name: '世界海事日'),
    (Value: 1011; Name: '国际住房日'),       //..10

    (Value: 1013; Name: '国际减轻自然灾害日(减灾日)'),
    (Value: 1144; Name: '感恩节')            //..12
  );

  {农历节日}
  ChineseHolidays: array[0..14] of TIdentMapEntry = (
    (Value: 0101; Name: '春节'),
    (Value: 0115; Name: '元宵节'),
    (Value: 0202; Name: '龙抬头节'),
    (Value: 0323; Name: '妈祖生辰'),
    (Value: 0505; Name: '端午节'),
    (Value: 0606; Name: '泼水节(苗族)'),     //..5
    (Value: 0707; Name: '七夕中国情人节'),
    (Value: 0715; Name: '中元节'),
    (Value: 0815; Name: '中秋节'),
    (Value: 0909; Name: '重阳节'),
    (Value: 0909; Name: '重阳节'),          //..10
    (Value: 1208; Name: '腊八节'),
    (Value: 1223; Name: '灶君(祭灶)节'),
    (Value: 1224; Name: '小年'),
    (Value: 0130; Name: '除夕')            //..14
  );

  { 纪念日 }
  LocketDays: array[0..103] of TIdentMapEntry = (
    (Value: 0202; Name: '世界湿地日'),
    (Value: 0207; Name: '国际声援南非日'),
    (Value: 0210; Name: '国际气象节'),
    (Value: 0212; Name: '国际足球比赛日'),

    (Value: 0301; Name: '国际海豹日'),
    (Value: 0303; Name: '全国爱耳日'),
    (Value: 0312; Name: '孙中山逝世纪念日'),

    (Value: 0314; Name: '国际警察日'),
    (Value: 0315; Name: '国际消费者权益日'),
    (Value: 0317; Name: '中国国医节'),
    (Value: 0317; Name: '国际航海日'),                 //..10
    (Value: 0321; Name: '世界森林日'),
    (Value: 0321; Name: '消除种族歧视国际日'),
    (Value: 0321; Name: '世界儿歌日'),
    (Value: 0322; Name: '世界水日'),
    (Value: 0323; Name: '世界气象日'),
    (Value: 0324; Name: '世界防治结核病日'),
    (Value: 0325; Name: '全国中小学生安全教育日'),
    (Value: 0315; Name: '消费者权益日'),
    (Value: 0330; Name: '巴勒斯坦国土日'),

    (Value: 0401; Name: '全国爱国卫生运动月(四月)'),   //..20
    (Value: 0401; Name: '税收宣传月(四月)'),
    (Value: 0407; Name: '世界卫生日'),
    (Value: 0422; Name: '世界地球日'),
    (Value: 0423; Name: '世界图书和版权日'),
    (Value: 0424; Name: '亚非新闻工作者日'),           

    (Value: 0505; Name: '碘缺乏病防治日'),
    (Value: 0508; Name: '世界红十字日'),
    (Value: 0515; Name: '国际家庭日'),
    (Value: 0517; Name: '世界电信日'),
    (Value: 0518; Name: '国际博物馆日'),               //..30
    (Value: 0520; Name: '全国学生营养日'),
    (Value: 0523; Name: '国际牛奶日'),
    (Value: 0531; Name: '世界无烟日'),

    (Value: 0605; Name: '世界环境日'),
    (Value: 0606; Name: '全国爱眼日'),
    (Value: 0617; Name: '防治荒漠化和干旱日'),
    (Value: 0623; Name: '国际奥林匹克日'),
    (Value: 0625; Name: '全国土地日'),
    (Value: 0626; Name: '国际反毒品日'),

    (Value: 0701; Name: '中国***建党日'),          //..40 --网上提交时不能提交，所以加了下划线。
    (Value: 0701; Name: '香港回归纪念日'),
    (Value: 0702; Name: '国际体育记者日'),
    (Value: 0707; Name: '七七事变'),
    (Value: 0707; Name: '中国人民抗日战争纪念日'),
    (Value: 0711; Name: '世界人口日'),
    (Value: 0730; Name: '非洲妇女日'),

    (Value: 0801; Name: '中国建军节'),
    (Value: 0808; Name: '中国男子节'),
    (Value: 0815; Name: '日本正式宣布无条件投降日'),
    (Value: 0903; Name: '抗日战争胜利纪念日'),        //..50
    (Value: 0908; Name: '国际扫盲日'),
    (Value: 0908; Name: '国际新闻工作者日'),
    (Value: 0909; Name: '***逝世纪念日'),
    (Value: 0914; Name: '世界清洁地球日'),
    (Value: 0916; Name: '国际臭氧层保护日'),
    (Value: 0917; Name: '甲午海战(1894年)'),
    (Value: 0918; Name: '九·一八事变纪念日'),
    (Value: 0920; Name: '国际爱牙日'),
    (Value: 0927; Name: '世界旅游日'),
    (Value: 0928; Name: '孔子诞辰纪念日'),           //..60

    (Value: 1001; Name: '世界音乐日'),
    (Value: 1002; Name: '国际和平与民主自由斗争日'),
    (Value: 1004; Name: '世界动物日'),
    (Value: 1008; Name: '全国高血压日'),
    (Value: 1008; Name: '世界视觉日'),
    (Value: 1009; Name: '世界邮政日'),
    (Value: 1009; Name: '万国邮联日'),
    (Value: 1010; Name: '辛亥革命纪念日'),
    (Value: 1010; Name: '世界精神卫生日'),
    (Value: 1013; Name: '世界保健日'),              //..70
    (Value: 1013; Name: '少先队建队日'),
    (Value: 1014; Name: '世界标准日'),
    (Value: 1015; Name: '国际盲人节(白手杖节)'),
    (Value: 1016; Name: '世界粮食日'),
    (Value: 1017; Name: '世界消除贫困日'),
    (Value: 1022; Name: '世界传统医药日'),
    (Value: 1024; Name: '联合国日'),
    (Value: 1024; Name: '世界发展信息日'),
    (Value: 1031; Name: '世界勤俭日'),

    (Value: 1107; Name: '十月社会主义革命纪念日'),  //..80
    (Value: 1108; Name: '中国记者日'),
    (Value: 1109; Name: '全国消防安全宣传教育日'),
    (Value: 1110; Name: '世界青年节'),
    (Value: 1111; Name: '国际科学与和平周(本日所属的一周)'),
    (Value: 1112; Name: '孙中山诞辰纪念日'),
    (Value: 1114; Name: '世界糖尿病日'),
    (Value: 1117; Name: '国际大学生节 世界学生节'),
    (Value: 1121; Name: '世界问候日'),
    (Value: 1121; Name: '世界电视日'),
    (Value: 1129; Name: '国际声援巴勒斯坦人民国际日'),   //..90

    (Value: 1201; Name: '世界艾滋病日'),
    (Value: 1203; Name: '世界残疾人日'),
    (Value: 1205; Name: '国际经济和社会发展志愿人员日'),
    (Value: 1208; Name: '国际儿童电视日'),
    (Value: 1209; Name: '世界足球日'),
    (Value: 1210; Name: '世界人权日'),
    (Value: 1212; Name: '西安事变纪念日'),
    (Value: 1213; Name: '南京大屠杀(1937年)纪念日！'),
    (Value: 1220; Name: '澳门回归纪念日'),
    (Value: 1221; Name: '国际篮球日'),               //..100
    (Value: 1224; Name: '平安夜'),
    (Value: 1226; Name: '***诞辰纪念日'),
    (Value: 1229; Name: '国际生物多样性日')          //..103
  );


  { 公历节日 }
  Holidays: array[0..21] of TIdentMapEntry = (
    (Value: 0101; Name: '元旦'),
    (Value: 0214; Name: '西方情人节'),
    (Value: 0308; Name: '国际妇女节'),
    (Value: 0312; Name: '植树节'),
    (Value: 0312; Name: '复活节'),
    (Value: 0401; Name: '愚人节'),          //..5
    (Value: 0405; Name: '清明节'),
    (Value: 0425; Name: '读者节'),
    (Value: 0501; Name: '国际劳动节'),
    (Value: 0504; Name: '中国五四青年节'),
    (Value: 0512; Name: '国际护士节'),      //..10
    (Value: 0601; Name: '国际儿童节'),
    (Value: 0808; Name: '父亲节'),
    (Value: 0910; Name: '教师节'),
    (Value: 1001; Name: '国庆节'),
    (Value: 1001; Name: '国际老人节'),      //..15
    (Value: 1013; Name: '国际教师节'),
    (Value: 1031; Name: '万圣节'),
    (Value: 1101; Name: '电影节'),
    (Value: 1111; Name: '光棍节'),
    (Value: 1117; Name: '学生节'),          //..20
    (Value: 1225; Name: '圣诞节')           //..21
  );



{ LunarDayText: 取对应的农历日文本 }
function LunarDayText(iDay: Integer): String;

{ DaysInLunarYear: 农历年的总天数 }
function DaysInLunarYear(Year: Word): Integer;

{ DaysInLeapMonth: 农历年闰月的总天数 }
function DaysInLeapMonth(Year: Word): Integer;

{ DaysInLunarMonth: 农历年一月的总天数 }
function DaysInLunarMonth(Year, Month: Word): integer;

{ LeapMonthOfLunarYear: 取一年中的闰月, 返回 0 时表示没有闰月 }
function LeapMonthOfLunarYear(Year: Word): Integer;

{ LunarOfDate: 公历转换为农历}
procedure LunarOfDate(ADate: TDateTime; var Y, M, D: Word; var IsLeapMonth: Boolean);

{ DateOfLunar: 农历转换为公历 }
function DateOfLunar(Year, Month, Day: Word; IsLeapMonth: Boolean): TDateTime;

{ DateTimeOfTerm: 一年中某个节气的时间 }
function DateTimeOfTerm(Y, N: Word): TDateTime;

{ ChineseEraOfDate: 公历某日的年柱,月柱,日柱}
procedure ChineseEraOfDate(ADate: TDateTime; var YEra, MEra, DEra: string);

{ YearOfLunar: 取某一年的年柱 }
function YearTextOfLunar(ADate: TDateTime): string;

{ AnimalSignOfYear: 一年的属相 }
function AnimalSignOfYear(Year: Word; IsLong: Boolean=False): string;

{ HolidayOfDate: 取一天是否有节日 }
function HolidayOfDate(ADate: TDateTime; FList: TStrings): string;

implementation

uses ldClasses, Variants, DateUtils;

{ GetChineseEra: 取天干地支 }

function GetChineseEra(Offset: Integer): String;
begin
   Result := sChineseEra1[Offset mod 10] + sChineseEra2[Offset mod 12];
end;

{ LunarDayText }

function LunarDayText(iDay: Integer): String;
var
  S: String;
begin
   case (iDay) of
     10: S := '初十';
     20: S := '二十';
     30: S := '三十';
     else
       S := sChineseDayStr2[Trunc(iDay/10)];
       S := S + sChineseDayStr1[iDay mod 10];
   end;
   Result := S;
end;

{ AnimalSignOfYear }

function AnimalSignOfYear(Year: Word; IsLong: Boolean=False): string;
var
  M: Integer;
begin
  M := (Year-4) mod 12;
  Result := sChineseAnimalSigns[M];

  if IsLong then
    Result := sChineseEra2[M] + Result;
end;

{ YearTextOfLunar }

function YearTextOfLunar(ADate: TDateTime): string;
var
  term: TDateTime;
  iY, y, m, d: Word;
begin
  Result := '';
  DecodeDate(ADate, y, m, d);
  if y < 1900 then exit;
  term := DateTimeOfTerm(y, (m - 1) * 2);  // 当月的节气日期

  iY := y - 1900 + 36;

  Result := GetChineseEra(iY);
end;

{ DaysInLunarMonth }

function DaysInLunarMonth(Year, Month: Word): integer;
var
  temp1, temp2, temp3: Word;
begin
  if (LunarTables[Year - 1900] and ($10000 shr Month))>0 then
    Result := 30
  else
    Result := 29;
end;

{ DaysInLunarYear }

function DaysInLunarYear(Year: Word): Integer;
var
  I, C: integer;
begin
  C := 348; // (29 * 12)
  I := $8000;

  while i > $8 do
  begin
    if (LunarTables[Year - 1900] and I) > 0 then
      Inc(C) ;

    I := I shr 1;
  end;
  
  Result:= C + DaysInLeapMonth(Year);
end;

{ DaysInLeapMonth }

function DaysInLeapMonth(Year: Word): Integer;
begin
 if LeapMonthOfLunarYear(Year) > 0 then
   if (LunarTables[Year - 1899] and $f) = $f then
     Result := 30
   else
     Result := 29
 else
   Result := 0;
end;

{ LeapMonthOfLunarYear }

function LeapMonthOfLunarYear(Year: Word): Integer;
var
  M: Word;
begin
   M := LunarTables[Year - 1900] and $f;

   if M = $f then Result:= 0 else Result := M;
end;

{ DateOfLunar }

function DateOfLunar(Year, Month, Day: Word; IsLeapMonth: Boolean): TDateTime;
var
  i, j, t, y, m: Integer;
  isLeap: Boolean;
  Leap, Temp, Offset: Integer;
begin
  Result:= NullDate;

  y := (Year-1900);
  if not (y in LunarYears) or not (Month in LunarMonths) or not (Day in LunarDays) then Exit;

  if IsLeapMonth then
    IsLeapMonth := Month=LeapMonthOfLunarYear(Year);
  
  y := Year;
  m := Month;
  Leap := LeapMonthOfLunarYear(y);
  isLeap := False;
  Offset := 0;

  i := 1;
  while i < m do
  begin
    if i = Leap then
    begin
      if isLeap then
      begin
        Temp := DaysInLeapMonth(y);
        isLeap:= False;
      end
      else begin
        Temp := DaysInLunarMonth(y, i);
        isLeap:= True;
        i:= i - 1;
      end;
    end else
      Temp := DaysInLunarMonth(y, i);
    offset:= offset + temp;
    Inc(i);
  end;

  Offset:= Offset + Day - 1;
  if (m = Leap) and IsLeapMonth then
    Offset:= Offset + DaysInLunarMonth(y, m);

  // from 2000-1-1
  if y > 2000 then
  begin
    i := 2000;
    j := y - 1;
  end
  else begin
    i := y;
    j := 1999;
  end;

  Temp := 0;
  for t := i to j do
  begin
    Temp:= Temp + DaysInLunarYear(t);
  end;

  if y > 1999 then
    Offset:= Offset + Temp
  else
    Offset:= Offset - Temp;

  Result := IncDay(EncodeDate(2000, 2, 5), Offset);
end;

{ LunarDate }

procedure LunarOfDate(ADate: TDateTime; var Y, M, D: Word; var IsLeapMonth: Boolean);
var
  I, Leap, Temp: Integer;
  Offset: LongInt;
begin
  Temp := 0;

  Offset := Trunc((ADate - LunarBaseDate)*60*60*24 / 86400);

  I := 1900;

  while (I<2050) and (Offset>0) do
  begin
    Temp := DaysInLunarYear(i);
    Dec(Offset, Temp);
    Inc(I);
  end;

  if(Offset<0) then
  begin
    Inc(Offset, Temp);
    Dec(I);
  end;
  
  Y := I;
  Leap := LeapMonthOfLunarYear(I);
  IsLeapMonth := False;
  
  I := 1;
  while (I<13) and (Offset>0) do
  begin
    if (Leap>0) and (I=Leap+1) and not IsLeapMonth then
    begin
      Dec(I);
      IsLeapMonth := True;
      Temp := DaysInLeapMonth(Y);
    end else
      Temp := DaysInLunarMonth(Y, i);
    
    if (IsLeapMonth) and (I=(Leap+1)) then IsLeapMonth := False;
    Dec(Offset, Temp);
    Inc(I);
  end;

  if (Offset=0) and (Leap>0) and (I=Leap+1) then
    if IsLeapMonth then
      IsLeapMonth := False
    else
    begin
      IsLeapMonth := True;
      Dec(I);
    end;
    
  if (Offset<0) then
  begin
    Inc(Offset, Temp);
    Dec(I);
  end;
  
  M := I;
  D := Offset + 1;
end;

{ DateTimeOfTerm }

function DateTimeOfTerm(Y, N: Word): TDateTime;
var
  t: Real;
  I: Int64;
begin
  t := SolarTermTables[n];
  t := t * 60000;
  I := Round(t + 31556925974.7*(y-1900));
  Result:= IncMilliSecond(EncodeDateTime(1900,1,6,2,5,0,0), i);
end;


procedure ChineseEraOfDate(ADate: TDateTime; var YEra, MEra, DEra: string);
var
  term: TDateTime;
  sy, sm, sd: Word;
  iY, iM, iD: Word;
  cY, cM, cD: string;
begin
  DecodeDate(ADate, sy, sm, sd);
  if sy < 1900 then exit;
  term := DateTimeOfTerm(sy, (sm - 1) * 2);  // 当月的节气日期

  iY := sy - 1900 + 36;
  //依立春日期调整年柱
  if (sm = 1) or ((sm = 2) and (ADate < DateOf(Term))) then
    iY := sy - 1900 + 35;

  iM := (sy - 1900) * 12 + sm + 11;
  if ADate >= DateOf(term) then iM := (sy - 1900) * 12 + sm + 12;

  // 1900/1/1 日柱为甲辰日(60进制10)
  iD := DaysBetween(EncodeDate(1900,1,1),ADate) + 10;

  YEra := GetChineseEra(iY);
  MEra := GetChineseEra(iM);
  DEra := GetChineseEra(iD);
end;

{ HolidayOfDate }

function HolidayOfDate(ADate: TDateTime; FList: TStrings): string;
var
  I: Integer;
  Leap: Boolean;
  iY, iM, iD, Y, M, D: Word;
  HolidayStr: string;
begin
  HolidayStr := '';
  DecodeDate(Adate, iY, iM, iD);
  LunarOfDate(ADate, Y, M, D, Leap);

  {国历节日}
  for I:=low(Holidays) to high(Holidays) do
  begin
    if Holidays[I].Value = (iM*100 + iD) then
    begin
      StrUnite(HolidayStr, Holidays[I].Name, #13);
      if Assigned(FList) then FList.Add(Holidays[I].Name+'=1');
    end;
  end;

  {纪念日}
  for I:=low(LocketDays) to high(LocketDays) do
  begin
    if LocketDays[I].Value = (iM*100 + iD) then
    begin
      StrUnite(HolidayStr, LocketDays[I].Name, #13);
      if Assigned(FList) then FList.Add(LocketDays[I].Name+'=2');
    end;
  end;

  {农历节日}
  for I:=low(ChineseHolidays) to high(ChineseHolidays) do
  begin
    if ChineseHolidays[I].Value = (M*100 + D) then
    begin
      StrUnite(HolidayStr, ChineseHolidays[I].Name, #13);
      if Assigned(FList) then FList.Add(ChineseHolidays[I].Name+'=3');
    end;
  end;

  {星期日节日}
  Y := DaysInMonth(ADate) div 7;
  D := DayOfTheWeek(ADate);
  M := WeekOfTheMonth(ADate);

  if (iD=13) and (DayOfWeek(ADate)=6) then
  begin
    StrUnite(HolidayStr, '黑色星期五', #13);
    if Assigned(FList) then FList.Add('黑色星期五'+'=4');
  end else if DayOfWeek(ADate)=1 then
  begin
    for I:=low(WeekHolidays) to high(WeekHolidays) do
    begin
      if (WeekHolidays[I].Value = (iM*100 + M*10 + D)) or
        ((Y=M) and (WeekHolidays[I].Value = (iM*100 + 50 + D))) then //最后一周的一天
      begin
        StrUnite(HolidayStr, WeekHolidays[I].Name, #13);
        if Assigned(FList) then FList.Add(WeekHolidays[I].Name+'=4');
      end;
    end;
  end;
end;

end.