• 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.   
  • 相关阅读:
    青檬音乐台闲时听听电台吧
    [转]What is AOP?
    实现页面元素拖动效果的JS函数
    gorithms.算法概论.习题答案
    Asp.Net读取并显示Excel文件中的内容(OleDb方式)
    收藏的一些小软件
    Master Page Path (MasterPage 相对路径)
    rundll32 netplwiz.dll,UsersRunDll
    关于锁
    我的回帖保存
  • 原文地址:https://www.cnblogs.com/MaxWoods/p/3488986.html
Copyright © 2020-2023  润新知