123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073 |
- {$mode objfpc}
- {$h+}
- {
- This file is part of the Free Pascal run time library.
- Copyright (c) 1999-2000 by the Free Pascal development team
- Delphi/Kylix compatibility unit, provides Date/Time handling routines.
- See the file COPYING.FPC, included in this distribution,
- for details about the copyright.
- This program is distributed in the hope that it will be useful,
- but WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
- **********************************************************************}
- unit dateutils;
- interface
- uses
- SysUtils, Math, Types;
- { ---------------------------------------------------------------------
- Various constants
- ---------------------------------------------------------------------}
- const
- DaysPerWeek = 7;
- WeeksPerFortnight = 2;
- MonthsPerYear = 12;
- YearsPerDecade = 10;
- YearsPerCentury = 100;
- YearsPerMillennium = 1000;
- // ISO day numbers.
- DayMonday = 1;
- DayTuesday = 2;
- DayWednesday = 3;
- DayThursday = 4;
- DayFriday = 5;
- DaySaturday = 6;
- DaySunday = 7;
- // Fraction of a day
- OneHour = 1/HoursPerDay;
- OneMinute = 1/MinsPerDay;
- OneSecond = 1/SecsPerDay;
- OneMillisecond = 1/MSecsPerDay;
- { This is actual days per year but you need to know if it's a leap year}
- DaysPerYear: array [Boolean] of Word = (365, 366);
- { Used in RecodeDate, RecodeTime and RecodeDateTime for those datetime }
- { fields you want to leave alone }
- RecodeLeaveFieldAsIs = High(Word);
- { ---------------------------------------------------------------------
- Global variables used in this unit
- ---------------------------------------------------------------------}
- Const
- { Average over a 4 year span. Valid for next 100 years }
- ApproxDaysPerMonth: Double = 30.4375;
- ApproxDaysPerYear: Double = 365.25;
- { ---------------------------------------------------------------------
- Simple trimming functions.
- ---------------------------------------------------------------------}
- Function DateOf(const AValue: TDateTime): TDateTime;
- Function TimeOf(const AValue: TDateTime): TDateTime;
- { ---------------------------------------------------------------------
- Identification functions.
- ---------------------------------------------------------------------}
- Function IsInLeapYear(const AValue: TDateTime): Boolean;
- Function IsPM(const AValue: TDateTime): Boolean;
- Function IsValidDate(const AYear, AMonth, ADay: Word): Boolean;
- Function IsValidTime(const AHour, AMinute, ASecond, AMilliSecond: Word): Boolean;
- Function IsValidDateTime(const AYear, AMonth, ADay, AHour, AMinute, ASecond, AMilliSecond: Word): Boolean;
- Function IsValidDateDay(const AYear, ADayOfYear: Word): Boolean;
- Function IsValidDateWeek(const AYear, AWeekOfYear, ADayOfWeek: Word): Boolean;
- Function IsValidDateMonthWeek(const AYear, AMonth, AWeekOfMonth, ADayOfWeek: Word): Boolean;
- { ---------------------------------------------------------------------
- Enumeration functions.
- ---------------------------------------------------------------------}
- Function WeeksInYear(const AValue: TDateTime): Word;
- Function WeeksInAYear(const AYear: Word): Word;
- Function DaysInYear(const AValue: TDateTime): Word;
- Function DaysInAYear(const AYear: Word): Word;
- Function DaysInMonth(const AValue: TDateTime): Word;
- Function DaysInAMonth(const AYear, AMonth: Word): Word;
- { ---------------------------------------------------------------------
- Variations on current date/time.
- ---------------------------------------------------------------------}
- Function Today: TDateTime;
- Function Yesterday: TDateTime;
- Function Tomorrow: TDateTime;
- Function IsToday(const AValue: TDateTime): Boolean;
- Function IsSameDay(const AValue, ABasis: TDateTime): Boolean;
- Function PreviousDayOfWeek (DayOfWeek : Word) : Word;
- { ---------------------------------------------------------------------
- Extraction functions.
- ---------------------------------------------------------------------}
- Function YearOf(const AValue: TDateTime): Word;
- Function MonthOf(const AValue: TDateTime): Word;
- Function WeekOf(const AValue: TDateTime): Word;
- Function DayOf(const AValue: TDateTime): Word;
- Function HourOf(const AValue: TDateTime): Word;
- Function MinuteOf(const AValue: TDateTime): Word;
- Function SecondOf(const AValue: TDateTime): Word;
- Function MilliSecondOf(const AValue: TDateTime): Word;
- { ---------------------------------------------------------------------
- Start/End of year functions.
- ---------------------------------------------------------------------}
- Function StartOfTheYear(const AValue: TDateTime): TDateTime;
- Function EndOfTheYear(const AValue: TDateTime): TDateTime;
- Function StartOfAYear(const AYear: Word): TDateTime;
- Function EndOfAYear(const AYear: Word): TDateTime;
- { ---------------------------------------------------------------------
- Start/End of month functions.
- ---------------------------------------------------------------------}
- Function StartOfTheMonth(const AValue: TDateTime): TDateTime;
- Function EndOfTheMonth(const AValue: TDateTime): TDateTime;
- Function StartOfAMonth(const AYear, AMonth: Word): TDateTime;
- Function EndOfAMonth(const AYear, AMonth: Word): TDateTime;
- { ---------------------------------------------------------------------
- Start/End of week functions.
- ---------------------------------------------------------------------}
- Function StartOfTheWeek(const AValue: TDateTime): TDateTime;
- Function EndOfTheWeek(const AValue: TDateTime): TDateTime;
- Function StartOfAWeek(const AYear, AWeekOfYear: Word; const ADayOfWeek: Word): TDateTime;
- Function StartOfAWeek(const AYear, AWeekOfYear: Word): TDateTime; // ADayOFWeek 1
- Function EndOfAWeek(const AYear, AWeekOfYear: Word; const ADayOfWeek: Word): TDateTime;
- Function EndOfAWeek(const AYear, AWeekOfYear: Word): TDateTime; // const ADayOfWeek: Word = 7
- { ---------------------------------------------------------------------
- Start/End of day functions.
- ---------------------------------------------------------------------}
- Function StartOfTheDay(const AValue: TDateTime): TDateTime;
- Function EndOfTheDay(const AValue: TDateTime): TDateTime;
- Function StartOfADay(const AYear, AMonth, ADay: Word): TDateTime; overload;
- Function StartOfADay(const AYear, ADayOfYear: Word): TDateTime; overload;
- Function EndOfADay(const AYear, AMonth, ADay: Word): TDateTime; overload;
- Function EndOfADay(const AYear, ADayOfYear: Word): TDateTime; overload;
- { ---------------------------------------------------------------------
- Part of year functions.
- ---------------------------------------------------------------------}
- Function MonthOfTheYear(const AValue: TDateTime): Word;
- Function WeekOfTheYear(const AValue: TDateTime): Word; overload;
- Function WeekOfTheYear(const AValue: TDateTime; var AYear: Word): Word; overload;
- Function DayOfTheYear(const AValue: TDateTime): Word;
- Function HourOfTheYear(const AValue: TDateTime): Word;
- Function MinuteOfTheYear(const AValue: TDateTime): LongWord;
- Function SecondOfTheYear(const AValue: TDateTime): LongWord;
- Function MilliSecondOfTheYear(const AValue: TDateTime): Int64;
- { ---------------------------------------------------------------------
- Part of month functions.
- ---------------------------------------------------------------------}
- Function WeekOfTheMonth(const AValue: TDateTime): Word; overload;
- Function WeekOfTheMonth(const AValue: TDateTime; var AYear, AMonth: Word): Word; overload;
- Function DayOfTheMonth(const AValue: TDateTime): Word;
- Function HourOfTheMonth(const AValue: TDateTime): Word;
- Function MinuteOfTheMonth(const AValue: TDateTime): Word;
- Function SecondOfTheMonth(const AValue: TDateTime): LongWord;
- Function MilliSecondOfTheMonth(const AValue: TDateTime): LongWord;
- { ---------------------------------------------------------------------
- Part of week functions.
- ---------------------------------------------------------------------}
- Function DayOfTheWeek(const AValue: TDateTime): Word;
- Function HourOfTheWeek(const AValue: TDateTime): Word;
- Function MinuteOfTheWeek(const AValue: TDateTime): Word;
- Function SecondOfTheWeek(const AValue: TDateTime): LongWord;
- Function MilliSecondOfTheWeek(const AValue: TDateTime): LongWord;
- { ---------------------------------------------------------------------
- Part of day functions.
- ---------------------------------------------------------------------}
- Function HourOfTheDay(const AValue: TDateTime): Word;
- Function MinuteOfTheDay(const AValue: TDateTime): Word;
- Function SecondOfTheDay(const AValue: TDateTime): LongWord;
- Function MilliSecondOfTheDay(const AValue: TDateTime): LongWord;
- { ---------------------------------------------------------------------
- Part of hour functions.
- ---------------------------------------------------------------------}
- Function MinuteOfTheHour(const AValue: TDateTime): Word;
- Function SecondOfTheHour(const AValue: TDateTime): Word;
- Function MilliSecondOfTheHour(const AValue: TDateTime): LongWord;
- { ---------------------------------------------------------------------
- Part of minute functions.
- ---------------------------------------------------------------------}
- Function SecondOfTheMinute(const AValue: TDateTime): Word;
- Function MilliSecondOfTheMinute(const AValue: TDateTime): LongWord;
- { ---------------------------------------------------------------------
- Part of second functions.
- ---------------------------------------------------------------------}
- Function MilliSecondOfTheSecond(const AValue: TDateTime): Word;
- { ---------------------------------------------------------------------
- Range checking functions.
- ---------------------------------------------------------------------}
- Function WithinPastYears(const ANow, AThen: TDateTime; const AYears: Integer): Boolean;
- Function WithinPastMonths(const ANow, AThen: TDateTime; const AMonths: Integer): Boolean;
- Function WithinPastWeeks(const ANow, AThen: TDateTime; const AWeeks: Integer): Boolean;
- Function WithinPastDays(const ANow, AThen: TDateTime; const ADays: Integer): Boolean;
- Function WithinPastHours(const ANow, AThen: TDateTime; const AHours: Int64): Boolean;
- Function WithinPastMinutes(const ANow, AThen: TDateTime; const AMinutes: Int64): Boolean;
- Function WithinPastSeconds(const ANow, AThen: TDateTime; const ASeconds: Int64): Boolean;
- Function WithinPastMilliSeconds(const ANow, AThen: TDateTime; const AMilliSeconds: Int64): Boolean;
- { ---------------------------------------------------------------------
- Period functions.
- ---------------------------------------------------------------------}
- Function YearsBetween(const ANow, AThen: TDateTime): Integer;
- Function MonthsBetween(const ANow, AThen: TDateTime): Integer;
- Function WeeksBetween(const ANow, AThen: TDateTime): Integer;
- Function DaysBetween(const ANow, AThen: TDateTime): Integer;
- Function HoursBetween(const ANow, AThen: TDateTime): Int64;
- Function MinutesBetween(const ANow, AThen: TDateTime): Int64;
- Function SecondsBetween(const ANow, AThen: TDateTime): Int64;
- Function MilliSecondsBetween(const ANow, AThen: TDateTime): Int64;
- { ---------------------------------------------------------------------
- Timespan in xxx functions.
- ---------------------------------------------------------------------}
- { YearSpan and MonthSpan are approximate values }
- Function YearSpan(const ANow, AThen: TDateTime): Double;
- Function MonthSpan(const ANow, AThen: TDateTime): Double;
- Function WeekSpan(const ANow, AThen: TDateTime): Double;
- Function DaySpan(const ANow, AThen: TDateTime): Double;
- Function HourSpan(const ANow, AThen: TDateTime): Double;
- Function MinuteSpan(const ANow, AThen: TDateTime): Double;
- Function SecondSpan(const ANow, AThen: TDateTime): Double;
- Function MilliSecondSpan(const ANow, AThen: TDateTime): Double;
- { ---------------------------------------------------------------------
- Increment/decrement functions.
- ---------------------------------------------------------------------}
- Function IncYear(const AValue: TDateTime; const ANumberOfYears: Integer ): TDateTime;
- Function IncYear(const AValue: TDateTime): TDateTime; // ; const ANumberOfYears: Integer = 1)
- // Function IncMonth is in SysUtils
- Function IncWeek(const AValue: TDateTime; const ANumberOfWeeks: Integer): TDateTime;
- Function IncWeek(const AValue: TDateTime): TDateTime; // ; const ANumberOfWeeks: Integer = 1)
- Function IncDay(const AValue: TDateTime; const ANumberOfDays: Integer): TDateTime;
- Function IncDay(const AValue: TDateTime): TDateTime; //; const ANumberOfDays: Integer = 1)
- Function IncHour(const AValue: TDateTime; const ANumberOfHours: Int64): TDateTime;
- Function IncHour(const AValue: TDateTime): TDateTime; //; const ANumberOfHours: Int64 = 1
- Function IncMinute(const AValue: TDateTime; const ANumberOfMinutes: Int64): TDateTime;
- Function IncMinute(const AValue: TDateTime): TDateTime; // ; const ANumberOfMinutes: Int64 = 1
- Function IncSecond(const AValue: TDateTime; const ANumberOfSeconds: Int64): TDateTime;
- Function IncSecond(const AValue: TDateTime): TDateTime; // ; const ANumberOfSeconds: Int64 = 1
- Function IncMilliSecond(const AValue: TDateTime; const ANumberOfMilliSeconds: Int64): TDateTime;
- Function IncMilliSecond(const AValue: TDateTime): TDateTime; // ; const ANumberOfMilliSeconds: Int64 = 1
- { ---------------------------------------------------------------------
- Encode/Decode of complete timestamp
- ---------------------------------------------------------------------}
- Function EncodeDateTime(const AYear, AMonth, ADay, AHour, AMinute, ASecond, AMilliSecond: Word): TDateTime;
- Procedure DecodeDateTime(const AValue: TDateTime; var AYear, AMonth, ADay, AHour, AMinute, ASecond, AMilliSecond: Word);
- Function TryEncodeDateTime(const AYear, AMonth, ADay, AHour, AMinute, ASecond, AMilliSecond: Word; var AValue: TDateTime): Boolean;
- { ---------------------------------------------------------------------
- Encode/decode date, specifying week of year and day of week
- ---------------------------------------------------------------------}
- Function EncodeDateWeek(const AYear, AWeekOfYear: Word; const ADayOfWeek: Word): TDateTime;
- Function EncodeDateWeek(const AYear, AWeekOfYear: Word): TDateTime; //; const ADayOfWeek: Word = 1
- Procedure DecodeDateWeek(const AValue: TDateTime; var AYear, AWeekOfYear, ADayOfWeek: Word);
- Function TryEncodeDateWeek(const AYear, AWeekOfYear: Word; var AValue: TDateTime; const ADayOfWeek: Word): Boolean;
- Function TryEncodeDateWeek(const AYear, AWeekOfYear: Word; var AValue: TDateTime): Boolean; //; const ADayOfWeek: Word = 1
- { ---------------------------------------------------------------------
- Encode/decode date, specifying day of year
- ---------------------------------------------------------------------}
- Function EncodeDateDay(const AYear, ADayOfYear: Word): TDateTime;
- Procedure DecodeDateDay(const AValue: TDateTime; var AYear, ADayOfYear: Word);
- Function TryEncodeDateDay(const AYear, ADayOfYear: Word; var AValue: TDateTime): Boolean;
- { ---------------------------------------------------------------------
- Encode/decode date, specifying week of month
- ---------------------------------------------------------------------}
- Function EncodeDateMonthWeek(const AYear, AMonth, AWeekOfMonth, ADayOfWeek: Word): TDateTime;
- Procedure DecodeDateMonthWeek(const AValue: TDateTime; var AYear, AMonth, AWeekOfMonth, ADayOfWeek: Word);
- Function TryEncodeDateMonthWeek(const AYear, AMonth, AWeekOfMonth, ADayOfWeek: Word; var AValue: TDateTime): Boolean;
- { ---------------------------------------------------------------------
- Replace given element with supplied value.
- ---------------------------------------------------------------------}
- Function RecodeYear(const AValue: TDateTime; const AYear: Word): TDateTime;
- Function RecodeMonth(const AValue: TDateTime; const AMonth: Word): TDateTime;
- Function RecodeDay(const AValue: TDateTime; const ADay: Word): TDateTime;
- Function RecodeHour(const AValue: TDateTime; const AHour: Word): TDateTime;
- Function RecodeMinute(const AValue: TDateTime; const AMinute: Word): TDateTime;
- Function RecodeSecond(const AValue: TDateTime; const ASecond: Word): TDateTime;
- Function RecodeMilliSecond(const AValue: TDateTime; const AMilliSecond: Word): TDateTime;
- Function RecodeDate(const AValue: TDateTime; const AYear, AMonth, ADay: Word): TDateTime;
- Function RecodeTime(const AValue: TDateTime; const AHour, AMinute, ASecond, AMilliSecond: Word): TDateTime;
- Function RecodeDateTime(const AValue: TDateTime; const AYear, AMonth, ADay, AHour, AMinute, ASecond, AMilliSecond: Word): TDateTime;
- Function TryRecodeDateTime(const AValue: TDateTime; const AYear, AMonth, ADay, AHour, AMinute, ASecond, AMilliSecond: Word; var AResult: TDateTime): Boolean;
- { ---------------------------------------------------------------------
- Comparision of date/time
- ---------------------------------------------------------------------}
- Function CompareDateTime(const A, B: TDateTime): TValueRelationship;
- Function CompareDate(const A, B: TDateTime): TValueRelationship;
- Function CompareTime(const A, B: TDateTime): TValueRelationship;
- Function SameDateTime(const A, B: TDateTime): Boolean;
- Function SameDate(const A, B: TDateTime): Boolean;
- Function SameTime(const A, B: TDateTime): Boolean;
- { For a given date these Functions tell you the which day of the week of the
- month (or year). If its a Thursday, they will tell you if its the first,
- second, etc Thursday of the month (or year). Remember, even though its
- the first Thursday of the year it doesn't mean its the first week of the
- year. See ISO 8601 above for more information. }
- Function NthDayOfWeek(const AValue: TDateTime): Word;
- Procedure DecodeDayOfWeekInMonth(const AValue: TDateTime; var AYear, AMonth, ANthDayOfWeek, ADayOfWeek: Word);
- Function EncodeDayOfWeekInMonth(const AYear, AMonth, ANthDayOfWeek, ADayOfWeek: Word): TDateTime;
- Function TryEncodeDayOfWeekInMonth(const AYear, AMonth, ANthDayOfWeek, ADayOfWeek: Word; var AValue: TDateTime): Boolean;
- { ---------------------------------------------------------------------
- Exception throwing routines
- ---------------------------------------------------------------------}
- Procedure InvalidDateTimeError(const AYear, AMonth, ADay, AHour, AMinute, ASecond, AMilliSecond: Word; const ABaseDate: TDateTime);
- Procedure InvalidDateTimeError(const AYear, AMonth, ADay, AHour, AMinute, ASecond, AMilliSecond: Word); // const ABaseDate: TDateTime = 0
- Procedure InvalidDateWeekError(const AYear, AWeekOfYear, ADayOfWeek: Word);
- Procedure InvalidDateDayError(const AYear, ADayOfYear: Word);
- Procedure InvalidDateMonthWeekError(const AYear, AMonth, AWeekOfMonth, ADayOfWeek: Word);
- Procedure InvalidDayOfWeekInMonthError(const AYear, AMonth, ANthDayOfWeek, ADayOfWeek: Word);
- { ---------------------------------------------------------------------
- Julian and Modified Julian Date conversion support
- ---------------------------------------------------------------------}
- Function DateTimeToJulianDate(const AValue: TDateTime): Double;
- Function JulianDateToDateTime(const AValue: Double): TDateTime;
- Function TryJulianDateToDateTime(const AValue: Double; var ADateTime: TDateTime): Boolean;
- Function DateTimeToModifiedJulianDate(const AValue: TDateTime): Double;
- Function ModifiedJulianDateToDateTime(const AValue: Double): TDateTime;
- Function TryModifiedJulianDateToDateTime(const AValue: Double; var ADateTime: TDateTime): Boolean;
- { ---------------------------------------------------------------------
- Unix timestamp support.
- ---------------------------------------------------------------------}
- Function DateTimeToUnix(const AValue: TDateTime): Int64;
- Function UnixToDateTime(const AValue: Int64): TDateTime;
- Function UnixTimeStampToMac(const AValue: Int64): Int64;
- { ---------------------------------------------------------------------
- Mac timestamp support.
- ---------------------------------------------------------------------}
- Function DateTimeToMac(const AValue: TDateTime): Int64;
- Function MacToDateTime(const AValue: Int64): TDateTime;
- Function MacTimeStampToUnix(const AValue: Int64): Int64;
- implementation
- uses sysconst;
- { ---------------------------------------------------------------------
- Auxiliary routines
- ---------------------------------------------------------------------}
- Procedure NotYetImplemented (FN : String);
- begin
- Raise Exception.CreateFmt('Function "%s" (dateutils) is not yet implemented',[FN]);
- end;
- { ---------------------------------------------------------------------
- Simple trimming functions.
- ---------------------------------------------------------------------}
- Function DateOf(const AValue: TDateTime): TDateTime;
- begin
- Result:=Trunc(AValue);
- end;
- Function TimeOf(const AValue: TDateTime): TDateTime;
- begin
- Result:=Frac(Avalue);
- end;
- { ---------------------------------------------------------------------
- Identification functions.
- ---------------------------------------------------------------------}
- Function IsInLeapYear(const AValue: TDateTime): Boolean;
- Var
- D,Y,M : Word;
- begin
- DecodeDate(AValue,Y,M,D);
- Result:=IsLeapYear(Y);
- end;
- Function IsPM(const AValue: TDateTime): Boolean;
- Var
- H,M,S,MS : Word;
- begin
- DecodeTime(AValue,H,M,S,MS);
- Result:=(H>=12);
- end;
- Function IsValidDate(const AYear, AMonth, ADay: Word): Boolean;
- begin
- Result:=(AYear<>0) and (AYear<10000)
- and (AMonth in [1..12])
- and (ADay<>0) and (ADay<=MonthDays[IsleapYear(AYear),AMonth]);
- end;
- Function IsValidTime(const AHour, AMinute, ASecond, AMilliSecond: Word): Boolean;
- begin
- Result:=(AHour=HoursPerDay) and (AMinute=0) and (ASecond=0) and (AMillisecond=0);
- Result:=Result or
- ((AHour<HoursPerDay) and (AMinute<MinsPerHour) and (ASecond<SecsPerMin) and
- (AMillisecond<MSecsPerSec));
- end;
- Function IsValidDateTime(const AYear, AMonth, ADay, AHour, AMinute, ASecond, AMilliSecond: Word): Boolean;
- begin
- Result:=IsValidDate(AYear,AMonth,ADay) and
- IsValidTime(AHour,AMinute,ASecond,AMillisecond)
- end;
- Function IsValidDateDay(const AYear, ADayOfYear: Word): Boolean;
- begin
- Result:=(AYear<>0) and (ADayOfYear<>0) and (AYear<10000) and
- (ADayOfYear<=DaysPerYear[IsLeapYear(AYear)]);
- end;
- Function IsValidDateWeek(const AYear, AWeekOfYear, ADayOfWeek: Word): Boolean;
- begin
- Result:=(AYear<>0) and (AYear<10000)
- and (ADayOfWeek in [1..7])
- and (AWeekOfYear<>0)
- and (AWeekOfYear<=WeeksInaYear(AYear));
- { should we not also check whether the day of the week is not
- larger than the last day of the last week in the year 9999 ?? }
- end;
- Function IsValidDateMonthWeek(const AYear, AMonth, AWeekOfMonth, ADayOfWeek: Word): Boolean;
- begin
- Result:=(AYear<>0) and (AYear<10000)
- and (AMonth in [1..12])
- and (AWeekOfMonth in [1..5])
- and (ADayOfWeek in [1..7]);
- end;
- { ---------------------------------------------------------------------
- Enumeration functions.
- ---------------------------------------------------------------------}
- Function WeeksInYear(const AValue: TDateTime): Word;
- Var
- Y,M,D : Word;
- begin
- DecodeDate(AValue,Y,M,D);
- Result:=WeeksInAYear(Y);
- end;
- Function WeeksInAYear(const AYear: Word): Word;
- Var
- DOW : Word;
- begin
- Result:=52;
- DOW:=DayOfTheWeek(StartOfAYear(AYear));
- If (DOW=4) or ((DOW=3) and IsLeapYear(AYear)) then
- Inc(Result);
- end;
- Function DaysInYear(const AValue: TDateTime): Word;
- Var
- Y,M,D : Word;
- begin
- DecodeDate(AValue,Y,M,D);
- Result:=DaysPerYear[IsLeapYear(Y)];
- end;
- Function DaysInAYear(const AYear: Word): Word;
- begin
- Result:=DaysPerYear[Isleapyear(AYear)];
- end;
- Function DaysInMonth(const AValue: TDateTime): Word;
- Var
- Y,M,D : Word;
- begin
- Decodedate(AValue,Y,M,D);
- Result:=MonthDays[IsLeapYear(Y),M];
- end;
- Function DaysInAMonth(const AYear, AMonth: Word): Word;
- begin
- Result:=MonthDays[IsLeapYear(AYear),AMonth];
- end;
- { ---------------------------------------------------------------------
- Variations on current date/time.
- ---------------------------------------------------------------------}
- Function Today: TDateTime;
- begin
- Result:=Date;
- end;
- Function Yesterday: TDateTime;
- begin
- Result:=Date-1;
- end;
- Function Tomorrow: TDateTime;
- begin
- Result:=Date+1;
- end;
- Function IsToday(const AValue: TDateTime): Boolean;
- begin
- Result:=IsSameDay(AValue,Date);
- end;
- Function IsSameDay(const AValue, ABasis: TDateTime): Boolean;
- Var
- D : TDateTime;
- begin
- D:=AValue-Trunc(ABasis);
- Result:=(D>=0) and (D<1);
- end;
- const
- DOWMap: array [1..7] of Word = (7, 1, 2, 3, 4, 5, 6);
- Function PreviousDayOfWeek (DayOfWeek : Word) : Word;
- begin
- If Not (DayOfWeek in [1..7]) then
- Raise EConvertError.CreateFmt(SErrInvalidDayOfWeek,[DayOfWeek]);
- Result:=DOWMap[DayOfWeek];
- end;
- { ---------------------------------------------------------------------
- Extraction functions.
- ---------------------------------------------------------------------}
- Function YearOf(const AValue: TDateTime): Word;
- Var
- D,M : Word;
- begin
- DecodeDate(AValue,Result,D,M);
- end;
- Function MonthOf(const AValue: TDateTime): Word;
- Var
- Y,D : Word;
- begin
- DecodeDate(AValue,Y,Result,D);
- end;
- Function WeekOf(const AValue: TDateTime): Word;
- begin
- Result:=WeekOfTheYear(AValue);
- end;
- Function DayOf(const AValue: TDateTime): Word;
- Var
- Y,M : Word;
- begin
- DecodeDate(AValue,Y,M,Result);
- end;
- Function HourOf(const AValue: TDateTime): Word;
- Var
- N,S,MS : Word;
- begin
- DecodeTime(AValue,Result,N,S,MS);
- end;
- Function MinuteOf(const AValue: TDateTime): Word;
- Var
- H,S,MS : Word;
- begin
- DecodeTime(AValue,H,Result,S,MS);
- end;
- Function SecondOf(const AValue: TDateTime): Word;
- Var
- H,N,MS : Word;
- begin
- DecodeTime(AVAlue,H,N,Result,MS);
- end;
- Function MilliSecondOf(const AValue: TDateTime): Word;
- Var
- H,N,S : Word;
- begin
- DecodeTime(AValue,H,N,S,Result);
- end;
- { ---------------------------------------------------------------------
- Start/End of year functions.
- ---------------------------------------------------------------------}
- Function StartOfTheYear(const AValue: TDateTime): TDateTime;
- Var
- Y,M,D : Word;
- begin
- DecodeDate(AValue,Y,M,D);
- Result:=EncodeDate(Y,1,1);
- end;
- Function EndOfTheYear(const AValue: TDateTime): TDateTime;
- Var
- Y,M,D : Word;
- begin
- DecodeDate(AValue,Y,M,D);
- Result:=EncodeDateTime(Y,12,31,23,59,59,999);
- end;
- Function StartOfAYear(const AYear: Word): TDateTime;
- begin
- Result:=EncodeDate(AYear,1,1);
- end;
- Function EndOfAYear(const AYear: Word): TDateTime;
- begin
- Result:=(EncodeDateTime(AYear,12,31,23,59,59,999));
- end;
- { ---------------------------------------------------------------------
- Start/End of month functions.
- ---------------------------------------------------------------------}
- Function StartOfTheMonth(const AValue: TDateTime): TDateTime;
- Var
- Y,M,D : Word;
- begin
- DecodeDate(AValue,Y,M,D);
- Result:=EncodeDate(Y,M,1);
- // MonthDays[IsLeapYear(Y),M])
- end;
- Function EndOfTheMonth(const AValue: TDateTime): TDateTime;
- Var
- Y,M,D : Word;
- begin
- DecodeDate(AValue,Y,M,D);
- Result:=EncodeDateTime(Y,M,MonthDays[IsLeapYear(Y),M],23,59,59,999);
- end;
- Function StartOfAMonth(const AYear, AMonth: Word): TDateTime;
- begin
- Result:=EncodeDate(AYear,AMonth,1);
- end;
- Function EndOfAMonth(const AYear, AMonth: Word): TDateTime;
- begin
- Result:=EncodeDateTime(AYear,AMonth,MonthDays[IsLeapYear(AYear),AMonth],23,59,59,999);
- end;
- { ---------------------------------------------------------------------
- Start/End of week functions.
- ---------------------------------------------------------------------}
- Function StartOfTheWeek(const AValue: TDateTime): TDateTime;
- begin
- Result:=Trunc(AValue)-DayOfTheWeek(AValue)+1;
- end;
- Function EndOfTheWeek(const AValue: TDateTime): TDateTime;
- begin
- Result:=EndOfTheDay(AValue-DayOfTheWeek(AValue)+7);
- end;
- Function StartOfAWeek(const AYear, AWeekOfYear: Word; const ADayOfWeek: Word): TDateTime;
- begin
- Result:=EncodeDateWeek(AYear,AWeekOfYear,ADayOfWeek);
- end;
- Function StartOfAWeek(const AYear, AWeekOfYear: Word): TDateTime; // ADayOFWeek 1
- begin
- Result:=StartOfAWeek(AYear,AWeekOfYear,1)
- end;
- Function EndOfAWeek(const AYear, AWeekOfYear: Word; const ADayOfWeek: Word): TDateTime;
- begin
- Result := EndOfTheDay(EncodeDateWeek(AYear, AWeekOfYear, ADayOfWeek));
- end;
- Function EndOfAWeek(const AYear, AWeekOfYear: Word): TDateTime; // const ADayOfWeek: Word = 7
- begin
- Result:=EndOfAWeek(AYear,AWeekOfYear,7);
- end;
- { ---------------------------------------------------------------------
- Start/End of day functions.
- ---------------------------------------------------------------------}
- Function StartOfTheDay(const AValue: TDateTime): TDateTime;
- begin
- StartOfTheDay:=Trunc(Avalue);
- end;
- Function EndOfTheDay(const AValue: TDateTime): TDateTime;
- Var
- Y,M,D : Word;
- begin
- DecodeDate(AValue,Y,M,D);
- Result:=EncodeDateTime(Y,M,D,23,59,59,999);
- end;
- Function StartOfADay(const AYear, AMonth, ADay: Word): TDateTime;
- begin
- Result:=EncodeDate(AYear,AMonth,ADay);
- end;
- Function StartOfADay(const AYear, ADayOfYear: Word): TDateTime;
- begin
- Result:=StartOfAYear(AYear)+ADayOfYear-1;
- end;
- Function EndOfADay(const AYear, AMonth, ADay: Word): TDateTime;
- begin
- Result:=EndOfTheDay(EncodeDate(AYear,AMonth,ADay));
- end;
- Function EndOfADay(const AYear, ADayOfYear: Word): TDateTime;
- begin
- Result:=StartOfAYear(AYear)+ADayOfYear-1+EncodeTime(23,59,59,999);
- end;
- { ---------------------------------------------------------------------
- Part of year functions.
- ---------------------------------------------------------------------}
- Function MonthOfTheYear(const AValue: TDateTime): Word;
- Var
- Y,D : Word;
- begin
- DecodeDate(AValue,Y,Result,D);
- end;
- Function WeekOfTheYear(const AValue: TDateTime): Word;
- Var
- Y,DOW : Word;
- begin
- DecodeDateWeek(AValue,Y,Result,DOW)
- end;
- Function WeekOfTheYear(const AValue: TDateTime; var AYear: Word): Word;
- Var
- DOW : Word;
- begin
- DecodeDateWeek(AValue,AYear,Result,DOW);
- end;
- Function DayOfTheYear(const AValue: TDateTime): Word;
- begin
- Result:=Trunc(AValue-StartOfTheYear(AValue)+1);
- end;
- Function HourOfTheYear(const AValue: TDateTime): Word;
- Var
- H,M,S,MS : Word;
- begin
- DecodeTime(AValue,H,M,S,MS);
- Result:=H+((DayOfTheYear(AValue)-1)*24);
- end;
- Function MinuteOfTheYear(const AValue: TDateTime): LongWord;
- Var
- H,M,S,MS : Word;
- begin
- DecodeTime(AValue,H,M,S,MS);
- Result:=M+(H+((DayOfTheYear(AValue)-1)*24))*60;
- end;
- Function SecondOfTheYear(const AValue: TDateTime): LongWord;
- Var
- H,M,S,MS : Word;
- begin
- DecodeTime(AValue,H,M,S,MS);
- Result:=(M+(H+((DayOfTheYear(AValue)-1)*24))*60)*60+S;
- end;
- Function MilliSecondOfTheYear(const AValue: TDateTime): Int64;
- Var
- H,M,S,MS : Word;
- begin
- DecodeTime(AValue,H,M,S,MS);
- Result:=((M+(H+((int64(DayOfTheYear(AValue))-1)*24))*60)*60+S)*1000+MS;
- end;
- { ---------------------------------------------------------------------
- Part of month functions.
- ---------------------------------------------------------------------}
- Function WeekOfTheMonth(const AValue: TDateTime): Word;
- var
- Y,M,DOW : word;
- begin
- DecodeDateMonthWeek(AValue,Y,M,Result,DOW);
- end;
- Function WeekOfTheMonth(const AValue: TDateTime; var AYear, AMonth: Word): Word;
- Var
- DOW : Word;
- begin
- DecodeDateMonthWeek(AValue,AYear,AMonth,Result,DOW);
- end;
- Function DayOfTheMonth(const AValue: TDateTime): Word;
- Var
- Y,M : Word;
- begin
- DecodeDate(AValue,Y,M,Result);
- end;
- Function HourOfTheMonth(const AValue: TDateTime): Word;
- Var
- Y,M,D,H,N,S,MS : Word;
- begin
- DecodeDateTime(AValue,Y,M,D,H,N,S,MS);
- Result:=(D-1)*24+H;
- end;
- Function MinuteOfTheMonth(const AValue: TDateTime): Word;
- Var
- Y,M,D,H,N,S,MS : Word;
- begin
- DecodeDateTime(AValue,Y,M,D,H,N,S,MS);
- Result:=((D-1)*24+H)*60+N;
- end;
- Function SecondOfTheMonth(const AValue: TDateTime): LongWord;
- Var
- Y,M,D,H,N,S,MS : Word;
- begin
- DecodeDateTime(AValue,Y,M,D,H,N,S,MS);
- Result:=(((D-1)*24+H)*60+N)*60+S;
- end;
- Function MilliSecondOfTheMonth(const AValue: TDateTime): LongWord;
- Var
- Y,M,D,H,N,S,MS : Word;
- begin
- DecodeDateTime(AValue,Y,M,D,H,N,S,MS);
- Result:=((((D-1)*24+H)*60+N)*60+S)*1000+MS;
- end;
- { ---------------------------------------------------------------------
- Part of week functions.
- ---------------------------------------------------------------------}
- Function DayOfTheWeek(const AValue: TDateTime): Word;
- begin
- Result:=DowMAP[DayOfWeek(AValue)];
- end;
- Function HourOfTheWeek(const AValue: TDateTime): Word;
- Var
- H,M,S,MS : Word;
- begin
- DecodeTime(AValue,H,M,S,MS);
- Result:=(DayOfTheWeek(AValue)-1)*24+H;
- end;
- Function MinuteOfTheWeek(const AValue: TDateTime): Word;
- Var
- H,M,S,MS : Word;
- begin
- DecodeTime(AValue,H,M,S,MS);
- Result:=((DayOfTheWeek(AValue)-1)*24+H)*60+M;
- end;
- Function SecondOfTheWeek(const AValue: TDateTime): LongWord;
- Var
- H,M,S,MS : Word;
- begin
- DecodeTime(AValue,H,M,S,MS);
- Result:=(((DayOfTheWeek(AValue)-1)*24+H)*60+M)*60+S;
- end;
- Function MilliSecondOfTheWeek(const AValue: TDateTime): LongWord;
- Var
- H,M,S,MS : Word;
- begin
- DecodeTime(AValue,H,M,S,MS);
- Result:=((((DayOfTheWeek(AValue)-1)*24+H)*60+M)*60+S)*1000+MS;
- end;
- { ---------------------------------------------------------------------
- Part of day functions.
- ---------------------------------------------------------------------}
- Function HourOfTheDay(const AValue: TDateTime): Word;
- Var
- M,S,MS : Word;
- begin
- DecodeTime(AValue,Result,M,S,MS);
- end;
- Function MinuteOfTheDay(const AValue: TDateTime): Word;
- Var
- H,M,S,MS : Word;
- begin
- DecodeTime(AValue,H,M,S,MS);
- Result:=(H*60)+M;
- end;
- Function SecondOfTheDay(const AValue: TDateTime): LongWord;
- Var
- H,M,S,MS : Word;
- begin
- DecodeTime(AValue,H,M,S,MS);
- Result:=((H*60)+M)*60+S;
- end;
- Function MilliSecondOfTheDay(const AValue: TDateTime): LongWord;
- Var
- H,M,S,MS : Word;
- begin
- DecodeTime(AValue,H,M,S,MS);
- Result:=(((H*60)+M)*60+S)*1000+MS;
- end;
- { ---------------------------------------------------------------------
- Part of hour functions.
- ---------------------------------------------------------------------}
- Function MinuteOfTheHour(const AValue: TDateTime): Word;
- Var
- H,S,MS : Word;
- begin
- DecodeTime(AValue,H,Result,S,MS);
- end;
- Function SecondOfTheHour(const AValue: TDateTime): Word;
- Var
- H,S,M,MS : Word;
- begin
- DecodeTime(AValue,H,M,S,MS);
- Result:=M*60+S;
- end;
- Function MilliSecondOfTheHour(const AValue: TDateTime): LongWord;
- Var
- H,S,M,MS : Word;
- begin
- DecodeTime(AValue,H,M,S,MS);
- Result:=(M*60+S)*1000+MS;
- end;
- { ---------------------------------------------------------------------
- Part of minute functions.
- ---------------------------------------------------------------------}
- Function SecondOfTheMinute(const AValue: TDateTime): Word;
- Var
- H,M,MS : Word;
- begin
- DecodeTime(AValue,H,M,Result,MS);
- end;
- Function MilliSecondOfTheMinute(const AValue: TDateTime): LongWord;
- Var
- H,S,M,MS : Word;
- begin
- DecodeTime(AValue,H,M,S,MS);
- Result:=S*1000+MS;
- end;
- { ---------------------------------------------------------------------
- Part of second functions.
- ---------------------------------------------------------------------}
- Function MilliSecondOfTheSecond(const AValue: TDateTime): Word;
- Var
- H,M,S : Word;
- begin
- DecodeTime(AValue,H,M,S,Result);
- end;
- { ---------------------------------------------------------------------
- Range checking functions.
- ---------------------------------------------------------------------}
- Function WithinPastYears(const ANow, AThen: TDateTime; const AYears: Integer): Boolean;
- begin
- Result:=YearsBetween(ANow,AThen)<=AYears;
- end;
- Function WithinPastMonths(const ANow, AThen: TDateTime; const AMonths: Integer): Boolean;
- begin
- Result:=MonthsBetween(ANow,AThen)<=AMonths;
- end;
- Function WithinPastWeeks(const ANow, AThen: TDateTime; const AWeeks: Integer): Boolean;
- begin
- Result:=WeeksBetween(ANow,AThen)<=AWeeks;
- end;
- Function WithinPastDays(const ANow, AThen: TDateTime; const ADays: Integer): Boolean;
- begin
- Result:=DaysBetween(ANow,AThen)<=ADays;
- end;
- Function WithinPastHours(const ANow, AThen: TDateTime; const AHours: Int64): Boolean;
- begin
- Result:=HoursBetween(ANow,AThen)<=AHours;
- end;
- Function WithinPastMinutes(const ANow, AThen: TDateTime; const AMinutes: Int64): Boolean;
- begin
- Result:=MinutesBetween(ANow,AThen)<=AMinutes;
- end;
- Function WithinPastSeconds(const ANow, AThen: TDateTime; const ASeconds: Int64): Boolean;
- begin
- Result:=SecondsBetween(ANow,Athen)<=ASeconds;
- end;
- Function WithinPastMilliSeconds(const ANow, AThen: TDateTime; const AMilliSeconds: Int64): Boolean;
- begin
- Result:=MilliSecondsBetween(ANow,AThen)<=AMilliSeconds;
- end;
- { ---------------------------------------------------------------------
- Period functions.
- ---------------------------------------------------------------------}
- {
- These functions are declared as approximate by Borland.
- A bit strange, since it can be calculated exactly ?
- }
- Function YearsBetween(const ANow, AThen: TDateTime): Integer;
- begin
- Result:=Trunc(Abs(ANow-AThen)/ApproxDaysPerYear);
- end;
- Function MonthsBetween(const ANow, AThen: TDateTime): Integer;
- begin
- Result:=Trunc(Abs(ANow-Athen)/ApproxDaysPerMonth);
- end;
- Function WeeksBetween(const ANow, AThen: TDateTime): Integer;
- begin
- Result:=Trunc(Abs(ANow-AThen)) div 7;
- end;
- Function DaysBetween(const ANow, AThen: TDateTime): Integer;
- begin
- Result:=Trunc(Abs(ANow-AThen));
- end;
- Function HoursBetween(const ANow, AThen: TDateTime): Int64;
- begin
- Result:=Trunc(Abs(ANow-AThen)*HoursPerDay);
- end;
- Function MinutesBetween(const ANow, AThen: TDateTime): Int64;
- begin
- Result:=Trunc(Abs(ANow-AThen)*MinsPerDay);
- end;
- Function SecondsBetween(const ANow, AThen: TDateTime): Int64;
- begin
- Result:=Trunc(Abs(ANow-AThen)*SecsPerDay);
- end;
- Function MilliSecondsBetween(const ANow, AThen: TDateTime): Int64;
- begin
- Result:=Trunc(Abs(ANow-AThen)*MSecsPerDay);
- end;
- { ---------------------------------------------------------------------
- Timespan in xxx functions.
- ---------------------------------------------------------------------}
- Function YearSpan(const ANow, AThen: TDateTime): Double;
- begin
- Result:=Abs(Anow-Athen)/ApproxDaysPerYear;
- end;
- Function MonthSpan(const ANow, AThen: TDateTime): Double;
- begin
- Result:=Abs(ANow-AThen)/ApproxDaysPerMonth;
- end;
- Function WeekSpan(const ANow, AThen: TDateTime): Double;
- begin
- Result:=Abs(ANow-AThen) / 7
- end;
- Function DaySpan(const ANow, AThen: TDateTime): Double;
- begin
- Result:=Abs(ANow-AThen);
- end;
- Function HourSpan(const ANow, AThen: TDateTime): Double;
- begin
- Result:=Abs(ANow-AThen)*HoursPerDay;
- end;
- Function MinuteSpan(const ANow, AThen: TDateTime): Double;
- begin
- Result:=Abs(ANow-AThen)*MinsPerDay;
- end;
- Function SecondSpan(const ANow, AThen: TDateTime): Double;
- begin
- Result:=Abs(ANow-AThen)*SecsPerDay;
- end;
- Function MilliSecondSpan(const ANow, AThen: TDateTime): Double;
- begin
- Result:=Abs(ANow-AThen)*MSecsPerDay;
- end;
- { ---------------------------------------------------------------------
- Increment/decrement functions.
- ---------------------------------------------------------------------}
- Function IncYear(const AValue: TDateTime; const ANumberOfYears: Integer ): TDateTime;
- Var
- Y,M,D,H,N,S,MS : Word;
- begin
- DecodeDateTime(AValue,Y,M,D,H,N,S,MS);
- Y:=Y+ANumberOfYears;
- If (M=2) and (D=29) And (Not IsLeapYear(Y)) then
- D:=28;
- Result:=EncodeDateTime(Y,M,D,H,N,S,MS);
- end;
- Function IncYear(const AValue: TDateTime): TDateTime; // ; const ANumberOfYears: Integer = 1)
- begin
- Result:=IncYear(Avalue,1);
- end;
- Function IncWeek(const AValue: TDateTime; const ANumberOfWeeks: Integer): TDateTime;
- begin
- Result:=AValue+ANumberOfWeeks*7;
- end;
- Function IncWeek(const AValue: TDateTime): TDateTime; // ; const ANumberOfWeeks: Integer = 1)
- begin
- Result:=IncWeek(Avalue,1);
- end;
- Function IncDay(const AValue: TDateTime; const ANumberOfDays: Integer): TDateTime;
- begin
- Result:=AValue+ANumberOfDays;
- end;
- Function IncDay(const AValue: TDateTime): TDateTime; //; const ANumberOfDays: Integer = 1)
- begin
- Result:=IncDay(Avalue,1);
- end;
- Function IncHour(const AValue: TDateTime; const ANumberOfHours: Int64): TDateTime;
- begin
- Result:=AValue+ANumberOfHours/HoursPerDay;
- end;
- Function IncHour(const AValue: TDateTime): TDateTime; //; const ANumberOfHours: Int64 = 1
- begin
- Result:=IncHour(AValue,1);
- end;
- Function IncMinute(const AValue: TDateTime; const ANumberOfMinutes: Int64): TDateTime;
- begin
- Result:=AValue+ANumberOfMinutes / MinsPerDay;
- end;
- Function IncMinute(const AValue: TDateTime): TDateTime; // ; const ANumberOfMinutes: Int64 = 1
- begin
- Result:=IncMinute(AValue,1);
- end;
- Function IncSecond(const AValue: TDateTime; const ANumberOfSeconds: Int64): TDateTime;
- begin
- Result:=AValue+ANumberOfSeconds / SecsPerDay;
- end;
- Function IncSecond(const AValue: TDateTime): TDateTime; // ; const ANumberOfSeconds: Int64 = 1
- begin
- Result:=IncSecond(Avalue,1);
- end;
- Function IncMilliSecond(const AValue: TDateTime; const ANumberOfMilliSeconds: Int64): TDateTime;
- begin
- Result:=AValue+ANumberOfMilliSeconds/MSecsPerDay;
- end;
- Function IncMilliSecond(const AValue: TDateTime): TDateTime; // ; const ANumberOfMilliSeconds: Int64 = 1
- begin
- Result:=IncMilliSecond(AValue,1);
- end;
- { ---------------------------------------------------------------------
- Encode/Decode of complete timestamp
- ---------------------------------------------------------------------}
- Function EncodeDateTime(const AYear, AMonth, ADay, AHour, AMinute, ASecond, AMilliSecond: Word): TDateTime;
- begin
- If Not TryEncodeDateTime(AYear, AMonth, ADay, AHour, AMinute, ASecond, AMilliSecond,Result) then
- InvalidDateTimeError(AYear, AMonth, ADay, AHour, AMinute, ASecond, AMilliSecond)
- end;
- Procedure DecodeDateTime(const AValue: TDateTime; var AYear, AMonth, ADay, AHour, AMinute, ASecond, AMilliSecond: Word);
- begin
- DecodeDate(AValue,AYear,AMonth,ADay);
- DecodeTime(AValue,AHour,AMinute,ASecond,AMilliSecond);
- end;
- Function TryEncodeDateTime(const AYear, AMonth, ADay, AHour, AMinute, ASecond, AMilliSecond: Word; var AValue: TDateTime): Boolean;
- Var
- tmp : TDateTime;
- begin
- Result:=TryEncodeDate(AYear,AMonth,ADay,AValue);
- Result:=Result and TryEncodeTime(AHour,AMinute,ASecond,Amillisecond,Tmp);
- If Result then
- Avalue:=AValue+Tmp;
- end;
- { ---------------------------------------------------------------------
- Encode/decode date, specifying week of year and day of week
- ---------------------------------------------------------------------}
- Function EncodeDateWeek(const AYear, AWeekOfYear: Word; const ADayOfWeek: Word): TDateTime;
- begin
- If Not TryEncodeDateWeek(AYear,AWeekOfYear,Result,ADayOfWeek) then
- InvalidDateWeekError(AYear,AWeekOfYear,ADayOfWeek);
- end;
- Function EncodeDateWeek(const AYear, AWeekOfYear: Word): TDateTime; //; const ADayOfWeek: Word = 1
- begin
- Result := EncodeDateWeek(AYear,AWeekOfYear,1);
- end;
- Procedure DecodeDateWeek(const AValue: TDateTime; var AYear, AWeekOfYear, ADayOfWeek: Word);
- var
- DOY : Integer;
- D: Word;
- YS : TDateTime;
- YSDOW, YEDOW: Word;
- begin
- AYear:=YearOf(AValue);
- // Correct to ISO DOW
- ADayOfWeek:=DayOfWeek(AValue)-1;
- If ADAyOfWeek=0 then
- ADayofweek:=7;
- YS:=StartOfAYear(AYear);
- DOY:=Trunc(AValue-YS)+1;
- YSDOW:=DayOfTheWeek(YS);
- // Correct week if later than wednesday. First week never starts later than wednesday
- if (YSDOW<5) then
- Inc(DOY,YSDOW-1)
- else
- Dec(DOY,8-YSDOW);
- if (DOY<=0) then // Day is in last week of previous year.
- DecodeDateWeek(YS-1,AYear,AWeekOfYear,D)
- else
- begin
- AWeekOfYear:=DOY div 7;
- if ((DOY mod 7)<>0) then
- Inc(AWeekOfYear);
- if (AWeekOfYear>52) then // Maybe in first week of next year ?
- begin
- YEDOW:=YSDOW;
- if IsLeapYear(AYear) then
- begin
- Inc(YEDOW);
- if (YEDOW>7) then
- YEDOW:=1
- else
- end;
- if (YEDOW<4) then // Really next year.
- begin
- Inc(AYear);
- AWeekOfYear:=1;
- end;
- end;
- end;
- end;
- Function TryEncodeDateWeek(const AYear, AWeekOfYear: Word; var AValue: TDateTime; const ADayOfWeek: Word): Boolean;
- Var
- DOW : Word;
- Rest : Integer;
- begin
- Result:=IsValidDateWeek(Ayear,AWeekOfYear,ADayOfWeek);
- If Result then
- begin
- AValue:=EncodeDate(AYear,1,1)+(7*(AWeekOfYear-1));
- DOW:=DayOfTheWeek(AValue);
- Rest:=ADayOfWeek-DOW;
- If (DOW>4) then
- Inc(Rest,7);
- AValue:=AValue+Rest;
- end;
- end;
- Function TryEncodeDateWeek(const AYear, AWeekOfYear: Word; var AValue: TDateTime): Boolean; //; const ADayOfWeek: Word = 1
- begin
- Result:=TryEncodeDateWeek(AYear,AWeekOfYear,AValue,1);
- end;
- { ---------------------------------------------------------------------
- Encode/decode date, specifying day of year
- ---------------------------------------------------------------------}
- Function EncodeDateDay(const AYear, ADayOfYear: Word): TDateTime;
- begin
- If Not TryEncodeDateDay(AYear,ADayOfYear,Result) then
- InvalidDateDayError(AYear,ADayOfYear);
- end;
- Procedure DecodeDateDay(const AValue: TDateTime; var AYear, ADayOfYear: Word);
- Var
- M,D : Word;
- begin
- DecodeDate(AValue,AYear,M,D);
- ADayOfyear:=Trunc(AValue-EncodeDate(AYear,1,1))+1;
- end;
- Function TryEncodeDateDay(const AYear, ADayOfYear: Word; var AValue: TDateTime): Boolean;
- begin
- Result:=(ADayOfYear<>0) and (ADayOfYear<=DaysPerYear [IsleapYear(AYear)]);
- If Result then
- AValue:=EncodeDate(AYear,1,1)+ADayOfYear-1;
- end;
- { ---------------------------------------------------------------------
- Encode/decode date, specifying week of month
- ---------------------------------------------------------------------}
- Function EncodeDateMonthWeek(const AYear, AMonth, AWeekOfMonth, ADayOfWeek: Word): TDateTime;
- begin
- If Not TryEncodeDateMonthWeek(Ayear,AMonth,AWeekOfMonth,ADayOfWeek,Result) then
- InvalidDateMonthWeekError(AYear,AMonth,AWeekOfMonth,ADayOfWeek);
- end;
- Procedure DecodeDateMonthWeek(const AValue: TDateTime; var AYear, AMonth, AWeekOfMonth, ADayOfWeek: Word);
- Var
- D,SDOM,EDOM : Word;
- SOM : TdateTime;
- DOM : Integer;
- begin
- DecodeDate(AValue,AYear,AMonth,D);
- ADayOfWeek:=DayOfTheWeek(AValue);
- SOM:=EncodeDate(Ayear,Amonth,1);
- SDOM:=DayOfTheWeek(SOM);
- DOM:=D-1+SDOM;
- If SDOM>4 then
- Dec(DOM,7);
- // Too early in the month. First full week is next week, day is after thursday.
- If DOM<=0 Then
- DecodeDateMonthWeek(SOM-1,AYear,AMonth,AWeekOfMonth,D)
- else
- begin
- AWeekOfMonth:=(DOM div 7)+Ord((DOM mod 7)<>0);
- EDOM:=DayOfTheWeek(EndOfAMonth(Ayear,AMonth));
- // In last days of last long week, so in next month...
- If (EDOM<4) and ((DaysInAMonth(AYear,Amonth)-D)<EDOM) then
- begin
- AWeekOfMonth:=1;
- Inc(AMonth);
- If (AMonth=13) then
- begin
- AMonth:=1;
- Inc(AYear);
- end;
- end;
- end;
- end;
- Function TryEncodeDateMonthWeek(const AYear, AMonth, AWeekOfMonth, ADayOfWeek: Word; var AValue: TDateTime): Boolean;
- var
- S : Word;
- DOM : Integer;
- begin
- Result:=IsValidDateMonthWeek(AYear,AMonth,AWeekOfMonth,ADayOfWeek);
- if Result then
- begin
- AValue:=EncodeDate(AYear,AMonth,1);
- DOM:=(AWeekOfMonth-1)*7+ADayOfWeek-1;
- { Correct for first week in last month.}
- S:=DayOfTheWeek(AValue);
- Dec(DOM,S-1);
- if S in [DayFriday..DaySunday] then
- Inc(DOM,7);
- AValue:=AValue+DOM;
- end;
- end;
- { ---------------------------------------------------------------------
- Replace given element with supplied value.
- ---------------------------------------------------------------------}
- Const
- LFAI = RecodeLeaveFieldAsIS; // Less typing, readable code
- {
- Note: We have little choice but to implement it like Borland did:
- If AValue contains some 'wrong' value, it will throw an error.
- To simulate this we'd have to check in each function whether
- both arguments are correct. To avoid it, all is routed through
- the 'central' RecodeDateTime function as in Borland's implementation.
- }
- Function RecodeYear(const AValue: TDateTime; const AYear: Word): TDateTime;
- begin
- Result := RecodeDateTime(AValue,AYear,LFAI,LFAI,LFAI,LFAI,LFAI,LFAI);
- end;
- Function RecodeMonth(const AValue: TDateTime; const AMonth: Word): TDateTime;
- begin
- Result := RecodeDateTime(AValue,LFAI,AMonth,LFAI,LFAI,LFAI,LFAI,LFAI);
- end;
- Function RecodeDay(const AValue: TDateTime; const ADay: Word): TDateTime;
- begin
- Result := RecodeDateTime(AValue,LFAI,LFAI,ADay,LFAI,LFAI,LFAI,LFAI);
- end;
- Function RecodeHour(const AValue: TDateTime; const AHour: Word): TDateTime;
- begin
- Result := RecodeDateTime(AValue,LFAI,LFAI,LFAI,AHour,LFAI,LFAI,LFAI);
- end;
- Function RecodeMinute(const AValue: TDateTime; const AMinute: Word): TDateTime;
- begin
- Result := RecodeDateTime(AValue,LFAI,LFAI,LFAI,LFAI,AMinute,LFAI,LFAI);
- end;
- Function RecodeSecond(const AValue: TDateTime; const ASecond: Word): TDateTime;
- begin
- Result := RecodeDateTime(AValue,LFAI,LFAI,LFAI,LFAI,LFAI,ASecond,LFAI);
- end;
- Function RecodeMilliSecond(const AValue: TDateTime; const AMilliSecond: Word): TDateTime;
- begin
- Result := RecodeDateTime(AValue,LFAI,LFAI,LFAI,LFAI,LFAI,LFAI,AMilliSecond);
- end;
- Function RecodeDate(const AValue: TDateTime; const AYear, AMonth, ADay: Word): TDateTime;
- begin
- Result := RecodeDateTime(AValue,AYear,AMonth,ADay,LFAI,LFAI,LFAI,LFAI);
- end;
- Function RecodeTime(const AValue: TDateTime; const AHour, AMinute, ASecond, AMilliSecond: Word): TDateTime;
- begin
- Result := RecodeDateTime(AValue,LFAI,LFAI,LFAI,AHour,AMinute,ASecond,AMilliSecond);
- end;
- Function RecodeDateTime(const AValue: TDateTime; const AYear, AMonth, ADay, AHour, AMinute, ASecond, AMilliSecond: Word): TDateTime;
- begin
- If Not TryRecodeDateTime(AValue,AYear,AMonth,ADay,AHour,AMinute,ASecond,AMilliSecond,Result) then
- InvalidDateTimeError(AYear,AMonth,ADay,AHour,AMinute,ASecond,AMilliSecond,AValue);
- end;
- Function TryRecodeDateTime(const AValue: TDateTime; const AYear, AMonth, ADay, AHour, AMinute, ASecond, AMilliSecond: Word; var AResult: TDateTime): Boolean;
- Procedure FV (Var AV : Word; Arg : Word);
- begin
- If (Arg<>LFAI) then
- AV:=Arg;
- end;
- Var
- Y,M,D,H,N,S,MS : Word;
- begin
- DecodeDateTime(AValue,Y,M,D,H,N,S,MS);
- FV(Y,AYear);
- FV(M,AMonth);
- FV(D,ADay);
- FV(H,AHour);
- FV(N,AMinute);
- FV(S,ASecond);
- FV(MS,AMillisecond);
- Result:=TryEncodeDateTime(Y,M,D,H,N,S,MS,AResult);
- end;
- { ---------------------------------------------------------------------
- Comparision of date/time
- ---------------------------------------------------------------------}
- Function CompareDateTime(const A, B: TDateTime): TValueRelationship;
- begin
- If SameDateTime(A,B) then
- Result:=EqualsValue
- else If A>B then
- Result:=GreaterThanValue
- else
- Result:=LessThanValue
- end;
- Function CompareDate(const A, B: TDateTime): TValueRelationship;
- begin
- If SameDate(A,B) then
- Result:=EQualsValue
- else if A<B then
- Result:=LessThanValue
- else
- Result:=GreaterThanValue;
- end;
- Function CompareTime(const A, B: TDateTime): TValueRelationship;
- begin
- If SameTime(A,B) then
- Result:=EQualsValue
- else If Frac(A)<Frac(B) then
- Result:=LessThanValue
- else
- Result:=GreaterThanValue;
- end;
- Function SameDateTime(const A, B: TDateTime): Boolean;
- begin
- Result:=Abs(A-B)<OneMilliSecond;
- end;
- Function SameDate(const A, B: TDateTime): Boolean;
- begin
- Result:=Trunc(A)=Trunc(B);
- end;
- Function SameTime(const A, B: TDateTime): Boolean;
- begin
- Result:=Frac(Abs(A-B))<OneMilliSecond;
- end;
- Function InternalNthDayOfWeek(DoM : Word) : Word;
- begin
- Result:=(Dom-1) div 7 +1;
- end;
- Function NthDayOfWeek(const AValue: TDateTime): Word;
- begin
- Result:=InternalNthDayOfWeek(DayOfTheMonth(AValue));
- end;
- Procedure DecodeDayOfWeekInMonth(const AValue: TDateTime; var AYear, AMonth, ANthDayOfWeek, ADayOfWeek: Word);
- var
- D: Word;
- begin
- DecodeDate(AValue,AYear,AMonth,D);
- ADayOfWeek:=DayOfTheWeek(AValue);
- ANthDayOfWeek:=InternalNthDayOfWeek(D);
- end;
- Function EncodeDayOfWeekInMonth(const AYear, AMonth, ANthDayOfWeek, ADayOfWeek: Word): TDateTime;
- begin
- If Not TryEncodeDayOfWeekInMonth(AYear,AMonth,ANthDayOfWeek,ADayOfWeek,Result) then
- InvalidDayOfWeekInMonthError(AYear,AMonth,ANthDayOfWeek,ADayOfWeek);
- end;
- Function TryEncodeDayOfWeekInMonth(const AYear, AMonth, ANthDayOfWeek, ADayOfWeek: Word; var AValue: TDateTime): Boolean;
- Var
- SOM,D : Word;
- begin
- SOM:=DayOfTheWeek(EncodeDate(Ayear,AMonth,1));
- D:=1+ADayOfWeek-SOM+7*(ANthDayOfWeek-1);
- If SOM>ADayOfWeek then
- D:=D+7; // Clearer would have been Inc(ANthDayOfweek) but it's a const
- Result:=TryEncodeDate(Ayear,AMonth,D,AValue);
- end;
- { ---------------------------------------------------------------------
- Exception throwing routines
- ---------------------------------------------------------------------}
- Procedure InvalidDateTimeError(const AYear, AMonth, ADay, AHour, AMinute, ASecond, AMilliSecond: Word; const ABaseDate: TDateTime);
- Function DoField(Arg,Def : Word; Unknown: String) : String;
- begin
- If (Arg<>LFAI) then
- Result:=Format('%.*d',[Length(Unknown),Arg])
- else if (ABaseDate=0) then
- Result:=Unknown
- else
- Result:=Format('%.*d',[Length(Unknown),Arg]);
- end;
- Var
- Y,M,D,H,N,S,MS : Word;
- Msg : String;
- begin
- DecodeDateTime(ABasedate,Y,M,D,H,N,S,MS);
- Msg:=DoField(AYear,Y,'????');
- Msg:=Msg+DateSeparator+DoField(AMonth,M,'??');
- Msg:=Msg+DateSeparator+DoField(ADay,D,'??');
- Msg:=Msg+' '+DoField(AHour,H,'??');
- Msg:=Msg+TimeSeparator+DoField(AMinute,N,'??');
- Msg:=Msg+TimeSeparator+Dofield(ASecond,S,'??');
- Msg:=Msg+DecimalSeparator+DoField(AMilliSecond,MS,'???');
- Raise EConvertError.CreateFmt(SErrInvalidTimeStamp,[Msg]);
- end;
- Procedure InvalidDateTimeError(const AYear, AMonth, ADay, AHour, AMinute, ASecond, AMilliSecond: Word); // const ABaseDate: TDateTime = 0
- begin
- InvalidDateTimeError(AYear,AMonth,ADay,AHour,AMinute,ASecond,AMilliSecond,0);
- end;
- Procedure InvalidDateWeekError(const AYear, AWeekOfYear, ADayOfWeek: Word);
- begin
- Raise EConvertError.CreateFmt(SErrInvalidDateWeek,[AYear,AWeekOfYear,ADayOfWeek]);
- end;
- Procedure InvalidDateDayError(const AYear, ADayOfYear: Word);
- begin
- Raise EConvertError.CreateFmt(SErrInvalidDayOfYear,[AYear,ADayOfYear]);
- end;
- Procedure InvalidDateMonthWeekError(const AYear, AMonth, AWeekOfMonth, ADayOfWeek: Word);
- begin
- Raise EConvertError.CreateFmt(SErrInvalidDateMonthWeek,[Ayear,AMonth,AWeekOfMonth,ADayOfWeek]);
- end;
- Procedure InvalidDayOfWeekInMonthError(const AYear, AMonth, ANthDayOfWeek, ADayOfWeek: Word);
- begin
- Raise EConvertError.CreateFmt(SErrInvalidDayOfWeekInMonth,[AYear,AMonth,ANthDayOfWeek,ADayOfWeek]);
- end;
- { ---------------------------------------------------------------------
- Julian and Modified Julian Date conversion support
- ---------------------------------------------------------------------}
- {$warnings off}
- Function DateTimeToJulianDate(const AValue: TDateTime): Double;
- begin
- NotYetImplemented('DateTimeToJulianDate');
- end;
- Function JulianDateToDateTime(const AValue: Double): TDateTime;
- begin
- NotYetImplemented('JulianDateToDateTime');
- end;
- Function TryJulianDateToDateTime(const AValue: Double; var ADateTime: TDateTime): Boolean;
- begin
- NotYetImplemented('TryJulianDateToDateTime');
- end;
- Function DateTimeToModifiedJulianDate(const AValue: TDateTime): Double;
- begin
- NotYetImplemented('DateTimeToModifiedJulianDate');
- end;
- Function ModifiedJulianDateToDateTime(const AValue: Double): TDateTime;
- begin
- NotYetImplemented('ModifiedJulianDateToDateTime');
- end;
- Function TryModifiedJulianDateToDateTime(const AValue: Double; var ADateTime: TDateTime): Boolean;
- begin
- NotYetImplemented('TryModifiedJulianDateToDateTime');
- end;
- {$warnings on}
- { ---------------------------------------------------------------------
- Unix timestamp support.
- ---------------------------------------------------------------------}
- Function DateTimeToUnix(const AValue: TDateTime): Int64;
- var
- Epoch:TDateTime;
- begin
- Epoch:=EncodeDateTime( 1970, 1, 1, 0, 0, 0, 0 );
- Result:=SecondsBetween( Epoch, AValue );
- end;
- Function UnixToDateTime(const AValue: Int64): TDateTime;
- var
- Epoch:TDateTime;
- begin
- Epoch:=EncodeDateTime( 1970, 1, 1, 0, 0, 0, 0 );
- Result:=IncSecond( Epoch, AValue );
- end;
- Function UnixTimeStampToMac(const AValue: Int64): Int64;
- const
- Epoch=24107 * 24 * 3600;
- begin
- Result:=AValue + Epoch;
- end;
- { ---------------------------------------------------------------------
- Mac timestamp support.
- ---------------------------------------------------------------------}
- Function DateTimeToMac(const AValue: TDateTime): Int64;
- var
- Epoch:TDateTime;
- begin
- Epoch:=EncodeDateTime( 1904, 1, 1, 0, 0, 0, 0 );
- Result:=SecondsBetween( Epoch, AValue );
- end;
- Function MacToDateTime(const AValue: Int64): TDateTime;
- var
- Epoch:TDateTime;
- begin
- Epoch:=EncodeDateTime( 1904, 1, 1, 0, 0, 0, 0 );
- Result:=IncSecond( Epoch, AValue );
- end;
- Function MacTimeStampToUnix(const AValue: Int64): Int64;
- const
- Epoch=24107 * 24 * 3600;
- begin
- Result:=AValue - Epoch;
- end;
- end.
|