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.