dateprocess.pas

来自「delphi框架可以学习, 写的很好的」· PAS 代码 · 共 1,406 行 · 第 1/3 页

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

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

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

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

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

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

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

function SubtractMonths (const DT: TDateTime; const Months: Extended): TDateTime;
begin
Result := AddMonths (DT, -1 * 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 := -1
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 := 0;
UCDOW := UpperCase (DOW);
N := Length (DOW);
for I := 1 to 7 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 := 0;
UCMonth := UpperCase (Month);
N := Length (Month);
for I := 1 to 12 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[2];
begin
DecodeDate(Now, wYear, wMonth, wDay);
wYear  := wYear - 1911;
sYear  := Copy(IntToStr(wYear + 1000), 3, 2);
sMonth := Copy(IntToStr(wMonth + 100), 2, 2);
sDay   := Copy(IntToStr(wDay + 100), 2, 2);
Result := sYear + DateSeparator + sMonth + DateSeparator + sDay;
end;

Function TransC_DateToE_Date(Const CDT :String) :TDateTime;
Var  iYear,iMonth,iDay:Word;
Begin
  if Length(CDT) <> 12 then Exit;
if Pos(' ',CDT ) <> 0 then Exit;
  (* 民国日期 -> 公元日期 *)
iYear := StrToInt(Copy(CDT, 1, 2)) + 1911;
iMonth := StrToInt(Copy(CDT, 5, 2));
iDay:= StrToInt(Copy(CDT, 9, 2));
  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
2: Begin
If IsLeapYear(Y) then
D:=29
Else
D:=28;
End;
4,6,9,11:D:=30
Else
D:=31;
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,1);
Result := EncodeDate (Y, M, 1);
End;

function GetLastDayForPeriorMonth(const DT: TDateTime):TDateTime;
Var  Y,M,D:Word;
Begin
DecodeDate(DT,Y,M,D);
   M:=M-1;
Case M of
2: Begin
If IsLeapYear(Y) then
D:=29
Else
D:=28;
End;
4,6,9,11:D:=30
Else
D:=31;
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-1;
Result := EncodeDate (Y, M, 1);
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=0) and (month=0) and (day=0) then
  begin
    Result:='';
    exit;
  end;

  YY:=YEAR-1911;
  if YY>0 then
  begin
    CY:=inttostr(YY);
    if Length(CY)=1 then CY:='00'+CY;
    if Length(CY)=2 then CY:='0'+CY;
    end
    else begin
      YY:=YEAR-1912;
      CY:=inttostr(YY);
      if Length(CY)=2 then CY:='-0'+COPY(CY,2,1);
  end;

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

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

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

if P=0 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) / 7;
end;

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

function GetFirstSundayOfYear (const Year: Word): TDateTime;
var
StartYear: TDateTime;
begin
StartYear := GetFirstDayOfYear (Year);
if DayOfWeek (StartYear) = 1 then
Result := StartYear
else
Result := StartOfWeek (StartYear) + 7;
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) = 0 then
  begin
    FirstSunday := StartYear;
    WeekOfs := 1;
  end
  else begin
    FirstSunday := StartOfWeek (StartYear) + 7;
    WeekOfs := 2;
    if DT < FirstSunday then
    begin
      Result := 1;
      Exit;
    end;
  end;
  Result := DaysApart (FirstSunday, StartofWeek (DT)) div 7 + 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 := -999
  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) = 1 then
    Result := AddWeeks (FirstSunday, WeekNo - 1)
  else
    Result := AddWeeks (FirstSunday, WeekNo - 2)
end;

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

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

function AgeAtDateInMonths (const DOB, DT: TDateTime): Integer;
var
   D1, D2 : Word;
   M1, M2 : Word;
   Y1, Y2 : Word;
begin
if DT < DOB then
Result := -1
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 := 12 * AgeAtDate (DOB, DT);
if M1 > M2 then
Result := Result + (12 - M1) + M2
else if M1 < M2 then
Result := Result + M2 - M1
else if D1 > D2 then // Same Month
Result := Result + 12;
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)),1);
End;

function AgeAtDateInWeeks (const DOB, DT: TDateTime): Integer;
begin
if DT < DOB then
Result := -1
else
begin
Result := Trunc (DT - DOB) div 7;
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 > 0 then
  begin
  if Age = 1 then
    Result := LInt2EStr (Age) + ' 岁'
  else
    Result := LInt2EStr (Age) + ' 岁';
  end
  else begin
    Age := AgeNowInMonths (DOB);
    if Age >= 2 then
      Result := LInt2EStr(Age) + ' 月'
    else begin
      Age := AgeNowInWeeks (DOB);
      if Age = 1 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) <> 8 then Exit;
  if Pos(' ', sCheckedDateString) <> 0 then Exit;
  if (sCheckedDateString[3] <> DateSeparator) or
     (sCheckedDateString[6] <> DateSeparator) then Exit;

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

  (* 日之判断 *)
  if iDay < 0 then Exit;
  case iMonth of
    1, 3, 5, 7, 8, 10, 12: Result := iDay <= 31; (* 大月 *)
    4, 6, 9, 11: Result := iDay <= 30; (* 小月 *)
    2:  (* 依闰年计算法判断 *)
      if (iYear mod 400 = 0) or
         ((iYear mod 4 = 0) and (iYear Mod 100 <> 0) ) then
         (* 闰年 *)
         Result := iDay <= 29
      else
         Result := iDay <= 28;
  end;
end;


function CheckLastDayOfMonth(DT : TDateTime) : Boolean;
var
  D, M, Y: Word;
Begin DecodeDate (DT, Y, M, D);
  If M in [4,6,9,11]  then
  begin
    If D = 30 then Result:= True
              Else Result:= False;
  End;

  If M in [1,3,5,7,8,10,12]  then
  Begin
    If D = 31 then Result:= True
              Else Result:= False;
End;

if IsLeapYear (Y) and (D=29) or Not IsLeapYear (Y) and (D=28) then
Begin
  Result:= True; end else Begin Result:= False; end;
End;

end.