delphi时间日期函数

 unit DateProcess;
 interface

 const
 DayOfWeekStrings: array [..] of String = ('SUNDAY', 'MONDAY', 'TUESDAY',
 'WEDNESDAY', 'THURSDAY', 'FRIDAY', 'SATURDAY');

 //: English Calendar Months - used for Month2Int
 const
 MonthStrings: array [..] of String = ('JANUARY', 'FEBRUARY', 'MARCH',
 'APRIL','MAY', 'JUNE', 'JULY', 'AUGUST', 'SEPTEMBER', 'OCTOBER',
 'NOVEMBER', 'DECEMBER');
 const
  //:中文显示星期─要用Week2CWeek()函数转换
     DayOfCWeekStrings: array [..] of String = ('星期日','星期一',
 '星期二','星期三','星期四','星期五','星期六');
 const
  //: 中文显示月份─要用Month2CMonth()函数转换
 MonthCStrings: array [..] of String = ('一月', '二月', '三月','四月','五月',
                                               '六月', '七月', '八月', '九月', '十月','十一月', '十二月');

 const
   OneDay         = 1.0;
   OneHour        = OneDay / 24.0;
   OneMinute      = OneHour / 60.0;
   OneSecond      = OneMinute / 60.0;
   OneMillisecond = OneSecond / 1000.0;

 //--- 年度函数 ---

 //检查日期值是否是润年
 function IsLeapYear (Year: Word): Boolean;

 //传回日期值年度的第一天
 function GetFirstDayOfYear (const Year: Word): TDateTime;

 //传回日期值年度的最后一天
 function GetLastDayOfYear (const Year: Word): TDateTime;

 //传回日期值年度的第一星期天的日期
 function GetFirstSundayOfYear (const Year: Word): TDateTime;

 //传回西洋日期的格式MM/DD/YY
 function GetMDY (const DT: TDateTime): String;

 //--- 日期型的转换 ---

 //日期转成字符串
 //如果是错误将传一空值
 function Date2Str (const DT: TDateTime): String;

 //传回日期值的日期
 function GetDay (const DT: TDateTime): Word;

 //:传回日期值的月份
 function GetMonth (const DT: TDateTime): Word;

 //: 传回日期值的年份
 function GetYear (const DT: TDateTime): Word;

 //:将日期的值取出时间的值
 function Time2Hr (const DT: TDateTime): Word;

 //:将日期的值取出分锺的值
 function Time2Min (const DT: TDateTime): Word;

 //:将日期的值取出秒数的值
 function Time2Sec (const DT: TDateTime): Word;

 //:将日期的值取出微秒的值
 function Time2MSec (const DT: TDateTime): Word;

 //传回目前的年度
 function ThisYear: Word;

 //传回目前的月份
 function ThisMonth: Word;

 //传回目前的日期
 function ThisDay: Word;

 //传回目前的时间
 function ThisHr: Word;

 //传回目前的分锺
 function ThisMin: Word;

 //传回目前的秒数
 function ThisSec: Word;

 //将英文的星期转成整数值
 //例如EDOWToInt(''SUNDAY')=1
 function EDOWToInt (const DOW: string): Integer;

 //将英文的月份转成整数值的月
 //例如EMonthToInt('JANUARY')=
 function EMonthToInt (const Month: string): Integer;

 function GetCMonth(const DT: TDateTime): String;
 //传回中文显示的月份

 function GetC_Today: string;
 //传回中国的日期
 //例如： GetC_Today传回值为89//

 Function TransC_DateToE_Date(Const CDT :String) :TDateTime;
 //将民国的年月日转换为公元的YYYY/MM/DD
 ////加入 例如：TransC_DateToE_Date('90年2月1日')传回值是2001//

 function GetCWeek(const DT: TDateTime): String;
 //传回值为中文显示的星期  例如：GETCWeek(//)=星期四

 function GetLastDayForMonth(const DT: TDateTime):TDateTime;
 //传回本月的最后一天

 function GetFirstDayForMonth (const DT :TDateTime): TDateTime;
 //取得月份的第一天

 function GetLastDayForPeriorMonth(const DT: TDateTime):TDateTime;
 //传回上个月的最后一天

 function GetFirstDayForPeriorMonth (const DT :TDateTime): TDateTime;
 //取得上个月份的第一天

 function ROCDATE(DD:TDATETIME;P:integer):string;
 {转换某日期为民国0YYMMDD 型式字符串，例如：ROCDATE(Now,0)='900304' }
 {P=0 不加'年'+'月'+'日'}
 {P=1 加'年'+'月'+'日'}

 {------------------- 日期和时间的计算函数------------------}

 //传回两个日期相减值的分锺数
 function MinutesApart (const DT1, DT2: TDateTime): Word;

 //调整年度的时间
 //例如AdjustDateYear(Now,)传回值为'1998/02/25'
 function AdjustDateYear (const D: TDateTime; const Year: Word): TDateTime;

 //增加n个分钟的时间
 function AddMins (const DT: TDateTime; const Mins: Extended): TDateTime;

 //增加n个小时的时间
 function AddHrs (const DT: TDateTime; const Hrs: Extended): TDateTime;

 //可将日期加上欲增加的天数为得到的值   例如：AddDays(//,)=//
 function AddDays (const DT: TDateTime; const Days: Extended): TDateTime;

 //增加n周的时间
 //例如：AddWeeks(//,)传回值为'2001/02/4'
 function AddWeeks (const DT: TDateTime; const Weeks: Extended): TDateTime;

 //增加n个月的时间
 function AddMonths (const DT: TDateTime; const Months: Extended): TDateTime;

 //增加n个年的时间
 function AddYrs (const DT: TDateTime; const Yrs: Extended): TDateTime;

 //传回向前算的N个分锺
 function SubtractMins (const DT: TDateTime; const Mins: Extended): TDateTime;

 //传回向前算的N个小时
 function SubtractHrs (const DT: TDateTime; const Hrs: Extended): TDateTime;

 //传回向前算的N个天
 function SubtractDays (const DT: TDateTime; const Days: Extended): TDateTime;

 //传回向前算的N个周
 function SubtractWeeks (const DT: TDateTime; const Weeks: Extended): TDateTime;

 //传回向前算的N个月，例如：SubtractMonths('2000/11/21',)传回'2000/08/22'
 function SubtractMonths (const DT: TDateTime; const Months: Extended): TDateTime;

 //传回日期值的本月份的最后一天
 function GetLastDayOfMonth (const DT: TDateTime): TDateTime;

 //传回日期值的本月份的第一天
 function GetFirstDayOfMonth (const DT: TDateTime): TDateTime;

 //传回年度第一周的第一个星期天的日期
 function StartOfWeek (const DT: TDateTime): TDateTime;

 //传回年度最后一周的最后一个星期天的日期
 function EndOfWeek (const DT: TDateTime): TDateTime;

 //将秒数转换为时分秒
 function Hrs_Min_Sec (Secs: Extended): string;

 //: 比较两的日期值是否是同月如果是为真
 function DatesInSameMonth (const DT1, DT2: TDateTime): Boolean;

 //: 比较两的日期值是否是同年如果是为真
 function DatesInSameYear (const DT1, DT2: TDateTime): Boolean;

 //: 比较两的日期值是否是同年和同月如果是为真
 function DatesInSameMonthYear (const DT1, DT2: TDateTime): Boolean;

 //:传回两个日期相减值的天数
 //例如：DaysApart是DT2减DT1
 function DaysApart (const DT1, DT2: TDateTime): LongInt;

 //传回两个日期相减值的周数
 //例如：ExactWeeksApart是DT2减DT1
 function ExactWeeksApart (const DT1, DT2: TDateTime): Extended;

 //传回两个日期相减值的周数
 //例如：ExactWeeksApart是DT2减DT1
 function WeeksApart (const DT1, DT2: TDateTime): LongInt;

 //: 如果是真表示日期为润年
 function DateIsLeapYear (const DT: TDateTime): Boolean;

 //: 传回日期值本月份的天数
 // DaysThisMonth(Now)= ，三月有31天
 function DaysThisMonth (const DT: TDateTime): Byte;

 //: 传回日期值的本年度的月份中的日数，还有几天
 //DaysLeftInMonth('2001/04/28')传回值2
 function DaysLeftInMonth (const DT: TDateTime): Byte;

 //: 传回日期值的本年度的月份中的日数，还有几天
 function DaysInMonth (const DT: TDateTime): Byte;
 //: 传回日期值的本年度的天数，如果是润年有366天；不是就有365天
 function DaysInYear (const DT: TDateTime): Word;

 //: 传回日期值中本年度已过了几天
 //例如：DayOfYear(now)=
 function DayOfYear (const DT: TDateTime): Word;

 //: 传回今天的日期在本年度过了几天
 //例如: ThisDayOfYear=
 function ThisDayOfYear: Word;

 //:传回今年度还有几天
 function DaysLeftInYear (const DT: TDateTime): Word;

 //传回日期值的季别
 //例如：WhichQuarter(now)=
 function WhichQuarter (const DT: TDateTime): Byte;

 //传回年龄，依现在其日期减出生的日期
 function AgeAtDate (const DOB, DT: TDateTime): Integer;

 //传回年龄，依现在其日期减出生的日期
 function AgeNow (const DOB: TDateTime): Integer;

 //传回年龄，依现在其日期减出生的日期
 function AgeAtDateInMonths (const DOB, DT: TDateTime): Integer;

 //传回年龄，依现在其日期减出生的日期
 function AgeNowInMonths (const DOB: TDateTime): Integer;

 //传回日期值已存活的周数
 //例如 AgeAtDateInWeeks('1963/06/24',Now)=
 function AgeAtDateInWeeks (const DOB, DT: TDateTime): Integer;

 //传回日期值已存活的周数，不同的是此函数不用第二个参数是用上一个函数完成的
 //例如 AgeNowInWeeks('1963/06/24')=
 function AgeNowInWeeks (const DOB: TDateTime): Integer;

 //可传回几岁几月几周的详细年龄
 function AgeNowDescr (const DOB: TDateTime): String;

 function CheckDate(const sCheckedDateString: string): boolean;
 //检查是否是中华民国的日期格式
 //例如：CheckDate(DatetoStr(Now))=//，传回值是Boolean

 {----------------- 周数处理用函数 --------------------}

 //将日期值转换成周数
 function DateToWeekNo (const DT: TDateTime): Integer;

 //比较两个日期值是否相同
 function DatesInSameWeekNo (const DT1, DT2: TDateTime): Boolean;

 //将两个日期相减后转成周数
 function WeekNosApart (const DT1, DT2: TDateTime): Integer;

 //传回目前日期的周数
 function ThisWeekNo: Integer;

 //传回在X的年度的第n周的时间
 //例如：GetWeekNoToDate(,)='2001/07/08'，取得值是从星期天开始
 function GetWeekNoToDate_Sun (const WeekNo, Year: Word): TDateTime;

 //传回在X的年度的第n周的时间
 //例如：GetWeekNoToDate(,)='2001/07/08'，取得值是从星期一开始
 function GetWeekNoToDate_Mon (const WeekNo, Year: Word): TDateTime;

 //传回在X的年度的第n周的时间
 //例如：DWYToDate(,,)='2001/07/10'，取得值是强制从星期天开始的
 function DWYToDate (const DOW, WeekNo, Year: Word): TDateTime;

 //将周数转换成月日格式
 //例如：WeekNoToDate()传回08/
 function WeekNoToDate(Const Weekno : Word):TDateTime;

 {--- 检查确定日期函数 ---}
 //: 如果传回值是真表示目前是一月
 function IsJanuary (const DT: TDateTime): Boolean;

 //: 如果传回值是真表示目前是二月
 function IsFebruary (const DT: TDateTime): Boolean;

 //: 如果传回值是真表示目前是三月
 function IsMarch (const DT: TDateTime): Boolean;

 //: 如果传回值是真表示目前是四月
 function IsApril (const DT: TDateTime): Boolean;

 //: 如果传回值是真表示目前是五月
 function IsMay (const DT: TDateTime): Boolean;

 //: 如果传回值是真表示目前是六月
 function IsJune (const DT: TDateTime): Boolean;

 //: 如果传回值是真表示目前是七月
 function IsJuly (const DT: TDateTime): Boolean;

 //: 如果传回值是真表示目前是八月
 function IsAugust (const DT: TDateTime): Boolean;

 //: 如果传回值是真表示目前是九月
 function IsSeptember (const DT: TDateTime): Boolean;

 //: 如果传回值是真表示目前是十月
 function IsOctober (const DT: TDateTime): Boolean;

 //: 如果传回值是真表示目前是十一月
 function IsNovember (const DT: TDateTime): Boolean;

 //: 如果传回值是真表示目前是十二月
 function IsDecember (const DT: TDateTime): Boolean;

 //: 如果传回值是真表示目前是上午
 function IsAM (const DT: TDateTime): Boolean;

 //: 如果传回值是真表示目前是下午
 function IsPM (const DT: TDateTime): Boolean;

 //: 如果传回值是真表示目前是中午
 function IsNoon (const DT: TDateTime): Boolean;

 //:如果传回值是真表示目前是夜晚
 function IsMidnight (const DT: TDateTime): Boolean;

 //: 如果传回值是真表示目前是星期天
 function IsSunday (const DT: TDateTime): Boolean;

 //: 如果日期值是星期一即为真
 function IsMonday (const DT: TDateTime): Boolean;

 //: 如果日期值是星期二即为真
 function IsTuesday (const DT: TDateTime): Boolean;

 //: 如果日期值是星期三即为真
 function IsWednesday (const DT: TDateTime): Boolean;

 //: 如果日期值是星期四即为真
 function IsThursday (const DT: TDateTime): Boolean;

 //: 如果日期值是星期五即为真
 function IsFriday (const DT: TDateTime): Boolean;

 //: 如果日期值是星期六即为真
 function IsSaturday (const DT: TDateTime): Boolean;

 //:如果日期值是星期六或日即为真
 function IsWeekend (const DT: TDateTime): Boolean;

 //: 如果日期值是星期一至五即为真
 function IsWorkDays (const DT: TDateTime): Boolean;

 function CheckLastDayOfMonth(DT : TDateTime) : Boolean;
 //检查是否是本月的最后一天

 implementation

 uses

 Windows, SysUtils, StrProcess;

 function LInt2EStr (const L: LongInt): String;
 begin
 try
 Result := IntToStr (L);
 except
 Result := '';
 end;
 end;

 function LeftStr (const S : string; const N : Integer): string;
 begin
 Result := Copy (S, , N);
 end;

 function RightAfterStr (const S : String; const N : Integer): String;
 begin
 Result := Copy (S, N + , Length (S) - N );
 end;

 function FillStr (const Ch : Char; const N : Integer): string;
 begin
 SetLength (Result, N);
 FillChar (Result [], N, Ch);
 end;

 function PadChLeftStr (const S : string; const Ch : Char;
 const Len : Integer): string;
 var
 N: Integer;
 begin
 N := Length (S);
 if N < Len then
 Result := FillStr (Ch, Len - N) + S
 else
 Result := S;
 end;

 function LInt2ZStr (const L: LongInt; const Len: Byte): String;
 begin
 Result := LInt2EStr (L);
 Result := PadChLeftStr (LeftStr (Result, Len), '', Len);
 end;

 function ReplaceChStr (const S : string;
 const OldCh, NewCh : Char): string;
 var
 I: Integer;
 begin
 Result := S;
 if OldCh = NewCh then
 Exit;
 for I :=  to Length (S) do
 if S [I] = OldCh then
 Result [I] := NewCh;
 end;

 function Str2Ext (const S: String): Extended;
 begin
 try
 Result := StrToFloat (S);
 except
 Result := ;
 end;
 end;

 function Str2Lint (const S: String): LongInt;
 begin
 try
 Result := StrToInt (S);
 except
 Result := ;
 end;
 end;

 function IsLeapYear (Year: Word): Boolean;
 begin
 Result := ((Year and ) = ) and ((Year mod  > ) or (Year mod  = ))
 end;

 function Date2Str (const DT: TDateTime): String;
 begin
 try
 if abs (DT) < 0.000001 then
 Result := ''
 else
 Result := DateToStr (DT);
 except
 Result := '';
 end;
 end;

 function GetYear (const DT: TDateTime): Word;
 var
 D, M: Word;
 begin
 DecodeDate (DT, Result, M, D);
 end;

 function GetMonth (const DT: TDateTime): Word;
 var
 D, Y : Word;
 begin
 DecodeDate (DT, Y, Result, D);
 end;

 function GetDay (const DT: TDateTime): Word;
 var
 M, Y : Word;
 begin
 DecodeDate (DT, Y, M, Result);
 end;

 function Time2Hr (const DT: TDateTime): Word;
 var
 Min, Sec, MSec: Word;
 begin
 DecodeTime (DT, Result, Min, Sec, MSec);
 end;

 function Time2Min (const DT: TDateTime): Word;
 var
 Hr, Sec, MSec: Word;
 begin
 DecodeTime (DT, Hr, Result, Sec, MSec);
 end;

 function Time2Sec (const DT: TDateTime): Word;
 var
 Hr, Min, MSec: Word;
 begin
 DecodeTime (DT, Hr, Min, Result, MSec);
 end;

 function Time2MSec (const DT: TDateTime): Word;
 var
 Hr, Min, Sec: Word;
 begin
 DecodeTime (DT, Hr, Min, Sec, Result);
 end;

 function MinutesApart (const DT1, DT2: TDateTime): Word;
 var
 Hr1, Min1, Sec1, MSec1: Word;
 Hr2, Min2, Sec2, MSec2: Word;
 begin
 DecodeTime (DT1, Hr1, Min1, Sec1, MSec1);
 DecodeTime (DT2, Hr2, Min2, Sec2, MSec2);
 if Min2 < Min1 then
 begin
 Min2 := Min2 + ;
 Dec (Hr2);
 end;
 if Hr1 > Hr2 then
 Hr2 := Hr2 + ;
 Result := (Hr2 - Hr1) *  + (Min2 - Min1);
 end;

 function AdjustDateYear (const D: TDateTime; const Year: Word): TDateTime;
 var
 Day, Month, OldYear: Word;
 begin
 DecodeDate (D, OldYear, Month, Day);
 if Year = OldYear then
 begin
 Result := Int (D);
 Exit;
 end;
 if not IsLeapYear (Year) and (Month = ) and (Day = ) then
 begin
 Month := ;
 Day := ;
 end;
 Result := EncodeDate (Year, Month, Day);
 end;

 function AddMins (const DT: TDateTime; const Mins: Extended): TDateTime;
 begin
 Result := DT + Mins / ( * )
 end;

 function AddHrs (const DT: TDateTime; const Hrs: Extended): TDateTime;
 begin
 Result := DT + Hrs / 24.0
 end;

 function AddWeeks (const DT: TDateTime; const Weeks: Extended): TDateTime;
 begin
 Result := DT + Weeks * ;
 end;

 function AddMonths (const DT: TDateTime; const Months: Extended): TDateTime;
 var
 Day, Month, Year: Word;
 IMonth: Integer;
 begin
 DecodeDate (DT, Year, Month, Day);
 IMonth := Month + Trunc (Months);

 if IMonth >  then
 begin
 Year := Year + (IMonth - ) div ;
 IMonth := IMonth mod ;
 if IMonth =  then
 IMonth := ;
 end
 else if IMonth <  then
 begin
 Year := Year + (IMonth div ) - ; // sub years;
 IMonth :=  - abs (IMonth) mod ;
 end;
      Month := IMonth;

 // Ensure Day of Month is valid
 if Month =  then
 begin
 if IsLeapYear (Year) and (Day > ) then
 Day :=
 else if not IsLeapYear (Year) and (Day > ) then
 Day := ;
 end
 else if (Month in [, , , ]) and (Day = ) then
 Day := ;

 Result := EncodeDate (Year, Month, Day) + Frac (Months) *  +
 Frac (DT);
 end;

 function AddYrs (const DT: TDateTime; const Yrs: Extended): TDateTime;
 var
 Day, Month, Year: Word;
 begin
 DecodeDate (DT, Year, Month, Day);
 Year := Year + Trunc (Yrs);
 if not IsLeapYear (Year) and (Month = ) and (Day = ) then
 Day := ;
 Result := EncodeDate (Year, Month, Day) + Frac (Yrs) * 365.25
 + Frac (DT);
 end;

 function GetLastDayofMonth (const DT: TDateTime): TDateTime;
 var
 D, M, Y: Word;
 begin
 DecodeDate (DT, Y, M, D);
 case M of
 :
 begin
 if IsLeapYear (Y) then
 D :=
 else
 D := ;
 end;
 , , , : D :=
 else
 D := ;
 end;
 Result := EncodeDate (Y, M, D) + Frac (DT);
 end;

 function GetFirstDayofMonth (const DT: TDateTime): TDateTime;
 var
 D, M, Y: Word;
 begin
 DecodeDate (DT, Y, M, D);
 Result := EncodeDate (Y, M, ) + Frac (DT);
 end;

 function GMTStr2Value(const GMTStr: string): Extended;
 var
 P: Integer;
 begin
 P := Pos (GMTStr, '+');
 if P >  then
 begin
 Result := Str2Ext (Trim (Copy (GMTStr, P + , Length (GMTStr) - P)));
 end
 else
 begin
 P := Pos (GMTStr, '-');
 if P >  then
 begin
 Result := - * Str2Ext (Trim (Copy (GMTStr, P + , Length (GMTStr) - P)));
 end
 else
 Result := ;
 end;
 end;

 function ConvertGMTStrTimes (const FromGMTStr: string; const FromDT: TDateTime;
 const ToGMTStr: string): TDateTime;
 var
 GMT1, GMT2: Extended;
 begin
 GMT1 := GMTStr2Value (FromGMTStr);
 GMT2 := GMTStr2Value (ToGMTStr);
 Result := FromDT + GMT2 - GMT1;
 end;

 function GetRFC822Difference: string;
 var
 TZ : TTimeZoneInformation;
 begin
 GetTimeZoneInformation (TZ);
 if TZ.Bias <=  then
 begin
 TZ.Bias := Abs (TZ.Bias);
 Result := '+' + LInt2ZStr (TZ.Bias div , )
 + LInt2ZStr (TZ.Bias mod , )
 end
 else
 Result := '-' + LInt2ZStr (TZ.Bias div , )
 + LInt2ZStr (TZ.Bias mod , )
 end;

 function StartOfWeek (const DT: TDateTime): TDateTime;
 begin
 Result := DT - DayOfWeek (DT) + ;
 end;

 function EndOfWeek (const DT: TDateTime): TDateTime;
 begin
 Result := DT - DayOfWeek (DT) + ;
 end;

 function ThisYear: Word;
 var
 D, M: Word;
 begin
 DeCodeDate(Now,Result,M,D) ;
 end;

 function ThisMonth: Word;
 var
 D,  Y: Word;
 begin
 DeCodeDate(Now,Y,Result,D);
 end;

 function ThisDay: Word;
 var
 M, Y: Word;
 begin
 DeCodeDate(Now,Y,M,Result);
 end;

 function ThisHr: Word;
 begin
 Result := Time2Hr (Time);
 end;

 function ThisMin: Word;
 begin
 Result := Time2Min (Time);
 end;

 function ThisSec: Word;
 begin
 Result := Time2Sec (Time);
 end;

 function IsJanuary (const DT: TDateTime): Boolean;
 begin
 Result := GetMonth(DT) = ;
 end;

 function IsFebruary (const DT: TDateTime): Boolean;
 begin
 Result := GetMonth (DT) = ;
 end;

 function IsMarch (const DT: TDateTime): Boolean;
 begin
 Result := GetMonth (DT) = ;
 end;

 function IsApril (const DT: TDateTime): Boolean;
 begin
 Result := GetMonth (DT) = ;
 end;

 function IsMay (const DT: TDateTime): Boolean;
 begin
 Result := GetMonth (DT) = ;
 end;

 function IsJune (const DT: TDateTime): Boolean;
 begin
 Result := GetMonth (DT) = ;
 end;

 function IsJuly (const DT: TDateTime): Boolean;
 begin
 Result := GetMonth (DT) = ;
 end;

 function IsAugust (const DT: TDateTime): Boolean;
 begin
 Result := GetMonth (DT) = ;
 end;

 function IsSeptember (const DT: TDateTime): Boolean;
 begin
 Result := GetMonth (DT) = ;
 end;

 function IsOctober (const DT: TDateTime): Boolean;
 begin
 Result := GetMonth (DT) = ;
 end;

 function IsNovember (const DT: TDateTime): Boolean;
 begin
 Result := GetMonth (DT) = ;
 end;

 function IsDecember (const DT: TDateTime): Boolean;
 begin
 Result := GetMonth (DT) = ;
 end;

 function Hrs_Min_Sec (Secs: Extended): string;
 const
 OneSecond = //;
 var
 Total: Extended;
 begin
 Total := Secs * OneSecond;
 Result := Format( '%1.0f 天%s', [Int (Total),
 FormatDateTime ('hh:nn:ss', Frac (total))]);
 end;

 function DatesInSameMonth (const DT1, DT2: TDateTime): Boolean;
 begin
 Result := GetMonth (DT1) = GetMonth (DT2);
 end;

 function DatesInSameYear (const DT1, DT2: TDateTime): Boolean;
 begin
 Result := GetYear (DT1) = GetYear (DT2);
 end;

 function DatesInSameMonthYear (const DT1, DT2: TDateTime): Boolean;
 begin
 Result := DatesInSameMonth (DT1, DT2) and DatesInSameYear (DT1, DT2);
 end;

 function AddDays (const DT: TDateTime; const Days: Extended): TDateTime;
 begin
 Result := DT + Days;
 end;

 function IsAM (const DT: TDateTime): Boolean;
 begin
 Result := Frac (DT) < 0.5
 end;

 function IsPM (const DT: TDateTime): Boolean;
 begin
 Result := not IsAM (DT);
 end;

 function IsNoon (const DT: TDateTime): Boolean;
 begin
 Result := Frac (DT) = 0.5;
 end;

 function IsMidnight (const DT: TDateTime): Boolean;
 begin
 Result := Frac (DT) = 0.0;
 end;

 function IsSunday (const DT: TDateTime): Boolean;
 begin
 Result := DayOfWeek (DT) = ;
 end;

 function IsMonday (const DT: TDateTime): Boolean;
 begin
 Result := DayOfWeek (DT) = ;
 end;

 function IsTuesday (const DT: TDateTime): Boolean;
 begin
 Result := DayOfWeek (DT) = ;
 end;

 function IsWednesday (const DT: TDateTime): Boolean;
 begin
 Result := DayOfWeek (DT) = ;
 end;

 function IsThursday (const DT: TDateTime): Boolean;
 begin
 Result := DayOfWeek (DT) = ;
 end;

 function IsFriday (const DT: TDateTime): Boolean;
 begin
 Result := DayOfWeek (DT) = ;
 end;

 function IsSaturday (const DT: TDateTime): Boolean;
 begin
 Result := DayOfWeek (DT) = ;
 end;

 function IsWeekend (const DT: TDateTime): Boolean;
 begin
 Result := DayOfWeek (DT) in [, ];
 end;

 function IsWorkDays (const DT: TDateTime): Boolean;
 begin
 Result := DayOfWeek (DT) in [..];
 end;

 function DaysApart (const DT1, DT2: TDateTime): LongInt;
 begin
 Result := Trunc (DT2) - Trunc (DT1);
 end;

 function DateIsLeapYear (const DT: TDateTime): Boolean;
 begin
 Result := IsLeapYear (GetYear (DT));
 end;

 function DaysThisMonth (const DT: TDateTime): Byte;
 begin
 case GetMonth (DT) of
 : if DateIsLeapYear (DT) then
 Result :=
   else
 Result := ;
 , , , : Result := ;
 else
 Result := ;
 end;
 end;

 function DaysInMonth (const DT: TDateTime): Byte;
 begin    case GetMonth (DT) of       : if DateIsLeapYear (DT) then          Result :=           else          Result := ;       , , , : Result := ;       else          Result := ;    end; End;

 function DaysLeftInMonth (const DT: TDateTime): Byte;
 begin
 Result := DaysInMonth (DT) - GetDay (DT);
 end;

 function DaysInYear (const DT: TDateTime): Word;
 begin
 if DateIsLeapYear (DT) then
 Result :=
 else
 Result := ;
 end;

 function DayOfYear (const DT: TDateTime): Word;
 begin
 Result := Trunc (DT) - Trunc (EncodeDate (GetYear (DT), , )) + ;
 end;

 function DaysLeftInYear (const DT: TDateTime): Word;
 begin
 Result := DaysInYear (DT) - DayOfYear (DT);
 end;

 function ThisDayOfYear: Word;
 begin
 Result := DayOfYear (Date);
 end;

 function WhichQuarter (const DT: TDateTime): Byte;
 begin
 Result := (GetMonth (DT) - ) div  + ;
 end;

 function GetFirstDayOfYear (const Year: Word): TDateTime;
 begin
 Result := EncodeDate (Year, , );
 end;

 function GetLastDayOfYear (const Year: Word): TDateTime;
 begin
 Result := EncodeDate (Year, , );
 end;

 function SubtractMins (const DT: TDateTime; const Mins: Extended): TDateTime;
 begin
 Result := AddMins (DT, - * Mins);
 end;

 function SubtractHrs (const DT: TDateTime; const Hrs: Extended): TDateTime;
 begin
 Result := AddHrs (DT, - * Hrs);
 end;

 function SubtractWeeks (const DT: TDateTime; const Weeks: Extended): TDateTime;
 begin
 Result := AddWeeks (DT, - * Weeks);
 end;

 function SubtractMonths (const DT: TDateTime; const Months: Extended): TDateTime;
 begin
 Result := AddMonths (DT, - * Months);
 end;

 function SubtractDays (const DT: TDateTime; const Days: Extended): TDateTime;
 begin
 Result := DT - Days;
 end;

 function AgeAtDate (const DOB, DT: TDateTime): Integer;
 var
 D1, M1, Y1, D2, M2, Y2: Word;
 begin
 if DT < DOB then
 Result := -
 else
 begin
 DecodeDate (DOB, Y1, M1, D1);
 DecodeDate (DT, Y2, M2, D2);
 Result := Y2 - Y1;
 if (M2 < M1) or ((M2 = M1) and (D2 < D1)) then
 Dec (Result);
 end;
 end;

 function AgeNow (const DOB: TDateTime): Integer;
 begin
 Result := AgeAtDate (DOB, Date);
 end;

 function EDOWToInt (const DOW: string): Integer;
 var
 UCDOW: string;
 I,N: Integer;
 begin
 Result := ;
 UCDOW := UpperCase (DOW);
 N := Length (DOW);
 for I :=  to  do
 begin
 if LeftStr (DayOfWeekStrings [I], N) = UCDOW then
 begin
 Result := I;
 Break;
 end;
 end;
 end;

 function EMonthToInt (const Month: string): Integer;
 var
 UCMonth: string;
 I,N: Integer;
 begin
 Result := ;
 UCMonth := UpperCase (Month);
 N := Length (Month);
 for I :=  to  do
 begin
 if LeftStr (MonthStrings [I], N) = UCMonth then
 begin
 Result := I;
 Break;
 end;
 end;
 end;

 function GetCMonth(const DT: TDateTime): String;
 begin
 Result :=MonthCStrings[GetMonth(DT)];
 end;

 function GetC_Today: string;
 var
 wYear, wMonth, wDay: Word;
 sYear, sMonth, sDay: string[];
 begin
 DecodeDate(Now, wYear, wMonth, wDay);
 wYear  := wYear - ;
 sYear  := Copy(IntToStr(wYear + ), , );
 sMonth := Copy(IntToStr(wMonth + ), , );
 sDay   := Copy(IntToStr(wDay + ), , );
 Result := sYear + DateSeparator + sMonth + DateSeparator + sDay;
 end;

 Function TransC_DateToE_Date(Const CDT :String) :TDateTime;
 Var  iYear,iMonth,iDay:Word;
 Begin
   if Length(CDT) <>  then Exit;
 if Pos(' ',CDT ) <>  then Exit;
   (* 民国日期 -> 公元日期 *)
 iYear := StrToInt(Copy(CDT, , )) + ;
 iMonth := StrToInt(Copy(CDT, , ));
 iDay:= StrToInt(Copy(CDT, , ));
   Result:=EncodeDate(iYear,iMonth,iDay);
 End;

 function GetCWeek(const DT: TDateTime): String;
 begin
 Result :=DayOfCWeekStrings[DayOfWeek(DT)];
 end;

 function GetLastDayForMonth(const DT: TDateTime):TDateTime;
 Var Y,M,D :Word;
 Begin
 DecodeDate(DT,Y,M,D);
 Case M of
 : Begin
 If IsLeapYear(Y) then
 D:=
 Else
 D:=;
 End;
 ,,,:D:=
 Else
 D:=;
 End;
 Result:=EnCodeDate(Y,M,D);
 End;

 function GetFirstDayForMonth (const DT : TDateTime): TDateTime;
 Var  Y,M,D:Word;
 Begin
      DecodeDate(DT,Y,M,D);
 //DecodeDate(DT,Y,M,);
 Result := EncodeDate (Y, M, );
 End;

 function GetLastDayForPeriorMonth(const DT: TDateTime):TDateTime;
 Var  Y,M,D:Word;
 Begin
 DecodeDate(DT,Y,M,D);
    M:=M-;
 Case M of
 : Begin
 If IsLeapYear(Y) then
 D:=
 Else
 D:=;
 End;
 ,,,:D:=
 Else
 D:=;
 End;
 Result:=EnCodeDate(Y,M,D);
 End;

 function GetFirstDayForPeriorMonth (const DT :TDateTime): TDateTime;
 Var  Y,M,D:Word;
 Begin
      DecodeDate(DT,Y,M,D);
 M:=M-;
 Result := EncodeDate (Y, M, );
 End;

 function ROCDATE(DD:TDATETIME;P:integer):string; {转换某日期为民国0YYMMDD 型式字符串 }
 var YEAR,MONTH,DAY : WORD;  {P=0 不加'年'+'月'+'日'}
 Y,CY,M,D,LONGY : string;  {P=1 加'年'+'月'+'日'}
 YY:integer;
 begin
 DECODEDATE(DD,YEAR,MONTH,DAY);

 if (year=) and (month=) and (day=) then
 begin
 Result:='';
 exit;
 end;

 YY:=YEAR-;
 if YY> then
 begin
 CY:=inttostr(YY);
 if Length(CY)= then CY:=''+CY;
 if Length(CY)= then CY:=''+CY;
 end
 else
 begin
 YY:=YEAR-;
 CY:=inttostr(YY);
 if Length(CY)= then CY:='-0'+RIGHT(CY,);
 end;

 if strtoint(CY)> then
 CY:='XXX';

 if (CY<>'XXX') and (strtoint(CY)<-) then
 CY:='-XX';

 M:=inttostr(MONTH);
 if Length(M)= then M:=''+M;
 D:=inttostr(DAY);
    if Length(D)= then D:=''+D;

 if P= then
  Result:=CY+ DateSeparator+M+ DateSeparator+D
 else
  Result:=CY+'年'+M+'月'+D+'日';

 end;

 function ExactWeeksApart (const DT1, DT2: TDateTime): Extended;
 begin
 Result := DaysApart (DT1, DT2) / ;
 end;

 function WeeksApart (const DT1, DT2: TDateTime): Integer;
 begin
 Result := DaysApart (DT1, DT2) div ;;
 end;

 function GetFirstSundayOfYear (const Year: Word): TDateTime;
 var
 StartYear: TDateTime;
 begin
 StartYear := GetFirstDayOfYear (Year);
 if DayOfWeek (StartYear) =  then
 Result := StartYear
 else
 Result := StartOfWeek (StartYear) + ;
 end;

 function GetMDY (const DT: TDateTime): String;

 Begin
    Result := FormatDateTime('MM/DD/YY',DT);
 End;

 function DateToWeekNo (const DT: TDateTime): Integer;
 var
 Year: Word;
 FirstSunday, StartYear: TDateTime;
 WeekOfs: Byte;
 begin
 Year := GetYear (DT);
 StartYear := GetFirstDayOfYear (Year);
 if DayOfWeek (StartYear) =  then
 begin
 FirstSunday := StartYear;
 WeekOfs := ;
 end
 else
 begin
 FirstSunday := StartOfWeek (StartYear) + ;
 WeekOfs := ;
 if DT < FirstSunday then
 begin
 Result := ;
 Exit;
 end;
 end;
 Result := DaysApart (FirstSunday, StartofWeek (DT)) div  + WeekOfs;
 end;

 function DatesInSameWeekNo (const DT1, DT2: TDateTime): Boolean;
 begin
 if GetYear (DT1) <> GetYear (DT2) then
 Result := False
 else
 Result := DateToWeekNo (DT1) = DateToWeekNo (DT2);
 end;

 function WeekNosApart (const DT1, DT2: TDateTime): Integer;
 begin
 if GetYear (DT1) <> GetYear (DT2) then
 Result := -
 else
 Result := DateToWeekNo (DT2) - DateToWeekNo (DT1);
 end;

 function ThisWeekNo: Integer;
 begin
 Result := DateToWeekNo (Date);
 end;

 function GetWeekNoToDate_Sun (const WeekNo, Year: Word): TDateTime;
 var
 FirstSunday: TDateTime;
 begin
 FirstSunday := GetFirstSundayOfYear (Year);
 if GetDay (FirstSunday) =  then
 Result := AddWeeks (FirstSunday, WeekNo - )
 else
 Result := AddWeeks (FirstSunday, WeekNo - )
 end;

 function GetWeekNoToDate_Mon (const WeekNo, Year: Word): TDateTime;
 begin
 Result := GetWeekNoToDate_Sun (WeekNo, Year) + ;
 end;

 function DWYToDate (const DOW, WeekNo, Year: Word): TDateTime;
 begin
 Result := GetWeekNoToDate_Sun (WeekNo, Year) + DOW - ;
 end;

 function AgeAtDateInMonths (const DOB, DT: TDateTime): Integer;
 var
    D1, D2 : Word;
    M1, M2 : Word;
    Y1, Y2 : Word;
 begin
 if DT < DOB then
 Result := -
 else
 begin
 DecodeDate (DOB, Y1, M1, D1);
 DecodeDate (DT, Y2, M2, D2);
 if Y1 = Y2 then // Same Year
 Result := M2 - M1
 else // 不同年份
 begin
 // 前12月的年龄
 Result :=  * AgeAtDate (DOB, DT);
 if M1 > M2 then
 Result := Result + ( - M1) + M2
 else if M1 < M2 then
 Result := Result + M2 - M1
 else if D1 > D2 then // Same Month
 Result := Result + ;
 end;
 if D1 > D2 then // we have counted one month too many
 Dec (Result);
 end;
 end;

 function WeekNoToDate(Const Weekno : Word):TDateTime;
 Begin
    Result :=AddDays(GetWeekNoToDate_Sun(WeekNo,GetYear(Now)),);
 End;

 function AgeAtDateInWeeks (const DOB, DT: TDateTime): Integer;
 begin
 if DT < DOB then
 Result := -
 else
 begin
 Result := Trunc (DT - DOB) div ;
 end;
 end;

 function AgeNowInMonths (const DOB: TDateTime): Integer;
 begin
 Result := AgeAtDateInMonths (DOB, Date);
 end;

 function AgeNowInWeeks (const DOB: TDateTime): Integer;
 begin
 Result := AgeAtDateInWeeks (DOB, Date);
 end;

 function AgeNowDescr (const DOB: TDateTime): String;
 var
 Age : integer;
 begin
 Age := AgeNow (DOB);
 if Age >  then
 begin
 if Age =  then
 Result := LInt2EStr (Age) + ' 岁'
 else
 Result := LInt2EStr (Age) + ' 岁';
 end
 else
 begin
 Age := AgeNowInMonths (DOB);
 if Age >=  then
 Result := LInt2EStr(Age) + ' 月'
 else
 begin
 Age := AgeNowInWeeks (DOB);
 if Age =  then
 Result := LInt2EStr(Age) + ' 周'
 else
 Result := LInt2EStr(Age) + ' 周';
 end;
 end;
 end;

 function CheckDate(const sCheckedDateString: string): boolean;
 var
 iYear, iMonth, iDay: word;
 begin
 Result := False;
 (* 格式检查 *)
 if Length(sCheckedDateString) <>  then Exit;
 if Pos(' ', sCheckedDateString) <>  then Exit;
 if (sCheckedDateString[] <> DateSeparator) or
 (sCheckedDateString[] <> DateSeparator) then Exit;

 (* 民国日期 -> 公元日期 *)
 iYear := StrToInt(Copy(sCheckedDateString, , )) + ;
 iMonth := StrToInt(Copy(sCheckedDateString, , ));
 iDay := StrToInt(Copy(sCheckedDateString, , ));

 (* 日之判断 *)
 if iDay <  then Exit;
 case iMonth of
 , , , , , , : Result := iDay <= ; (* 大月 *)
 , , , : Result := iDay <= ; (* 小月 *)
 :  (* 依闰年计算法判断 *)
 if (iYear mod  = ) or
 ( (iYear mod  = ) and (iYear Mod  <> ) ) then
 (* 闰年 *)
 Result := iDay <=
 else
 Result := iDay <= ;
 end;
 end;

 function CheckLastDayOfMonth(DT : TDateTime) : Boolean;
 var
 D, M, Y: Word; Begin DecodeDate (DT, Y, M, D);
 If M in [,,,]  then begin
 If D =  then
 Result:= True
 Else
 Result:= False;
 End;
 If M in [,,,,,,]  then Begin
 If D =  then
 Result:= True
 Else
 Result:= False;
 End;
 if M= then begin
 if IsLeapYear (Y) and (D=) or Not IsLeapYear (Y) and (D=) then
 Begin
 Result:= True; end else Begin Result:= False; end; End;end;

 end.