BaiduFMX

qcndate.pas
885 строк · 36.1 Кб
Перенос по словам
1
unit qcndate;
2

3
interface
4

5
{
6
  The algorithm data of this unit uses the lunar calendar data from the early UCDOS.
7
}
8

9
uses
10
  System.Classes,
11
  System.SysUtils,
12
  System.Math,
13
  System.DateUtils;
14

15
type
16
{$HPPEMIT '#pragma link "qcndate"'}
17
  TCalendarDate = record
18
    case Integer of
19
      1:
20
        // 16-значный год, 8-значный месяц, 8-значный день
21
        (Year: Word; Month: Shortint; Day: Byte); // 16位年，8位月，8位日
22
      2: // 32-битное целое значение
23
        (Value: Integer); // 32位的整数值
24
  end;
25

26
const
27
  CnDayNames: array [1 .. 30] of String = ('初一', '初二', '初三', '初四', '初五', '初六',
28
    '初七', '初八', '初九', '初十', '十一', '十二', '十三', '十四', '十五', '十六', '十七', '十八',
29
    '十九', '二十', '廿一', '廿二', '廿三', '廿四', '廿五', '廿六', '廿七', '廿八', '廿九', '三十');
30
  RuDayNames: array [1 .. 30] of String = ('Первый', 'Второй', 'Третий', 'Четвёртый', 'Пятый', 'Шестой',
31
    'Седьмой', 'Восьмой', 'Девятый', 'Десятый', 'Одиннадцатый', 'Двенадцатый', 'Тринадцатый',
32
    'Четырнадцатый', 'Пятнадцатый', 'Шестнадцатый', 'Семьнадцатый', 'Восемьнадцатый', 'Девятнадцатый',
33
    'Двадцатый', 'Двадцатьпервый', 'Двадцатьвторой', 'Двадцатьтретий', 'Двадцатьчетвёртый', 'Двадцатьпятый',
34
    'Двадцатьшестой', 'Двадцатьседьмой', 'Двадцатьвосьмой', 'Двадцатьдевятый', 'Тридцатый');
35
  CnMonthNames: array [1 .. 12] of String = ('正月', '二月', '三月', '四月', '五月', '六月',
36
    '七月', '八月', '九月', '十月', '冬月', '腊月');
37
  CnSkyNames: array [1 .. 10] of String = ('甲', '乙', '丙', '丁', '戊', '己', '庚',
38
    '辛', '壬', '癸');
39
  CnEarthNames: array [1 .. 12] of String = ('子', '丑', '寅', '卯', '辰', '巳', '午',
40
    '未', '申', '酉', '戌', '亥');
41
  CnAnimals: array [1 .. 12] of String = ('鼠', '牛', '虎', '兔', '龙', '蛇', '马',
42
    '羊', '猴', '鸡', '狗', '猪');
43
  CnSolarTerms: array [0 .. 24] of String = ('', '小寒', '大寒', '立春', '雨水', '惊蛰',
44
    '春分', '清明', '谷雨', '立夏', '小满', '芒种', '夏至', '小暑', '大暑', '立秋', '处暑', '白露',
45
    '秋分', '寒露', '霜降', '立冬', '小雪', '大雪', '冬至');
46
  CnWeekNames: array [1 .. 7] of String = ('一', '二', '三', '四', '五', '六', '日');
47

48
  /// <summary>
49
  /// 将指定的农历年月日编码为一个TCalendarDate变量
50
  /// </summary>
51
  /// <params>
52
  /// <param name="Y">农历年份，取值范围为1901-2050  </param>
53
  /// <param name="M">农历月份，负数代表是闰月</param>
54
  /// <param name="D">农历日数，取值范围为1-30</param>
55
  /// </params>
56
  /// <returns>返回编码后日期</returns>
57
function CnDate(Y: Word; M, D: Shortint): TCalendarDate; inline;
58

59
/// <summary>将指定的日期转换为农历日期</summary>
60
/// <params>
61
/// <param name=“ADate">阳历日期</param>
62
/// </params>
63
/// <returns>返回转换后的日期</returns>
64
function ToCnDate(ADate: TDateTime): TCalendarDate; overload;
65

66
/// <summary>将指定的日期转换为农历日期</summary>
67
/// <params>
68
/// <param name=“yyyy">阳历年份</param>
69
/// <param name="mm">阳历月份</param>
70
/// <param name="dd">阳历日</param>
71
/// </params>
72
/// <returns>返回转换后的日期</returns>
73
function ToCnDate(yyyy, mm, dd: Word): TCalendarDate; overload;
74

75
/// <summary>Convert the specified lunar calendar date to the solar calendar date</summary>
76
/// <params>
77
/// <param name="ADate">Lunar calendar date</param>
78
/// </params>
79
/// <returns>Return the converted solar calendar date</returns>
80
function ToEnDate(ADate: TCalendarDate): TDateTime;
81

82
/// <summary>获取指定阳历日期的农历年份</summary>
83
/// <params>
84
/// <param name="ADate">阳历日期</param>
85
/// </params>
86
/// <returns>返回指定阳历日期的农历年份</returns>
87
function CnYearOf(ADate: TDateTime): Smallint; overload;
88

89
/// <summary>获取指定农历日期的年份的天干地支名称</summary>
90
/// <params>
91
/// <param name="ADate">阴历日期</param>
92
/// </params>
93
/// <returns>返回天干地支名称，如"甲午"</reutrns>
94
function CnYearName(ADate: TCalendarDate): String; overload;
95

96
/// <summary>获取指定阳历日期对应的农历年份的天干地支名称</summary>
97
/// <params>
98
/// <param name="ADate">阴历日期</param>
99
/// </params>
100
/// <returns>返回天干地支名称，如"甲午"</reutrns>
101
function CnYearName(ADate: TDateTime): String; overload;
102
/// <summary>获取指定阳历日期对应的月份数</summary>
103
/// <params>
104
/// <param name="ADate">阳历日期</param>
105
/// </params>
106
/// <returns>返回月份数，取值范围为1-12，-12~-1，负数代表是闰月</returns>
107
function CnMonthOf(ADate: TDateTime): Shortint; overload;
108
/// <summary>获取指定农历日期对应的月份名称</summary>
109
/// <params>
110
/// <param name="ADate">农历日期</param>
111
/// </params>
112
/// <returns>返回农历月份名称，如“腊月”</param>
113
function CnMonthName(ADate: TCalendarDate): String; overload;
114
/// <summary>获取指定阳历日期对应农历日期对应的月份名称</summary>
115
/// <params>
116
/// <param name="ADate">农历日期</param>
117
/// </params>
118
/// <returns>返回农历月份名称，如“腊月”</param>
119
function CnMonthName(ADate: TDateTime): String; overload;
120
/// <summary>获取指定农历年月的天数</summary>
121
/// <params>
122
/// <param name="Y">农历年份</param>
123
/// <param name="M">农历月份，负数代表闰月</param>
124
/// </params>
125
/// <returns>返回指定农历年月的天数</returns>
126
function CnMonthDays(Y: Word; M: Shortint): Byte;
127
/// <summary>获取指定阳历日期的农历日</summary>
128
/// <params>
129
/// <param name="ADate">阳历日期</param>
130
/// </params>
131
/// <returns>返回指定的农历日</returns>
132
function CnDayOf(ADate: TDateTime): Shortint; overload;
133
/// <summary>获取指定农历日期的中文名称</summary>
134
/// <params>
135
/// <param name="ADate">农历日期</param>
136
/// </params>
137
/// <returns>返回指定日期的日的中文名称</returns>
138
function CnDayName(ADate: TCalendarDate): String; overload;
139
//function RuDayName(ADate: TCalendarDate): String; overload;
140

