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