delphi时间日期函数

   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.   
原文地址:https://www.cnblogs.com/MaxWoods/p/3488986.html