stdate.pas

条码控件： 一维条码控件 二维条码控件 PDF417Barcode MaxiCodeBarcode

(* ***** BEGIN LICENSE BLOCK *****
 * Version: MPL 1.1
 *
 * The contents of this file are subject to the Mozilla Public License Version
 * 1.1 (the "License"); you may not use this file except in compliance with
 * the License. You may obtain a copy of the License at
 * http://www.mozilla.org/MPL/
 *
 * Software distributed under the License is distributed on an "AS IS" basis,
 * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
 * for the specific language governing rights and limitations under the
 * License.
 *
 * The Original Code is TurboPower SysTools
 *
 * The Initial Developer of the Original Code is
 * TurboPower Software
 *
 * Portions created by the Initial Developer are Copyright (C) 1996-2002
 * the Initial Developer. All Rights Reserved.
 *
 * Contributor(s):
 *
 * ***** END LICENSE BLOCK ***** *)

{*********************************************************}
{* SysTools: StDate.pas 4.03                             *}
{*********************************************************}
{* SysTools: Date and time manipulation                  *}
{*********************************************************}

{$I StDefine.inc}

{For BCB 3.0 package support.}
{$IFDEF VER110}
  {$ObjExportAll On}
{$ENDIF}

unit StDate;

interface

uses
  Windows, SysUtils;

type
  TStDate = LongInt;
    {In STDATE, dates are stored in long integer format as the number of days
    since January 1, 1600}

  TDateArray = array[0..(MaxLongInt div SizeOf(TStDate))-1] of TStDate;
    {Type for StDate open array}

  TStDayType = (Sunday, Monday, Tuesday, Wednesday, Thursday, Friday, Saturday);
    {An enumerated type used when representing a day of the week}

  TStBondDateType = (bdtActual, bdt30E360, bdt30360, bdt30360psa);
    {An enumerated type used for calculating bond date differences}

  TStTime = LongInt;
    {STDATE handles time in a manner similar to dates, representing a given
    time of day as the number of seconds since midnight}

  TStDateTimeRec =
    record
     {This record type simply combines the two basic date types defined by
      STDATE, Date and Time}
      D : TStDate;
      T : TStTime;
    end;

const
  MinYear = 1600;        {Minimum valid year for a date variable}
  MaxYear = 3999;        {Maximum valid year for a date variable}
  Mindate = $00000000;   {Minimum valid date for a date variable - 01/01/1600}
  Maxdate = $000D6025;   {Maximum valid date for a date variable - 12/31/3999}
  Date1900 : longint = $0001AC05;  {Julian date for 01/01/1900}
  Date1970 : longint = $00020FE4;  {Julian date for 01/01/1970}
  Date1980 : longint = $00021E28;  {Julian date for 01/01/1980}
  Date2000 : longint = $00023AB1;  {Julian date for 01/01/2000}
  Days400Yr : longint = 146097;    {days in 400 years}
  {This value is used to represent an invalid date, such as 12/32/1992}
  BadDate = LongInt($FFFFFFFF);

  DeltaJD     = $00232DA8;   {Days between 1/1/-4173 and 1/1/1600}

  MinTime = 0;          {Minimum valid time for a time variable - 00:00:00 am}
  MaxTime = 86399;      {Maximum valid time for a time variable - 23:59:59 pm}
  {This value is used to represent an invalid time of day, such as 12:61:00}
  BadTime = LongInt($FFFFFFFF);
  SecondsInDay = 86400;      {Number of seconds in a day}
  SecondsInHour = 3600;      {Number of seconds in an hour}
  SecondsInMinute = 60;      {Number of seconds in a minute}
  HoursInDay = 24;           {Number of hours in a day}
  MinutesInHour = 60;        {Number of minutes in an hour}
  MinutesInDay = 1440;       {Number of minutes in a day}

var
  DefaultYear : Integer;     {default year--used by DateStringToDMY}
  DefaultMonth : ShortInt;   {default month}

  {-------julian date routines---------------}