141
/// <summary>获取指定阳历日期对应农历日期日的中文名称</summary>
142
/// <params>
143
/// <param name="ADate">阳历日期</param>
144
/// </params>
145
/// <returns>返回指定日期的日的中文名称</returns>
146
function CnDayName(ADate: TDateTime): String; overload;
147
/// <summary>获取指定小时的时刻名称</summary>
148
/// <params>
149
/// <param name="AHour">小时数，取值范围0-23</param>
150
/// </params>
151
/// <returns>返回中文的小时对应的时刻名称（子、丑等）</returns>
152
function CnHourName(AHour: Byte): String; overload;
153
/// <summary>获取指定的农历日期的属相名称</summary>
154
/// <params>
155
/// <param name="ADate">农历日期</param>
156
/// </params>
157
/// <returns>返回指定的农历年份对应的属相名称</returns>
158
function CnAnimalOf(ADate: TCalendarDate): String; overload;
159
/// <summary>获取指定的阳历日期的属相名称</summary>
160
/// <params>
161
/// <param name="ADate">阳历日期</param>
162
/// </params>
163
/// <returns>返回指定的阳历年份对应的属相名称</returns>
164
function CnAnimalOf(ADate: TDateTime): String; overload;
165
/// <summary>获取指定年份相应节气对应的阳历日期</summary>
166
/// <params>
167
/// <param name="AYear">农历年份</param>
168
/// <param name="AName">节气名称</param>
169
/// </params>
170
/// <returns>返回对应的阳历日期</returns>
171
function DateOfCnSolarTerm(AYear: Smallint; AName: String): TDateTime; overload;
172
/// <summary>获取指定阳历日期对应的节气序号</summary>
173
/// <params>
174
/// <param name="AYear">阳历年份</param>
175
/// <param name="AMonth">阳历月份</param>
176
/// <param name="ADay">阳历日</param>
177
/// </params>
178
/// <returns>返回节气序列，如果不是任何节气，返回0</returns>
179
function CnSolarTerm(AYear, AMonth, ADay: Word): Shortint; overload;
180
/// <summary>获取指定农历日期对应的节气序号</summary>
181
/// <params>
182
/// <param name="AYear">农历年份</param>
183
/// <param name="AMonth">农历月份</param>
184
/// <param name="ADay">农历日</param>
185
/// </params>
186
/// <returns>返回节气序列，如果不是任何节气，返回0</returns>
187
function CnSolarTerm(ADate: TCalendarDate): Shortint; overload;
188
/// <summary>获取指定阳历日期对应的节气序号</summary>
189
/// <params>
190
/// <param name="ADate">阳历日期</param>
191
/// </params>
192
/// <returns>返回节气序列，如果不是任何节气，返回0</returns>
193
function CnSolarTerm(ADate: TDateTime): Shortint; overload;
194
/// <summary>获取指定农历日期对应的节气名称</summary>
195
/// <params>
196
/// <param name="ADate">农历日期</param>
197
/// </params>
198
/// <returns>返回节气名称，如果不属于任何节气，返回空字符串</returns>
199
function CnSolarTermName(ADate: TCalendarDate): String; overload;
200
/// <summary>获取指定阳历日期对应的节气名称</summary>
201
/// <params>
202
/// <param name="ADate">阳历日期</param>
203
/// </params>
204
/// <returns>返回节气名称，如果不属于任何节气，返回空字符串</returns>
205
function CnSolarTermName(ADate: TDateTime): String; overload;
206
/// <summary>获取指定日期在相应的农历年份中的周次</summary>
207
/// <params>
208
/// <param name="ADate">阳历日期</param>
209
/// </params>
210
/// <returns>返回周次</returns>
211
function CnWeeksInYear(const ADate: TDateTime): Byte;
212
/// <summary>增加指定的农历的年数</summary>
213
/// <params>
214
/// <param name="ADate">当前日期</param>
215
/// <param name="ADelta">增量</param>
216
/// </params>
217
/// <returns>返回增加或减少（负增量）的年数后的农历日期</returns>
218
function CnIncYear(ADate: TCalendarDate; ADelta: Integer = 1): TCalendarDate;
219
/// <summary>增加指定的农历的月数</summary>
220
/// <params>
221
/// <param name="ADate">当前日期</param>
222
/// <param name="ADelta">增量</param>
223
/// </params>
224
/// <returns>返回增加或减少（负增量）的月数后的农历日期</returns>
225
function CnIncMonth(ADate: TCalendarDate; ADelta: Integer = 1): TCalendarDate;
226
/// <summary>增加指定的农历的天数</summary>
227
/// <params>
228
/// <param name="ADate">当前日期</param>
229
/// <param name="ADelta">增量</param>
230
/// </params>
231
/// <returns>返回增加或减少（负增量）的月数后的农历日期</returns>
232
function CnIncDay(ADate: TCalendarDate; ADelta: Integer = 1): TCalendarDate;
233

234
implementation //--------------------------------------------------------------
235

236
const
237
  // 农历月份数据，每年4字节，从1901年开始，共150年
238
  // 数据来源：UCDOS 6.0 UCT.COM
239
  // 分析整理：Copyright (c) 1996-1998, Randolph
240
  // 数据解析：
241
  // 如果第一字节的bit7为1，则该年1月1日位于农历12月，否则位于11月
242
  // 第一字节去除bit7为该年1月1日的农历日期
243
  // 第二字节                 第三字节
244
  // bit:     7  6  5  4  3  2  1  0   7  6  5  4  3  2  1  0
245
  // 农历月份:16 15 14 13 12 11 10 9   8  7  6  5  4  3  2  1
246
  // 农历月份指的是从该年1月1日的农历月份算起的顺序号
247
  // 农历月份对应的bit为1则该月为30日，否则为29日
248
  // 第四字节为闰月月份
249
  // BaseDate='2000/02/04';//2000立春
