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

作者: 陆岛工作室



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

虽然是用 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..6of string = ('''','','','','','');

  
//农历日期
  sChineseDayStr1: 
array[0..12of string =('','','','','','','','','','','''十一''十二');
  sChineseDayStr2: 
array[0..4of string =('','','廿','','');

  
//天干地支
  sChineseEra1: 
array[0..9of string = ('','','','','','','','','','');
  sChineseEra2: 
array[0..11of string = ('','','','','','','','','','','','');
  
//属相
  sChineseAnimalSigns: 
array[0..11of string = ('','','','','','''','','','','','');


  
//农历数据对应表  1900-2100
  LunarTables: 
array[0..200of 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..23of Integer=
    (     
021208424676383685337,107014,128867,150921173149,195551,218072,240693,
     
263343,285989,308563,331033,353350,375494,397447,419210440795,462224,483532,504758);


  
{节日在某月的第几个星期几}
  WeekHolidays: 
array[0..12of 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..14of 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..103of 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..21of 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-4mod 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 - 1900and ($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 - 1900and 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 - 1899and $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 - 1900and $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(200025), 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<2050and (Offset>0do
  
begin
    Temp :
= DaysInLunarYear(i);
    Dec(Offset, Temp);
    Inc(I);
  
end;

  
if(Offset<0then
  
begin
    Inc(Offset, Temp);
    Dec(I);
  
end;
  
  Y :
= I;
  Leap :
= LeapMonthOfLunarYear(I);
  IsLeapMonth :
= False;
  
  I :
= 1;
  
while (I<13and (Offset>0do
  
begin
    
if (Leap>0and (I=Leap+1and 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=0and (Leap>0and (I=Leap+1then
    
if IsLeapMonth then
      IsLeapMonth :
= False
    
else
    
begin
      IsLeapMonth :
= True;
      Dec(I);
    
end;
    
  
if (Offset<0then
  
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 = 1or ((sm = 2and (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=13and (DayOfWeek(ADate)=6then
  
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.
posted @ 2008-06-08 21:58  陆岛工作室  阅读(...)  评论(...编辑  收藏