function CurrentDate : TStDate;
  {-returns today's date as a Julian date}

function ValidDate(Day, Month, Year, Epoch : Integer) : Boolean;
  {-Verify that day, month, year is a valid date}

function DMYtoStDate(Day, Month, Year, Epoch : Integer) : TStDate;
  {-Convert from day, month, year to a Julian date}

procedure StDateToDMY(Julian : TStDate; var Day, Month, Year : Integer);
  {-Convert from a Julian date to day, month, year}

function IncDate(Julian : TStDate; Days, Months, Years : Integer) : TStDate;
  {-Add (or subtract) the number of days, months, and years to a date}

function IncDateTrunc(Julian : TStDate; Months, Years : Integer) : TStDate;
  {-Add (or subtract) the specified number of months and years to a date}

procedure DateDiff(Date1, Date2 : TStDate;
                   var Days, Months, Years : Integer);
{-Return the difference in days, months, and years between two valid Julian
  dates}

function BondDateDiff(Date1, Date2 : TStDate; DayBasis : TStBondDateType) : TStDate;
  {-Return the difference in days between two valid Julian
  dates using a specific financial basis}

function WeekOfYear(Julian : TStDate) : Byte;
  {-Returns the week number of the year given the Julian Date}

function AstJulianDate(Julian : TStDate) : Double;
  {-Returns the Astronomical Julian Date from a TStDate}

function AstJulianDatetoStDate(AstJulian : Double; Truncate : Boolean) : TStDate;
  {-Returns a TStDate from an Astronomical Julian Date.
  Truncate TRUE   Converts to appropriate 0 hours then truncates
           FALSE  Converts to appropriate 0 hours, then rounds to
                  nearest;}

function AstJulianDatePrim(Year, Month, Date : Integer; UT : TStTime) : Double;
  {-Returns an Astronomical Julian Date for any year, even those outside
    MinYear..MaxYear}

function DayOfWeek(Julian : TStDate) : TStDayType;
  {-Return the day of the week for a Julian date}

function DayOfWeekDMY(Day, Month, Year, Epoch : Integer) : TStDayType;
  {-Return the day of the week for the day, month, year}

function IsLeapYear(Year : Integer) : Boolean;
  {-Return True if Year is a leap year}

function DaysInMonth(Month : Integer; Year, Epoch : Integer) : Integer;
  {-Return the number of days in the specified month of a given year}

function ResolveEpoch(Year, Epoch : Integer) : Integer;
  {-Convert 2 digit year to 4 digit year according to Epoch}


  {-------time routines---------------}

function ValidTime(Hours, Minutes, Seconds : Integer) : Boolean;
  {-Return True if Hours:Minutes:Seconds is a valid time}

procedure StTimeToHMS(T : TStTime;
                    var Hours, Minutes, Seconds : Byte);
  {-Convert a time variable to hours, minutes, seconds}

function HMStoStTime(Hours, Minutes, Seconds : Byte) : TStTime;
  {-Convert hours, minutes, seconds to a time variable}

function CurrentTime : TStTime;
  {-Return the current time in seconds since midnight}

procedure TimeDiff(Time1, Time2 : TStTime;
                   var Hours, Minutes, Seconds : Byte);
  {-Return the difference in hours, minutes, and seconds between two times}

function IncTime(T : TStTime; Hours, Minutes, Seconds : Byte) : TStTime;
  {-Add the specified hours, minutes, and seconds to a given time of day}

function DecTime(T : TStTime; Hours, Minutes, Seconds : Byte) : TStTime;
  {-Subtract the specified hours, minutes, and seconds from a given time of day}

function RoundToNearestHour(T : TStTime; Truncate : Boolean) : TStTime;
  {-Given a time, round it to the nearest hour, or truncate minutes and
  seconds}

function RoundToNearestMinute(const T : TStTime; Truncate : Boolean) : TStTime;
  {-Given a time, round it to the nearest minute, or truncate seconds}

  {-------- routines for DateTimeRec records ---------}

procedure DateTimeDiff(const DT1 : TStDateTimeRec; var DT2 : TStDateTimeRec; {!!.02}
                       var Days : LongInt; var Secs : LongInt);
  {-Return the difference in days and seconds between two points in time}

procedure IncDateTime(const DT1 : TStDateTimeRec; var DT2 : TStDateTimeRec;  {!!.02}
                      Days : Integer; Secs : LongInt);
  {-Increment (or decrement) a date and time by the specified number of days
  and seconds}

function DateTimeToStDate(DT : TDateTime) : TStDate;
  {-Convert Delphi TDateTime to TStDate}

function DateTimeToStTime(DT : TDateTime) : TStTime;
  {-Convert Delphi TDateTime to TStTime}

function StDateToDateTime(D : TStDate) : TDateTime;
  {-Convert TStDate to TDateTime}

function StTimeToDateTime(T : TStTime) : TDateTime;
  {-Convert TStTime to TDateTime}

function Convert2ByteDate(TwoByteDate : Word) : TStDate;
  {-Convert an Object Professional two byte date into a SysTools date}

function Convert4ByteDate(FourByteDate : TStDate) : Word;
  {-Convert a SysTools date into an Object Professional two byte date}


implementation

const
  First2Months = 59;           {1600 was a leap year}
  FirstDayOfWeek = Saturday;   {01/01/1600 was a Saturday}
  DateLen = 40;                {maximum length of Picture strings}
  MaxMonthName = 15;
  MaxDayName   = 15;


type
{  DateString = string[DateLen];}
  SString = string[255];

function IsLeapYear(Year : Integer) : Boolean;
  {-Return True if Year is a leap year}
begin
  Result := (Year mod 4 = 0) and (Year mod 4000 <> 0) and
    ((Year mod 100 <> 0) or (Year mod 400 = 0));
end;

function IsLastDayofMonth(Day, Month, Year : Integer) : Boolean;
  {-Return True if date is the last day in month}
var
  Epoch : Integer;
begin
  Epoch := (Year div 100) * 100;
  if ValidDate(Day + 1, Month, Year, Epoch) then
    Result := false
  else
    Result := true;
end;

function IsLastDayofFeb(Date : TStDate) : Boolean;
  {-Return True if date is the last day in February}
var
  Day, Month, Year : Integer;
begin
  StDateToDMY(Date, Day, Month, Year);
  if (Month = 2) and IsLastDayOfMonth(Day, Month, Year) then
    Result := true
  else
    Result := false;
end;

procedure ExchangeLongInts(var I, J : LongInt);
register;
asm
  mov  ecx, [eax]
  push ecx
  mov  ecx, [edx]
  mov  [eax], ecx
  pop  ecx
  mov  [edx], ecx
end;

procedure ExchangeStructs(var I, J; Size : Cardinal);
register;
asm
  push edi
  push ebx
  push ecx
  shr  ecx, 2
  jz   @@LessThanFour

@@AgainDWords:
  mov  ebx, [eax]
  mov  edi, [edx]
  mov  [edx], ebx
  mov  [eax], edi
  add  eax, 4
  add  edx, 4
  dec  ecx
  jnz  @@AgainDWords

@@LessThanFour:
  pop  ecx
  and  ecx, $3
  jz   @@Done
  mov  bl, [eax]
  mov  bh, [edx]
  mov  [edx], bl
  mov  [eax], bh
  inc  eax
  inc  edx
  dec  ecx
  jz   @@Done

  mov  bl, [eax]
  mov  bh, [edx]
  mov  [edx], bl
  mov  [eax], bh
  inc  eax
  inc  edx
  dec  ecx
  jz   @@Done

  mov  bl, [eax]
  mov  bh, [edx]
  mov  [edx], bl
  mov  [eax], bh

@@Done:
  pop  ebx
  pop  edi
end;


function ResolveEpoch(Year, Epoch : Integer) : Integer;              
  {-Convert 2-digit year to 4-digit year according to Epoch}         
var                                                                  
  EpochYear,                                                         
  EpochCent : Integer;                                               
begin                                                                
  if Word(Year) < 100 then begin                                     
    EpochYear := Epoch mod 100;                                      
    EpochCent := (Epoch div 100) * 100;
    if (Year < EpochYear) then                                       
      Inc(Year,EpochCent+100)                                        
    else                                                             
      Inc(Year,EpochCent);
  end;                                                               
  Result := Year;
end;                                                                 

function CurrentDate : TStDate;
  {-Returns today's date as a julian}
var
  Year, Month, Date : Word;
begin
  DecodeDate(Now,Year,Month,Date);
  Result := DMYToStDate(Date,Month,Year,0);
end;

function DaysInMonth(Month : integer; Year, Epoch : Integer) : Integer;
    {-Return the number of days in the specified month of a given year}
begin
  Year := ResolveEpoch(Year, Epoch);                                 

  if (Year < MinYear) OR (Year > MaxYear) then
  begin
    Result := 0;
    Exit;
  end;

  case Month of
    1, 3, 5, 7, 8, 10, 12 :
      Result := 31;
    4, 6, 9, 11 :
      Result := 30;
    2 :
     Result := 28+Ord(IsLeapYear(Year));
  else
    Result := 0;
  end;
end;

function ValidDate(Day, Month, Year, Epoch : Integer) : Boolean;
  {-Verify that day, month, year is a valid date}
begin
  Year := ResolveEpoch(Year, Epoch);                                 

  if (Day < 1) or (Year < MinYear) or (Year > MaxYear) then
    Result := False
  else case Month of
    1..12 :
      Result := Day <= DaysInMonth(Month, Year, Epoch);
  else
    Result := False;
  end
end;

function DMYtoStDate(Day, Month, Year, Epoch : Integer) : TStDate;
  {-Convert from day, month, year to a julian date}
begin
  Year := ResolveEpoch(Year, Epoch);

  if not ValidDate(Day, Month, Year, Epoch) then
    Result := BadDate
  else if (Year = MinYear) and (Month < 3) then
    if Month = 1 then
      Result := Pred(Day)
    else
      Result := Day+30
  else begin
    if Month > 2 then
      Dec(Month, 3)
    else begin
      Inc(Month, 9);
      Dec(Year);
    end;
    Dec(Year, MinYear);
    Result :=
      ((LongInt(Year div 100)*Days400Yr) div 4)+
      ((LongInt(Year mod 100)*1461) div 4)+
      (((153*Month)+2) div 5)+Day+First2Months;
  end;
end;

function WeekOfYear(Julian : TStDate) : Byte;
  {-Returns the week number of the year given the Julian Date}
var
  Day, Month, Year : Integer;
  FirstJulian : TStDate;
begin
  if (Julian < MinDate) or (Julian > MaxDate) then
  begin
    Result := 0;
    Exit;
  end;

  Julian := Julian + 3 - ((6 + Ord(DayOfWeek(Julian))) mod 7);
  StDateToDMY(Julian,Day,Month,Year);
  FirstJulian := DMYToStDate(1,1,Year,0);
  Result := 1 + (Julian - FirstJulian) div 7;
end;

function AstJulianDate(Julian : TStDate) : Double;
  {-Returns the Astronomical Julian Date from a TStDate}
begin
  {Subtract 0.5d since Astronomical JD starts at noon
   while TStDate (with implied .0) starts at midnight}
  Result := Julian - 0.5 + DeltaJD;
end;


function AstJulianDatePrim(Year, Month, Date : Integer; UT : TStTime) : Double;
var
  A, B : integer;
  LY,
  GC   : Boolean;

begin
  Result := -MaxLongInt;
  if (not (Month in [1..12])) or (Date < 1)  then
    Exit
  else if (Month in [1, 3, 5, 7, 8, 10, 12]) and (Date > 31) then
    Exit
  else if (Month in [4, 6, 9, 11]) and (Date > 30) then
    Exit
  else if (Month = 2) then begin
    LY := IsLeapYear(Year);
    if ((LY) and (Date > 29)) or (not (LY) and (Date > 28)) then
      Exit;
  end else if ((UT < 0) or (UT >= SecondsInDay)) then
    Exit;

  if (Month <= 2) then begin
    Year := Year - 1;
    Month := Month + 12;
  end;
  A := abs(Year div 100);

  if (Year > 1582) then
    GC := True