dateprocess.pas

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

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 + 60;
Dec (Hr2);
end;
if Hr1 > Hr2 then
Hr2 := Hr2 + 24;
Result := (Hr2 - Hr1) * 60 + (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 = 2) and (Day = 29) then
begin
Month := 3;
Day := 1;
end;
Result := EncodeDate (Year, Month, Day);
end;

function AddMins (const DT: TDateTime; const Mins: Extended): TDateTime;
begin
Result := DT + Mins / (60 * 24)
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 * 7;
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 > 12 then
begin
Year := Year + (IMonth - 1) div 12;
IMonth := IMonth mod 12;
if IMonth = 0 then
IMonth := 12;
end
else if IMonth < 1 then
begin
Year := Year + (IMonth div 12) - 1; // sub years;
IMonth := 12 - abs (IMonth) mod 12;
end;
     Month := IMonth;

// Ensure Day of Month is valid
if Month = 2 then
begin
if IsLeapYear (Year) and (Day > 29) then
Day := 29
else if not IsLeapYear (Year) and (Day > 28) then
Day := 28;
end
else if (Month in [9, 4, 6, 11]) and (Day = 31) then
Day := 30;

Result := EncodeDate (Year, Month, Day) + Frac (Months) * 30 +
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 = 2) and (Day = 29) then
Day := 28;
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
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) + Frac (DT);
end;

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

function GMTStr2Value(const GMTStr: string): Extended;
var
P: Integer;
begin
P := Pos (GMTStr, '+');
if P > 0 then
begin
Result := Str2Ext (Trim (Copy (GMTStr, P + 1, Length (GMTStr) - P)));
end
else
begin
P := Pos (GMTStr, '-');
if P > 0 then
begin
Result := -1 * Str2Ext (Trim (Copy (GMTStr, P + 1, Length (GMTStr) - P)));
end
else
Result := 0;
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 <= 0 then
begin
TZ.Bias := Abs (TZ.Bias);
Result := '+' + LInt2ZStr (TZ.Bias div 60, 2)
+ LInt2ZStr (TZ.Bias mod 60, 2)
end
else
Result := '-' + LInt2ZStr (TZ.Bias div 60, 2)
+ LInt2ZStr (TZ.Bias mod 60, 2)
end;

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

function EndOfWeek (const DT: TDateTime): TDateTime;
begin
  Result := DT - DayOfWeek (DT) + 7;
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) = 1;
end;

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

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

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

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

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

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

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

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

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

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

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

function Hrs_Min_Sec (Secs: Extended): string;
const
OneSecond = 1/24/3600;
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) = 1;
end;

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

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

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

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

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

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

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

function IsWorkDays (const DT: TDateTime): Boolean;
begin
Result := DayOfWeek (DT) in [2..6];
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
2: if DateIsLeapYear (DT) then
Result := 29
  else
Result := 28;
4, 6, 9, 11: Result := 30;
else
Result := 31;
end;
end;

function DaysInMonth (const DT: TDateTime): Byte;
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;

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 := 366
else
Result := 365;
end;

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

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