jcldatetime.pas

East make Tray Icon in delphi

// http://www.phys.uu.nl/~vgent/calendar/isocalendar.htm

function IsISOLongYear(const DateTime: TDateTime): Boolean;
var
  TmpYear: Word;
begin
  TmpYear := YearOfDate(DateTime);
  Result := IsISOLongYear(TmpYear);
end;

function IsISOLongYear(const Year: Word): Boolean;
var
  TmpWeekday: Word;
begin
  TmpWeekday := ISODayOfWeek(DayOfTheYearToDateTime(Year, 1));
  Result := (IsLeapYear(Year) and ((TmpWeekday = 3) or (TmpWeekday = 4))) or (TmpWeekday = 4);
end;

function GetISOYearNumberOfDays(const Year: Word): Word;
begin
  Result := 52;
  if IsISOLongYear(Year) then
    Result := 53;
end;

// ISOWeekNumber function returns Integer 1..7 equivalent to Sunday..Saturday.
// ISO 8601 weeks start with Monday and the first week of a year is the one which
// includes the first Thursday

function ISOWeekNumber(DateTime: TDateTime; var YearOfWeekNumber, WeekDay: Integer): Integer;
var
 TmpYear: Integer;
 January4th: TDateTime;
 FirstMonday: TDateTime;
begin
  // Applying the rule: The first calender week is the week that includes January, 4th
  TmpYear := YearOfDate(DateTime);
  WeekDay := ISODayOfWeek(DateTime);
  // adjust if we are between 12/29 and 12/31
  if (MonthOfDate(DateTime) = 12) and (DayOfDate(DateTime) >= 29) and
    (ISODayOfWeek(DateTime) <= 3) then
    TmpYear := TmpYear + 1;

  January4th := DayOfTheYearToDateTime(TmpYear, 4);
  FirstMonday := January4th + 1 - ISODayOfWeek(January4th);

  // If our date is < FirstMonday we are in the last week of the previous year
  if DateTime < FirstMonday then
  begin
    Result := GetISOYearNumberOfDays(TmpYear - 1);
    YearOfWeekNumber := TmpYear - 1;
    Exit;
  end
  else
  begin
    YearOfWeekNumber := TmpYear;
    Result := (Trunc(DateTime - FirstMonday) div 7) + 1;
  end;

  if Result > GetISOYearNumberOfDays(YearOfDate(DateTime)) then
    Result := GetISOYearNumberOfDays(YearOfDate(DateTime));
end;

function ISOWeekNumber(DateTime: TDateTime; var YearOfWeekNumber: Integer): Integer;
var
  Temp: Integer;
begin
  Result := ISOWeekNumber(DateTime, YearOfWeekNumber, Temp);
end;

function ISOWeekNumber(DateTime: TDateTime): Integer;
var
  Temp: Integer;
begin
  Result := ISOWeekNumber(DateTime, Temp, Temp);
end;

function ISOWeekToDateTime(const Year, Week, Day: Integer): TDateTime;
var
 January4th: TDateTime;
 FirstMonday: TDateTime;
begin
  January4th := DayOfTheYearToDateTime(Year, 4);
  FirstMonday := January4th + 1 - ISODayOfWeek(January4th);
  Result := FirstMonday + (Week - 1) * 7 + (Day - 1);
end;

// The original Gregorian rule for all who want to learn it
// Result := (Year mod 4 = 0) and ((Year mod 100 <> 0) or (Year mod 400 = 0));

function IsLeapYear(const Year: Integer): Boolean;
begin
  Result := SysUtils.IsLeapYear(Year);
end;

function IsLeapYear(const DateTime: TDateTime): Boolean;
begin
  Result := IsLeapYear(YearOfDate(DateTime));
end;

function Make4DigitYear(Year, Pivot: Integer): Integer;
begin
  { TODO : Make4DigitYear }                                                                                                  
  Assert((Year >= 0) and (Year <= 100) and (Pivot >= 0) and (Pivot <= 100));
  if Year = 100 then
    Year := 0;
  if Pivot = 100 then
    Pivot := 0;
  if Year < Pivot then
    Result := 2000 + Year
  else
    Result := 1900 + Year;