250
  BaseAnimalDate = 1972; // 1972年支为子(是鼠年)
251
  BaseSkyStemDate = 1974; // 1974年干为甲
252
  START_YEAR = 1901;
253
  END_YEAR = 2050;
254

255
  gLunarHolDay: array [0 .. 1799] of Byte = ($96, $B4, $96, $A6, $97, $97, $78,
256
    $79, $79, $69, $78, $77, // 1901
257
    $96, $A4, $96, $96, $97, $87, $79, $79, $79, $69, $78, $78, // 1902
258
    $96, $A5, $87, $96, $87, $87, $79, $69, $69, $69, $78, $78, // 1903
259
    $86, $A5, $96, $A5, $96, $97, $88, $78, $78, $79, $78, $87, // 1904
260
    $96, $B4, $96, $A6, $97, $97, $78, $79, $79, $69, $78, $77, // 1905
261
    $96, $A4, $96, $96, $97, $97, $79, $79, $79, $69, $78, $78, // 1906
262
    $96, $A5, $87, $96, $87, $87, $79, $69, $69, $69, $78, $78, // 1907
263
    $86, $A5, $96, $A5, $96, $97, $88, $78, $78, $69, $78, $87, // 1908
264
    $96, $B4, $96, $A6, $97, $97, $78, $79, $79, $69, $78, $77, // 1909
265
    $96, $A4, $96, $96, $97, $97, $79, $79, $79, $69, $78, $78, // 1910
266
    $96, $A5, $87, $96, $87, $87, $79, $69, $69, $69, $78, $78, // 1911
267
    $86, $A5, $96, $A5, $96, $97, $88, $78, $78, $69, $78, $87, // 1912
268
    $95, $B4, $96, $A6, $97, $97, $78, $79, $79, $69, $78, $77, // 1913
269
    $96, $B4, $96, $A6, $97, $97, $79, $79, $79, $69, $78, $78, // 1914
270
    $96, $A5, $97, $96, $97, $87, $79, $79, $69, $69, $78, $78, // 1915
271
    $96, $A5, $96, $A5, $96, $97, $88, $78, $78, $79, $77, $87, // 1916
272
    $95, $B4, $96, $A6, $96, $97, $78, $79, $78, $69, $78, $87, // 1917
273
    $96, $B4, $96, $A6, $97, $97, $79, $79, $79, $69, $78, $77, // 1918
274
    $96, $A5, $97, $96, $97, $87, $79, $79, $69, $69, $78, $78, // 1919
275
    $96, $A5, $96, $A5, $96, $97, $88, $78, $78, $79, $77, $87, // 1920
276
    $95, $B4, $96, $A5, $96, $97, $78, $79, $78, $69, $78, $87, // 1921
277
    $96, $B4, $96, $A6, $97, $97, $79, $79, $79, $69, $78, $77, // 1922
278
    $96, $A4, $96, $96, $97, $87, $79, $79, $69, $69, $78, $78, // 1923
279
    $96, $A5, $96, $A5, $96, $97, $88, $78, $78, $79, $77, $87, // 1924
280
    $95, $B4, $96, $A5, $96, $97, $78, $79, $78, $69, $78, $87, // 1925
281
    $96, $B4, $96, $A6, $97, $97, $78, $79, $79, $69, $78, $77, // 1926
282
    $96, $A4, $96, $96, $97, $87, $79, $79, $79, $69, $78, $78, // 1927
283
    $96, $A5, $96, $A5, $96, $96, $88, $78, $78, $78, $87, $87, // 1928
284
    $95, $B4, $96, $A5, $96, $97, $88, $78, $78, $79, $77, $87, // 1929
285
    $96, $B4, $96, $A6, $97, $97, $78, $79, $79, $69, $78, $77, // 1930
286
    $96, $A4, $96, $96, $97, $87, $79, $79, $79, $69, $78, $78, // 1931
287
    $96, $A5, $96, $A5, $96, $96, $88, $78, $78, $78, $87, $87, // 1932
288
    $95, $B4, $96, $A5, $96, $97, $88, $78, $78, $69, $78, $87, // 1933
289
    $96, $B4, $96, $A6, $97, $97, $78, $79, $79, $69, $78, $77, // 1934
290
    $96, $A4, $96, $96, $97, $97, $79, $79, $79, $69, $78, $78, // 1935
291
    $96, $A5, $96, $A5, $96, $96, $88, $78, $78, $78, $87, $87, // 1936
292
    $95, $B4, $96, $A5, $96, $97, $88, $78, $78, $69, $78, $87, // 1937
293
    $96, $B4, $96, $A6, $97, $97, $78, $79, $79, $69, $78, $77, // 1938
294
    $96, $A4, $96, $96, $97, $97, $79, $79, $79, $69, $78, $78, // 1939
295
    $96, $A5, $96, $A5, $96, $96, $88, $78, $78, $78, $87, $87, // 1940
296
    $95, $B4, $96, $A5, $96, $97, $88, $78, $78, $69, $78, $87, // 1941
297
    $96, $B4, $96, $A6, $97, $97, $78, $79, $79, $69, $78, $77, // 1942
298
    $96, $A4, $96, $96, $97, $97, $79, $79, $79, $69, $78, $78, // 1943
299
    $96, $A5, $96, $A5, $A6, $96, $88, $78, $78, $78, $87, $87, // 1944
300
    $95, $B4, $96, $A5, $96, $97, $88, $78, $78, $79, $77, $87, // 1945
301
    $95, $B4, $96, $A6, $97, $97, $78, $79, $78, $69, $78, $77, // 1946
302
    $96, $B4, $96, $A6, $97, $97, $79, $79, $79, $69, $78, $78, // 1947
303
    $96, $A5, $A6, $A5, $A6, $96, $88, $88, $78, $78, $87, $87, // 1948
304
    $A5, $B4, $96, $A5, $96, $97, $88, $79, $78, $79, $77, $87, // 1949
305
    $95, $B4, $96, $A5, $96, $97, $78, $79, $78, $69, $78, $77, // 1950
306
    $96, $B4, $96, $A6, $97, $97, $79, $79, $79, $69, $78, $78, // 1951
307
    $96, $A5, $A6, $A5, $A6, $96, $88, $88, $78, $78, $87, $87, // 1952
308
    $A5, $B4, $96, $A5, $96, $97, $88, $78, $78, $79, $77, $87, // 1953
309
    $95, $B4, $96, $A5, $96, $97, $78, $79, $78, $68, $78, $87, // 1954
310
    $96, $B4, $96, $A6, $97, $97, $78, $79, $79, $69, $78, $77, // 1955
311
    $96, $A5, $A5, $A5, $A6, $96, $88, $88, $78, $78, $87, $87, // 1956
312
    $A5, $B4, $96, $A5, $96, $97, $88, $78, $78, $79, $77, $87, // 1957
313
    $95, $B4, $96, $A5, $96, $97, $88, $78, $78, $69, $78, $87, // 1958
314
    $96, $B4, $96, $A6, $97, $97, $78, $79, $79, $69, $78, $77, // 1959
315
    $96, $A4, $A5, $A5, $A6, $96, $88, $88, $88, $78, $87, $87, // 1960
316
    $A5, $B4, $96, $A5, $96, $96, $88, $78, $78, $78, $87, $87, // 1961
317
    $96, $B4, $96, $A5, $96, $97, $88, $78, $78, $69, $78, $87, // 1962
318
    $96, $B4, $96, $A6, $97, $97, $78, $79, $79, $69, $78, $77, // 1963
319
    $96, $A4, $A5, $A5, $A6, $96, $88, $88, $88, $78, $87, $87, // 1964
320
    $A5, $B4, $96, $A5, $96, $96, $88, $78, $78, $78, $87, $87, // 1965
321
    $95, $B4, $96, $A5, $96, $97, $88, $78, $78, $69, $78, $87, // 1966
322
    $96, $B4, $96, $A6, $97, $97, $78, $79, $79, $69, $78, $77, // 1967
323
    $96, $A4, $A5, $A5, $A6, $A6, $88, $88, $88, $78, $87, $87, // 1968
324
    $A5, $B4, $96, $A5, $96, $96, $88, $78, $78, $78, $87, $87, // 1969
325
    $95, $B4, $96, $A5, $96, $97, $88, $78, $78, $69, $78, $87, // 1970
326
    $96, $B4, $96, $A6, $97, $97, $78, $79, $79, $69, $78, $77, // 1971
327
    $96, $A4, $A5, $A5, $A6, $A6, $88, $88, $88, $78, $87, $87, // 1972
328
    $A5, $B5, $96, $A5, $A6, $96, $88, $78, $78, $78, $87, $87, // 1973
329
    $95, $B4, $96, $A5, $96, $97, $88, $78, $78, $69, $78, $87, // 1974
330
    $96, $B4, $96, $A6, $97, $97, $78, $79, $78, $69, $78, $77, // 1975
331
    $96, $A4, $A5, $B5, $A6, $A6, $88, $89, $88, $78, $87, $87, // 1976
332
    $A5, $B4, $96, $A5, $96, $96, $88, $88, $78, $78, $87, $87, // 1977
333
    $95, $B4, $96, $A5, $96, $97, $88, $78, $78, $79, $78, $87, // 1978
334
    $96, $B4, $96, $A6, $96, $97, $78, $79, $78, $69, $78, $77, // 1979
335
    $96, $A4, $A5, $B5, $A6, $A6, $88, $88, $88, $78, $87, $87, // 1980
336
    $A5, $B4, $96, $A5, $A6, $96, $88, $88, $78, $78, $77, $87, // 1981
337
    $95, $B4, $96, $A5, $96, $97, $88, $78, $78, $79, $77, $87, // 1982
338
    $95, $B4, $96, $A5, $96, $97, $78, $79, $78, $69, $78, $77, // 1983
339
    $96, $B4, $A5, $B5, $A6, $A6, $87, $88, $88, $78, $87, $87, // 1984
340
    $A5, $B4, $A6, $A5, $A6, $96, $88, $88, $78, $78, $87, $87, // 1985
341
    $A5, $B4, $96, $A5, $96, $97, $88, $78, $78, $79, $77, $87, // 1986
342
    $95, $B4, $96, $A5, $96, $97, $88, $79, $78, $69, $78, $87, // 1987
343
    $96, $B4, $A5, $B5, $A6, $A6, $87, $88, $88, $78, $87, $86, // 1988
344
    $A5, $B4, $A5, $A5, $A6, $96, $88, $88, $88, $78, $87, $87, // 1989
345
    $A5, $B4, $96, $A5, $96, $96, $88, $78, $78, $79, $77, $87, // 1990
346
    $95, $B4, $96, $A5, $86, $97, $88, $78, $78, $69, $78, $87, // 1991
347
    $96, $B4, $A5, $B5, $A6, $A6, $87, $88, $88, $78, $87, $86, // 1992
348
    $A5, $B3, $A5, $A5, $A6, $96, $88, $88, $88, $78, $87, $87, // 1993
349
    $A5, $B4, $96, $A5, $96, $96, $88, $78, $78, $78, $87, $87, // 1994
350
    $95, $B4, $96, $A5, $96, $97, $88, $76, $78, $69, $78, $87, // 1995
351
    $96, $B4, $A5, $B5, $A6, $A6, $87, $88, $88, $78, $87, $86, // 1996
352
    $A5, $B3, $A5, $A5, $A6, $A6, $88, $88, $88, $78, $87, $87, // 1997
353
    $A5, $B4, $96, $A5, $96, $96, $88, $78, $78, $78, $87, $87, // 1998
354
    $95, $B4, $96, $A5, $96, $97, $88, $78, $78, $69, $78, $87, // 1999
355
    $96, $B4, $A5, $B5, $A6, $A6, $87, $88, $88, $78, $87, $86, // 2000
356
    $A5, $B3, $A5, $A5, $A6, $A6, $88, $88, $88, $78, $87, $87, // 2001
357
    $A5, $B4, $96, $A5, $96, $96, $88, $78, $78, $78, $87, $87, // 2002
358
    $95, $B4, $96, $A5, $96, $97, $88, $78, $78, $69, $78, $87, // 2003
359
    $96, $B4, $A5, $B5, $A6, $A6, $87, $88, $88, $78, $87, $86, // 2004
360
    $A5, $B3, $A5, $A5, $A6, $A6, $88, $88, $88, $78, $87, $87, // 2005
361
    $A5, $B4, $96, $A5, $A6, $96, $88, $88, $78, $78, $87, $87, // 2006
362
    $95, $B4, $96, $A5, $96, $97, $88, $78, $78, $69, $78, $87, // 2007
363
    $96, $B4, $A5, $B5, $A6, $A6, $87, $88, $87, $78, $87, $86, // 2008
364
    $A5, $B3, $A5, $B5, $A6, $A6, $88, $88, $88, $78, $87, $87, // 2009
365
    $A5, $B4, $96, $A5, $A6, $96, $88, $88, $78, $78, $87, $87, // 2010
366
    $95, $B4, $96, $A5, $96, $97, $88, $78, $78, $79, $78, $87, // 2011
367
    $96, $B4, $A5, $B5, $A5, $A6, $87, $88, $87, $78, $87, $86, // 2012
368
    $A5, $B3, $A5, $B5, $A6, $A6, $87, $88, $88, $78, $87, $87, // 2013
369
    $A5, $B4, $96, $A5, $A6, $96, $88, $88, $78, $78, $87, $87, // 2014
370
    $95, $B4, $96, $A5, $96, $97, $88, $78, $78, $79, $77, $87, // 2015
371
    $95, $B4, $A5, $B4, $A5, $A6, $87, $88, $87, $78, $87, $86, // 2016
372
    $A5, $C3, $A5, $B5, $A6, $A6, $87, $88, $88, $78, $87, $87, // 2017
373
    $A5, $B4, $A6, $A5, $A6, $96, $88, $88, $78, $78, $87, $87, // 2018
374
    $A5, $B4, $96, $A5, $96, $96, $88, $78, $78, $79, $77, $87, // 2019
375
    $95, $B4, $A5, $B4, $A5, $A6, $97, $87, $87, $78, $87, $86, // 2020
376
    $A5, $C3, $A5, $B5, $A6, $A6, $87, $88, $88, $78, $87, $86, // 2021
377
    $A5, $B4, $A5, $A5, $A6, $96, $88, $88, $88, $78, $87, $87, // 2022
378
    $A5, $B4, $96, $A5, $96, $96, $88, $78, $78, $79, $77, $87, // 2023
379
    $95, $B4, $A5, $B4, $A5, $A6, $97, $87, $87, $78, $87, $96, // 2024
380
    $A5, $C3, $A5, $B5, $A6, $A6, $87, $88, $88, $78, $87, $86, // 2025
381
    $A5, $B3, $A5, $A5, $A6, $A6, $88, $88, $88, $78, $87, $87, // 2026
382
    $A5, $B4, $96, $A5, $96, $96, $88, $78, $78, $78, $87, $87, // 2027
383
    $95, $B4, $A5, $B4, $A5, $A6, $97, $87, $87, $78, $87, $96, // 2028
384
    $A5, $C3, $A5, $B5, $A6, $A6, $87, $88, $88, $78, $87, $86, // 2029
385
    $A5, $B3, $A5, $A5, $A6, $A6, $88, $88, $88, $78, $87, $87, // 2030
386
    $A5, $B4, $96, $A5, $96, $96, $88, $78, $78, $78, $87, $87, // 2031
387
    $95, $B4, $A5, $B4, $A5, $A6, $97, $87, $87, $78, $87, $96, // 2032
388
    $A5, $C3, $A5, $B5, $A6, $A6, $88, $88, $88, $78, $87, $86, // 2033
389
    $A5, $B3, $A5, $A5, $A6, $A6, $88, $78, $88, $78, $87, $87, // 2034
390
    $A5, $B4, $96, $A5, $A6, $96, $88, $88, $78, $78, $87, $87, // 2035
391
    $95, $B4, $A5, $B4, $A5, $A6, $97, $87, $87, $78, $87, $96, // 2036
392
    $A5, $C3, $A5, $B5, $A6, $A6, $87, $88, $88, $78, $87, $86, // 2037
393
    $A5, $B3, $A5, $A5, $A6, $A6, $88, $88, $88, $78, $87, $87, // 2038
394
    $A5, $B4, $96, $A5, $A6, $96, $88, $88, $78, $78, $87, $87, // 2039
395
    $95, $B4, $A5, $B4, $A5, $A6, $97, $87, $87, $78, $87, $96, // 2040
396
    $A5, $C3, $A5, $B5, $A5, $A6, $87, $88, $87, $78, $87, $86, // 2041
397
    $A5, $B3, $A5, $B5, $A6, $A6, $88, $88, $88, $78, $87, $87, // 2042
398
    $A5, $B4, $96, $A5, $A6, $96, $88, $88, $78, $78, $87, $87, // 2043
399
    $95, $B4, $A5, $B4, $A5, $A6, $97, $87, $87, $88, $87, $96, // 2044
400
    $A5, $C3, $A5, $B4, $A5, $A6, $87, $88, $87, $78, $87, $86, // 2045
401
    $A5, $B3, $A5, $B5, $A6, $A6, $87, $88, $88, $78, $87, $87, // 2046
402
    $A5, $B4, $96, $A5, $A6, $96, $88, $88, $78, $78, $87, $87, // 2047
403
    $95, $B4, $A5, $B4, $A5, $A5, $97, $87, $87, $88, $86, $96, // 2048
404
    $A4, $C3, $A5, $A5, $A5, $A6, $97, $87, $87, $78, $87, $86, // 2049
405
    $A5, $C3, $A5, $B5, $A6, $A6, $87, $88, $78, $78, $87, $87); // 2050
