← Back to branch summary

~ubuntu-branches/debian/lenny/fpc/lenny

« back to all changes in this revision

Viewing changes to rtl/objpas/dateutil.inc

  • Committer: Bazaar Package Importer
  • Author(s): Mazen Neifer, Torsten Werner, Mazen Neifer
  • Date: 2008-05-17 17:12:11 UTC
  • mfrom: (3.1.9 intrepid)
  • Revision ID: james.westby@ubuntu.com-20080517171211-9qi33xhd9evfa0kg
Tags: 2.2.0-dfsg1-9
http://bugs.debian.org/477743
[ Torsten Werner ]
* Add Mazen Neifer to Uploaders field.

[ Mazen Neifer ]
* Moved FPC sources into a version dependent directory from /usr/share/fpcsrc
  to /usr/share/fpcsrc/${FPCVERSION}. This allow installing more than on FPC
  release.
* Fixed far call issue in compiler preventing building huge binearies.
  (closes: #477743)
* Updated building dependencies, recomennded and suggested packages.
* Moved fppkg to fp-utils as it is just a helper tool and is not required by
  compiler.

Show diffs side-by-side

added added

removed removed

Lines of Context:
rtl/objpas/dateutil.inc
1
 
{$mode objfpc}
2
 
{$h+}
3
 
{
4
 
    $Id: dateutil.inc,v 1.2 2004/01/10 19:35:17 michael Exp $
5
 
    This file is part of the Free Pascal run time library.
6
 
    Copyright (c) 1999-2000 by the Free Pascal development team
7
 
 
8
 
    Delphi/Kylix compatibility unit, provides Date/Time handling routines.
9
 
 
10
 
    See the file COPYING.FPC, included in this distribution,
11
 
    for details about the copyright.
12
 
 
13
 
    This program is distributed in the hope that it will be useful,
14
 
    but WITHOUT ANY WARRANTY; without even the implied warranty of
15
 
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
16
 
 
17
 
 **********************************************************************}
18
 
 
19
 
unit dateutils;
20
 
 
21
 
interface
22
 
 
23
 
uses
24
 
  SysUtils, Math, Types;
25
 
 
26
 
{ ---------------------------------------------------------------------
27
 
    Various constants
28
 
  ---------------------------------------------------------------------}
29
 
 
30
 
const
31
 
  DaysPerWeek        = 7;
32
 
  WeeksPerFortnight  = 2;
33
 
  MonthsPerYear      = 12;
34
 
  YearsPerDecade     = 10;
35
 
  YearsPerCentury    = 100;
36
 
  YearsPerMillennium = 1000;
37
 
 
38
 
  // ISO day numbers.
39
 
  DayMonday    = 1;
40
 
  DayTuesday   = 2;
41
 
  DayWednesday = 3;
42
 
  DayThursday  = 4;
43
 
  DayFriday    = 5;
44
 
  DaySaturday  = 6;
45
 
  DaySunday    = 7;
46
 
 
47
 
  // Fraction of a day
48
 
  OneHour        = 1/HoursPerDay;
49
 
  OneMinute      = 1/MinsPerDay;
50
 
  OneSecond      = 1/SecsPerDay;
51
 
  OneMillisecond = 1/MSecsPerDay;
52
 
 
53
 
  { This is actual days per year but you need to know if it's a leap year}
54
 
  DaysPerYear: array [Boolean] of Word = (365, 366);
55
 
 
56
 
  { Used in RecodeDate, RecodeTime and RecodeDateTime for those datetime }
57
 
  {  fields you want to leave alone }
58
 
  RecodeLeaveFieldAsIs = High(Word);
59
 
 
60
 
{ ---------------------------------------------------------------------
61
 
    Global variables used in this unit
62
 
  ---------------------------------------------------------------------}
63
 
 
64
 
Const
65
 
 
66
 
  { Average over a 4 year span. Valid for next 100 years }
67
 
  ApproxDaysPerMonth: Double = 30.4375;
68
 
  ApproxDaysPerYear: Double  = 365.25;
69
 
 
70
 
 
71
 
 
72
 
{ ---------------------------------------------------------------------
73
 
    Simple trimming functions.
74
 
  ---------------------------------------------------------------------}
75
 
 
76
 
Function DateOf(const AValue: TDateTime): TDateTime;
77
 
Function TimeOf(const AValue: TDateTime): TDateTime;
78
 
 
79
 
{ ---------------------------------------------------------------------
80
 
    Identification functions.
81
 
  ---------------------------------------------------------------------}
82
 
 
83
 
Function IsInLeapYear(const AValue: TDateTime): Boolean;
84
 
Function IsPM(const AValue: TDateTime): Boolean;
85
 
Function IsValidDate(const AYear, AMonth, ADay: Word): Boolean;
86
 
Function IsValidTime(const AHour, AMinute, ASecond, AMilliSecond: Word): Boolean;
87
 
Function IsValidDateTime(const AYear, AMonth, ADay, AHour, AMinute, ASecond, AMilliSecond: Word): Boolean;
88
 
Function IsValidDateDay(const AYear, ADayOfYear: Word): Boolean;
89
 
Function IsValidDateWeek(const AYear, AWeekOfYear, ADayOfWeek: Word): Boolean;
90
 
Function IsValidDateMonthWeek(const AYear, AMonth, AWeekOfMonth, ADayOfWeek: Word): Boolean;
91
 
 
92
 
{ ---------------------------------------------------------------------
93
 
    Enumeration functions.
94
 
  ---------------------------------------------------------------------}
95
 
 
96
 
Function WeeksInYear(const AValue: TDateTime): Word;
97
 
Function WeeksInAYear(const AYear: Word): Word;
98
 
Function DaysInYear(const AValue: TDateTime): Word;
99
 
Function DaysInAYear(const AYear: Word): Word;
100
 
Function DaysInMonth(const AValue: TDateTime): Word;
101
 
Function DaysInAMonth(const AYear, AMonth: Word): Word;
102
 
 
103
 
 
104
 
{ ---------------------------------------------------------------------
105
 
    Variations on current date/time.
106
 
  ---------------------------------------------------------------------}
107
 
 
108
 
 
109
 
Function Today: TDateTime;
110
 
Function Yesterday: TDateTime;
111
 
Function Tomorrow: TDateTime;
112
 
Function IsToday(const AValue: TDateTime): Boolean;
113
 
Function IsSameDay(const AValue, ABasis: TDateTime): Boolean;
114
 
Function PreviousDayOfWeek (DayOfWeek : Word) : Word;
115
 
 
116
 
{ ---------------------------------------------------------------------
117
 
    Extraction functions.
118
 
  ---------------------------------------------------------------------}
119
 
 
120
 
Function YearOf(const AValue: TDateTime): Word;
121
 
Function MonthOf(const AValue: TDateTime): Word;
122
 
Function WeekOf(const AValue: TDateTime): Word;
123
 
Function DayOf(const AValue: TDateTime): Word;
124
 
Function HourOf(const AValue: TDateTime): Word;
125
 
Function MinuteOf(const AValue: TDateTime): Word;
126
 
Function SecondOf(const AValue: TDateTime): Word;
127
 
Function MilliSecondOf(const AValue: TDateTime): Word;
128
 
 
129
 
{ ---------------------------------------------------------------------
130
 
    Start/End of year functions.
131
 
  ---------------------------------------------------------------------}
132
 
 
133
 
Function StartOfTheYear(const AValue: TDateTime): TDateTime;
134
 
Function EndOfTheYear(const AValue: TDateTime): TDateTime;
135
 
Function StartOfAYear(const AYear: Word): TDateTime;
136
 
Function EndOfAYear(const AYear: Word): TDateTime;
137
 
 
138
 
{ ---------------------------------------------------------------------
139
 
    Start/End of month functions.
140
 
  ---------------------------------------------------------------------}
141
 
 
142
 
Function StartOfTheMonth(const AValue: TDateTime): TDateTime;
143
 
Function EndOfTheMonth(const AValue: TDateTime): TDateTime;
144
 
Function StartOfAMonth(const AYear, AMonth: Word): TDateTime;
145
 
Function EndOfAMonth(const AYear, AMonth: Word): TDateTime;
146
 
 
147
 
{ ---------------------------------------------------------------------
148
 
    Start/End of week functions.
149
 
  ---------------------------------------------------------------------}
150
 
 
151
 
 
152
 
Function StartOfTheWeek(const AValue: TDateTime): TDateTime;
153
 
Function EndOfTheWeek(const AValue: TDateTime): TDateTime;
154
 
Function StartOfAWeek(const AYear, AWeekOfYear: Word; const ADayOfWeek: Word): TDateTime;
155
 
Function StartOfAWeek(const AYear, AWeekOfYear: Word): TDateTime; // ADayOFWeek 1
156
 
Function EndOfAWeek(const AYear, AWeekOfYear: Word; const ADayOfWeek: Word): TDateTime;
157
 
Function EndOfAWeek(const AYear, AWeekOfYear: Word): TDateTime; // const ADayOfWeek: Word = 7
158
 
 
159
 
 
160
 
{ ---------------------------------------------------------------------
161
 
    Start/End of day functions.
162
 
  ---------------------------------------------------------------------}
163
 
 
164
 
Function StartOfTheDay(const AValue: TDateTime): TDateTime;
165
 
Function EndOfTheDay(const AValue: TDateTime): TDateTime;
166
 
Function StartOfADay(const AYear, AMonth, ADay: Word): TDateTime; overload;
167
 
Function StartOfADay(const AYear, ADayOfYear: Word): TDateTime; overload;
168
 
Function EndOfADay(const AYear, AMonth, ADay: Word): TDateTime; overload;
169
 
Function EndOfADay(const AYear, ADayOfYear: Word): TDateTime; overload;
170
 
 
171
 
{ ---------------------------------------------------------------------
172
 
    Part of year functions.
173
 
  ---------------------------------------------------------------------}
174
 
 
175
 
Function MonthOfTheYear(const AValue: TDateTime): Word;
176
 
Function WeekOfTheYear(const AValue: TDateTime): Word; overload;
177
 
Function WeekOfTheYear(const AValue: TDateTime; var AYear: Word): Word; overload;
178
 
Function DayOfTheYear(const AValue: TDateTime): Word;
179
 
Function HourOfTheYear(const AValue: TDateTime): Word;
180
 
Function MinuteOfTheYear(const AValue: TDateTime): LongWord;
181
 
Function SecondOfTheYear(const AValue: TDateTime): LongWord;
182
 
Function MilliSecondOfTheYear(const AValue: TDateTime): Int64;
183
 
 
184
 
{ ---------------------------------------------------------------------
185
 
    Part of month functions.
186
 
  ---------------------------------------------------------------------}
187
 
 
188
 
Function WeekOfTheMonth(const AValue: TDateTime): Word; overload;
189
 
Function WeekOfTheMonth(const AValue: TDateTime; var AYear, AMonth: Word): Word; overload;
190
 
Function DayOfTheMonth(const AValue: TDateTime): Word;
191
 
Function HourOfTheMonth(const AValue: TDateTime): Word;
192
 
Function MinuteOfTheMonth(const AValue: TDateTime): Word;
193
 
Function SecondOfTheMonth(const AValue: TDateTime): LongWord;
194
 
Function MilliSecondOfTheMonth(const AValue: TDateTime): LongWord;
195
 
 
196
 
{ ---------------------------------------------------------------------
197
 
    Part of week functions.
198
 
  ---------------------------------------------------------------------}
199
 
 
200
 
Function DayOfTheWeek(const AValue: TDateTime): Word;
201
 
Function HourOfTheWeek(const AValue: TDateTime): Word;
202
 
Function MinuteOfTheWeek(const AValue: TDateTime): Word;
203
 
Function SecondOfTheWeek(const AValue: TDateTime): LongWord;
204
 
Function MilliSecondOfTheWeek(const AValue: TDateTime): LongWord;
205
 
 
206
 
{ ---------------------------------------------------------------------
207
 
    Part of day functions.
208
 
  ---------------------------------------------------------------------}
209
 
 
210
 
Function HourOfTheDay(const AValue: TDateTime): Word;
211
 
Function MinuteOfTheDay(const AValue: TDateTime): Word;
212
 
Function SecondOfTheDay(const AValue: TDateTime): LongWord;
213
 
Function MilliSecondOfTheDay(const AValue: TDateTime): LongWord;
214
 
 
215
 
{ ---------------------------------------------------------------------
216
 
    Part of hour functions.
217
 
  ---------------------------------------------------------------------}
218
 
 
219
 
Function MinuteOfTheHour(const AValue: TDateTime): Word;
220
 
Function SecondOfTheHour(const AValue: TDateTime): Word;
221
 
Function MilliSecondOfTheHour(const AValue: TDateTime): LongWord;
222
 
 
223
 
{ ---------------------------------------------------------------------
224
 
    Part of minute functions.
225
 
  ---------------------------------------------------------------------}
226
 
 
227
 
 
228
 
Function SecondOfTheMinute(const AValue: TDateTime): Word;
229
 
Function MilliSecondOfTheMinute(const AValue: TDateTime): LongWord;
230
 
 
231
 
{ ---------------------------------------------------------------------
232
 
    Part of second functions.
233
 
  ---------------------------------------------------------------------}
234
 
 
235
 
Function MilliSecondOfTheSecond(const AValue: TDateTime): Word;
236
 
 
237
 
 
238
 
{ ---------------------------------------------------------------------
239
 
    Range checking functions.
240
 
  ---------------------------------------------------------------------}
241
 
 
242
 
Function WithinPastYears(const ANow, AThen: TDateTime; const AYears: Integer): Boolean;
243
 
Function WithinPastMonths(const ANow, AThen: TDateTime; const AMonths: Integer): Boolean;
244
 
Function WithinPastWeeks(const ANow, AThen: TDateTime; const AWeeks: Integer): Boolean;
245
 
Function WithinPastDays(const ANow, AThen: TDateTime; const ADays: Integer): Boolean;
246
 
Function WithinPastHours(const ANow, AThen: TDateTime; const AHours: Int64): Boolean;
247
 
Function WithinPastMinutes(const ANow, AThen: TDateTime; const AMinutes: Int64): Boolean;
248
 
Function WithinPastSeconds(const ANow, AThen: TDateTime; const ASeconds: Int64): Boolean;
249
 
Function WithinPastMilliSeconds(const ANow, AThen: TDateTime; const AMilliSeconds: Int64): Boolean;
250
 
 
251
 
{ ---------------------------------------------------------------------
252
 
    Period functions.
253
 
  ---------------------------------------------------------------------}
254
 
 
255
 
Function YearsBetween(const ANow, AThen: TDateTime): Integer;
256
 
Function MonthsBetween(const ANow, AThen: TDateTime): Integer;
257
 
Function WeeksBetween(const ANow, AThen: TDateTime): Integer;
258
 
Function DaysBetween(const ANow, AThen: TDateTime): Integer;
259
 
Function HoursBetween(const ANow, AThen: TDateTime): Int64;
260
 
Function MinutesBetween(const ANow, AThen: TDateTime): Int64;
261
 
Function SecondsBetween(const ANow, AThen: TDateTime): Int64;
262
 
Function MilliSecondsBetween(const ANow, AThen: TDateTime): Int64;
263
 
 
264
 
{ ---------------------------------------------------------------------
265
 
    Timespan in xxx functions.
266
 
  ---------------------------------------------------------------------}
267
 
 
268
 
{ YearSpan and MonthSpan are approximate values }
269
 
Function YearSpan(const ANow, AThen: TDateTime): Double;
270
 
Function MonthSpan(const ANow, AThen: TDateTime): Double;
271
 
Function WeekSpan(const ANow, AThen: TDateTime): Double;
272
 
Function DaySpan(const ANow, AThen: TDateTime): Double;
273
 
Function HourSpan(const ANow, AThen: TDateTime): Double;
274
 
Function MinuteSpan(const ANow, AThen: TDateTime): Double;
275
 
Function SecondSpan(const ANow, AThen: TDateTime): Double;
276
 
Function MilliSecondSpan(const ANow, AThen: TDateTime): Double;
277
 
 
278
 
{ ---------------------------------------------------------------------
279
 
    Increment/decrement functions.
280
 
  ---------------------------------------------------------------------}
281
 
 
282
 
Function IncYear(const AValue: TDateTime; const ANumberOfYears: Integer ): TDateTime;
283
 
Function IncYear(const AValue: TDateTime): TDateTime; // ; const ANumberOfYears: Integer = 1)
284
 
// Function IncMonth is in SysUtils
285
 
Function IncWeek(const AValue: TDateTime; const ANumberOfWeeks: Integer): TDateTime;
286
 
Function IncWeek(const AValue: TDateTime): TDateTime; // ; const ANumberOfWeeks: Integer = 1)
287
 
Function IncDay(const AValue: TDateTime; const ANumberOfDays: Integer): TDateTime;
288
 
Function IncDay(const AValue: TDateTime): TDateTime; //; const ANumberOfDays: Integer = 1)
289
 
Function IncHour(const AValue: TDateTime; const ANumberOfHours: Int64): TDateTime;
290
 
Function IncHour(const AValue: TDateTime): TDateTime; //; const ANumberOfHours: Int64 = 1
291
 
Function IncMinute(const AValue: TDateTime; const ANumberOfMinutes: Int64): TDateTime;
292
 
Function IncMinute(const AValue: TDateTime): TDateTime; // ; const ANumberOfMinutes: Int64 = 1
293
 
Function IncSecond(const AValue: TDateTime; const ANumberOfSeconds: Int64): TDateTime;
294
 
Function IncSecond(const AValue: TDateTime): TDateTime; // ; const ANumberOfSeconds: Int64 = 1
295
 
Function IncMilliSecond(const AValue: TDateTime; const ANumberOfMilliSeconds: Int64): TDateTime;
296
 
Function IncMilliSecond(const AValue: TDateTime): TDateTime; // ; const ANumberOfMilliSeconds: Int64 = 1
297
 
 
298
 
{ ---------------------------------------------------------------------
299
 
    Encode/Decode of complete timestamp
300
 
  ---------------------------------------------------------------------}
301
 
 
302
 
Function EncodeDateTime(const AYear, AMonth, ADay, AHour, AMinute, ASecond, AMilliSecond: Word): TDateTime;
303
 
Procedure DecodeDateTime(const AValue: TDateTime; var AYear, AMonth, ADay, AHour, AMinute, ASecond, AMilliSecond: Word);
304
 
Function TryEncodeDateTime(const AYear, AMonth, ADay, AHour, AMinute, ASecond, AMilliSecond: Word; var AValue: TDateTime): Boolean;
305
 
 
306
 
{ ---------------------------------------------------------------------
307
 
    Encode/decode date, specifying week of year and day of week
308
 
  ---------------------------------------------------------------------}
309
 
 
310
 
Function EncodeDateWeek(const AYear, AWeekOfYear: Word; const ADayOfWeek: Word): TDateTime;
311
 
Function EncodeDateWeek(const AYear, AWeekOfYear: Word): TDateTime; //; const ADayOfWeek: Word = 1
312
 
Procedure DecodeDateWeek(const AValue: TDateTime; var AYear, AWeekOfYear, ADayOfWeek: Word);
313
 
Function TryEncodeDateWeek(const AYear, AWeekOfYear: Word; var AValue: TDateTime; const ADayOfWeek: Word): Boolean;
314
 
Function TryEncodeDateWeek(const AYear, AWeekOfYear: Word; var AValue: TDateTime): Boolean; //; const ADayOfWeek: Word = 1
315
 
 
316
 
{ ---------------------------------------------------------------------
317
 
    Encode/decode date, specifying day of year
318
 
  ---------------------------------------------------------------------}
319
 
 
320
 
Function EncodeDateDay(const AYear, ADayOfYear: Word): TDateTime;
321
 
Procedure DecodeDateDay(const AValue: TDateTime; var AYear, ADayOfYear: Word);
322
 
Function TryEncodeDateDay(const AYear, ADayOfYear: Word; var AValue: TDateTime): Boolean;
323
 
 
324
 
{ ---------------------------------------------------------------------
325
 
    Encode/decode date, specifying week of month
326
 
  ---------------------------------------------------------------------}
327
 
 
328
 
Function EncodeDateMonthWeek(const AYear, AMonth, AWeekOfMonth, ADayOfWeek: Word): TDateTime;
329
 
Procedure DecodeDateMonthWeek(const AValue: TDateTime; var AYear, AMonth, AWeekOfMonth, ADayOfWeek: Word);
330
 
Function TryEncodeDateMonthWeek(const AYear, AMonth, AWeekOfMonth, ADayOfWeek: Word; var AValue: TDateTime): Boolean;
331
 
 
332
 
{ ---------------------------------------------------------------------
333
 
    Replace given element with supplied value.
334
 
  ---------------------------------------------------------------------}
335
 
 
336
 
Function RecodeYear(const AValue: TDateTime; const AYear: Word): TDateTime;
337
 
Function RecodeMonth(const AValue: TDateTime; const AMonth: Word): TDateTime;
338
 
Function RecodeDay(const AValue: TDateTime; const ADay: Word): TDateTime;
339
 
Function RecodeHour(const AValue: TDateTime; const AHour: Word): TDateTime;
340
 
Function RecodeMinute(const AValue: TDateTime; const AMinute: Word): TDateTime;
341
 
Function RecodeSecond(const AValue: TDateTime; const ASecond: Word): TDateTime;
342
 
Function RecodeMilliSecond(const AValue: TDateTime; const AMilliSecond: Word): TDateTime;
343
 
Function RecodeDate(const AValue: TDateTime; const AYear, AMonth, ADay: Word): TDateTime;
344
 
Function RecodeTime(const AValue: TDateTime; const AHour, AMinute, ASecond, AMilliSecond: Word): TDateTime;
345
 
Function RecodeDateTime(const AValue: TDateTime; const AYear, AMonth, ADay, AHour, AMinute, ASecond, AMilliSecond: Word): TDateTime;
346
 
Function TryRecodeDateTime(const AValue: TDateTime; const AYear, AMonth, ADay, AHour, AMinute, ASecond, AMilliSecond: Word; var AResult: TDateTime): Boolean;
347
 
 
348
 
{ ---------------------------------------------------------------------
349
 
    Comparision of date/time
350
 
  ---------------------------------------------------------------------}
351
 
 
352
 
Function CompareDateTime(const A, B: TDateTime): TValueRelationship;
353
 
Function CompareDate(const A, B: TDateTime): TValueRelationship;
354
 
Function CompareTime(const A, B: TDateTime): TValueRelationship;
355
 
Function SameDateTime(const A, B: TDateTime): Boolean;
356
 
Function SameDate(const A, B: TDateTime): Boolean;
357
 
Function SameTime(const A, B: TDateTime): Boolean;
358
 
 
359
 
{ For a given date these Functions tell you the which day of the week of the
360
 
  month (or year).  If its a Thursday, they will tell you if its the first,
361
 
  second, etc Thursday of the month (or year).  Remember, even though its
362
 
  the first Thursday of the year it doesn't mean its the first week of the
363
 
  year.  See ISO 8601 above for more information. }
364
 
 
365
 
Function NthDayOfWeek(const AValue: TDateTime): Word;
366
 
 
367
 
Procedure DecodeDayOfWeekInMonth(const AValue: TDateTime; var AYear, AMonth, ANthDayOfWeek, ADayOfWeek: Word);
368
 
 
369
 
Function EncodeDayOfWeekInMonth(const AYear, AMonth, ANthDayOfWeek,  ADayOfWeek: Word): TDateTime;
370
 
Function TryEncodeDayOfWeekInMonth(const AYear, AMonth, ANthDayOfWeek,  ADayOfWeek: Word; var AValue: TDateTime): Boolean;
371
 
 
372
 
{ ---------------------------------------------------------------------
373
 
    Exception throwing routines
374
 
  ---------------------------------------------------------------------}
375
 
 
376
 
Procedure InvalidDateTimeError(const AYear, AMonth, ADay, AHour, AMinute, ASecond, AMilliSecond: Word; const ABaseDate: TDateTime);
377
 
Procedure InvalidDateTimeError(const AYear, AMonth, ADay, AHour, AMinute, ASecond, AMilliSecond: Word); // const ABaseDate: TDateTime = 0
378
 
Procedure InvalidDateWeekError(const AYear, AWeekOfYear, ADayOfWeek: Word);
379
 
Procedure InvalidDateDayError(const AYear, ADayOfYear: Word);
380
 
Procedure InvalidDateMonthWeekError(const AYear, AMonth, AWeekOfMonth, ADayOfWeek: Word);
381
 
Procedure InvalidDayOfWeekInMonthError(const AYear, AMonth, ANthDayOfWeek,  ADayOfWeek: Word);
382
 
 
383
 
{ ---------------------------------------------------------------------
384
 
    Julian and Modified Julian Date conversion support
385
 
  ---------------------------------------------------------------------}
386
 
 
387
 
Function DateTimeToJulianDate(const AValue: TDateTime): Double;
388
 
Function JulianDateToDateTime(const AValue: Double): TDateTime;
389
 
Function TryJulianDateToDateTime(const AValue: Double; var ADateTime: TDateTime): Boolean;
390
 
 
391
 
Function DateTimeToModifiedJulianDate(const AValue: TDateTime): Double;
392
 
Function ModifiedJulianDateToDateTime(const AValue: Double): TDateTime;
393
 
Function TryModifiedJulianDateToDateTime(const AValue: Double; var ADateTime: TDateTime): Boolean;
394
 
 
395
 
{ ---------------------------------------------------------------------
396
 
    Unix timestamp support.
397
 
  ---------------------------------------------------------------------}
398
 
 
399
 
Function DateTimeToUnix(const AValue: TDateTime): Int64;
400
 
Function UnixToDateTime(const AValue: Int64): TDateTime;
401
 
 
402
 
implementation
403
 
 
404
 
uses sysconst;
405
 
 
406
 
{ ---------------------------------------------------------------------
407
 
    Auxiliary routines
408
 
  ---------------------------------------------------------------------}
409
 
 
410
 
Procedure NotYetImplemented (FN : String);
411
 
 
412
 
begin
413
 
  Raise Exception.CreateFmt('Function "%s" (dateutils) is not yet implemented',[FN]);
414
 
end;
415
 
 
416
 
{ ---------------------------------------------------------------------
417
 
    Simple trimming functions.
418
 
  ---------------------------------------------------------------------}
419
 
 
420
 
Function DateOf(const AValue: TDateTime): TDateTime;
421
 
begin
422
 
  Result:=Trunc(DateOf);
423
 
end;
424
 
 
425
 
 
426
 
Function TimeOf(const AValue: TDateTime): TDateTime;
427
 
begin
428
 
  Result:=Frac(Avalue);
429
 
end;
430
 
 
431
 
 
432
 
{ ---------------------------------------------------------------------
433
 
    Identification functions.
434
 
  ---------------------------------------------------------------------}
435
 
 
436
 
 
437
 
Function IsInLeapYear(const AValue: TDateTime): Boolean;
438
 
 
439
 
Var
440
 
  D,Y,M : Word;
441
 
 
442
 
begin
443
 
  DecodeDate(AValue,Y,M,D);
444
 
  Result:=IsLeapYear(Y);
445
 
end;
446
 
 
447
 
 
448
 
Function IsPM(const AValue: TDateTime): Boolean;
449
 
 
450
 
Var
451
 
  H,M,S,MS : Word;
452
 
 
453
 
begin
454
 
  DecodeTime(AValue,H,M,S,MS);
455
 
  Result:=(H>=12);
456
 
end;
457
 
 
458
 
 
459
 
Function IsValidDate(const AYear, AMonth, ADay: Word): Boolean;
460
 
begin
461
 
  Result:=(AYear<>0) and (AYear<10000)
462
 
          and (AMonth in [1..12])
463
 
          and (ADay<>0) and (ADay<=MonthDays[IsleapYear(AYear),AMonth]);
464
 
end;
465
 
 
466
 
 
467
 
Function IsValidTime(const AHour, AMinute, ASecond, AMilliSecond: Word): Boolean;
468
 
begin
469
 
  Result:=(AHour=HoursPerDay) and (AMinute=0) and (ASecond=0) and (AMillisecond=0);
470
 
  Result:=Result or
471
 
          ((AHour<HoursPerDay) and (AMinute<MinsPerHour) and (ASecond<SecsPerMin) and
472
 
           (AMillisecond<MSecsPerSec));
473
 
end;
474
 
 
475
 
 
476
 
Function IsValidDateTime(const AYear, AMonth, ADay, AHour, AMinute, ASecond, AMilliSecond: Word): Boolean;
477
 
begin
478
 
  Result:=IsValidDate(AYear,AMonth,ADay) and
479
 
          IsValidTime(AHour,AMinute,ASecond,AMillisecond)
480
 
end;
481
 
 
482
 
 
483
 
Function IsValidDateDay(const AYear, ADayOfYear: Word): Boolean;
484
 
begin
485
 
  Result:=(AYear<>0) and (ADayOfYear<>0) and (AYear<10000) and
486
 
          (ADayOfYear<=DaysPerYear[IsLeapYear(AYear)]);
487
 
end;
488
 
 
489
 
 
490
 
Function IsValidDateWeek(const AYear, AWeekOfYear, ADayOfWeek: Word): Boolean;
491
 
begin
492
 
  Result:=(AYear<>0) and (AYear<10000)
493
 
          and (ADayOfWeek in [1..7])
494
 
          and (AWeekOfYear<>0)
495
 
          and (AWeekOfYear<=WeeksInaYear(AYear));
496
 
  { should we not also check whether the day of the week is not
497
 
    larger than the last day of the last week in the year 9999 ?? }
498
 
end;
499
 
 
500
 
 
501
 
Function IsValidDateMonthWeek(const AYear, AMonth, AWeekOfMonth, ADayOfWeek: Word): Boolean;
502
 
 
503
 
begin
504
 
  Result:=(AYear<>0) and (AYear<10000)
505
 
          and (AMonth in [1..12])
506
 
          and (AWeekOfMonth in [1..5])
507
 
          and (ADayOfWeek in [1..7]);
508
 
end;
509
 
 
510
 
{ ---------------------------------------------------------------------
511
 
    Enumeration functions.
512
 
  ---------------------------------------------------------------------}
513
 
 
514
 
Function WeeksInYear(const AValue: TDateTime): Word;
515
 
 
516
 
Var
517
 
  Y,M,D : Word;
518
 
 
519
 
begin
520
 
  DecodeDate(AValue,Y,M,D);
521
 
  Result:=WeeksInAYear(Y);
522
 
end;
523
 
 
524
 
 
525
 
Function WeeksInAYear(const AYear: Word): Word;
526
 
 
527
 
Var
528
 
  DOW : Word;
529
 
 
530
 
begin
531
 
  Result:=52;
532
 
  DOW:=DayOfTheWeek(StartOfAYear(AYear));
533
 
  If (DOW=4) or ((DOW=3) and IsLeapYear(AYear)) then
534
 
    Inc(Result);
535
 
end;
536
 
 
537
 
 
538
 
Function DaysInYear(const AValue: TDateTime): Word;
539
 
 
540
 
Var
541
 
  Y,M,D : Word;
542
 
 
543
 
begin
544
 
  DecodeDate(AValue,Y,M,D);
545
 
  Result:=DaysPerYear[IsLeapYear(Y)];
546
 
end;
547
 
 
548
 
 
549
 
Function DaysInAYear(const AYear: Word): Word;
550
 
begin
551
 
  Result:=DaysPerYear[Isleapyear(AYear)];
552
 
end;
553
 
 
554
 
 
555
 
Function DaysInMonth(const AValue: TDateTime): Word;
556
 
 
557
 
Var
558
 
  Y,M,D : Word;
559
 
 
560
 
begin
561
 
  Decodedate(AValue,Y,M,D);
562
 
  Result:=MonthDays[IsLeapYear(Y),M];
563
 
end;
564
 
 
565
 
 
566
 
Function DaysInAMonth(const AYear, AMonth: Word): Word;
567
 
begin
568
 
  Result:=MonthDays[IsLeapYear(AYear),AMonth];
569
 
end;
570
 
 
571
 
 
572
 
{ ---------------------------------------------------------------------
573
 
    Variations on current date/time.
574
 
  ---------------------------------------------------------------------}
575
 
 
576
 
 
577
 
Function Today: TDateTime;
578
 
begin
579
 
  Result:=Date;
580
 
end;
581
 
 
582
 
 
583
 
Function Yesterday: TDateTime;
584
 
begin
585
 
  Result:=Date-1;
586
 
end;
587
 
 
588
 
 
589
 
Function Tomorrow: TDateTime;
590
 
begin
591
 
  Result:=Date+1;
592
 
end;
593
 
 
594
 
 
595
 
Function IsToday(const AValue: TDateTime): Boolean;
596
 
begin
597
 
  Result:=IsSameDay(AValue,Date);
598
 
end;
599
 
 
600
 
 
601
 
Function IsSameDay(const AValue, ABasis: TDateTime): Boolean;
602
 
 
603
 
Var
604
 
  D : TDateTime;
605
 
 
606
 
begin
607
 
  D:=AValue-Trunc(ABasis);
608
 
  Result:=(D>=0) and (D<1);
609
 
end;
610
 
 
611
 
const
612
 
  DOWMap: array [1..7] of Word = (7, 1, 2, 3, 4, 5, 6);
613
 
 
614
 
Function PreviousDayOfWeek (DayOfWeek : Word) : Word;
615
 
 
616
 
begin
617
 
  If Not (DayOfWeek in [1..7]) then
618
 
    Raise EConvertError.CreateFmt(SErrInvalidDayOfWeek,[DayOfWeek]);
619
 
  Result:=DOWMap[DayOfWeek];
620
 
end;
621
 
 
622
 
 
623
 
 
624
 
{ ---------------------------------------------------------------------
625
 
    Extraction functions.
626
 
  ---------------------------------------------------------------------}
627
 
 
628
 
 
629
 
Function YearOf(const AValue: TDateTime): Word;
630
 
 
631
 
Var
632
 
  D,M : Word;
633
 
 
634
 
begin
635
 
  DecodeDate(AValue,Result,D,M);
636
 
end;
637
 
 
638
 
 
639
 
Function MonthOf(const AValue: TDateTime): Word;
640
 
 
641
 
Var
642
 
  Y,D : Word;
643
 
 
644
 
begin
645
 
  DecodeDate(AValue,Y,Result,D);
646
 
end;
647
 
 
648
 
 
649
 
Function WeekOf(const AValue: TDateTime): Word;
650
 
begin
651
 
  Result:=WeekOfTheYear(AValue);
652
 
end;
653
 
 
654
 
 
655
 
Function DayOf(const AValue: TDateTime): Word;
656
 
 
657
 
Var
658
 
  Y,M : Word;
659
 
 
660
 
begin
661
 
  DecodeDate(AValue,Y,M,Result);
662
 
end;
663
 
 
664
 
 
665
 
Function HourOf(const AValue: TDateTime): Word;
666
 
 
667
 
Var
668
 
  N,S,MS : Word;
669
 
 
670
 
begin
671
 
  DecodeTime(AValue,Result,N,S,MS);
672
 
end;
673
 
 
674
 
 
675
 
Function MinuteOf(const AValue: TDateTime): Word;
676
 
 
677
 
Var
678
 
  H,S,MS : Word;
679
 
 
680
 
begin
681
 
  DecodeTime(AValue,H,Result,S,MS);
682
 
end;
683
 
 
684
 
 
685
 
Function SecondOf(const AValue: TDateTime): Word;
686
 
 
687
 
Var
688
 
  H,N,MS : Word;
689
 
 
690
 
begin
691
 
  DecodeTime(AVAlue,H,N,Result,MS);
692
 
end;
693
 
 
694
 
 
695
 
Function MilliSecondOf(const AValue: TDateTime): Word;
696
 
 
697
 
Var
698
 
  H,N,S : Word;
699
 
 
700
 
begin
701
 
  DecodeTime(AValue,H,N,S,Result);
702
 
end;
703
 
 
704
 
 
705
 
{ ---------------------------------------------------------------------
706
 
    Start/End of year functions.
707
 
  ---------------------------------------------------------------------}
708
 
 
709
 
 
710
 
Function StartOfTheYear(const AValue: TDateTime): TDateTime;
711
 
 
712
 
Var
713
 
  Y,M,D : Word;
714
 
 
715
 
begin
716
 
  DecodeDate(AValue,Y,M,D);
717
 
  Result:=EncodeDate(Y,1,1);
718
 
end;
719
 
 
720
 
 
721
 
Function EndOfTheYear(const AValue: TDateTime): TDateTime;
722
 
 
723
 
Var
724
 
  Y,M,D : Word;
725
 
 
726
 
begin
727
 
  DecodeDate(AValue,Y,M,D);
728
 
  Result:=EncodeDateTime(Y,12,31,23,59,59,999);
729
 
end;
730
 
 
731
 
 
732
 
Function StartOfAYear(const AYear: Word): TDateTime;
733
 
begin
734
 
  Result:=EncodeDate(AYear,1,1);
735
 
end;
736
 
 
737
 
 
738
 
Function EndOfAYear(const AYear: Word): TDateTime;
739
 
 
740
 
begin
741
 
  Result:=(EncodeDateTime(AYear,12,31,23,59,59,999));
742
 
end;
743
 
 
744
 
{ ---------------------------------------------------------------------
745
 
    Start/End of month functions.
746
 
  ---------------------------------------------------------------------}
747
 
 
748
 
Function StartOfTheMonth(const AValue: TDateTime): TDateTime;
749
 
 
750
 
Var
751
 
  Y,M,D : Word;
752
 
 
753
 
begin
754
 
  DecodeDate(AValue,Y,M,D);
755
 
  Result:=EncodeDate(Y,M,1);
756
 
//  MonthDays[IsLeapYear(Y),M])
757
 
end;
758
 
 
759
 
 
760
 
Function EndOfTheMonth(const AValue: TDateTime): TDateTime;
761
 
 
762
 
Var
763
 
  Y,M,D : Word;
764
 
 
765
 
begin
766
 
  DecodeDate(AValue,Y,M,D);
767
 
  Result:=EncodeDateTime(Y,M,MonthDays[IsLeapYear(Y),M],23,59,59,999);
768
 
end;
769
 
 
770
 
 
771
 
Function StartOfAMonth(const AYear, AMonth: Word): TDateTime;
772
 
begin
773
 
  Result:=EncodeDate(AYear,AMonth,1);
774
 
end;
775
 
 
776
 
 
777
 
Function EndOfAMonth(const AYear, AMonth: Word): TDateTime;
778
 
 
779
 
begin
780
 
  Result:=EncodeDateTime(AYear,AMonth,MonthDays[IsLeapYear(AYear),AMonth],23,59,59,999);
781
 
end;
782
 
 
783
 
 
784
 
{ ---------------------------------------------------------------------
785
 
    Start/End of week functions.
786
 
  ---------------------------------------------------------------------}
787
 
 
788
 
 
789
 
Function StartOfTheWeek(const AValue: TDateTime): TDateTime;
790
 
begin
791
 
  Result:=Trunc(AValue)-DayOfTheWeek(AValue)+1;
792
 
end;
793
 
 
794
 
 
795
 
Function EndOfTheWeek(const AValue: TDateTime): TDateTime;
796
 
begin
797
 
  Result:=EndOfTheDay(AValue-DayOfTheWeek(AValue)+7);
798
 
end;
799
 
 
800
 
 
801
 
Function StartOfAWeek(const AYear, AWeekOfYear: Word; const ADayOfWeek: Word): TDateTime;
802
 
begin
803
 
  Result:=EncodeDateWeek(AYear,AWeekOfYear,ADayOfWeek);
804
 
end;
805
 
 
806
 
 
807
 
Function StartOfAWeek(const AYear, AWeekOfYear: Word): TDateTime; // ADayOFWeek 1
808
 
begin
809
 
  Result:=StartOfAWeek(AYear,AWeekOfYear,1)
810
 
end;
811
 
 
812
 
 
813
 
Function EndOfAWeek(const AYear, AWeekOfYear: Word; const ADayOfWeek: Word): TDateTime;
814
 
begin
815
 
  Result := EndOfTheDay(EncodeDateWeek(AYear, AWeekOfYear, ADayOfWeek));
816
 
end;
817
 
 
818
 
 
819
 
Function EndOfAWeek(const AYear, AWeekOfYear: Word): TDateTime; // const ADayOfWeek: Word = 7
820
 
 
821
 
 
822
 
begin
823
 
  Result:=EndOfAWeek(AYear,AWeekOfYear,7);
824
 
end;
825
 
 
826
 
{ ---------------------------------------------------------------------
827
 
    Start/End of day functions.
828
 
  ---------------------------------------------------------------------}
829
 
 
830
 
Function StartOfTheDay(const AValue: TDateTime): TDateTime;
831
 
begin
832
 
  StartOfTheDay:=Trunc(Avalue);
833
 
end;
834
 
 
835
 
 
836
 
Function EndOfTheDay(const AValue: TDateTime): TDateTime;
837
 
 
838
 
Var
839
 
  Y,M,D : Word;
840
 
 
841
 
begin
842
 
  DecodeDate(AValue,Y,M,D);
843
 
  Result:=EncodeDateTime(Y,M,D,23,59,59,999);
844
 
end;
845
 
 
846
 
 
847
 
Function StartOfADay(const AYear, AMonth, ADay: Word): TDateTime;
848
 
begin
849
 
  Result:=EncodeDate(AYear,AMonth,ADay);
850
 
end;
851
 
 
852
 
 
853
 
Function StartOfADay(const AYear, ADayOfYear: Word): TDateTime;
854
 
begin
855
 
  Result:=StartOfAYear(AYear)+ADayOfYear;
856
 
end;
857
 
 
858
 
 
859
 
Function EndOfADay(const AYear, AMonth, ADay: Word): TDateTime;
860
 
begin
861
 
  Result:=EndOfTheDay(EncodeDate(AYear,AMonth,ADay));
862
 
end;
863
 
 
864
 
 
865
 
Function EndOfADay(const AYear, ADayOfYear: Word): TDateTime;
866
 
 
867
 
 
868
 
begin
869
 
  Result:=StartOfAYear(AYear)+ADayOfYear+EncodeTime(23,59,59,999);
870
 
end;
871
 
 
872
 
{ ---------------------------------------------------------------------
873
 
    Part of year functions.
874
 
  ---------------------------------------------------------------------}
875
 
 
876
 
 
877
 
Function MonthOfTheYear(const AValue: TDateTime): Word;
878
 
 
879
 
Var
880
 
  Y,D : Word;
881
 
 
882
 
begin
883
 
  DecodeDate(AValue,Y,Result,D);
884
 
end;
885
 
 
886
 
 
887
 
Function WeekOfTheYear(const AValue: TDateTime): Word;
888
 
 
889
 
Var
890
 
  Y,DOW : Word;
891
 
 
892
 
begin
893
 
  DecodeDateWeek(AValue,Y,Result,DOW)
894
 
end;
895
 
 
896
 
 
897
 
Function WeekOfTheYear(const AValue: TDateTime; var AYear: Word): Word;
898
 
 
899
 
Var
900
 
  DOW : Word;
901
 
 
902
 
begin
903
 
  DecodeDateWeek(AValue,AYear,Result,DOW);
904
 
end;
905
 
 
906
 
 
907
 
Function DayOfTheYear(const AValue: TDateTime): Word;
908
 
begin
909
 
  Result:=Trunc(AValue-StartOfTheYear(AValue)+1);
910
 
end;
911
 
 
912
 
 
913
 
Function HourOfTheYear(const AValue: TDateTime): Word;
914
 
 
915
 
Var
916
 
  H,M,S,MS : Word;
917
 
 
918
 
begin
919
 
  DecodeTime(AValue,H,M,S,MS);
920
 
  Result:=H+((DayOfTheYear(AValue)-1)*24);
921
 
end;
922
 
 
923
 
 
924
 
Function MinuteOfTheYear(const AValue: TDateTime): LongWord;
925
 
 
926
 
Var
927
 
  H,M,S,MS : Word;
928
 
 
929
 
begin
930
 
  DecodeTime(AValue,H,M,S,MS);
931
 
  Result:=M+(H+((DayOfTheYear(AValue)-1)*24))*60;
932
 
end;
933
 
 
934
 
 
935
 
Function SecondOfTheYear(const AValue: TDateTime): LongWord;
936
 
 
937
 
Var
938
 
  H,M,S,MS : Word;
939
 
 
940
 
begin
941
 
  DecodeTime(AValue,H,M,S,MS);
942
 
  Result:=(M+(H+((DayOfTheYear(AValue)-1)*24))*60)*60+S;
943
 
end;
944
 
 
945
 
 
946
 
Function MilliSecondOfTheYear(const AValue: TDateTime): Int64;
947
 
 
948
 
Var
949
 
  H,M,S,MS : Word;
950
 
 
951
 
begin
952
 
  DecodeTime(AValue,H,M,S,MS);
953
 
  Result:=((M+(H+((DayOfTheYear(AValue)-1)*24))*60)*60+S)*1000+MS;
954
 
end;
955
 
 
956
 
 
957
 
{ ---------------------------------------------------------------------
958
 
    Part of month functions.
959
 
  ---------------------------------------------------------------------}
960
 
 
961
 
 
962
 
Function WeekOfTheMonth(const AValue: TDateTime): Word;
963
 
 
964
 
var
965
 
  Y,M,DOW : word;
966
 
 
967
 
begin
968
 
  DecodeDateMonthWeek(AValue,Y,M,Result,DOW);
969
 
end;
970
 
 
971
 
 
972
 
Function WeekOfTheMonth(const AValue: TDateTime; var AYear, AMonth: Word): Word;
973
 
 
974
 
Var
975
 
  DOW : Word;
976
 
 
977
 
begin
978
 
  DecodeDateMonthWeek(AValue,AYear,AMonth,Result,DOW);
979
 
end;
980
 
 
981
 
 
982
 
Function DayOfTheMonth(const AValue: TDateTime): Word;
983
 
 
984
 
Var
985
 
  Y,M : Word;
986
 
 
987
 
begin
988
 
  DecodeDate(AValue,Y,M,Result);
989
 
end;
990
 
 
991
 
 
992
 
Function HourOfTheMonth(const AValue: TDateTime): Word;
993
 
 
994
 
Var
995
 
  Y,M,D,H,N,S,MS : Word;
996
 
 
997
 
begin
998
 
  DecodeDateTime(AValue,Y,M,D,H,N,S,MS);
999
 
  Result:=(D-1)*24+H;
1000
 
end;
1001
 
 
1002
 
 
1003
 
Function MinuteOfTheMonth(const AValue: TDateTime): Word;
1004
 
 
1005
 
Var
1006
 
  Y,M,D,H,N,S,MS : Word;
1007
 
 
1008
 
begin
1009
 
  DecodeDateTime(AValue,Y,M,D,H,N,S,MS);
1010
 
  Result:=((D-1)*24+H)*60+N;
1011
 
end;
1012
 
 
1013
 
 
1014
 
Function SecondOfTheMonth(const AValue: TDateTime): LongWord;
1015
 
 
1016
 
Var
1017
 
  Y,M,D,H,N,S,MS : Word;
1018
 
 
1019
 
begin
1020
 
  DecodeDateTime(AValue,Y,M,D,H,N,S,MS);
1021
 
  Result:=(((D-1)*24+H)*60+N)*60+S;
1022
 
end;
1023
 
 
1024
 
 
1025
 
Function MilliSecondOfTheMonth(const AValue: TDateTime): LongWord;
1026
 
 
1027
 
Var
1028
 
  Y,M,D,H,N,S,MS : Word;
1029
 
 
1030
 
begin
1031
 
  DecodeDateTime(AValue,Y,M,D,H,N,S,MS);
1032
 
  Result:=((((D-1)*24+H)*60+N)*60+S)*1000+MS;
1033
 
end;
1034
 
 
1035
 
{ ---------------------------------------------------------------------
1036
 
    Part of week functions.
1037
 
  ---------------------------------------------------------------------}
1038
 
 
1039
 
 
1040
 
Function DayOfTheWeek(const AValue: TDateTime): Word;
1041
 
 
1042
 
begin
1043
 
  Result:=DowMAP[DayOfWeek(AValue)];
1044
 
end;
1045
 
 
1046
 
 
1047
 
Function HourOfTheWeek(const AValue: TDateTime): Word;
1048
 
 
1049
 
Var
1050
 
  H,M,S,MS : Word;
1051
 
 
1052
 
begin
1053
 
  DecodeTime(AValue,H,M,S,MS);
1054
 
  Result:=(DayOfTheWeek(AValue)-1)*24+H;
1055
 
end;
1056
 
 
1057
 
 
1058
 
Function MinuteOfTheWeek(const AValue: TDateTime): Word;
1059
 
 
1060
 
Var
1061
 
  H,M,S,MS : Word;
1062
 
 
1063
 
begin
1064
 
  DecodeTime(AValue,H,M,S,MS);
1065
 
  Result:=((DayOfTheWeek(AValue)-1)*24+H)*60+M;
1066
 
end;
1067
 
 
1068
 
 
1069
 
Function SecondOfTheWeek(const AValue: TDateTime): LongWord;
1070
 
 
1071
 
Var
1072
 
  H,M,S,MS : Word;
1073
 
 
1074
 
begin
1075
 
  DecodeTime(AValue,H,M,S,MS);
1076
 
  Result:=(((DayOfTheWeek(AValue)-1)*24+H)*60+M)*60+S;
1077
 
end;
1078
 
 
1079
 
 
1080
 
Function MilliSecondOfTheWeek(const AValue: TDateTime): LongWord;
1081
 
 
1082
 
 
1083
 
Var
1084
 
  H,M,S,MS : Word;
1085
 
 
1086
 
begin
1087
 
  DecodeTime(AValue,H,M,S,MS);
1088
 
  Result:=((((DayOfTheWeek(AValue)-1)*24+H)*60+M)*60+S)*1000+MS;
1089
 
end;
1090
 
 
1091
 
{ ---------------------------------------------------------------------
1092
 
    Part of day functions.
1093
 
  ---------------------------------------------------------------------}
1094
 
 
1095
 
 
1096
 
Function HourOfTheDay(const AValue: TDateTime): Word;
1097
 
 
1098
 
Var
1099
 
  M,S,MS : Word;
1100
 
 
1101
 
begin
1102
 
  DecodeTime(AValue,Result,M,S,MS);
1103
 
end;
1104
 
 
1105
 
 
1106
 
Function MinuteOfTheDay(const AValue: TDateTime): Word;
1107
 
 
1108
 
Var
1109
 
  H,M,S,MS : Word;
1110
 
 
1111
 
begin
1112
 
  DecodeTime(AValue,H,M,S,MS);
1113
 
  Result:=(H*60)+M;
1114
 
end;
1115
 
 
1116
 
 
1117
 
Function SecondOfTheDay(const AValue: TDateTime): LongWord;
1118
 
 
1119
 
Var
1120
 
  H,M,S,MS : Word;
1121
 
 
1122
 
begin
1123
 
  DecodeTime(AValue,H,M,S,MS);
1124
 
  Result:=((H*60)+M)*60+S;
1125
 
end;
1126
 
 
1127
 
 
1128
 
Function MilliSecondOfTheDay(const AValue: TDateTime): LongWord;
1129
 
 
1130
 
Var
1131
 
  H,M,S,MS : Word;
1132
 
 
1133
 
begin
1134
 
  DecodeTime(AValue,H,M,S,MS);
1135
 
  Result:=(((H*60)+M)*60+S)*1000+MS;
1136
 
end;
1137
 
 
1138
 
{ ---------------------------------------------------------------------
1139
 
    Part of hour functions.
1140
 
  ---------------------------------------------------------------------}
1141
 
 
1142
 
 
1143
 
Function MinuteOfTheHour(const AValue: TDateTime): Word;
1144
 
 
1145
 
Var
1146
 
  H,S,MS : Word;
1147
 
 
1148
 
begin
1149
 
  DecodeTime(AValue,H,Result,S,MS);
1150
 
end;
1151
 
 
1152
 
 
1153
 
Function SecondOfTheHour(const AValue: TDateTime): Word;
1154
 
 
1155
 
Var
1156
 
  H,S,M,MS : Word;
1157
 
 
1158
 
begin
1159
 
  DecodeTime(AValue,H,M,S,MS);
1160
 
  Result:=M*60+S;
1161
 
end;
1162
 
 
1163
 
 
1164
 
Function MilliSecondOfTheHour(const AValue: TDateTime): LongWord;
1165
 
 
1166
 
Var
1167
 
  H,S,M,MS : Word;
1168
 
 
1169
 
begin
1170
 
  DecodeTime(AValue,H,M,S,MS);
1171
 
  Result:=(M*60+S)*1000+MS;
1172
 
end;
1173
 
 
1174
 
{ ---------------------------------------------------------------------
1175
 
    Part of minute functions.
1176
 
  ---------------------------------------------------------------------}
1177
 
 
1178
 
 
1179
 
Function SecondOfTheMinute(const AValue: TDateTime): Word;
1180
 
 
1181
 
Var
1182
 
  H,M,MS : Word;
1183
 
 
1184
 
begin
1185
 
  DecodeTime(AValue,H,M,Result,MS);
1186
 
end;
1187
 
 
1188
 
 
1189
 
Function MilliSecondOfTheMinute(const AValue: TDateTime): LongWord;
1190
 
 
1191
 
Var
1192
 
  H,S,M,MS : Word;
1193
 
 
1194
 
begin
1195
 
  DecodeTime(AValue,H,M,S,MS);
1196
 
  Result:=S*1000+MS;
1197
 
end;
1198
 
 
1199
 
{ ---------------------------------------------------------------------
1200
 
    Part of second functions.
1201
 
  ---------------------------------------------------------------------}
1202
 
 
1203
 
Function MilliSecondOfTheSecond(const AValue: TDateTime): Word;
1204
 
 
1205
 
Var
1206
 
  H,M,S : Word;
1207
 
 
1208
 
begin
1209
 
  DecodeTime(AValue,H,M,S,Result);
1210
 
end;
1211
 
 
1212
 
{ ---------------------------------------------------------------------
1213
 
    Range checking functions.
1214
 
  ---------------------------------------------------------------------}
1215
 
 
1216
 
Function WithinPastYears(const ANow, AThen: TDateTime; const AYears: Integer): Boolean;
1217
 
begin
1218
 
  Result:=YearsBetween(ANow,AThen)<=AYears;
1219
 
end;
1220
 
 
1221
 
 
1222
 
Function WithinPastMonths(const ANow, AThen: TDateTime; const AMonths: Integer): Boolean;
1223
 
begin
1224
 
  Result:=MonthsBetween(ANow,AThen)<=AMonths;
1225
 
end;
1226
 
 
1227
 
 
1228
 
Function WithinPastWeeks(const ANow, AThen: TDateTime; const AWeeks: Integer): Boolean;
1229
 
begin
1230
 
  Result:=WeeksBetween(ANow,AThen)<=AWeeks;
1231
 
end;
1232
 
 
1233
 
 
1234
 
Function WithinPastDays(const ANow, AThen: TDateTime; const ADays: Integer): Boolean;
1235
 
begin
1236
 
  Result:=DaysBetween(ANow,AThen)<=ADays;
1237
 
end;
1238
 
 
1239
 
 
1240
 
Function WithinPastHours(const ANow, AThen: TDateTime; const AHours: Int64): Boolean;
1241
 
begin
1242
 
  Result:=HoursBetween(ANow,AThen)<=AHours;
1243
 
end;
1244
 
 
1245
 
 
1246
 
Function WithinPastMinutes(const ANow, AThen: TDateTime; const AMinutes: Int64): Boolean;
1247
 
begin
1248
 
  Result:=MinutesBetween(ANow,AThen)<=AMinutes;
1249
 
end;
1250
 
 
1251
 
 
1252
 
Function WithinPastSeconds(const ANow, AThen: TDateTime; const ASeconds: Int64): Boolean;
1253
 
begin
1254
 
  Result:=SecondsBetween(ANow,Athen)<=ASeconds;
1255
 
end;
1256
 
 
1257
 
 
1258
 
Function WithinPastMilliSeconds(const ANow, AThen: TDateTime; const AMilliSeconds: Int64): Boolean;
1259
 
begin
1260
 
  Result:=MilliSecondsBetween(ANow,AThen)<=AMilliSeconds;
1261
 
end;
1262
 
 
1263
 
 
1264
 
{ ---------------------------------------------------------------------
1265
 
    Period functions.
1266
 
  ---------------------------------------------------------------------}
1267
 
 
1268
 
{
1269
 
  These functions are declared as approximate by Borland.
1270
 
  A bit strange, since it can be calculated exactly ?
1271
 
}
1272
 
 
1273
 
 
1274
 
Function YearsBetween(const ANow, AThen: TDateTime): Integer;
1275
 
begin
1276
 
  Result:=Trunc(Abs(ANow-AThen)/ApproxDaysPerYear);
1277
 
end;
1278
 
 
1279
 
 
1280
 
Function MonthsBetween(const ANow, AThen: TDateTime): Integer;
1281
 
begin
1282
 
  Result:=Trunc(Abs(ANow-Athen)/ApproxDaysPerMonth);
1283
 
end;
1284
 
 
1285
 
 
1286
 
Function WeeksBetween(const ANow, AThen: TDateTime): Integer;
1287
 
begin
1288
 
  Result:=Trunc(Abs(ANow-AThen)) div 7;
1289
 
end;
1290
 
 
1291
 
 
1292
 
Function DaysBetween(const ANow, AThen: TDateTime): Integer;
1293
 
begin
1294
 
  Result:=Trunc(Abs(ANow-AThen));
1295
 
end;
1296
 
 
1297
 
 
1298
 
Function HoursBetween(const ANow, AThen: TDateTime): Int64;
1299
 
begin
1300
 
  Result:=Trunc(Abs(ANow-AThen)*HoursPerDay);
1301
 
end;
1302
 
 
1303
 
 
1304
 
Function MinutesBetween(const ANow, AThen: TDateTime): Int64;
1305
 
begin
1306
 
  Result:=Trunc(Abs(ANow-AThen)*MinsPerDay);
1307
 
end;
1308
 
 
1309
 
 
1310
 
Function SecondsBetween(const ANow, AThen: TDateTime): Int64;
1311
 
begin
1312
 
  Result:=Trunc(Abs(ANow-AThen)*SecsPerDay);
1313
 
end;
1314
 
 
1315
 
 
1316
 
Function MilliSecondsBetween(const ANow, AThen: TDateTime): Int64;
1317
 
begin
1318
 
  Result:=Trunc(Abs(ANow-AThen)*MSecsPerDay);
1319
 
end;
1320
 
 
1321
 
 
1322
 
{ ---------------------------------------------------------------------
1323
 
    Timespan in xxx functions.
1324
 
  ---------------------------------------------------------------------}
1325
 
 
1326
 
Function YearSpan(const ANow, AThen: TDateTime): Double;
1327
 
begin
1328
 
  Result:=Abs(Anow-Athen)/ApproxDaysPerYear;
1329
 
end;
1330
 
 
1331
 
 
1332
 
Function MonthSpan(const ANow, AThen: TDateTime): Double;
1333
 
begin
1334
 
  Result:=Abs(ANow-AThen)/ApproxDaysPerMonth;
1335
 
end;
1336
 
 
1337
 
 
1338
 
Function WeekSpan(const ANow, AThen: TDateTime): Double;
1339
 
begin
1340
 
  Result:=Abs(ANow-AThen) / 7
1341
 
end;
1342
 
 
1343
 
 
1344
 
Function DaySpan(const ANow, AThen: TDateTime): Double;
1345
 
begin
1346
 
  Result:=Abs(ANow-AThen);
1347
 
end;
1348
 
 
1349
 
 
1350
 
Function HourSpan(const ANow, AThen: TDateTime): Double;
1351
 
begin
1352
 
  Result:=Abs(ANow-AThen)*HoursPerDay;
1353
 
end;
1354
 
 
1355
 
 
1356
 
Function MinuteSpan(const ANow, AThen: TDateTime): Double;
1357
 
begin
1358
 
  Result:=Abs(ANow-AThen)*MinsPerDay;
1359
 
end;
1360
 
 
1361
 
 
1362
 
Function SecondSpan(const ANow, AThen: TDateTime): Double;
1363
 
begin
1364
 
  Result:=Abs(ANow-AThen)*SecsPerDay;
1365
 
end;
1366
 
 
1367
 
 
1368
 
Function MilliSecondSpan(const ANow, AThen: TDateTime): Double;
1369
 
begin
1370
 
  Result:=Abs(ANow-AThen)*MSecsPerDay;
1371
 
end;
1372
 
 
1373
 
 
1374
 
{ ---------------------------------------------------------------------
1375
 
    Increment/decrement functions.
1376
 
  ---------------------------------------------------------------------}
1377
 
 
1378
 
 
1379
 
Function IncYear(const AValue: TDateTime; const ANumberOfYears: Integer ): TDateTime;
1380
 
 
1381
 
Var
1382
 
  Y,M,D,H,N,S,MS : Word;
1383
 
 
1384
 
 
1385
 
begin
1386
 
  DecodeDateTime(AValue,Y,M,D,H,N,S,MS);
1387
 
  Y:=Y+ANumberOfYears;
1388
 
  If (M=2) and (D=29) And (Not IsLeapYear(Y)) then
1389
 
    D:=28;
1390
 
  Result:=EncodeDateTime(Y,M,D,H,N,S,MS);
1391
 
end;
1392
 
 
1393
 
 
1394
 
Function IncYear(const AValue: TDateTime): TDateTime; // ; const ANumberOfYears: Integer = 1)
1395
 
begin
1396
 
  Result:=IncYear(Avalue,1);
1397
 
end;
1398
 
 
1399
 
 
1400
 
Function IncWeek(const AValue: TDateTime; const ANumberOfWeeks: Integer): TDateTime;
1401
 
begin
1402
 
  Result:=AValue+ANumberOfWeeks*7;
1403
 
end;
1404
 
 
1405
 
 
1406
 
Function IncWeek(const AValue: TDateTime): TDateTime; // ; const ANumberOfWeeks: Integer = 1)
1407
 
begin
1408
 
  Result:=IncWeek(Avalue,1);
1409
 
end;
1410
 
 
1411
 
 
1412
 
Function IncDay(const AValue: TDateTime; const ANumberOfDays: Integer): TDateTime;
1413
 
begin
1414
 
  Result:=AValue+ANumberOfDays;
1415
 
end;
1416
 
 
1417
 
 
1418
 
Function IncDay(const AValue: TDateTime): TDateTime; //; const ANumberOfDays: Integer = 1)
1419
 
begin
1420
 
  Result:=IncDay(Avalue,1);
1421
 
end;
1422
 
 
1423
 
 
1424
 
Function IncHour(const AValue: TDateTime; const ANumberOfHours: Int64): TDateTime;
1425
 
begin
1426
 
  Result:=AValue+ANumberOfHours/HoursPerDay;
1427
 
end;
1428
 
 
1429
 
 
1430
 
Function IncHour(const AValue: TDateTime): TDateTime; //; const ANumberOfHours: Int64 = 1
1431
 
begin
1432
 
  Result:=IncHour(AValue,1);
1433
 
end;
1434
 
 
1435
 
 
1436
 
Function IncMinute(const AValue: TDateTime; const ANumberOfMinutes: Int64): TDateTime;
1437
 
begin
1438
 
  Result:=Result+ANumberOfMinutes / MinsPerDay;
1439
 
end;
1440
 
 
1441
 
 
1442
 
Function IncMinute(const AValue: TDateTime): TDateTime; // ; const ANumberOfMinutes: Int64 = 1
1443
 
begin
1444
 
  Result:=IncMinute(AValue,1);
1445
 
end;
1446
 
 
1447
 
 
1448
 
Function IncSecond(const AValue: TDateTime; const ANumberOfSeconds: Int64): TDateTime;
1449
 
begin
1450
 
  Result:=Result+ANumberOfSeconds / SecsPerDay;
1451
 
end;
1452
 
 
1453
 
 
1454
 
Function IncSecond(const AValue: TDateTime): TDateTime; // ; const ANumberOfSeconds: Int64 = 1
1455
 
begin
1456
 
  Result:=IncSecond(Avalue,1);
1457
 
end;
1458
 
 
1459
 
 
1460
 
Function IncMilliSecond(const AValue: TDateTime; const ANumberOfMilliSeconds: Int64): TDateTime;
1461
 
begin
1462
 
  Result:=Result+ANumberOfMilliSeconds/MSecsPerDay;
1463
 
end;
1464
 
 
1465
 
 
1466
 
Function IncMilliSecond(const AValue: TDateTime): TDateTime; // ; const ANumberOfMilliSeconds: Int64 = 1
1467
 
begin
1468
 
  Result:=IncMilliSecond(AValue,1);
1469
 
end;
1470
 
 
1471
 
 
1472
 
{ ---------------------------------------------------------------------
1473
 
    Encode/Decode of complete timestamp
1474
 
  ---------------------------------------------------------------------}
1475
 
 
1476
 
 
1477
 
Function EncodeDateTime(const AYear, AMonth, ADay, AHour, AMinute, ASecond, AMilliSecond: Word): TDateTime;
1478
 
begin
1479
 
  If Not TryEncodeDateTime(AYear, AMonth, ADay, AHour, AMinute, ASecond, AMilliSecond,Result) then
1480
 
    InvalidDateTimeError(AYear, AMonth, ADay, AHour, AMinute, ASecond, AMilliSecond)
1481
 
end;
1482
 
 
1483
 
 
1484
 
Procedure DecodeDateTime(const AValue: TDateTime; var AYear, AMonth, ADay, AHour, AMinute, ASecond, AMilliSecond: Word);
1485
 
begin
1486
 
  DecodeDate(AValue,AYear,AMonth,ADay);
1487
 
  DecodeTime(AValue,AHour,AMinute,ASecond,AMilliSecond);
1488
 
end;
1489
 
 
1490
 
 
1491
 
Function TryEncodeDateTime(const AYear, AMonth, ADay, AHour, AMinute, ASecond, AMilliSecond: Word; var AValue: TDateTime): Boolean;
1492
 
 
1493
 
Var
1494
 
 tmp : TDateTime;
1495
 
 
1496
 
begin
1497
 
  Result:=TryEncodeDate(AYear,AMonth,ADay,AValue);
1498
 
  Result:=Result and TryEncodeTime(AHour,AMinute,ASecond,Amillisecond,Tmp);
1499
 
  If Result then
1500
 
    Avalue:=AValue+Tmp;
1501
 
end;
1502
 
 
1503
 
{ ---------------------------------------------------------------------
1504
 
    Encode/decode date, specifying week of year and day of week
1505
 
  ---------------------------------------------------------------------}
1506
 
 
1507
 
Function EncodeDateWeek(const AYear, AWeekOfYear: Word; const ADayOfWeek: Word): TDateTime;
1508
 
begin
1509
 
  If Not TryEncodeDateWeek(AYear,AWeekOfYear,Result,ADayOfWeek) then
1510
 
    InvalidDateWeekError(AYear,AWeekOfYear,ADayOfWeek);
1511
 
end;
1512
 
 
1513
 
 
1514
 
Function EncodeDateWeek(const AYear, AWeekOfYear: Word): TDateTime; //; const ADayOfWeek: Word = 1
1515
 
begin
1516
 
  EncodeDateWeek(AYear,AWeekOfYear,1);
1517
 
end;
1518
 
 
1519
 
 
1520
 
Procedure DecodeDateWeek(const AValue: TDateTime; var AYear, AWeekOfYear, ADayOfWeek: Word);
1521
 
begin
1522
 
  NotYetImplemented('DecodeDateWeek');
1523
 
end;
1524
 
 
1525
 
 
1526
 
Function TryEncodeDateWeek(const AYear, AWeekOfYear: Word; var AValue: TDateTime; const ADayOfWeek: Word): Boolean;
1527
 
 
1528
 
Var
1529
 
  DOW : Word;
1530
 
  Rest : Integer;
1531
 
 
1532
 
begin
1533
 
  Result:=IsValidDateWeek(Ayear,AWeekOfYear,ADayOfWeek);
1534
 
  If Result then
1535
 
    begin
1536
 
    AValue:=EncodeDate(AYear,1,1)+(7*(AWeekOfYear-1));
1537
 
    DOW:=DayOfTheWeek(AValue);
1538
 
    Rest:=ADayOfWeek-DOW;
1539
 
    If (DOW>4) then
1540
 
      Inc(Rest,7);
1541
 
    AValue:=AValue+Rest;
1542
 
    end;
1543
 
end;
1544
 
 
1545
 
 
1546
 
Function TryEncodeDateWeek(const AYear, AWeekOfYear: Word; var AValue: TDateTime): Boolean; //; const ADayOfWeek: Word = 1
1547
 
begin
1548
 
  Result:=TryEncodeDateWeek(AYear,AWeekOfYear,AValue,1);
1549
 
end;
1550
 
 
1551
 
{ ---------------------------------------------------------------------
1552
 
    Encode/decode date, specifying day of year
1553
 
  ---------------------------------------------------------------------}
1554
 
 
1555
 
Function EncodeDateDay(const AYear, ADayOfYear: Word): TDateTime;
1556
 
begin
1557
 
  If Not TryEncodeDateDay(AYear,ADayOfYear,Result) then
1558
 
    InvalidDateDayError(AYear,ADayOfYear);
1559
 
end;
1560
 
 
1561
 
 
1562
 
Procedure DecodeDateDay(const AValue: TDateTime; var AYear, ADayOfYear: Word);
1563
 
 
1564
 
Var
1565
 
  M,D : Word;
1566
 
 
1567
 
begin
1568
 
  DecodeDate(AValue,AYear,M,D);
1569
 
  ADayOfyear:=Trunc(AValue-EncodeDate(AYear,1,1))+1;
1570
 
end;
1571
 
 
1572
 
 
1573
 
Function TryEncodeDateDay(const AYear, ADayOfYear: Word; var AValue: TDateTime): Boolean;
1574
 
begin
1575
 
  Result:=(ADayOfYear<>0) and (ADayOfYear<=DaysPerYear [IsleapYear(AYear)]);
1576
 
  If Result then
1577
 
    AValue:=EncodeDate(AYear,1,1)+ADayOfYear-1;
1578
 
end;
1579
 
 
1580
 
 
1581
 
{ ---------------------------------------------------------------------
1582
 
    Encode/decode date, specifying week of month
1583
 
  ---------------------------------------------------------------------}
1584
 
 
1585
 
 
1586
 
Function EncodeDateMonthWeek(const AYear, AMonth, AWeekOfMonth, ADayOfWeek: Word): TDateTime;
1587
 
begin
1588
 
  If Not TryEncodeDateMonthWeek(Ayear,AMonth,AWeekOfMonth,ADayOfWeek,Result) then
1589
 
    InvalidDateMonthWeekError(AYear,AMonth,AWeekOfMonth,ADayOfWeek);
1590
 
end;
1591
 
 
1592
 
Procedure DecodeDateMonthWeek(const AValue: TDateTime; var AYear, AMonth, AWeekOfMonth, ADayOfWeek: Word);
1593
 
 
1594
 
Var
1595
 
  D,SDOM,EDOM : Word;
1596
 
  SOM,EOM : TdateTime;
1597
 
  DOM : Integer;
1598
 
begin
1599
 
  DecodeDate(AValue,AYear,AMonth,D);
1600
 
  ADayOfWeek:=DayOfTheWeek(AValue);
1601
 
  SOM:=EncodeDate(Ayear,Amonth,1);
1602
 
  SDOM:=DayOfTheWeek(SOM);
1603
 
  DOM:=D-1+SDOM;
1604
 
  If SDOM>4 then
1605
 
    Dec(DOM,7);
1606
 
  // Too early in the month. First full week is next week, day is after thursday.
1607
 
  If DOM<=0 Then
1608
 
    DecodeDateMonthWeek(SOM-1,AYear,AMonth,AWeekOfMonth,D)
1609
 
  else
1610
 
    begin
1611
 
    AWeekOfMonth:=(DOM div 7)+Ord((DOM mod 7)<>0);
1612
 
    EDOM:=DayOfTheWeek(EndOfAMonth(Ayear,AMonth));
1613
 
    // In last days of last long week, so in next month...
1614
 
    If (EDOM<4) and ((DaysInAMonth(AYear,Amonth)-D)<EDOM) then
1615
 
      begin
1616
 
      AWeekOfMonth:=1;
1617
 
      Inc(AMonth);
1618
 
      If (AMonth=13) then
1619
 
        begin
1620
 
        AMonth:=1;
1621
 
        Inc(AYear);
1622
 
        end;
1623
 
      end;
1624
 
    end;
1625
 
end;
1626
 
 
1627
 
 
1628
 
Function TryEncodeDateMonthWeek(const AYear, AMonth, AWeekOfMonth, ADayOfWeek: Word; var AValue: TDateTime): Boolean;
1629
 
begin
1630
 
  NotYetImplemented('TryEncodeDateMonthWeek');
1631
 
end;
1632
 
 
1633
 
 
1634
 
{ ---------------------------------------------------------------------
1635
 
    Replace given element with supplied value.
1636
 
  ---------------------------------------------------------------------}
1637
 
 
1638
 
Const
1639
 
  LFAI = RecodeLeaveFieldAsIS; // Less typing, readable code
1640
 
{
1641
 
  Note: We have little choice but to implement it like Borland did:
1642
 
  If AValue contains some 'wrong' value, it will throw an error.
1643
 
  To simulate this we'd have to check in each function whether
1644
 
  both arguments are correct. To avoid it, all is routed through
1645
 
  the 'central' RecodeDateTime function as in Borland's implementation.
1646
 
}
1647
 
 
1648
 
Function RecodeYear(const AValue: TDateTime; const AYear: Word): TDateTime;
1649
 
 
1650
 
begin
1651
 
  RecodeDateTime(AValue,AYear,LFAI,LFAI,LFAI,LFAI,LFAI,LFAI);
1652
 
end;
1653
 
 
1654
 
 
1655
 
Function RecodeMonth(const AValue: TDateTime; const AMonth: Word): TDateTime;
1656
 
begin
1657
 
  RecodeDateTime(AValue,LFAI,AMonth,LFAI,LFAI,LFAI,LFAI,LFAI);
1658
 
end;
1659
 
 
1660
 
 
1661
 
Function RecodeDay(const AValue: TDateTime; const ADay: Word): TDateTime;
1662
 
begin
1663
 
  RecodeDateTime(AValue,LFAI,LFAI,ADay,LFAI,LFAI,LFAI,LFAI);
1664
 
end;
1665
 
 
1666
 
 
1667
 
Function RecodeHour(const AValue: TDateTime; const AHour: Word): TDateTime;
1668
 
begin
1669
 
  RecodeDateTime(AValue,LFAI,LFAI,LFAI,AHour,LFAI,LFAI,LFAI);
1670
 
end;
1671
 
 
1672
 
 
1673
 
Function RecodeMinute(const AValue: TDateTime; const AMinute: Word): TDateTime;
1674
 
begin
1675
 
  RecodeDateTime(AValue,LFAI,LFAI,LFAI,LFAI,AMinute,LFAI,LFAI);
1676
 
end;
1677
 
 
1678
 
 
1679
 
Function RecodeSecond(const AValue: TDateTime; const ASecond: Word): TDateTime;
1680
 
begin
1681
 
  RecodeDateTime(AValue,LFAI,LFAI,LFAI,LFAI,LFAI,ASecond,LFAI);
1682
 
end;
1683
 
 
1684
 
 
1685
 
Function RecodeMilliSecond(const AValue: TDateTime; const AMilliSecond: Word): TDateTime;
1686
 
begin
1687
 
  RecodeDateTime(AValue,LFAI,LFAI,LFAI,LFAI,LFAI,LFAI,AMilliSecond);
1688
 
end;
1689
 
 
1690
 
 
1691
 
Function RecodeDate(const AValue: TDateTime; const AYear, AMonth, ADay: Word): TDateTime;
1692
 
begin
1693
 
  RecodeDateTime(AValue,AYear,AMonth,ADay,LFAI,LFAI,LFAI,LFAI);
1694
 
end;
1695
 
 
1696
 
 
1697
 
Function RecodeTime(const AValue: TDateTime; const AHour, AMinute, ASecond, AMilliSecond: Word): TDateTime;
1698
 
begin
1699
 
  RecodeDateTime(AValue,LFAI,LFAI,LFAI,AHour,AMinute,ASecond,AMilliSecond);
1700
 
end;
1701
 
 
1702
 
 
1703
 
Function RecodeDateTime(const AValue: TDateTime; const AYear, AMonth, ADay, AHour, AMinute, ASecond, AMilliSecond: Word): TDateTime;
1704
 
begin
1705
 
  If Not TryRecodeDateTime(AValue,AYear,AMonth,ADay,AHour,AMinute,ASecond,AMilliSecond,Result) then
1706
 
    InvalidDateTimeError(AYear,AMonth,ADay,AHour,AMinute,ASecond,AMilliSecond,AValue);
1707
 
end;
1708
 
 
1709
 
 
1710
 
Function TryRecodeDateTime(const AValue: TDateTime; const AYear, AMonth, ADay, AHour, AMinute, ASecond, AMilliSecond: Word; var AResult: TDateTime): Boolean;
1711
 
 
1712
 
  Procedure FV (Var FV : Word; Arg : Word);
1713
 
 
1714
 
  begin
1715
 
    If (Arg<>LFAI) then
1716
 
      FV:=Arg;
1717
 
  end;
1718
 
 
1719
 
Var
1720
 
  Y,M,D,H,N,S,MS : Word;
1721
 
 
1722
 
begin
1723
 
 DecodeDateTime(AValue,Y,M,D,H,N,S,MS);
1724
 
  FV(Y,AYear);
1725
 
  FV(M,AMonth);
1726
 
  FV(D,ADay);
1727
 
  FV(H,AHour);
1728
 
  FV(N,AMinute);
1729
 
  FV(S,ASecond);
1730
 
  FV(S,AMillisecond);
1731
 
  Result:=TryEncodeDateTime(Y,M,D,H,N,S,MS,AResult);
1732
 
end;
1733
 
 
1734
 
{ ---------------------------------------------------------------------
1735
 
    Comparision of date/time
1736
 
  ---------------------------------------------------------------------}
1737
 
 
1738
 
 
1739
 
Function CompareDateTime(const A, B: TDateTime): TValueRelationship;
1740
 
begin
1741
 
  If SameDateTime(A,B) then
1742
 
    Result:=EqualsValue
1743
 
  else If A>B then
1744
 
    Result:=GreaterThanValue
1745
 
  else
1746
 
    Result:=LessThanValue
1747
 
end;
1748
 
 
1749
 
 
1750
 
Function CompareDate(const A, B: TDateTime): TValueRelationship;
1751
 
begin
1752
 
  If SameDate(A,B) then
1753
 
    Result:=EQualsValue
1754
 
  else if A<B then
1755
 
    Result:=LessThanValue
1756
 
  else
1757
 
    Result:=GreaterThanValue;
1758
 
end;
1759
 
 
1760
 
 
1761
 
Function CompareTime(const A, B: TDateTime): TValueRelationship;
1762
 
 
1763
 
begin
1764
 
  If SameTime(A,B) then
1765
 
    Result:=EQualsValue
1766
 
  else If Frac(A)<Frac(B) then
1767
 
    Result:=LessThanValue
1768
 
  else
1769
 
    Result:=GreaterThanValue;
1770
 
end;
1771
 
 
1772
 
 
1773
 
Function SameDateTime(const A, B: TDateTime): Boolean;
1774
 
begin
1775
 
  Result:=Abs(A-B)<OneMilliSecond;
1776
 
end;
1777
 
 
1778
 
 
1779
 
Function SameDate(const A, B: TDateTime): Boolean;
1780
 
begin
1781
 
  Result:=Trunc(A)=Trunc(B);
1782
 
end;
1783
 
 
1784
 
 
1785
 
Function SameTime(const A, B: TDateTime): Boolean;
1786
 
 
1787
 
begin
1788
 
  Result:=Frac(Abs(A-B))<OneMilliSecond;
1789
 
end;
1790
 
 
1791
 
 
1792
 
Function NthDayOfWeek(const AValue: TDateTime): Word;
1793
 
 
1794
 
begin
1795
 
  Result:=(DayOfTheMonth(AValue)-1) div 7 + 1;
1796
 
end;
1797
 
 
1798
 
 
1799
 
Procedure DecodeDayOfWeekInMonth(const AValue: TDateTime; var AYear, AMonth, ANthDayOfWeek, ADayOfWeek: Word);
1800
 
 
1801
 
begin
1802
 
  NotYetImplemented('DecodeDayOfWeekInMonth');
1803
 
end;
1804
 
 
1805
 
 
1806
 
Function EncodeDayOfWeekInMonth(const AYear, AMonth, ANthDayOfWeek,  ADayOfWeek: Word): TDateTime;
1807
 
begin
1808
 
  If Not TryEncodeDayOfWeekInMonth(AYear,AMonth,ANthDayOfWeek,ADayOfWeek,Result) then
1809
 
    InvalidDayOfWeekInMonthError(AYear,AMonth,ANthDayOfWeek,ADayOfWeek);
1810
 
end;
1811
 
 
1812
 
 
1813
 
Function TryEncodeDayOfWeekInMonth(const AYear, AMonth, ANthDayOfWeek,  ADayOfWeek: Word; var AValue: TDateTime): Boolean;
1814
 
 
1815
 
Var
1816
 
  SOM,D : Word;
1817
 
 
1818
 
begin
1819
 
  SOM:=DayOfTheWeek(EncodeDate(Ayear,AMonth,1));
1820
 
  D:=1+ADayOfWeek-SOM+7*(ANthDayOfWeek-1);
1821
 
  If SOM>ADayOfWeek then
1822
 
    D:=D+7; // Clearer would have been Inc(ANthDayOfweek) but it's a const
1823
 
  Result:=TryEncodeDate(Ayear,AMonth,D,AValue);
1824
 
end;
1825
 
 
1826
 
{ ---------------------------------------------------------------------
1827
 
    Exception throwing routines
1828
 
  ---------------------------------------------------------------------}
1829
 
 
1830
 
 
1831
 
 
1832
 
Procedure InvalidDateTimeError(const AYear, AMonth, ADay, AHour, AMinute, ASecond, AMilliSecond: Word; const ABaseDate: TDateTime);
1833
 
 
1834
 
  Function DoField(Arg,Def : Word; Unknown: String) : String;
1835
 
 
1836
 
  begin
1837
 
    If (Arg<>LFAI) then
1838
 
      Result:=Format('%.*d',[Length(Unknown),Arg])
1839
 
    else if (ABaseDate=0) then
1840
 
      Result:=Unknown
1841
 
    else
1842
 
      Result:=Format('%.*d',[Length(Unknown),Arg]);
1843
 
  end;
1844
 
 
1845
 
Var
1846
 
  Y,M,D,H,N,S,MS : Word;
1847
 
  Msg : String;
1848
 
 
1849
 
begin
1850
 
  DecodeDateTime(ABasedate,Y,M,D,H,N,S,MS);
1851
 
  Msg:=DoField(AYear,Y,'????');
1852
 
  Msg:=Msg+DateSeparator+DoField(AMonth,M,'??');
1853
 
  Msg:=Msg+DateSeparator+DoField(ADay,D,'??');
1854
 
  Msg:=Msg+' '+DoField(AHour,H,'??');
1855
 
  Msg:=Msg+TimeSeparator+DoField(AMinute,N,'??');
1856
 
  Msg:=Msg+TimeSeparator+Dofield(ASecond,S,'??');
1857
 
  Msg:=Msg+DecimalSeparator+DoField(AMilliSecond,MS,'???');
1858
 
  Raise EConvertError.CreateFmt(SErrInvalidTimeStamp,[Msg]);
1859
 
end;
1860
 
 
1861
 
 
1862
 
Procedure InvalidDateTimeError(const AYear, AMonth, ADay, AHour, AMinute, ASecond, AMilliSecond: Word); // const ABaseDate: TDateTime = 0
1863
 
begin
1864
 
  InvalidDateTimeError(AYear,AMonth,ADay,AHour,AMinute,ASecond,AMilliSecond,0);
1865
 
end;
1866
 
 
1867
 
 
1868
 
Procedure InvalidDateWeekError(const AYear, AWeekOfYear, ADayOfWeek: Word);
1869
 
begin
1870
 
  Raise EConvertError.CreateFmt(SErrInvalidDateWeek,[AYear,AWeekOfYear,ADayOfWeek]);
1871
 
end;
1872
 
 
1873
 
 
1874
 
Procedure InvalidDateDayError(const AYear, ADayOfYear: Word);
1875
 
begin
1876
 
  Raise EConvertError.CreateFmt(SErrInvalidDayOfYear,[AYear,ADayOfYear]);
1877
 
end;
1878
 
 
1879
 
 
1880
 
Procedure InvalidDateMonthWeekError(const AYear, AMonth, AWeekOfMonth, ADayOfWeek: Word);
1881
 
begin
1882
 
  Raise EConvertError.CreateFmt(SErrInvalidDateMonthWeek,[Ayear,AMonth,AWeekOfMonth,ADayOfWeek]);
1883
 
end;
1884
 
 
1885
 
 
1886
 
Procedure InvalidDayOfWeekInMonthError(const AYear, AMonth, ANthDayOfWeek,  ADayOfWeek: Word);
1887
 
 
1888
 
begin
1889
 
  Raise EConvertError.CreateFmt(SErrInvalidDayOfWeekInMonth,[AYear,AMonth,ANthDayOfWeek,ADayOfWeek]);
1890
 
end;
1891
 
 
1892
 
 
1893
 
{ ---------------------------------------------------------------------
1894
 
    Julian and Modified Julian Date conversion support
1895
 
  ---------------------------------------------------------------------}
1896
 
 
1897
 
 
1898
 
Function DateTimeToJulianDate(const AValue: TDateTime): Double;
1899
 
begin
1900
 
  NotYetImplemented('DateTimeToJulianDate');
1901
 
end;
1902
 
 
1903
 
 
1904
 
Function JulianDateToDateTime(const AValue: Double): TDateTime;
1905
 
begin
1906
 
  NotYetImplemented('JulianDateToDateTime');
1907
 
end;
1908
 
 
1909
 
 
1910
 
Function TryJulianDateToDateTime(const AValue: Double; var ADateTime: TDateTime): Boolean;
1911
 
 
1912
 
begin
1913
 
  NotYetImplemented('TryJulianDateToDateTime');
1914
 
end;
1915
 
 
1916
 
 
1917
 
Function DateTimeToModifiedJulianDate(const AValue: TDateTime): Double;
1918
 
begin
1919
 
  NotYetImplemented('DateTimeToModifiedJulianDate');
1920
 
end;
1921
 
 
1922
 
 
1923
 
Function ModifiedJulianDateToDateTime(const AValue: Double): TDateTime;
1924
 
begin
1925
 
  NotYetImplemented('ModifiedJulianDateToDateTime');
1926
 
end;
1927
 
 
1928
 
 
1929
 
Function TryModifiedJulianDateToDateTime(const AValue: Double; var ADateTime: TDateTime): Boolean;
1930
 
 
1931
 
begin
1932
 
  NotYetImplemented('TryModifiedJulianDateToDateTime');
1933
 
end;
1934
 
 
1935
 
{ ---------------------------------------------------------------------
1936
 
    Unix timestamp support.
1937
 
  ---------------------------------------------------------------------}
1938
 
 
1939
 
Function DateTimeToUnix(const AValue: TDateTime): Int64;
1940
 
begin
1941
 
  NotYetImplemented('DateTimeToUnix');
1942
 
end;
1943
 
 
1944
 
 
1945
 
Function UnixToDateTime(const AValue: Int64): TDateTime;
1946
 
 
1947
 
begin
1948
 
  NotYetImplemented('UnixToDateTime');
1949
 
end;
1950
 
 
1951
 
end.
1952
 
 
1953
 
{
1954
 
  $Log: dateutil.inc,v $
1955
 
  Revision 1.2  2004/01/10 19:35:17  michael
1956
 
  + Moved all resource strings to rtlconst/sysconst
1957
 
 
1958
 
  Revision 1.1  2003/12/06 18:03:46  hajny
1959
 
    * include file for dateutil(s)
1960
 
 
1961
 
  Revision 1.2  2003/01/19 14:37:06  michael
1962
 
  + Much more functions implemented
1963
 
 
1964
 
}