end;

// "window" technique for years to translate 2 digits to 4 digits.
// The window is 100 years wide
// The windowsill year is the lower edge of the window
// A windowsill year of 1900 is equivalent to putting 1900 before every 2-digit year
// if WindowsillYear is 1940, then 40 is interpreted as 1940, 00 as 2000 and 39 as 2039
// The system default is 1950

function MakeYear4Digit(Year, WindowsillYear: Integer): Integer;
var
  CC, Y: Integer;
begin
  // have come across this specific problem : y2K read as year 100
  if Year = 100 then
    Year := 0;
  // turn 2 digit years to 4 digits
  Y := Year mod 100;
  CC := (WindowsillYear div 100) * 100;
  Result := Y + CC;  // give the result the same century as the windowsill
  if Result < WindowsillYear then   // cannot be lower than the windowsill
    Result := Result + 100;
  if (Year >= 100) or (Year < 0) then
    Assert(Year = Result);  // Assert: no unwanted century translation
end;

// Calculates and returns Easter Day for specified year.
// Originally from Mark Lussier, AppVision <MLussier att best dott com>.
// Corrected to prevent integer overflow if it is inadvertedly
// passed a year of 6554 or greater.

function EasterSunday(const Year: Integer): TDateTime;
var
  Month, Day, Moon, Epact, Sunday,
  Gold, Cent, Corx, Corz: Integer;