406

407
  CnData: array [0 .. 599] of Byte = ($0B, $52, $BA, $00, $16, $A9, $5D, $00,
408
    $83, $A9, $37, $05, $0E, $74, $9B, $00, $1A, $B6, $55, $00, $87, $B5, $55,
409
    $04, $11, $55, $AA, $00, $1C, $A6, $B5, $00, $8A, $A5, $75, $02, $14, $52,
410
    $BA, $00, $81, $52, $6E, $06, $0D, $E9, $37, $00, $18, $74, $97, $00, $86,
411
    $EA, $96, $05, $10, $6D, $55, $00, $1A, $35, $AA, $00, $88, $4B, $6A, $02,
412
    $13, $A5, $6D, $00, $1E, $D2, $6E, $07, $0B, $D2, $5E, $00, $17, $E9, $2E,
413
    $00, $84, $D9, $2D, $05, $0F, $DA, $95, $00, $19, $5B, $52, $00, $87, $56,
414
    $D4, $04, $11, $4A, $DA, $00, $1C, $A5, $5D, $00, $89, $A4, $BD, $02, $15,
415
    $D2, $5D, $00, $82, $B2, $5B, $06, $0D, $B5, $2B, $00, $18, $BA, $95, $00,
416
    $86, $B6, $A5, $05, $10, $56, $B4, $00, $1A, $4A, $DA, $00, $87, $49, $BA,
417
    $03, $13, $A4, $BB, $00, $1E, $B2, $5B, $07, $0B, $72, $57, $00, $16, $75,
418
    $2B, $00, $84, $6D, $2A, $06, $0F, $AD, $55, $00, $19, $55, $AA, $00, $86,
419
    $55, $6C, $04, $12, $C9, $76, $00, $1C, $64, $B7, $00, $8A, $E4, $AE, $02,
420
    $15, $EA, $56, $00, $83, $DA, $55, $07, $0D, $5B, $2A, $00, $18, $AD, $55,
421
    $00, $85, $AA, $D5, $05, $10, $53, $6A, $00, $1B, $A9, $6D, $00, $88, $A9,
422
    $5D, $03, $13, $D4, $AE, $00, $81, $D4, $AB, $08, $0C, $BA, $55, $00, $16,
423
    $5A, $AA, $00, $83, $56, $AA, $06, $0F, $AA, $D5, $00, $19, $52, $DA, $00,
424
    $86, $52, $BA, $04, $11, $A9, $5D, $00, $1D, $D4, $9B, $00, $8A, $74, $9B,
425
    $03, $15, $B6, $55, $00, $82, $AD, $55, $07, $0D, $55, $AA, $00, $18, $A5,
426
    $B5, $00, $85, $A5, $75, $05, $0F, $52, $B6, $00, $1B, $69, $37, $00, $89,
427
    $E9, $37, $04, $13, $74, $97, $00, $81, $EA, $96, $08, $0C, $6D, $52, $00,
428
    $16, $2D, $AA, $00, $83, $4B, $6A, $06, $0E, $A5, $6D, $00, $1A, $D2, $6E,
429
    $00, $87, $D2, $5E, $04, $12, $E9, $2E, $00, $1D, $EC, $96, $0A, $0B, $DA,
430
    $95, $00, $15, $5B, $52, $00, $82, $56, $D2, $06, $0C, $2A, $DA, $00, $18,
431
    $A4, $DD, $00, $85, $A4, $BD, $05, $10, $D2, $5D, $00, $1B, $D9, $2D, $00,
432
    $89, $B5, $2B, $03, $14, $BA, $95, $00, $81, $B5, $95, $08, $0B, $56, $B2,
433
    $00, $16, $2A, $DA, $00, $83, $49, $B6, $05, $0E, $64, $BB, $00, $19, $B2,
434
    $5B, $00, $87, $6A, $57, $04, $12, $75, $2B, $00, $1D, $B6, $95, $00, $8A,
435
    $AD, $55, $02, $15, $55, $AA, $00, $82, $55, $6C, $07, $0D, $C9, $76, $00,
436
    $17, $64, $B7, $00, $86, $E4, $AE, $05, $11, $EA, $56, $00, $1B, $6D, $2A,
437
    $00, $88, $5A, $AA, $04, $14, $AD, $55, $00, $81, $AA, $D5, $09, $0B, $52,
438
    $EA, $00, $16, $A9, $6D, $00, $84, $A9, $5D, $06, $0F, $D4, $AE, $00, $1A,
439
    $EA, $4D, $00, $87, $BA, $55, $04, $12, $5A, $AA, $00, $1D, $AB, $55, $00,
440
    $8A, $A6, $D5, $02, $14, $52, $DA, $00, $82, $52, $BA, $06, $0D, $A9, $3B,
441
    $00, $18, $B4, $9B, $00, $85, $74, $9B, $05, $11, $B5, $4D, $00, $1C, $D6,
442
    $A9, $00, $88, $35, $AA, $03, $13, $A5, $B5, $00, $81, $A5, $75, $0B, $0B,
443
    $52, $B6, $00, $16, $69, $37, $00, $84, $E9, $2F, $06, $10, $F4, $97, $00,
444
    $1A, $75, $4B, $00, $87, $6D, $52, $05, $11, $2D, $69, $00, $1D, $95, $B5,
445
    $00, $8A, $A5, $6D, $02, $15, $D2, $6E, $00, $82, $D2, $5E, $07, $0E, $E9,
446
    $2E, $00, $19, $EA, $96, $00, $86, $DA, $95, $05, $10, $5B, $4A, $00, $1C,
447
    $AB, $69, $00, $88, $2A, $D8, $03);
