1 unit DateProcess;
2 interface
3
4 const
5 DayOfWeekStrings: array [1..7] of String = ('SUNDAY', 'MONDAY', 'TUESDAY',
6 'WEDNESDAY', 'THURSDAY', 'FRIDAY', 'SATURDAY');
7
8 //: English Calendar Months - used for Month2Int
9 const
10 MonthStrings: array [1..12] of String = ('JANUARY', 'FEBRUARY', 'MARCH',
11 'APRIL','MAY', 'JUNE', 'JULY', 'AUGUST', 'SEPTEMBER', 'OCTOBER',
12 'NOVEMBER', 'DECEMBER');
13 const
14 //:中文显示星期─要用Week2CWeek()函数转换
15 DayOfCWeekStrings: array [1..7] of String = ('星期日','星期一',
16 '星期二','星期三','星期四','星期五','星期六');
17 const
18 //: 中文显示月份─要用Month2CMonth()函数转换
19 MonthCStrings: array [1..12] of String = ('一月', '二月', '三月','四月','五月',
20 '六月', '七月', '八月', '九月', '十月','十一月', '十二月');
21
22 const
23 OneDay = 1.0;
24 OneHour = OneDay / 24.0;
25 OneMinute = OneHour / 60.0;
26 OneSecond = OneMinute / 60.0;
27 OneMillisecond = OneSecond / 1000.0;
28
29 //--- 年度函数 ---
30
31 //检查日期值是否是润年
32 function IsLeapYear (Year: Word): Boolean;
33
34 //传回日期值年度的第一天
35 function GetFirstDayOfYear (const Year: Word): TDateTime;
36
37 //传回日期值年度的最后一天
38 function GetLastDayOfYear (const Year: Word): TDateTime;
39
40 //传回日期值年度的第一星期天的日期
41 function GetFirstSundayOfYear (const Year: Word): TDateTime;
42
43 //传回西洋日期的格式MM/DD/YY
44 function GetMDY (const DT: TDateTime): String;
45
46 //--- 日期型的转换 ---
47
48 //日期转成字符串
49 //如果是错误将传一空值
50 function Date2Str (const DT: TDateTime): String;
51
52 //传回日期值的日期
53 function GetDay (const DT: TDateTime): Word;
54
55 //:传回日期值的月份
56 function GetMonth (const DT: TDateTime): Word;
57
58 //: 传回日期值的年份
59 function GetYear (const DT: TDateTime): Word;
60
61 //:将日期的值取出时间的值
62 function Time2Hr (const DT: TDateTime): Word;
63
64 //:将日期的值取出分锺的值
65 function Time2Min (const DT: TDateTime): Word;
66
67 //:将日期的值取出秒数的值
68 function Time2Sec (const DT: TDateTime): Word;
69
70 //:将日期的值取出微秒的值
71 function Time2MSec (const DT: TDateTime): Word;
72
73 //传回目前的年度
74 function ThisYear: Word;
75
76 //传回目前的月份
77 function ThisMonth: Word;
78
79 //传回目前的日期
80 function ThisDay: Word;
81
82 //传回目前的时间
83 function ThisHr: Word;
84
85 //传回目前的分锺
86 function ThisMin: Word;
87
88 //传回目前的秒数
89 function ThisSec: Word;
90
91 //将英文的星期转成整数值
92 //例如EDOWToInt(''SUNDAY')=1
93 function EDOWToInt (const DOW: string): Integer;
94
95 //将英文的月份转成整数值的月
96 //例如EMonthToInt('JANUARY')=1
97 function EMonthToInt (const Month: string): Integer;
98
99 function GetCMonth(const DT: TDateTime): String;
100 //传回中文显示的月份
101
102 function GetC_Today: string;
103 //传回中国的日期
104 //例如: GetC_Today传回值为89/08/11
105
106 Function TransC_DateToE_Date(Const CDT :String) :TDateTime;
107 //将民国的年月日转换为公元的YYYY/MM/DD
108 //2001/02/02加入 例如:TransC_DateToE_Date('90年2月1日')传回值是2001/2/1
109
110 function GetCWeek(const DT: TDateTime): String;
111 //传回值为中文显示的星期 例如:GETCWeek(2000/08/31)=星期四
112
113 function GetLastDayForMonth(const DT: TDateTime):TDateTime;
114 //传回本月的最后一天
115
116 function GetFirstDayForMonth (const DT :TDateTime): TDateTime;
117 //取得月份的第一天
118
119 function GetLastDayForPeriorMonth(const DT: TDateTime):TDateTime;
120 //传回上个月的最后一天
121
122 function GetFirstDayForPeriorMonth (const DT :TDateTime): TDateTime;
123 //取得上个月份的第一天
124
125 function ROCDATE(DD:TDATETIME;P:integer):string;
126 {转换某日期为民国0YYMMDD 型式字符串,例如:ROCDATE(Now,0)='900304' }
127 {P=0 不加'年'+'月'+'日'}
128 {P=1 加'年'+'月'+'日'}
129
130 {------------------- 日期和时间的计算函数------------------}
131
132 //传回两个日期相减值的分锺数
133 function MinutesApart (const DT1, DT2: TDateTime): Word;
134
135 //调整年度的时间
136 //例如AdjustDateYear(Now,1998)传回值为'1998/02/25'
137 function AdjustDateYear (const D: TDateTime; const Year: Word): TDateTime;
138
139 //增加n个分钟的时间
140 function AddMins (const DT: TDateTime; const Mins: Extended): TDateTime;
141
142 //增加n个小时的时间
143 function AddHrs (const DT: TDateTime; const Hrs: Extended): TDateTime;
144
145 //可将日期加上欲增加的天数为得到的值 例如:AddDays(2000/08/31,10)=2000/09/10
146 function AddDays (const DT: TDateTime; const Days: Extended): TDateTime;
147
148 //增加n周的时间
149 //例如:AddWeeks(2001/01/21,2)传回值为'2001/02/4'
150 function AddWeeks (const DT: TDateTime; const Weeks: Extended): TDateTime;
151
152 //增加n个月的时间
153 function AddMonths (const DT: TDateTime; const Months: Extended): TDateTime;
154
155 //增加n个年的时间
156 function AddYrs (const DT: TDateTime; const Yrs: Extended): TDateTime;
157
158 //传回向前算的N个分锺
159 function SubtractMins (const DT: TDateTime; const Mins: Extended): TDateTime;
160
161 //传回向前算的N个小时
162 function SubtractHrs (const DT: TDateTime; const Hrs: Extended): TDateTime;
163
164 //传回向前算的N个天
165 function SubtractDays (const DT: TDateTime; const Days: Extended): TDateTime;
166
167 //传回向前算的N个周
168 function SubtractWeeks (const DT: TDateTime; const Weeks: Extended): TDateTime;
169
170 //传回向前算的N个月,例如:SubtractMonths('2000/11/21',3)传回'2000/08/22'
171 function SubtractMonths (const DT: TDateTime; const Months: Extended): TDateTime;
172
173 //传回日期值的本月份的最后一天
174 function GetLastDayOfMonth (const DT: TDateTime): TDateTime;
175
176 //传回日期值的本月份的第一天
177 function GetFirstDayOfMonth (const DT: TDateTime): TDateTime;
178
179 //传回年度第一周的第一个星期天的日期
180 function StartOfWeek (const DT: TDateTime): TDateTime;
181
182 //传回年度最后一周的最后一个星期天的日期
183 function EndOfWeek (const DT: TDateTime): TDateTime;
184
185 //将秒数转换为时分秒
186 function Hrs_Min_Sec (Secs: Extended): string;
187
188 //: 比较两的日期值是否是同月如果是为真
189 function DatesInSameMonth (const DT1, DT2: TDateTime): Boolean;
190
191 //: 比较两的日期值是否是同年如果是为真
192 function DatesInSameYear (const DT1, DT2: TDateTime): Boolean;
193
194 //: 比较两的日期值是否是同年和同月如果是为真
195 function DatesInSameMonthYear (const DT1, DT2: TDateTime): Boolean;
196
197 //:传回两个日期相减值的天数
198 //例如:DaysApart是DT2减DT1
199 function DaysApart (const DT1, DT2: TDateTime): LongInt;
200
201 //传回两个日期相减值的周数
202 //例如:ExactWeeksApart是DT2减DT1
203 function ExactWeeksApart (const DT1, DT2: TDateTime): Extended;
204
205 //传回两个日期相减值的周数
206 //例如:ExactWeeksApart是DT2减DT1
207 function WeeksApart (const DT1, DT2: TDateTime): LongInt;
208
209 //: 如果是真表示日期为润年
210 function DateIsLeapYear (const DT: TDateTime): Boolean;
211
212 //: 传回日期值本月份的天数
213 // DaysThisMonth(Now)= 31,三月有31天
214 function DaysThisMonth (const DT: TDateTime): Byte;
215
216 //: 传回日期值的本年度的月份中的日数,还有几天
217 //DaysLeftInMonth('2001/04/28')传回值2
218 function DaysLeftInMonth (const DT: TDateTime): Byte;
219
220 //: 传回日期值的本年度的月份中的日数,还有几天
221 function DaysInMonth (const DT: TDateTime): Byte;
222 //: 传回日期值的本年度的天数,如果是润年有366天;不是就有365天
223 function DaysInYear (const DT: TDateTime): Word;
224
225 //: 传回日期值中本年度已过了几天
226 //例如:DayOfYear(now)=119
227 function DayOfYear (const DT: TDateTime): Word;
228
229 //: 传回今天的日期在本年度过了几天
230 //例如: ThisDayOfYear=119
231 function ThisDayOfYear: Word;
232
233 //:传回今年度还有几天
234 function DaysLeftInYear (const DT: TDateTime): Word;
235
236 //传回日期值的季别
237 //例如:WhichQuarter(now)=2
238 function WhichQuarter (const DT: TDateTime): Byte;
239
240 //传回年龄,依现在其日期减出生的日期
241 function AgeAtDate (const DOB, DT: TDateTime): Integer;
242
243 //传回年龄,依现在其日期减出生的日期
244 function AgeNow (const DOB: TDateTime): Integer;
245
246 //传回年龄,依现在其日期减出生的日期
247 function AgeAtDateInMonths (const DOB, DT: TDateTime): Integer;
248
249 //传回年龄,依现在其日期减出生的日期
250 function AgeNowInMonths (const DOB: TDateTime): Integer;
251
252 //传回日期值已存活的周数
253 //例如 AgeAtDateInWeeks('1963/06/24',Now)=1975
254 function AgeAtDateInWeeks (const DOB, DT: TDateTime): Integer;
255
256 //传回日期值已存活的周数,不同的是此函数不用第二个参数是用上一个函数完成的
257 //例如 AgeNowInWeeks('1963/06/24')=1975
258 function AgeNowInWeeks (const DOB: TDateTime): Integer;
259
260 //可传回几岁几月几周的详细年龄
261 function AgeNowDescr (const DOB: TDateTime): String;
262
263 function CheckDate(const sCheckedDateString: string): boolean;
264 //检查是否是中华民国的日期格式
265 //例如:CheckDate(DatetoStr(Now))=89/08/29,传回值是Boolean
266
267 {----------------- 周数处理用函数 --------------------}
268
269 //将日期值转换成周数
270 function DateToWeekNo (const DT: TDateTime): Integer;
271
272 //比较两个日期值是否相同
273 function DatesInSameWeekNo (const DT1, DT2: TDateTime): Boolean;
274
275 //将两个日期相减后转成周数
276 function WeekNosApart (const DT1, DT2: TDateTime): Integer;
277
278 //传回目前日期的周数
279 function ThisWeekNo: Integer;
280
281 //传回在X的年度的第n周的时间
282 //例如:GetWeekNoToDate(28,2001)='2001/07/08',取得值是从星期天开始
283 function GetWeekNoToDate_Sun (const WeekNo, Year: Word): TDateTime;
284
285 //传回在X的年度的第n周的时间
286 //例如:GetWeekNoToDate(28,2001)='2001/07/08',取得值是从星期一开始
287 function GetWeekNoToDate_Mon (const WeekNo, Year: Word): TDateTime;
288
289 //传回在X的年度的第n周的时间
290 //例如:DWYToDate(3,28,2001)='2001/07/10',取得值是强制从星期天开始的
291 function DWYToDate (const DOW, WeekNo, Year: Word): TDateTime;
292
293 //将周数转换成月日格式
294 //例如:WeekNoToDate(35)传回08/26
295 function WeekNoToDate(Const Weekno : Word):TDateTime;
296
297 {--- 检查确定日期函数 ---}
298 //: 如果传回值是真表示目前是一月
299 function IsJanuary (const DT: TDateTime): Boolean;
300
301 //: 如果传回值是真表示目前是二月
302 function IsFebruary (const DT: TDateTime): Boolean;
303
304 //: 如果传回值是真表示目前是三月
305 function IsMarch (const DT: TDateTime): Boolean;
306
307 //: 如果传回值是真表示目前是四月
308 function IsApril (const DT: TDateTime): Boolean;
309
310 //: 如果传回值是真表示目前是五月
311 function IsMay (const DT: TDateTime): Boolean;
312
313 //: 如果传回值是真表示目前是六月
314 function IsJune (const DT: TDateTime): Boolean;
315
316 //: 如果传回值是真表示目前是七月
317 function IsJuly (const DT: TDateTime): Boolean;
318
319 //: 如果传回值是真表示目前是八月
320 function IsAugust (const DT: TDateTime): Boolean;
321
322 //: 如果传回值是真表示目前是九月
323 function IsSeptember (const DT: TDateTime): Boolean;
324
325 //: 如果传回值是真表示目前是十月
326 function IsOctober (const DT: TDateTime): Boolean;
327
328 //: 如果传回值是真表示目前是十一月
329 function IsNovember (const DT: TDateTime): Boolean;
330
331 //: 如果传回值是真表示目前是十二月
332 function IsDecember (const DT: TDateTime): Boolean;
333
334 //: 如果传回值是真表示目前是上午
335 function IsAM (const DT: TDateTime): Boolean;
336
337 //: 如果传回值是真表示目前是下午
338 function IsPM (const DT: TDateTime): Boolean;
339
340 //: 如果传回值是真表示目前是中午
341 function IsNoon (const DT: TDateTime): Boolean;
342
343 //:如果传回值是真表示目前是夜晚
344 function IsMidnight (const DT: TDateTime): Boolean;
345
346 //: 如果传回值是真表示目前是星期天
347 function IsSunday (const DT: TDateTime): Boolean;
348
349 //: 如果日期值是星期一即为真
350 function IsMonday (const DT: TDateTime): Boolean;
351
352 //: 如果日期值是星期二即为真
353 function IsTuesday (const DT: TDateTime): Boolean;
354
355 //: 如果日期值是星期三即为真
356 function IsWednesday (const DT: TDateTime): Boolean;
357
358 //: 如果日期值是星期四即为真
359 function IsThursday (const DT: TDateTime): Boolean;
360
361 //: 如果日期值是星期五即为真
362 function IsFriday (const DT: TDateTime): Boolean;
363
364 //: 如果日期值是星期六即为真
365 function IsSaturday (const DT: TDateTime): Boolean;
366
367 //:如果日期值是星期六或日即为真
368 function IsWeekend (const DT: TDateTime): Boolean;
369
370 //: 如果日期值是星期一至五即为真
371 function IsWorkDays (const DT: TDateTime): Boolean;
372
373 function CheckLastDayOfMonth(DT : TDateTime) : Boolean;
374 //检查是否是本月的最后一天
375
376 implementation
377
378 uses
379
380 Windows, SysUtils, StrProcess;
381
382 function LInt2EStr (const L: LongInt): String;
383 begin
384 try
385 Result := IntToStr (L);
386 except
387 Result := '';
388 end;
389 end;
390
391 function LeftStr (const S : string; const N : Integer): string;
392 begin
393 Result := Copy (S, 1, N);
394 end;
395
396 function RightAfterStr (const S : String; const N : Integer): String;
397 begin
398 Result := Copy (S, N + 1, Length (S) - N );
399 end;
400
401 function FillStr (const Ch : Char; const N : Integer): string;
402 begin
403 SetLength (Result, N);
404 FillChar (Result [1], N, Ch);
405 end;
406
407 function PadChLeftStr (const S : string; const Ch : Char;
408 const Len : Integer): string;
409 var
410 N: Integer;
411 begin
412 N := Length (S);
413 if N < Len then
414 Result := FillStr (Ch, Len - N) + S
415 else
416 Result := S;
417 end;
418
419 function LInt2ZStr (const L: LongInt; const Len: Byte): String;
420 begin
421 Result := LInt2EStr (L);
422 Result := PadChLeftStr (LeftStr (Result, Len), '0', Len);
423 end;
424
425 function ReplaceChStr (const S : string;
426 const OldCh, NewCh : Char): string;
427 var
428 I: Integer;
429 begin
430 Result := S;
431 if OldCh = NewCh then
432 Exit;
433 for I := 1 to Length (S) do
434 if S [I] = OldCh then
435 Result [I] := NewCh;
436 end;
437
438 function Str2Ext (const S: String): Extended;
439 begin
440 try
441 Result := StrToFloat (S);
442 except
443 Result := 0;
444 end;
445 end;
446
447 function Str2Lint (const S: String): LongInt;
448 begin
449 try
450 Result := StrToInt (S);
451 except
452 Result := 0;
453 end;
454 end;
455
456 function IsLeapYear (Year: Word): Boolean;
457 begin
458 Result := ((Year and 3) = 0) and ((Year mod 100 > 0) or (Year mod 400 = 0))
459 end;
460
461 function Date2Str (const DT: TDateTime): String;
462 begin
463 try
464 if abs (DT) < 0.000001 then
465 Result := ''
466 else
467 Result := DateToStr (DT);
468 except
469 Result := '';
470 end;
471 end;
472
473 function GetYear (const DT: TDateTime): Word;
474 var
475 D, M: Word;
476 begin
477 DecodeDate (DT, Result, M, D);
478 end;
479
480 function GetMonth (const DT: TDateTime): Word;
481 var
482 D, Y : Word;
483 begin
484 DecodeDate (DT, Y, Result, D);
485 end;
486
487 function GetDay (const DT: TDateTime): Word;
488 var
489 M, Y : Word;
490 begin
491 DecodeDate (DT, Y, M, Result);
492 end;
493
494 function Time2Hr (const DT: TDateTime): Word;
495 var
496 Min, Sec, MSec: Word;
497 begin
498 DecodeTime (DT, Result, Min, Sec, MSec);
499 end;
500
501 function Time2Min (const DT: TDateTime): Word;
502 var
503 Hr, Sec, MSec: Word;
504 begin
505 DecodeTime (DT, Hr, Result, Sec, MSec);
506 end;
507
508 function Time2Sec (const DT: TDateTime): Word;
509 var
510 Hr, Min, MSec: Word;
511 begin
512 DecodeTime (DT, Hr, Min, Result, MSec);
513 end;
514
515 function Time2MSec (const DT: TDateTime): Word;
516 var
517 Hr, Min, Sec: Word;
518 begin
519 DecodeTime (DT, Hr, Min, Sec, Result);
520 end;
521
522 function MinutesApart (const DT1, DT2: TDateTime): Word;
523 var
524 Hr1, Min1, Sec1, MSec1: Word;
525 Hr2, Min2, Sec2, MSec2: Word;
526 begin
527 DecodeTime (DT1, Hr1, Min1, Sec1, MSec1);
528 DecodeTime (DT2, Hr2, Min2, Sec2, MSec2);
529 if Min2 < Min1 then
530 begin
531 Min2 := Min2 + 60;
532 Dec (Hr2);
533 end;
534 if Hr1 > Hr2 then
535 Hr2 := Hr2 + 24;
536 Result := (Hr2 - Hr1) * 60 + (Min2 - Min1);
537 end;
538
539 function AdjustDateYear (const D: TDateTime; const Year: Word): TDateTime;
540 var
541 Day, Month, OldYear: Word;
542 begin
543 DecodeDate (D, OldYear, Month, Day);
544 if Year = OldYear then
545 begin
546 Result := Int (D);
547 Exit;
548 end;
549 if not IsLeapYear (Year) and (Month = 2) and (Day = 29) then
550 begin
551 Month := 3;
552 Day := 1;
553 end;
554 Result := EncodeDate (Year, Month, Day);
555 end;
556
557 function AddMins (const DT: TDateTime; const Mins: Extended): TDateTime;
558 begin
559 Result := DT + Mins / (60 * 24)
560 end;
561
562 function AddHrs (const DT: TDateTime; const Hrs: Extended): TDateTime;
563 begin
564 Result := DT + Hrs / 24.0
565 end;
566
567 function AddWeeks (const DT: TDateTime; const Weeks: Extended): TDateTime;
568 begin
569 Result := DT + Weeks * 7;
570 end;
571
572 function AddMonths (const DT: TDateTime; const Months: Extended): TDateTime;
573 var
574 Day, Month, Year: Word;
575 IMonth: Integer;
576 begin
577 DecodeDate (DT, Year, Month, Day);
578 IMonth := Month + Trunc (Months);
579
580 if IMonth > 12 then
581 begin
582 Year := Year + (IMonth - 1) div 12;
583 IMonth := IMonth mod 12;
584 if IMonth = 0 then
585 IMonth := 12;
586 end
587 else if IMonth < 1 then
588 begin
589 Year := Year + (IMonth div 12) - 1; // sub years;
590 IMonth := 12 - abs (IMonth) mod 12;
591 end;
592 Month := IMonth;
593
594 // Ensure Day of Month is valid
595 if Month = 2 then
596 begin
597 if IsLeapYear (Year) and (Day > 29) then
598 Day := 29
599 else if not IsLeapYear (Year) and (Day > 28) then
600 Day := 28;
601 end
602 else if (Month in [9, 4, 6, 11]) and (Day = 31) then
603 Day := 30;
604
605 Result := EncodeDate (Year, Month, Day) + Frac (Months) * 30 +
606 Frac (DT);
607 end;
608
609 function AddYrs (const DT: TDateTime; const Yrs: Extended): TDateTime;
610 var
611 Day, Month, Year: Word;
612 begin
613 DecodeDate (DT, Year, Month, Day);
614 Year := Year + Trunc (Yrs);
615 if not IsLeapYear (Year) and (Month = 2) and (Day = 29) then
616 Day := 28;
617 Result := EncodeDate (Year, Month, Day) + Frac (Yrs) * 365.25
618 + Frac (DT);
619 end;
620
621 function GetLastDayofMonth (const DT: TDateTime): TDateTime;
622 var
623 D, M, Y: Word;
624 begin
625 DecodeDate (DT, Y, M, D);
626 case M of
627 2:
628 begin
629 if IsLeapYear (Y) then
630 D := 29
631 else
632 D := 28;
633 end;
634 4, 6, 9, 11: D := 30
635 else
636 D := 31;
637 end;
638 Result := EncodeDate (Y, M, D) + Frac (DT);
639 end;
640
641 function GetFirstDayofMonth (const DT: TDateTime): TDateTime;
642 var
643 D, M, Y: Word;
644 begin
645 DecodeDate (DT, Y, M, D);
646 Result := EncodeDate (Y, M, 1) + Frac (DT);
647 end;
648
649 function GMTStr2Value(const GMTStr: string): Extended;
650 var
651 P: Integer;
652 begin
653 P := Pos (GMTStr, '+');
654 if P > 0 then
655 begin
656 Result := Str2Ext (Trim (Copy (GMTStr, P + 1, Length (GMTStr) - P)));
657 end
658 else
659 begin
660 P := Pos (GMTStr, '-');
661 if P > 0 then
662 begin
663 Result := -1 * Str2Ext (Trim (Copy (GMTStr, P + 1, Length (GMTStr) - P)));
664 end
665 else
666 Result := 0;
667 end;
668 end;
669
670 function ConvertGMTStrTimes (const FromGMTStr: string; const FromDT: TDateTime;
671 const ToGMTStr: string): TDateTime;
672 var
673 GMT1, GMT2: Extended;
674 begin
675 GMT1 := GMTStr2Value (FromGMTStr);
676 GMT2 := GMTStr2Value (ToGMTStr);
677 Result := FromDT + GMT2 - GMT1;
678 end;
679
680 function GetRFC822Difference: string;
681 var
682 TZ : TTimeZoneInformation;
683 begin
684 GetTimeZoneInformation (TZ);
685 if TZ.Bias <= 0 then
686 begin
687 TZ.Bias := Abs (TZ.Bias);
688 Result := '+' + LInt2ZStr (TZ.Bias div 60, 2)
689 + LInt2ZStr (TZ.Bias mod 60, 2)
690 end
691 else
692 Result := '-' + LInt2ZStr (TZ.Bias div 60, 2)
693 + LInt2ZStr (TZ.Bias mod 60, 2)
694 end;
695
696 function StartOfWeek (const DT: TDateTime): TDateTime;
697 begin
698 Result := DT - DayOfWeek (DT) + 1;
699 end;
700
701 function EndOfWeek (const DT: TDateTime): TDateTime;
702 begin
703 Result := DT - DayOfWeek (DT) + 7;
704 end;
705
706 function ThisYear: Word;
707 var
708 D, M: Word;
709 begin
710 DeCodeDate(Now,Result,M,D) ;
711 end;
712
713 function ThisMonth: Word;
714 var
715 D, Y: Word;
716 begin
717 DeCodeDate(Now,Y,Result,D);
718 end;
719
720 function ThisDay: Word;
721 var
722 M, Y: Word;
723 begin
724 DeCodeDate(Now,Y,M,Result);
725 end;
726
727 function ThisHr: Word;
728 begin
729 Result := Time2Hr (Time);
730 end;
731
732 function ThisMin: Word;
733 begin
734 Result := Time2Min (Time);
735 end;
736
737 function ThisSec: Word;
738 begin
739 Result := Time2Sec (Time);
740 end;
741
742 function IsJanuary (const DT: TDateTime): Boolean;
743 begin
744 Result := GetMonth(DT) = 1;
745 end;
746
747 function IsFebruary (const DT: TDateTime): Boolean;
748 begin
749 Result := GetMonth (DT) = 2;
750 end;
751
752 function IsMarch (const DT: TDateTime): Boolean;
753 begin
754 Result := GetMonth (DT) = 3;
755 end;
756
757 function IsApril (const DT: TDateTime): Boolean;
758 begin
759 Result := GetMonth (DT) = 4;
760 end;
761
762 function IsMay (const DT: TDateTime): Boolean;
763 begin
764 Result := GetMonth (DT) = 5;
765 end;
766
767 function IsJune (const DT: TDateTime): Boolean;
768 begin
769 Result := GetMonth (DT) = 6;
770 end;
771
772 function IsJuly (const DT: TDateTime): Boolean;
773 begin
774 Result := GetMonth (DT) = 7;
775 end;
776
777 function IsAugust (const DT: TDateTime): Boolean;
778 begin
779 Result := GetMonth (DT) = 8;
780 end;
781
782 function IsSeptember (const DT: TDateTime): Boolean;
783 begin
784 Result := GetMonth (DT) = 9;
785 end;
786
787 function IsOctober (const DT: TDateTime): Boolean;
788 begin
789 Result := GetMonth (DT) = 10;
790 end;
791
792 function IsNovember (const DT: TDateTime): Boolean;
793 begin
794 Result := GetMonth (DT) = 11;
795 end;
796
797 function IsDecember (const DT: TDateTime): Boolean;
798 begin
799 Result := GetMonth (DT) = 12;
800 end;
801
802 function Hrs_Min_Sec (Secs: Extended): string;
803 const
804 OneSecond = 1/24/3600;
805 var
806 Total: Extended;
807 begin
808 Total := Secs * OneSecond;
809 Result := Format( '%1.0f 天%s', [Int (Total),
810 FormatDateTime ('hh:nn:ss', Frac (total))]);
811 end;
812
813 function DatesInSameMonth (const DT1, DT2: TDateTime): Boolean;
814 begin
815 Result := GetMonth (DT1) = GetMonth (DT2);
816 end;
817
818 function DatesInSameYear (const DT1, DT2: TDateTime): Boolean;
819 begin
820 Result := GetYear (DT1) = GetYear (DT2);
821 end;
822
823 function DatesInSameMonthYear (const DT1, DT2: TDateTime): Boolean;
824 begin
825 Result := DatesInSameMonth (DT1, DT2) and DatesInSameYear (DT1, DT2);
826 end;
827
828 function AddDays (const DT: TDateTime; const Days: Extended): TDateTime;
829 begin
830 Result := DT + Days;
831 end;
832
833 function IsAM (const DT: TDateTime): Boolean;
834 begin
835 Result := Frac (DT) < 0.5
836 end;
837
838 function IsPM (const DT: TDateTime): Boolean;
839 begin
840 Result := not IsAM (DT);
841 end;
842
843 function IsNoon (const DT: TDateTime): Boolean;
844 begin
845 Result := Frac (DT) = 0.5;
846 end;
847
848 function IsMidnight (const DT: TDateTime): Boolean;
849 begin
850 Result := Frac (DT) = 0.0;
851 end;
852
853 function IsSunday (const DT: TDateTime): Boolean;
854 begin
855 Result := DayOfWeek (DT) = 1;
856 end;
857
858 function IsMonday (const DT: TDateTime): Boolean;
859 begin
860 Result := DayOfWeek (DT) = 2;
861 end;
862
863 function IsTuesday (const DT: TDateTime): Boolean;
864 begin
865 Result := DayOfWeek (DT) = 3;
866 end;
867
868 function IsWednesday (const DT: TDateTime): Boolean;
869 begin
870 Result := DayOfWeek (DT) = 4;
871 end;
872
873 function IsThursday (const DT: TDateTime): Boolean;
874 begin
875 Result := DayOfWeek (DT) = 5;
876 end;
877
878 function IsFriday (const DT: TDateTime): Boolean;
879 begin
880 Result := DayOfWeek (DT) = 6;
881 end;
882
883 function IsSaturday (const DT: TDateTime): Boolean;
884 begin
885 Result := DayOfWeek (DT) = 7;
886 end;
887
888 function IsWeekend (const DT: TDateTime): Boolean;
889 begin
890 Result := DayOfWeek (DT) in [1, 7];
891 end;
892
893 function IsWorkDays (const DT: TDateTime): Boolean;
894 begin
895 Result := DayOfWeek (DT) in [2..6];
896 end;
897
898 function DaysApart (const DT1, DT2: TDateTime): LongInt;
899 begin
900 Result := Trunc (DT2) - Trunc (DT1);
901 end;
902
903 function DateIsLeapYear (const DT: TDateTime): Boolean;
904 begin
905 Result := IsLeapYear (GetYear (DT));
906 end;
907
908 function DaysThisMonth (const DT: TDateTime): Byte;
909 begin
910 case GetMonth (DT) of
911 2: if DateIsLeapYear (DT) then
912 Result := 29
913 else
914 Result := 28;
915 4, 6, 9, 11: Result := 30;
916 else
917 Result := 31;
918 end;
919 end;
920
921 function DaysInMonth (const DT: TDateTime): Byte;
922 begin case GetMonth (DT) of 2: if DateIsLeapYear (DT) then Result := 29 else Result := 28; 4, 6, 9, 11: Result := 30; else Result := 31; end; End;
923
924 function DaysLeftInMonth (const DT: TDateTime): Byte;
925 begin
926 Result := DaysInMonth (DT) - GetDay (DT);
927 end;
928
929 function DaysInYear (const DT: TDateTime): Word;
930 begin
931 if DateIsLeapYear (DT) then
932 Result := 366
933 else
934 Result := 365;
935 end;
936
937 function DayOfYear (const DT: TDateTime): Word;
938 begin
939 Result := Trunc (DT) - Trunc (EncodeDate (GetYear (DT), 1, 1)) + 1;
940 end;
941
942 function DaysLeftInYear (const DT: TDateTime): Word;
943 begin
944 Result := DaysInYear (DT) - DayOfYear (DT);
945 end;
946
947 function ThisDayOfYear: Word;
948 begin
949 Result := DayOfYear (Date);
950 end;
951
952 function WhichQuarter (const DT: TDateTime): Byte;
953 begin
954 Result := (GetMonth (DT) - 1) div 3 + 1;
955 end;
956
957 function GetFirstDayOfYear (const Year: Word): TDateTime;
958 begin
959 Result := EncodeDate (Year, 1, 1);
960 end;
961
962 function GetLastDayOfYear (const Year: Word): TDateTime;
963 begin
964 Result := EncodeDate (Year, 12, 31);
965 end;
966
967 function SubtractMins (const DT: TDateTime; const Mins: Extended): TDateTime;
968 begin
969 Result := AddMins (DT, -1 * Mins);
970 end;
971
972 function SubtractHrs (const DT: TDateTime; const Hrs: Extended): TDateTime;
973 begin
974 Result := AddHrs (DT, -1 * Hrs);
975 end;
976
977 function SubtractWeeks (const DT: TDateTime; const Weeks: Extended): TDateTime;
978 begin
979 Result := AddWeeks (DT, -1 * Weeks);
980 end;
981
982 function SubtractMonths (const DT: TDateTime; const Months: Extended): TDateTime;
983 begin
984 Result := AddMonths (DT, -1 * Months);
985 end;
986
987 function SubtractDays (const DT: TDateTime; const Days: Extended): TDateTime;
988 begin
989 Result := DT - Days;
990 end;
991
992 function AgeAtDate (const DOB, DT: TDateTime): Integer;
993 var
994 D1, M1, Y1, D2, M2, Y2: Word;
995 begin
996 if DT < DOB then
997 Result := -1
998 else
999 begin
1000 DecodeDate (DOB, Y1, M1, D1);
1001 DecodeDate (DT, Y2, M2, D2);
1002 Result := Y2 - Y1;
1003 if (M2 < M1) or ((M2 = M1) and (D2 < D1)) then
1004 Dec (Result);
1005 end;
1006 end;
1007
1008 function AgeNow (const DOB: TDateTime): Integer;
1009 begin
1010 Result := AgeAtDate (DOB, Date);
1011 end;
1012
1013 function EDOWToInt (const DOW: string): Integer;
1014 var
1015 UCDOW: string;
1016 I,N: Integer;
1017 begin
1018 Result := 0;
1019 UCDOW := UpperCase (DOW);
1020 N := Length (DOW);
1021 for I := 1 to 7 do
1022 begin
1023 if LeftStr (DayOfWeekStrings [I], N) = UCDOW then
1024 begin
1025 Result := I;
1026 Break;
1027 end;
1028 end;
1029 end;
1030
1031 function EMonthToInt (const Month: string): Integer;
1032 var
1033 UCMonth: string;
1034 I,N: Integer;
1035 begin
1036 Result := 0;
1037 UCMonth := UpperCase (Month);
1038 N := Length (Month);
1039 for I := 1 to 12 do
1040 begin
1041 if LeftStr (MonthStrings [I], N) = UCMonth then
1042 begin
1043 Result := I;
1044 Break;
1045 end;
1046 end;
1047 end;
1048
1049 function GetCMonth(const DT: TDateTime): String;
1050 begin
1051 Result :=MonthCStrings[GetMonth(DT)];
1052 end;
1053
1054 function GetC_Today: string;
1055 var
1056 wYear, wMonth, wDay: Word;
1057 sYear, sMonth, sDay: string[2];
1058 begin
1059 DecodeDate(Now, wYear, wMonth, wDay);
1060 wYear := wYear - 1911;
1061 sYear := Copy(IntToStr(wYear + 1000), 3, 2);
1062 sMonth := Copy(IntToStr(wMonth + 100), 2, 2);
1063 sDay := Copy(IntToStr(wDay + 100), 2, 2);
1064 Result := sYear + DateSeparator + sMonth + DateSeparator + sDay;
1065 end;
1066
1067 Function TransC_DateToE_Date(Const CDT :String) :TDateTime;
1068 Var iYear,iMonth,iDay:Word;
1069 Begin
1070 if Length(CDT) <> 12 then Exit;
1071 if Pos(' ',CDT ) <> 0 then Exit;
1072 (* 民国日期 -> 公元日期 *)
1073 iYear := StrToInt(Copy(CDT, 1, 2)) + 1911;
1074 iMonth := StrToInt(Copy(CDT, 5, 2));
1075 iDay:= StrToInt(Copy(CDT, 9, 2));
1076 Result:=EncodeDate(iYear,iMonth,iDay);
1077 End;
1078
1079 function GetCWeek(const DT: TDateTime): String;
1080 begin
1081 Result :=DayOfCWeekStrings[DayOfWeek(DT)];
1082 end;
1083
1084 function GetLastDayForMonth(const DT: TDateTime):TDateTime;
1085 Var Y,M,D :Word;
1086 Begin
1087 DecodeDate(DT,Y,M,D);
1088 Case M of
1089 2: Begin
1090 If IsLeapYear(Y) then
1091 D:=29
1092 Else
1093 D:=28;
1094 End;
1095 4,6,9,11:D:=30
1096 Else
1097 D:=31;
1098 End;
1099 Result:=EnCodeDate(Y,M,D);
1100 End;
1101
1102 function GetFirstDayForMonth (const DT : TDateTime): TDateTime;
1103 Var Y,M,D:Word;
1104 Begin
1105 DecodeDate(DT,Y,M,D);
1106 //DecodeDate(DT,Y,M,1);
1107 Result := EncodeDate (Y, M, 1);
1108 End;
1109
1110 function GetLastDayForPeriorMonth(const DT: TDateTime):TDateTime;
1111 Var Y,M,D:Word;
1112 Begin
1113 DecodeDate(DT,Y,M,D);
1114 M:=M-1;
1115 Case M of
1116 2: Begin
1117 If IsLeapYear(Y) then
1118 D:=29
1119 Else
1120 D:=28;
1121 End;
1122 4,6,9,11:D:=30
1123 Else
1124 D:=31;
1125 End;
1126 Result:=EnCodeDate(Y,M,D);
1127 End;
1128
1129 function GetFirstDayForPeriorMonth (const DT :TDateTime): TDateTime;
1130 Var Y,M,D:Word;
1131 Begin
1132 DecodeDate(DT,Y,M,D);
1133 M:=M-1;
1134 Result := EncodeDate (Y, M, 1);
1135 End;
1136
1137 function ROCDATE(DD:TDATETIME;P:integer):string; {转换某日期为民国0YYMMDD 型式字符串 }
1138 var YEAR,MONTH,DAY : WORD; {P=0 不加'年'+'月'+'日'}
1139 Y,CY,M,D,LONGY : string; {P=1 加'年'+'月'+'日'}
1140 YY:integer;
1141 begin
1142 DECODEDATE(DD,YEAR,MONTH,DAY);
1143
1144 if (year=0) and (month=0) and (day=0) then
1145 begin
1146 Result:='';
1147 exit;
1148 end;
1149
1150 YY:=YEAR-1911;
1151 if YY>0 then
1152 begin
1153 CY:=inttostr(YY);
1154 if Length(CY)=1 then CY:='00'+CY;
1155 if Length(CY)=2 then CY:='0'+CY;
1156 end
1157 else
1158 begin
1159 YY:=YEAR-1912;
1160 CY:=inttostr(YY);
1161 if Length(CY)=2 then CY:='-0'+RIGHT(CY,1);
1162 end;
1163
1164 if strtoint(CY)>999 then
1165 CY:='XXX';
1166
1167 if (CY<>'XXX') and (strtoint(CY)<-99) then
1168 CY:='-XX';
1169
1170 M:=inttostr(MONTH);
1171 if Length(M)=1 then M:='0'+M;
1172 D:=inttostr(DAY);
1173 if Length(D)=1 then D:='0'+D;
1174
1175 if P=0 then
1176 Result:=CY+ DateSeparator+M+ DateSeparator+D
1177 else
1178 Result:=CY+'年'+M+'月'+D+'日';
1179
1180 end;
1181
1182 function ExactWeeksApart (const DT1, DT2: TDateTime): Extended;
1183 begin
1184 Result := DaysApart (DT1, DT2) / 7;
1185 end;
1186
1187 function WeeksApart (const DT1, DT2: TDateTime): Integer;
1188 begin
1189 Result := DaysApart (DT1, DT2) div 7;;
1190 end;
1191
1192 function GetFirstSundayOfYear (const Year: Word): TDateTime;
1193 var
1194 StartYear: TDateTime;
1195 begin
1196 StartYear := GetFirstDayOfYear (Year);
1197 if DayOfWeek (StartYear) = 1 then
1198 Result := StartYear
1199 else
1200 Result := StartOfWeek (StartYear) + 7;
1201 end;
1202
1203 function GetMDY (const DT: TDateTime): String;
1204
1205 Begin
1206 Result := FormatDateTime('MM/DD/YY',DT);
1207 End;
1208
1209 function DateToWeekNo (const DT: TDateTime): Integer;
1210 var
1211 Year: Word;
1212 FirstSunday, StartYear: TDateTime;
1213 WeekOfs: Byte;
1214 begin
1215 Year := GetYear (DT);
1216 StartYear := GetFirstDayOfYear (Year);
1217 if DayOfWeek (StartYear) = 0 then
1218 begin
1219 FirstSunday := StartYear;
1220 WeekOfs := 1;
1221 end
1222 else
1223 begin
1224 FirstSunday := StartOfWeek (StartYear) + 7;
1225 WeekOfs := 2;
1226 if DT < FirstSunday then
1227 begin
1228 Result := 1;
1229 Exit;
1230 end;
1231 end;
1232 Result := DaysApart (FirstSunday, StartofWeek (DT)) div 7 + WeekOfs;
1233 end;
1234
1235 function DatesInSameWeekNo (const DT1, DT2: TDateTime): Boolean;
1236 begin
1237 if GetYear (DT1) <> GetYear (DT2) then
1238 Result := False
1239 else
1240 Result := DateToWeekNo (DT1) = DateToWeekNo (DT2);
1241 end;
1242
1243 function WeekNosApart (const DT1, DT2: TDateTime): Integer;
1244 begin
1245 if GetYear (DT1) <> GetYear (DT2) then
1246 Result := -999
1247 else
1248 Result := DateToWeekNo (DT2) - DateToWeekNo (DT1);
1249 end;
1250
1251 function ThisWeekNo: Integer;
1252 begin
1253 Result := DateToWeekNo (Date);
1254 end;
1255
1256 function GetWeekNoToDate_Sun (const WeekNo, Year: Word): TDateTime;
1257 var
1258 FirstSunday: TDateTime;
1259 begin
1260 FirstSunday := GetFirstSundayOfYear (Year);
1261 if GetDay (FirstSunday) = 1 then
1262 Result := AddWeeks (FirstSunday, WeekNo - 1)
1263 else
1264 Result := AddWeeks (FirstSunday, WeekNo - 2)
1265 end;
1266
1267 function GetWeekNoToDate_Mon (const WeekNo, Year: Word): TDateTime;
1268 begin
1269 Result := GetWeekNoToDate_Sun (WeekNo, Year) + 6;
1270 end;
1271
1272 function DWYToDate (const DOW, WeekNo, Year: Word): TDateTime;
1273 begin
1274 Result := GetWeekNoToDate_Sun (WeekNo, Year) + DOW - 1;
1275 end;
1276
1277 function AgeAtDateInMonths (const DOB, DT: TDateTime): Integer;
1278 var
1279 D1, D2 : Word;
1280 M1, M2 : Word;
1281 Y1, Y2 : Word;
1282 begin
1283 if DT < DOB then
1284 Result := -1
1285 else
1286 begin
1287 DecodeDate (DOB, Y1, M1, D1);
1288 DecodeDate (DT, Y2, M2, D2);
1289 if Y1 = Y2 then // Same Year
1290 Result := M2 - M1
1291 else // 不同年份
1292 begin
1293 // 前12月的年龄
1294 Result := 12 * AgeAtDate (DOB, DT);
1295 if M1 > M2 then
1296 Result := Result + (12 - M1) + M2
1297 else if M1 < M2 then
1298 Result := Result + M2 - M1
1299 else if D1 > D2 then // Same Month
1300 Result := Result + 12;
1301 end;
1302 if D1 > D2 then // we have counted one month too many
1303 Dec (Result);
1304 end;
1305 end;
1306
1307 function WeekNoToDate(Const Weekno : Word):TDateTime;
1308 Begin
1309 Result :=AddDays(GetWeekNoToDate_Sun(WeekNo,GetYear(Now)),1);
1310 End;
1311
1312 function AgeAtDateInWeeks (const DOB, DT: TDateTime): Integer;
1313 begin
1314 if DT < DOB then
1315 Result := -1
1316 else
1317 begin
1318 Result := Trunc (DT - DOB) div 7;
1319 end;
1320 end;
1321
1322 function AgeNowInMonths (const DOB: TDateTime): Integer;
1323 begin
1324 Result := AgeAtDateInMonths (DOB, Date);
1325 end;
1326
1327 function AgeNowInWeeks (const DOB: TDateTime): Integer;
1328 begin
1329 Result := AgeAtDateInWeeks (DOB, Date);
1330 end;
1331
1332 function AgeNowDescr (const DOB: TDateTime): String;
1333 var
1334 Age : integer;
1335 begin
1336 Age := AgeNow (DOB);
1337 if Age > 0 then
1338 begin
1339 if Age = 1 then
1340 Result := LInt2EStr (Age) + ' 岁'
1341 else
1342 Result := LInt2EStr (Age) + ' 岁';
1343 end
1344 else
1345 begin
1346 Age := AgeNowInMonths (DOB);
1347 if Age >= 2 then
1348 Result := LInt2EStr(Age) + ' 月'
1349 else
1350 begin
1351 Age := AgeNowInWeeks (DOB);
1352 if Age = 1 then
1353 Result := LInt2EStr(Age) + ' 周'
1354 else
1355 Result := LInt2EStr(Age) + ' 周';
1356 end;
1357 end;
1358 end;
1359
1360 function CheckDate(const sCheckedDateString: string): boolean;
1361 var
1362 iYear, iMonth, iDay: word;
1363 begin
1364 Result := False;
1365 (* 格式检查 *)
1366 if Length(sCheckedDateString) <> 8 then Exit;
1367 if Pos(' ', sCheckedDateString) <> 0 then Exit;
1368 if (sCheckedDateString[3] <> DateSeparator) or
1369 (sCheckedDateString[6] <> DateSeparator) then Exit;
1370
1371 (* 民国日期 -> 公元日期 *)
1372 iYear := StrToInt(Copy(sCheckedDateString, 1, 2)) + 1911;
1373 iMonth := StrToInt(Copy(sCheckedDateString, 4, 2));
1374 iDay := StrToInt(Copy(sCheckedDateString, 7, 2));
1375
1376 (* 日之判断 *)
1377 if iDay < 0 then Exit;
1378 case iMonth of
1379 1, 3, 5, 7, 8, 10, 12: Result := iDay <= 31; (* 大月 *)
1380 4, 6, 9, 11: Result := iDay <= 30; (* 小月 *)
1381 2: (* 依闰年计算法判断 *)
1382 if (iYear mod 400 = 0) or
1383 ( (iYear mod 4 = 0) and (iYear Mod 100 <> 0) ) then
1384 (* 闰年 *)
1385 Result := iDay <= 29
1386 else
1387 Result := iDay <= 28;
1388 end;
1389 end;
1390
1391 function CheckLastDayOfMonth(DT : TDateTime) : Boolean;
1392 var
1393 D, M, Y: Word; Begin DecodeDate (DT, Y, M, D);
1394 If M in [4,6,9,11] then begin
1395 If D = 30 then
1396 Result:= True
1397 Else
1398 Result:= False;
1399 End;
1400 If M in [1,3,5,7,8,10,12] then Begin
1401 If D = 31 then
1402 Result:= True
1403 Else
1404 Result:= False;
1405 End;
1406 if M=2 then begin
1407 if IsLeapYear (Y) and (D=29) or Not IsLeapYear (Y) and (D=28) then
1408 Begin
1409 Result:= True; end else Begin Result:= False; end; End;end;
1410
1411 end.