begin
  { The Golden Number of the year in the 19 year Metonic Cycle: }
  Gold := Year mod 19 + 1;
  { Calculate the Century: }
  Cent := Year div 100 + 1;
  { Number of years in which leap year was dropped in order... }
  { to keep in step with the sun: }
  Corx := (3 * Cent) div 4 - 12;
  { Special correction to syncronize Easter with moon's orbit: }
  Corz := (8 * Cent + 5) div 25 - 5;
  { Find Sunday: }
  Sunday := (Longint(5) * Year) div 4 - Corx - 10;
              { ^ To prevent overflow at year 6554}
  { Set Epact - specifies occurrence of full moon: }
  Epact := (11 * Gold + 20 + Corz - Corx) mod 30;
  if Epact < 0 then
    Epact := Epact + 30;
  if ((Epact = 25) and (Gold > 11)) or (Epact = 24) then
    Epact := Epact + 1;
  { Find Full Moon: }
  Moon := 44 - Epact;
  if Moon < 21 then
    Moon := Moon + 30;
  { Advance to Sunday: }
  Moon := Moon + 7 - ((Sunday + Moon) mod 7);
  if Moon > 31 then
  begin
    Month := 4;
    Day := Moon - 31;
  end
  else
  begin
    Month := 3;
    Day := Moon;
  end;
  Result := EncodeDate(Year, Month, Day);
end;

// Conversion

{$IFDEF MSWINDOWS}
function DateTimeToLocalDateTime(DateTime: TDateTime): TDateTime;
var
  TimeZoneInfo: TTimeZoneInformation;
begin
  FillChar(TimeZoneInfo, SizeOf(TimeZoneInfo), #0);
  case GetTimeZoneInformation(TimeZoneInfo) of
    TIME_ZONE_ID_STANDARD, TIME_ZONE_ID_UNKNOWN:
      Result := DateTime - (TimeZoneInfo.Bias + TimeZoneInfo.StandardBias) / MinutesPerDay;
    TIME_ZONE_ID_DAYLIGHT:
      Result := DateTime - (TimeZoneInfo.Bias + TimeZoneInfo.DaylightBias) / MinutesPerDay;
  else
    raise EJclDateTimeError.CreateRes(@RsMakeUTCTime);
  end;
end;
{$ENDIF MSWINDOWS}

{$IFDEF UNIX}
function DateTimeToLocalDateTime(DateTime: TDateTime): TDateTime;
var
  TimeNow: time_t;
  Local, UTCTime: TUnixTime;
  Offset: Double;
begin
  TimeNow := __time(nil);
  UTCTime := gmtime(@TimeNow)^;
  Local   := localtime(@TimeNow)^;
  Offset  := difftime(mktime(UTCTime), mktime(Local));
  Result  := ((DateTime * SecsPerDay) - Offset) / SecsPerDay;
end;
{$ENDIF UNIX}

{$IFDEF MSWINDOWS}
function LocalDateTimeToDateTime(DateTime: TDateTime): TDateTime;
var
  TimeZoneInfo: TTimeZoneInformation;
begin
  FillChar(TimeZoneInfo, SizeOf(TimeZoneInfo), #0);
  case GetTimeZoneInformation(TimeZoneInfo) of
    TIME_ZONE_ID_STANDARD, TIME_ZONE_ID_UNKNOWN:
      Result := DateTime + (TimeZoneInfo.Bias + TimeZoneInfo.StandardBias) / MinutesPerDay;
    TIME_ZONE_ID_DAYLIGHT:
      Result := DateTime + (TimeZoneInfo.Bias + TimeZoneInfo.DaylightBias) / MinutesPerDay;
  else
    raise EJclDateTimeError.CreateRes(@RsMakeUTCTime);
  end;
end;
{$ENDIF MSWINDOWS}

{$IFDEF UNIX}
function LocalDateTimeToDateTime(DateTime: TDateTime): TDateTime;
var
  TimeNow: time_t;
  Local, UTCTime: TUnixTime;
  Offset: Double;
begin
  TimeNow := __time(nil);
  UTCTime := gmtime(@TimeNow)^;
  Local   := localtime(@TimeNow)^;
  Offset  := difftime(mktime(UTCTime), mktime(Local));
  Result  := ((DateTime * SecsPerDay) + Offset) / SecsPerDay;
end;
{$ENDIF UNIX}

function HoursToMSecs(Hours: Integer): Integer;
begin
  Assert(Hours < MaxInt / MsecsPerHour);
  Result := Hours * MsecsPerHour;
end;

function MinutesToMSecs(Minutes: Integer): Integer;
begin
  Assert(Minutes < MaxInt div MsecsPerMinute);
  Result := Minutes * MsecsPerMinute;
end;

function SecondsToMSecs(Seconds: Integer): Integer;
begin
  Assert(Seconds < MaxInt div 1000);
  Result := Seconds * 1000;
end;

// using system calls this can be done like this:
// var
//  SystemTime: TSystemTime;
// begin
//  ResultCheck(FileTimeToSystemTime(FileTime, SystemTime));
//  Result := SystemTimeToDateTime(SystemTime);

function FileTimeToDateTime(const FileTime: TFileTime): TDateTime;
begin
  Result := Int64(FileTime) / FileTimeStep;
  Result := Result + FileTimeBase;
end;

{$IFDEF MSWINDOWS}

function FileTimeToLocalDateTime(const FileTime: TFileTime): TDateTime;
var
  LocalFileTime: TFileTime;
begin
  ResultCheck(FileTimeToLocalFileTime(FileTime, LocalFileTime));
  Result := FileTimeToDateTime(LocalFileTime);
  { TODO : daylight saving time }
end;

function LocalDateTimeToFileTime(DateTime: TDateTime): FileTime;
var
  LocalFileTime: TFileTime;
begin
  LocalFileTime := DateTimeToFileTime(DateTime);
  ResultCheck(LocalFileTimeToFileTime(LocalFileTime, Result));
  { TODO : daylight saving time }
end;

{$ENDIF MSWINDOWS}

function DateTimeToFileTime(DateTime: TDateTime): TFileTime;
var
  E: Extended;
  F64: Int64;
begin
  E := (DateTime - FileTimeBase) * FileTimeStep;
  F64 := Round(E);
  Result := TFileTime(F64);
end;

{$IFDEF MSWINDOWS}

function DosDateTimeToSystemTime(const DosTime: TDosDateTime): TSystemTime;
var
  FileTime: TFileTime;
begin
  FileTime := DosDateTimeToFileTime(DosTime);
  Result := FileTimeToSystemTime(FileTime);
end;

function SystemTimeToDosDateTime(const SystemTime: TSystemTime): TDosDateTime;
var
  FileTime: TFileTime;
begin
  FileTime := SystemTimeToFileTime(SystemTime);
  Result := FileTimeToDosDateTime(FileTime);
end;

{$ENDIF MSWINDOWS}

// DosDateTimeToDateTime performs the same action as SysUtils.FileDateToDateTime
// not using SysUtils.FileDateToDateTime this can be done like that:
// var
//  FileTime: TFileTime;
//  SystemTime: TSystemTime;
//  begin
//  ResultCheck(DosDateTimeToFileTime(HiWord(DosTime), LoWord(DosTime), FileTime));
//  ResultCheck(FileTimeToSystemTime(FileTime, SystemTime));
//  Result := SystemTimeToDateTime(SystemTime);

function DosDateTimeToDateTime(const DosTime: TDosDateTime): TDateTime;
begin
  Result := SysUtils.FileDateToDateTime(DosTime);
end;

// DateTimeToDosDateTime performs the same action as SysUtils.DateTimeToFileDate
// not using SysUtils.DateTimeToDosDateTime this can be done like that:
// var
//  SystemTime: TSystemTime;
//  FileTime: TFileTime;
//  Date, Time: Word;
// begin
//  DateTimeToSystemTime(DateTime, SystemTime);
//  ResultCheck(SystemTimeToFileTime(SystemTime, FileTime));
//  ResultCheck(FileTimeToDosDateTime(FileTime, Date, Time));
//  Result := (Date shl 16) or Time;

function DateTimeToDosDateTime(const DateTime: TDateTime): TDosDateTime;
begin
  Result := SysUtils.DateTimeToFileDate(DateTime);
end;

{$IFDEF MSWINDOWS}

function FileTimeToSystemTime(const FileTime: TFileTime): TSystemTime; overload;
begin
  ResultCheck(Windows.FileTimeToSystemTime(FileTime, Result));
end;

procedure FileTimeToSystemTime(const FileTime: TFileTime; var ST: TSystemTime); overload;
begin
  Windows.FileTimeToSystemTime(FileTime, ST);
end;

function SystemTimeToFileTime(const SystemTime: TSystemTime): TFileTime;  overload;
begin
  ResultCheck(Windows.SystemTimeToFileTime(SystemTime, Result));
end;

procedure SystemTimeToFileTime(const SystemTime: TSystemTime; FTime: TFileTime); overload;
begin
  Windows.SystemTimeToFileTime(SystemTime, FTime);
end;

function DateTimeToSystemTime(DateTime: TDateTime): TSystemTime;  overload;
begin
  SysUtils.DateTimeToSystemTime(DateTime, Result);
end;

procedure DateTimeToSystemTime(DateTime: TDateTime; var SysTime : TSystemTime); overload;
begin
  SysUtils.DateTimeToSystemTime(DateTime, SysTime);
end;

function DosDateTimeToFileTime(DosTime: TDosDateTime): TFileTime; overload;
begin
  ResultCheck(Windows.DosDateTimeToFileTime(HIWORD(DosTime), LOWORD(DosTime), Result));
end;

procedure DosDateTimeToFileTime(DTH, DTL: Word; FT: TFileTime); overload;
begin
  Windows.DosDateTimeToFileTime(DTH, DTL, FT);
end;

function FileTimeToDosDateTime(const FileTime: TFileTime): TDosDateTime; overload;
var
  Date, Time: Word;
begin
  ResultCheck(Windows.FileTimeToDosDateTime(FileTime, Date, Time));
  Result := (Date shl 16) or Time;
end;

procedure FileTimeToDosDateTime(const FileTime: TFileTime; var Date, Time: Word); overload;
begin
  Windows.FileTimeToDosDateTime(FileTime, Date, Time);
end;