448

449
function CnDate(Y: Word; M, D: Shortint): TCalendarDate;
450
begin
451
  if (Y < 1901) or (Y > 2050) then
452
    raise EConvertError.CreateFmt('农历年份范围无效，只支持 1901-2050 年间的农历范围。', [Y]);
453
  if (M > 12) or (M = 0) or (M < -12) then
454
    raise EConvertError.CreateFmt('农历月份范围无效，只支持 -12~-1,1-12 之间的有效值。', [M]);
455
  if (D < 1) or (D > 30) then
456
    raise EConvertError.CreateFmt('农历日值范围无效，只支持 1-30 之间的有效值。', [M]);
457
  Result.Year := Y;
458
  Result.Day := CnMonthDays(Y, M);
459
  if Result.Day = 0 then
460
    raise Exception.CreateFmt('指定的年份 %d 不存在 %s 月', [Y, CnMonthName(M)]);
461
  Result.Month := M;
462
  if Byte(D) > Result.Day then
463
    raise Exception.CreateFmt('指定的 %d 年 %s 月 %d 日无效，该月只有 %d 天',
464
      [Y, CnMonthName(M), Result.Day]);
465
  Result.Day := D;
466
end;
467

468
// 日期是该年的第几天，1月1日为第一天
469
function DaysNumberOfDate(yyyy, mm, dd: Word): Integer; overload;
470
var
471
  I: Integer;
