作者: 陆岛工作室
在完成 陆岛桌面工具 时，需要对农历进行一些处理。以前有很多这方面的函数，这次利用写 陆岛桌面工具 的机会就重新整理了一下，并将以前所掌握的知识全部集合到一个单元文件里。不过，这些函数还只是应付 陆岛桌面工具 时的需要完成的。其实还有很多其他方面的农历相关的函数，没有时间整理了，还是那句话，够用就行。等以后需要用的时间再来收集整理下。
虽然是用 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.
在完成 陆岛桌面工具 时，需要对农历进行一些处理。以前有很多这方面的函数，这次利用写 陆岛桌面工具 的机会就重新整理了一下，并将以前所掌握的知识全部集合到一个单元文件里。不过，这些函数还只是应付 陆岛桌面工具 时的需要完成的。其实还有很多其他方面的农历相关的函数，没有时间整理了，还是那句话，够用就行。等以后需要用的时间再来收集整理下。
虽然是用 DELPHI 写的，其他编程语言也是相通的。相信对需要的朋友有点帮助的。贴出来，大家共同学习交流一下。我的想法是:自己知道的，让国人尽量有机会都知道，免得走弯路，这样相信有可能为别人节省了时间来做更好的*西。大家如果都这样，国内的软件发展岂不加速起来。见笑见笑。
其实这个单元中的很多知识也是通过网上得来的，有的代码也是COPY过来的，不过，基本上本人都处理过，主要是使语言代码高效简洁实用，而且尽量的只做了一些常用的实用的函数。