zoukankan      html  css  js  c++  java
  • 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.   
  • 相关阅读:
    go函数
    Linux 查看磁盘容量、查找大文件、查找大目录
    五分钟理解一致性哈希算法(consistent hashing)
    使用Java实现三个线程交替打印0-74
    Python实现IOC控制反转
    Wannafly挑战赛5 A珂朵莉与宇宙 前缀和+枚举平方数
    Yandex Big Data Essentials Week1 Scaling Distributed File System
    Yandex Big Data Essentials Week1 Unix Command Line Interface Processes managing
    Yandex Big Data Essentials Week1 Unix Command Line Interface File Content exploration
    Yandex Big Data Essentials Week1 Unix Command Line Interface File System exploration
  • 原文地址:https://www.cnblogs.com/MaxWoods/p/3488986.html
Copyright © 2011-2022 走看看