472
begin
473
  Result := 0;
474
  for I := 1 to mm - 1 do
475
    Inc(Result, MonthDays[IsLeapYear(yyyy), I]);
476
  Inc(Result, dd);
477
end;
478

479
function DaysNumberOfDate(ADate: TDateTime): Integer; overload;
480
var
481
  yyyy, mm, dd: Word;
482
begin
483
  DecodeDate(ADate, yyyy, mm, dd);
484
  Result := DaysNumberOfDate(yyyy, mm, dd);
485
end;
486

487
function ToCnDate(ADate: TDateTime): TCalendarDate;
488
var
489
  yyyy, mm, dd: Word;
490
begin
491
  DecodeDate(ADate, yyyy, mm, dd);
492
  Result := ToCnDate(yyyy, mm, dd);
493
end;
494

495
function CnMonthDays(Y: Word; M: Shortint): Byte;
496
var
497
  CnMonth, CnMonthDays: array [0 .. 15] of Integer;
498
  Bytes: array [0 .. 3] of Byte;
499
  I: Integer;
500
  LeapMonth: Integer;
501
  CnMonthData: Word;
502
begin
503
  Result := 0;
504
  if (Y < 1901) or (Y > 2050) then
505
    Exit;
506
  Bytes[0] := CnData[(Y - 1901) * 4];
507
  Bytes[1] := CnData[(Y - 1901) * 4 + 1];
508
  Bytes[2] := CnData[(Y - 1901) * 4 + 2];
509
  Bytes[3] := CnData[(Y - 1901) * 4 + 3];
510
  if (Bytes[0] and $80) <> 0 then
511
    CnMonth[0] := 12
512
  else
513
    CnMonth[0] := 11;
514
  CnMonthData := Bytes[1];
515
  CnMonthData := CnMonthData shl 8;
516
  CnMonthData := CnMonthData or Bytes[2];
517
  LeapMonth := Bytes[3];
518
  for I := 15 downto 0 do
519
  begin
520
    CnMonthDays[15 - I] := 29;
521
    if ((1 shl I) and CnMonthData) <> 0 then
522
      Inc(CnMonthDays[15 - I]);
523
    if CnMonth[15 - I] = LeapMonth then
524
      CnMonth[15 - I + 1] := -LeapMonth
525
    else
526
    begin
527
      if CnMonth[15 - I] < 0 then // 上月为闰月
528
        CnMonth[15 - I + 1] := -CnMonth[15 - I] + 1
529
      else
530
        CnMonth[15 - I + 1] := CnMonth[15 - I] + 1;
531
      if CnMonth[15 - I + 1] > 12 then
532
        CnMonth[15 - I + 1] := 1;
533
    end;
534
  end;
535
  I := 0;
536
  while I < 16 do
537
  begin
538
    if CnMonth[I] = 1 then // 1月
539
    begin
540
      while I < 16 do
541
      begin
542
        if CnMonth[I] = M then
543
        begin
544
          Result := CnMonthDays[I];
545
          Break;
546
        end;
547
        Inc(I);
548
      end;
549
      Break;
550
    end;
551
    Inc(I);
552
  end;
553
end;
554

555
function ToCnDate(yyyy, mm, dd: Word): TCalendarDate;
556
var
557
  CnMonth, CnMonthDays: array [0 .. 15] of Integer;
558
  CnBeginDay, LeapMonth: Integer;
559
  Bytes: array [0 .. 3] of Byte;
560
  I: Integer;
561
  CnMonthData: Word;
562
  ACnEnd: TCalendarDate;
563
  DaysCount, CnDaysCount, ResultMonth, ResultDay: Integer;
564
begin
565
  if (yyyy < 1901) or (yyyy > 2050) then
566
  begin
567
    Result.Value := 0;
568
    Exit;
569
  end;
570
  Bytes[0] := CnData[(yyyy - 1901) * 4];
571
  Bytes[1] := CnData[(yyyy - 1901) * 4 + 1];
572
  Bytes[2] := CnData[(yyyy - 1901) * 4 + 2];
573
  Bytes[3] := CnData[(yyyy - 1901) * 4 + 3];
574
  if (Bytes[0] and $80) <> 0 then
575
    CnMonth[0] := 12
576
  else
577
    CnMonth[0] := 11;
578
  CnBeginDay := (Bytes[0] and $7F);
579
  CnMonthData := Bytes[1];
580
  CnMonthData := CnMonthData shl 8;
581
  CnMonthData := CnMonthData or Bytes[2];
582
  LeapMonth := Bytes[3];
583
  for I := 15 downto 0 do
584
  begin
585
    CnMonthDays[15 - I] := 29;
586
    if ((1 shl I) and CnMonthData) <> 0 then
587
      Inc(CnMonthDays[15 - I]);
588
    if CnMonth[15 - I] = LeapMonth then
589
      CnMonth[15 - I + 1] := -LeapMonth
590
    else
591
    begin
592
      if CnMonth[15 - I] < 0 then // 上月为闰月
593
        CnMonth[15 - I + 1] := -CnMonth[15 - I] + 1
594
      else
595
        CnMonth[15 - I + 1] := CnMonth[15 - I] + 1;
596
      if CnMonth[15 - I + 1] > 12 then
597
        CnMonth[15 - I + 1] := 1;
598
    end;
599
  end;
600
  DaysCount := DaysNumberOfDate(yyyy, mm, dd) - 1;
601
  if DaysCount <= (CnMonthDays[0] - CnBeginDay) then
602
  begin
603
    ACnEnd := ToCnDate(EncodeDate(yyyy - 1, 12, 31));
604
    if (yyyy > 1901) and (ACnEnd.Month < 0) then
605
      ResultMonth := -CnMonth[0]
606
    else
607
      ResultMonth := CnMonth[0];
608
    ResultDay := CnBeginDay + DaysCount;
609
  end
610
  else
611
  begin
612
    CnDaysCount := CnMonthDays[0] - CnBeginDay;
613
    I := 1;
614
    while (CnDaysCount < DaysCount) and
615
      (CnDaysCount + CnMonthDays[I] < DaysCount) do
616
    begin
617
      Inc(CnDaysCount, CnMonthDays[I]);
618
      Inc(I);
619
    end;
620
    ResultMonth := CnMonth[I];
621
    ResultDay := DaysCount - CnDaysCount;
622
  end;
623
  if (ResultMonth in [11, 12]) and (mm in [1, 2]) then
624
    Dec(yyyy);
625
  Result.Year := yyyy;
626
  Result.Month := ResultMonth;
627
  Result.Day := ResultDay;
628
end;
629

630
//---------------------------------------------------------------------------
631

632
function ToEnDate(ADate: TCalendarDate): TDateTime;
633
var
634
  tempDate: TDateTime;
635
  ADelta: Integer;
636
  ACnTemp: TCalendarDate;
637
begin
638
  if ADate.Month > 11 then
639
    tempDate := EncodeDate(ADate.Year - 1, ADate.Month, ADate.Day)
640
  else
641
    tempDate := EncodeDate(ADate.Year, abs(ADate.Month), ADate.Day);
642
  Result := 0;
643
  while Result = 0 do
644
  begin
645
    ACnTemp := ToCnDate(tempDate);
646
    if ACnTemp.Value = ADate.Value then
647
    begin
648
      Result := tempDate;
649
      Break;
650
    end
651
    else
652
    begin
653
      ADelta := 0;
654
      if ADate.Year <> ACnTemp.Year then
655
        ADelta := (abs(ADate.Month) + 11 - abs(ACnTemp.Month)) * 29
656
      else if ADate.Month <> ACnTemp.Month then
657
      begin
658
        if ADate.Month <> -ACnTemp.Month then
659
          ADelta := (abs(ADate.Month) - abs(ACnTemp.Month) - 1) * 29;
660
      end;
661
      if ADelta = 0 then
662
        ADelta := 1;
663
      tempDate := IncDay(tempDate, ADelta);
664
    end;
665
  end;
666
end;
667

668
function CnYearOf(ADate: TDateTime): Smallint;
669
begin
670
  Result := ToCnDate(ADate).Year;
671
end;
672

673
function CnYearName(ADate: TCalendarDate): String;
674
begin
675
  Result := CnSkyNames[(ADate.Year - BaseSkyStemDate) mod 10 + 1] + CnEarthNames
676
    [(ADate.Year - BaseAnimalDate) mod 12 + 1];
677
end;
678

679
function CnYearName(ADate: TDateTime): String;
680
begin
681
  Result := CnYearName(ToCnDate(ADate));
682
end;
683

684
function CnMonthOf(ADate: TDateTime): Shortint;
685
begin
686
  Result := ToCnDate(ADate).Month;
687
end;
688

689
function CnMonthName(ADate: TCalendarDate): String;
690
begin
691
  if ADate.Month < 0 then
692
    Result := '闰' + CnMonthNames[-ADate.Month]
693
  else
694
    Result := CnMonthNames[ADate.Month]
695
end;
696

697
function CnMonthName(ADate: TDateTime): String;
698
begin
699
  Result := CnMonthName(ToCnDate(ADate));
700
end;
701

702
function CnDayOf(ADate: TDateTime): Shortint;
703
begin
704
  Result := ToCnDate(ADate).Day;
705
end;
706

707
function CnDayName(ADate: TCalendarDate): String;
708
begin
709
  Result := CnDayNames[ADate.Day];
710
end;
711

712
function CnDayName(ADate: TDateTime): String;
713
begin
714
  Result := CnDayNames[ToCnDate(ADate).Day];
715
end;
716

717
function CnHourName(AHour: Byte): String;
718
begin
719
  AHour := ((AHour + 1) shr 1) mod 12; //
720
  Result := CnEarthNames[AHour + 1];
721
end;
722

723
function CnAnimalOf(ADate: TCalendarDate): String;
724
begin
725
  Result := CnEarthNames[(ADate.Year - BaseAnimalDate) mod 12 + 1] +
726
    CnAnimals[(ADate.Year - BaseAnimalDate) mod 12 + 1];
727
end;
728

729
function CnAnimalOf(ADate: TDateTime): String;
730
begin
731
  Result := CnAnimalOf(ToCnDate(ADate));
732
end;
733

734
function DateOfCnSolarTerm(AYear: Smallint; AName: String): TDateTime;
735
var
736
  AIndex: Integer;
737
  AFlags: Byte;
738
  ADay: Word;
739
  I: Integer;
740
begin
741
  AIndex := (AYear - START_YEAR) * 12;
742
  Result := 0;
743
  for I := 1 to 12 do
744
  begin
745
    AFlags := gLunarHolDay[AIndex + I - 1];
746
    ADay := 15 - (AFlags shr 4) and $0F;
747
    if CnSolarTerms[((I - 1) shl 1) + 1] = AName then
748
    begin
749
      Result := EncodeDate(AYear, I, ADay);
750
      Break;
751
    end
752
    else
753
    begin
754
      ADay := 15 + (AFlags and $0F);
755
      if CnSolarTerms[I shl 1] = AName then
756
      begin
757
        Result := EncodeDate(AYear, I, ADay);
758
        Break;
759
      end
760
    end;
761
  end;
762
end;
763

764
function CnSolarTerm(ADate: TCalendarDate): Shortint;
765
begin
766
  Result := CnSolarTerm(ToEnDate(ADate));
767
end;
768

769
function CnSolarTerm(ADate: TDateTime): Shortint;
770
var
771
  iYear, iMonth, iDay: Word;
772
begin
773
  DecodeDate(ADate, iYear, iMonth, iDay);
774
  Result := CnSolarTerm(iYear, iMonth, iDay);
775
end;
776

777
function CnSolarTermName(ADate: TCalendarDate): String;
778
begin
779
  Result := CnSolarTerms[CnSolarTerm(ADate)];
780
end;
781

782
function CnSolarTermName(ADate: TDateTime): String;
783
begin
784
  Result := CnSolarTerms[CnSolarTerm(ADate)];
785
end;
786

787
function CnSolarTerm(AYear, AMonth, ADay: Word): Shortint;
788
var
789
  Flag: Byte;
790
  Day: Word;
791
  AIndex: Integer;
792
begin
793
  AIndex := (AYear - START_YEAR) * 12 + AMonth - 1;
794
  Flag := gLunarHolDay[AIndex];
795
  if ADay < 15 then
796
    Day := 15 - ((Flag shr 4) and $0F)
797
  else
798
    Day := (Flag and $0F) + 15;
799
  if ADay = Day then
800
    if ADay > 15 then
801
      Result := (AMonth - 1) * 2 + 2
802
    else
803
      Result := (AMonth - 1) * 2 + 1
804
  else
805
    Result := 0;
806
end;
807

808
function CalcCnFirstDay(ADate: TDateTime): TDateTime;
809
var
810
  ATemp: TCalendarDate;
811
begin
812
  ATemp.Year := CnYearOf(ADate);
813
  ATemp.Month := 1;
814
  ATemp.Day := 1;
815
  Result := ToEnDate(ATemp);
816
end;
817

818
function CnWeeksInYear(const ADate: TDateTime): Byte;
819
var
820
  CnStartYearDate, CnEndYearDate: TDateTime;
821
begin
822
  CnStartYearDate := CalcCnFirstDay(ADate);
823
  CnEndYearDate := CalcCnFirstDay(IncYear(ADate));
824
  Result := Trunc(CnEndYearDate - CnStartYearDate) div 7;
825
  if DayOfTheWeek(CnStartYearDate) <> 1 then
826
    Inc(Result, 1);
827
  if DayOfTheWeek(CnEndYearDate) <> 7 then
828
    Inc(Result, 1);
829
end;
830

831
function CnIncYear(ADate: TCalendarDate; ADelta: Integer): TCalendarDate;
832
var
833
  Days: Integer;
834
begin
835
  Inc(ADate.Year, ADelta);
836
  if (ADate.Year < 1901) or (ADate.Year > 2050) then
837
    raise Exception.Create('指定的年份范围越界，农历只支持 1901-2050年范围。');
838
  Result.Year := ADate.Year;
839
  if ADate.Month < 0 then
840
    Result.Month := -ADate.Month
841
  else
842
    Result.Month := ADate.Month;
843
  Days := CnMonthDays(Result.Year, Result.Month);
844
  if ADate.Day <= Days then
845
    Result.Day := ADate.Day
846
  else
847
    raise Exception.CreateFmt('编码日期时出错，无法获取 %d 年 %s 月的天数。',
848
      [Result.Year, CnMonthName(Result.Month)]);
849
end;
850

851
function CnIncDay(ADate: TCalendarDate; ADelta: Integer): TCalendarDate;
852
begin
853

854
end;
855

856
function CnIncMonth(ADate: TCalendarDate; ADelta: Integer): TCalendarDate;
857
var
858
  D: Byte;
859
begin
860
  Result.Value := ADate.Value;
861
  while ADelta > 0 do
862
  begin
863
    Result.Day := 1;
864
    Result := ToCnDate(IncDay(ToEnDate(Result), 31));
865
    D := CnMonthDays(Result.Year, Result.Month);
866
    if ADate.Day > D then
867
      Result.Day := D
868
    else
869
      Result.Day := ADate.Day;
870
    Dec(ADelta);
871
  end;
872
  while ADelta < 0 do
873
  begin
874
    Result.Day := 1;
875
    Result := ToCnDate(IncDay(ToEnDate(Result), -2));
876
    D := CnMonthDays(Result.Year, Result.Month);
877
    if ADate.Day > D then
878
      Result.Day := D
879
    else
880
      Result.Day := ADate.Day;
881
    Inc(ADelta);
882
  end;
883
end;
884

885
end.
886
BaiduFMX

Использование cookies
