1 |
torben |
2671 |
// Upgraded to Delphi 2009: Sebastian Zierer
|
2 |
|
|
|
3 |
|
|
(* ***** BEGIN LICENSE BLOCK *****
|
4 |
|
|
* Version: MPL 1.1
|
5 |
|
|
*
|
6 |
|
|
* The contents of this file are subject to the Mozilla Public License Version
|
7 |
|
|
* 1.1 (the "License"); you may not use this file except in compliance with
|
8 |
|
|
* the License. You may obtain a copy of the License at
|
9 |
|
|
* http://www.mozilla.org/MPL/
|
10 |
|
|
*
|
11 |
|
|
* Software distributed under the License is distributed on an "AS IS" basis,
|
12 |
|
|
* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
|
13 |
|
|
* for the specific language governing rights and limitations under the
|
14 |
|
|
* License.
|
15 |
|
|
*
|
16 |
|
|
* The Original Code is TurboPower SysTools
|
17 |
|
|
*
|
18 |
|
|
* The Initial Developer of the Original Code is
|
19 |
|
|
* TurboPower Software
|
20 |
|
|
*
|
21 |
|
|
* Portions created by the Initial Developer are Copyright (C) 1996-2002
|
22 |
|
|
* the Initial Developer. All Rights Reserved.
|
23 |
|
|
*
|
24 |
|
|
* Contributor(s):
|
25 |
|
|
*
|
26 |
|
|
* ***** END LICENSE BLOCK ***** *)
|
27 |
|
|
|
28 |
|
|
{*********************************************************}
|
29 |
|
|
{* SysTools: StDate.pas 4.04 *}
|
30 |
|
|
{*********************************************************}
|
31 |
|
|
{* SysTools: Date and time manipulation *}
|
32 |
|
|
{*********************************************************}
|
33 |
|
|
|
34 |
|
|
{$I StDefine.inc}
|
35 |
|
|
|
36 |
|
|
{For BCB 3.0 package support.}
|
37 |
|
|
{$IFDEF VER110}
|
38 |
|
|
{$ObjExportAll On}
|
39 |
|
|
{$ENDIF}
|
40 |
|
|
|
41 |
|
|
unit StDate;
|
42 |
|
|
|
43 |
|
|
interface
|
44 |
|
|
|
45 |
|
|
uses
|
46 |
|
|
Windows, SysUtils;
|
47 |
|
|
|
48 |
|
|
type
|
49 |
|
|
TStDate = LongInt;
|
50 |
|
|
{In STDATE, dates are stored in long integer format as the number of days
|
51 |
|
|
since January 1, 1600}
|
52 |
|
|
|
53 |
|
|
TDateArray = array[0..(MaxLongInt div SizeOf(TStDate))-1] of TStDate;
|
54 |
|
|
{Type for StDate open array}
|
55 |
|
|
|
56 |
|
|
TStDayType = (Sunday, Monday, Tuesday, Wednesday, Thursday, Friday, Saturday);
|
57 |
|
|
{An enumerated type used when representing a day of the week}
|
58 |
|
|
|
59 |
|
|
TStBondDateType = (bdtActual, bdt30E360, bdt30360, bdt30360psa);
|
60 |
|
|
{An enumerated type used for calculating bond date differences}
|
61 |
|
|
|
62 |
|
|
TStTime = LongInt;
|
63 |
|
|
{STDATE handles time in a manner similar to dates, representing a given
|
64 |
|
|
time of day as the number of seconds since midnight}
|
65 |
|
|
|
66 |
|
|
TStDateTimeRec =
|
67 |
|
|
record
|
68 |
|
|
{This record type simply combines the two basic date types defined by
|
69 |
|
|
STDATE, Date and Time}
|
70 |
|
|
D : TStDate;
|
71 |
|
|
T : TStTime;
|
72 |
|
|
end;
|
73 |
|
|
|
74 |
|
|
const
|
75 |
|
|
MinYear = 1600; {Minimum valid year for a date variable}
|
76 |
|
|
MaxYear = 3999; {Maximum valid year for a date variable}
|
77 |
|
|
Mindate = $00000000; {Minimum valid date for a date variable - 01/01/1600}
|
78 |
|
|
Maxdate = $000D6025; {Maximum valid date for a date variable - 12/31/3999}
|
79 |
|
|
Date1900 : longint = $0001AC05; {Julian date for 01/01/1900}
|
80 |
|
|
Date1970 : longint = $00020FE4; {Julian date for 01/01/1970}
|
81 |
|
|
Date1980 : longint = $00021E28; {Julian date for 01/01/1980}
|
82 |
|
|
Date2000 : longint = $00023AB1; {Julian date for 01/01/2000}
|
83 |
|
|
Days400Yr : longint = 146097; {days in 400 years}
|
84 |
|
|
{This value is used to represent an invalid date, such as 12/32/1992}
|
85 |
|
|
BadDate = LongInt($FFFFFFFF);
|
86 |
|
|
|
87 |
|
|
DeltaJD = $00232DA8; {Days between 1/1/-4173 and 1/1/1600}
|
88 |
|
|
|
89 |
|
|
MinTime = 0; {Minimum valid time for a time variable - 00:00:00 am}
|
90 |
|
|
MaxTime = 86399; {Maximum valid time for a time variable - 23:59:59 pm}
|
91 |
|
|
{This value is used to represent an invalid time of day, such as 12:61:00}
|
92 |
|
|
BadTime = LongInt($FFFFFFFF);
|
93 |
|
|
SecondsInDay = 86400; {Number of seconds in a day}
|
94 |
|
|
SecondsInHour = 3600; {Number of seconds in an hour}
|
95 |
|
|
SecondsInMinute = 60; {Number of seconds in a minute}
|
96 |
|
|
HoursInDay = 24; {Number of hours in a day}
|
97 |
|
|
MinutesInHour = 60; {Number of minutes in an hour}
|
98 |
|
|
MinutesInDay = 1440; {Number of minutes in a day}
|
99 |
|
|
|
100 |
|
|
var
|
101 |
|
|
DefaultYear : Integer; {default year--used by DateStringToDMY}
|
102 |
|
|
DefaultMonth : ShortInt; {default month}
|
103 |
|
|
|
104 |
|
|
{-------julian date routines---------------}
|
105 |
|
|
|
106 |
|
|
function CurrentDate : TStDate;
|
107 |
|
|
{-returns today's date as a Julian date}
|
108 |
|
|
|
109 |
|
|
function ValidDate(Day, Month, Year, Epoch : Integer) : Boolean;
|
110 |
|
|
{-Verify that day, month, year is a valid date}
|
111 |
|
|
|
112 |
|
|
function DMYtoStDate(Day, Month, Year, Epoch : Integer) : TStDate;
|
113 |
|
|
{-Convert from day, month, year to a Julian date}
|
114 |
|
|
|
115 |
|
|
procedure StDateToDMY(Julian : TStDate; var Day, Month, Year : Integer);
|
116 |
|
|
{-Convert from a Julian date to day, month, year}
|
117 |
|
|
|
118 |
|
|
function IncDate(Julian : TStDate; Days, Months, Years : Integer) : TStDate;
|
119 |
|
|
{-Add (or subtract) the number of days, months, and years to a date}
|
120 |
|
|
|
121 |
|
|
function IncDateTrunc(Julian : TStDate; Months, Years : Integer) : TStDate;
|
122 |
|
|
{-Add (or subtract) the specified number of months and years to a date}
|
123 |
|
|
|
124 |
|
|
procedure DateDiff(Date1, Date2 : TStDate;
|
125 |
|
|
var Days, Months, Years : Integer);
|
126 |
|
|
{-Return the difference in days, months, and years between two valid Julian
|
127 |
|
|
dates}
|
128 |
|
|
|
129 |
|
|
function BondDateDiff(Date1, Date2 : TStDate; DayBasis : TStBondDateType) : TStDate;
|
130 |
|
|
{-Return the difference in days between two valid Julian
|
131 |
|
|
dates using a specific financial basis}
|
132 |
|
|
|
133 |
|
|
function WeekOfYear(Julian : TStDate) : Byte;
|
134 |
|
|
{-Returns the week number of the year given the Julian Date}
|
135 |
|
|
|
136 |
|
|
function AstJulianDate(Julian : TStDate) : Double;
|
137 |
|
|
{-Returns the Astronomical Julian Date from a TStDate}
|
138 |
|
|
|
139 |
|
|
function AstJulianDatetoStDate(AstJulian : Double; Truncate : Boolean) : TStDate;
|
140 |
|
|
{-Returns a TStDate from an Astronomical Julian Date.
|
141 |
|
|
Truncate TRUE Converts to appropriate 0 hours then truncates
|
142 |
|
|
FALSE Converts to appropriate 0 hours, then rounds to
|
143 |
|
|
nearest;}
|
144 |
|
|
|
145 |
|
|
function AstJulianDatePrim(Year, Month, Date : Integer; UT : TStTime) : Double;
|
146 |
|
|
{-Returns an Astronomical Julian Date for any year, even those outside
|
147 |
|
|
MinYear..MaxYear}
|
148 |
|
|
|
149 |
|
|
function DayOfWeek(Julian : TStDate) : TStDayType;
|
150 |
|
|
{-Return the day of the week for a Julian date}
|
151 |
|
|
|
152 |
|
|
function DayOfWeekDMY(Day, Month, Year, Epoch : Integer) : TStDayType;
|
153 |
|
|
{-Return the day of the week for the day, month, year}
|
154 |
|
|
|
155 |
|
|
function IsLeapYear(Year : Integer) : Boolean;
|
156 |
|
|
{-Return True if Year is a leap year}
|
157 |
|
|
|
158 |
|
|
function DaysInMonth(Month : Integer; Year, Epoch : Integer) : Integer;
|
159 |
|
|
{-Return the number of days in the specified month of a given year}
|
160 |
|
|
|
161 |
|
|
function ResolveEpoch(Year, Epoch : Integer) : Integer;
|
162 |
|
|
{-Convert 2 digit year to 4 digit year according to Epoch}
|
163 |
|
|
|
164 |
|
|
|
165 |
|
|
{-------time routines---------------}
|
166 |
|
|
|
167 |
|
|
function ValidTime(Hours, Minutes, Seconds : Integer) : Boolean;
|
168 |
|
|
{-Return True if Hours:Minutes:Seconds is a valid time}
|
169 |
|
|
|
170 |
|
|
procedure StTimeToHMS(T : TStTime;
|
171 |
|
|
var Hours, Minutes, Seconds : Byte);
|
172 |
|
|
{-Convert a time variable to hours, minutes, seconds}
|
173 |
|
|
|
174 |
|
|
function HMStoStTime(Hours, Minutes, Seconds : Byte) : TStTime;
|
175 |
|
|
{-Convert hours, minutes, seconds to a time variable}
|
176 |
|
|
|
177 |
|
|
function CurrentTime : TStTime;
|
178 |
|
|
{-Return the current time in seconds since midnight}
|
179 |
|
|
|
180 |
|
|
procedure TimeDiff(Time1, Time2 : TStTime;
|
181 |
|
|
var Hours, Minutes, Seconds : Byte);
|
182 |
|
|
{-Return the difference in hours, minutes, and seconds between two times}
|
183 |
|
|
|
184 |
|
|
function IncTime(T : TStTime; Hours, Minutes, Seconds : Byte) : TStTime;
|
185 |
|
|
{-Add the specified hours, minutes, and seconds to a given time of day}
|
186 |
|
|
|
187 |
|
|
function DecTime(T : TStTime; Hours, Minutes, Seconds : Byte) : TStTime;
|
188 |
|
|
{-Subtract the specified hours, minutes, and seconds from a given time of day}
|
189 |
|
|
|
190 |
|
|
function RoundToNearestHour(T : TStTime; Truncate : Boolean) : TStTime;
|
191 |
|
|
{-Given a time, round it to the nearest hour, or truncate minutes and
|
192 |
|
|
seconds}
|
193 |
|
|
|
194 |
|
|
function RoundToNearestMinute(const T : TStTime; Truncate : Boolean) : TStTime;
|
195 |
|
|
{-Given a time, round it to the nearest minute, or truncate seconds}
|
196 |
|
|
|
197 |
|
|
{-------- routines for DateTimeRec records ---------}
|
198 |
|
|
|
199 |
|
|
procedure DateTimeDiff(const DT1 : TStDateTimeRec; var DT2 : TStDateTimeRec; {!!.02}
|
200 |
|
|
var Days : LongInt; var Secs : LongInt);
|
201 |
|
|
{-Return the difference in days and seconds between two points in time}
|
202 |
|
|
|
203 |
|
|
procedure IncDateTime(const DT1 : TStDateTimeRec; var DT2 : TStDateTimeRec; {!!.02}
|
204 |
|
|
Days : Integer; Secs : LongInt);
|
205 |
|
|
{-Increment (or decrement) a date and time by the specified number of days
|
206 |
|
|
and seconds}
|
207 |
|
|
|
208 |
|
|
function DateTimeToStDate(DT : TDateTime) : TStDate;
|
209 |
|
|
{-Convert Delphi TDateTime to TStDate}
|
210 |
|
|
|
211 |
|
|
function DateTimeToStTime(DT : TDateTime) : TStTime;
|
212 |
|
|
{-Convert Delphi TDateTime to TStTime}
|
213 |
|
|
|
214 |
|
|
function StDateToDateTime(D : TStDate) : TDateTime;
|
215 |
|
|
{-Convert TStDate to TDateTime}
|
216 |
|
|
|
217 |
|
|
function StTimeToDateTime(T : TStTime) : TDateTime;
|
218 |
|
|
{-Convert TStTime to TDateTime}
|
219 |
|
|
|
220 |
|
|
function Convert2ByteDate(TwoByteDate : Word) : TStDate;
|
221 |
|
|
{-Convert an Object Professional two byte date into a SysTools date}
|
222 |
|
|
|
223 |
|
|
function Convert4ByteDate(FourByteDate : TStDate) : Word;
|
224 |
|
|
{-Convert a SysTools date into an Object Professional two byte date}
|
225 |
|
|
|
226 |
|
|
|
227 |
|
|
implementation
|
228 |
|
|
|
229 |
|
|
const
|
230 |
|
|
First2Months = 59; {1600 was a leap year}
|
231 |
|
|
FirstDayOfWeek = Saturday; {01/01/1600 was a Saturday}
|
232 |
|
|
DateLen = 40; {maximum length of Picture strings}
|
233 |
|
|
MaxMonthName = 15;
|
234 |
|
|
MaxDayName = 15;
|
235 |
|
|
|
236 |
|
|
|
237 |
|
|
//type
|
238 |
|
|
{ DateString = string[DateLen];}
|
239 |
|
|
// SString = string[255];
|
240 |
|
|
|
241 |
|
|
function IsLeapYear(Year : Integer) : Boolean;
|
242 |
|
|
{-Return True if Year is a leap year}
|
243 |
|
|
begin
|
244 |
|
|
Result := (Year mod 4 = 0) and (Year mod 4000 <> 0) and
|
245 |
|
|
((Year mod 100 <> 0) or (Year mod 400 = 0));
|
246 |
|
|
end;
|
247 |
|
|
|
248 |
|
|
function IsLastDayofMonth(Day, Month, Year : Integer) : Boolean;
|
249 |
|
|
{-Return True if date is the last day in month}
|
250 |
|
|
var
|
251 |
|
|
Epoch : Integer;
|
252 |
|
|
begin
|
253 |
|
|
Epoch := (Year div 100) * 100;
|
254 |
|
|
if ValidDate(Day + 1, Month, Year, Epoch) then
|
255 |
|
|
Result := false
|
256 |
|
|
else
|
257 |
|
|
Result := true;
|
258 |
|
|
end;
|
259 |
|
|
|
260 |
|
|
function IsLastDayofFeb(Date : TStDate) : Boolean;
|
261 |
|
|
{-Return True if date is the last day in February}
|
262 |
|
|
var
|
263 |
|
|
Day, Month, Year : Integer;
|
264 |
|
|
begin
|
265 |
|
|
StDateToDMY(Date, Day, Month, Year);
|
266 |
|
|
if (Month = 2) and IsLastDayOfMonth(Day, Month, Year) then
|
267 |
|
|
Result := true
|
268 |
|
|
else
|
269 |
|
|
Result := false;
|
270 |
|
|
end;
|
271 |
|
|
|
272 |
|
|
procedure ExchangeLongInts(var I, J : LongInt);
|
273 |
|
|
register;
|
274 |
|
|
asm
|
275 |
|
|
mov ecx, [eax]
|
276 |
|
|
push ecx
|
277 |
|
|
mov ecx, [edx]
|
278 |
|
|
mov [eax], ecx
|
279 |
|
|
pop ecx
|
280 |
|
|
mov [edx], ecx
|
281 |
|
|
end;
|
282 |
|
|
|
283 |
|
|
procedure ExchangeStructs(var I, J; Size : Cardinal);
|
284 |
|
|
register;
|
285 |
|
|
asm
|
286 |
|
|
push edi
|
287 |
|
|
push ebx
|
288 |
|
|
push ecx
|
289 |
|
|
shr ecx, 2
|
290 |
|
|
jz @@LessThanFour
|
291 |
|
|
|
292 |
|
|
@@AgainDWords:
|
293 |
|
|
mov ebx, [eax]
|
294 |
|
|
mov edi, [edx]
|
295 |
|
|
mov [edx], ebx
|
296 |
|
|
mov [eax], edi
|
297 |
|
|
add eax, 4
|
298 |
|
|
add edx, 4
|
299 |
|
|
dec ecx
|
300 |
|
|
jnz @@AgainDWords
|
301 |
|
|
|
302 |
|
|
@@LessThanFour:
|
303 |
|
|
pop ecx
|
304 |
|
|
and ecx, $3
|
305 |
|
|
jz @@Done
|
306 |
|
|
mov bl, [eax]
|
307 |
|
|
mov bh, [edx]
|
308 |
|
|
mov [edx], bl
|
309 |
|
|
mov [eax], bh
|
310 |
|
|
inc eax
|
311 |
|
|
inc edx
|
312 |
|
|
dec ecx
|
313 |
|
|
jz @@Done
|
314 |
|
|
|
315 |
|
|
mov bl, [eax]
|
316 |
|
|
mov bh, [edx]
|
317 |
|
|
mov [edx], bl
|
318 |
|
|
mov [eax], bh
|
319 |
|
|
inc eax
|
320 |
|
|
inc edx
|
321 |
|
|
dec ecx
|
322 |
|
|
jz @@Done
|
323 |
|
|
|
324 |
|
|
mov bl, [eax]
|
325 |
|
|
mov bh, [edx]
|
326 |
|
|
mov [edx], bl
|
327 |
|
|
mov [eax], bh
|
328 |
|
|
|
329 |
|
|
@@Done:
|
330 |
|
|
pop ebx
|
331 |
|
|
pop edi
|
332 |
|
|
end;
|
333 |
|
|
|
334 |
|
|
|
335 |
|
|
function ResolveEpoch(Year, Epoch : Integer) : Integer;
|
336 |
|
|
{-Convert 2-digit year to 4-digit year according to Epoch}
|
337 |
|
|
var
|
338 |
|
|
EpochYear,
|
339 |
|
|
EpochCent : Integer;
|
340 |
|
|
begin
|
341 |
|
|
if Word(Year) < 100 then begin
|
342 |
|
|
EpochYear := Epoch mod 100;
|
343 |
|
|
EpochCent := (Epoch div 100) * 100;
|
344 |
|
|
if (Year < EpochYear) then
|
345 |
|
|
Inc(Year,EpochCent+100)
|
346 |
|
|
else
|
347 |
|
|
Inc(Year,EpochCent);
|
348 |
|
|
end;
|
349 |
|
|
Result := Year;
|
350 |
|
|
end;
|
351 |
|
|
|
352 |
|
|
function CurrentDate : TStDate;
|
353 |
|
|
{-Returns today's date as a julian}
|
354 |
|
|
var
|
355 |
|
|
Year, Month, Date : Word;
|
356 |
|
|
begin
|
357 |
|
|
DecodeDate(Now,Year,Month,Date);
|
358 |
|
|
Result := DMYToStDate(Date,Month,Year,0);
|
359 |
|
|
end;
|
360 |
|
|
|
361 |
|
|
function DaysInMonth(Month : integer; Year, Epoch : Integer) : Integer;
|
362 |
|
|
{-Return the number of days in the specified month of a given year}
|
363 |
|
|
begin
|
364 |
|
|
Year := ResolveEpoch(Year, Epoch);
|
365 |
|
|
|
366 |
|
|
if (Year < MinYear) OR (Year > MaxYear) then
|
367 |
|
|
begin
|
368 |
|
|
Result := 0;
|
369 |
|
|
Exit;
|
370 |
|
|
end;
|
371 |
|
|
|
372 |
|
|
case Month of
|
373 |
|
|
1, 3, 5, 7, 8, 10, 12 :
|
374 |
|
|
Result := 31;
|
375 |
|
|
4, 6, 9, 11 :
|
376 |
|
|
Result := 30;
|
377 |
|
|
2 :
|
378 |
|
|
Result := 28+Ord(IsLeapYear(Year));
|
379 |
|
|
else
|
380 |
|
|
Result := 0;
|
381 |
|
|
end;
|
382 |
|
|
end;
|
383 |
|
|
|
384 |
|
|
function ValidDate(Day, Month, Year, Epoch : Integer) : Boolean;
|
385 |
|
|
{-Verify that day, month, year is a valid date}
|
386 |
|
|
begin
|
387 |
|
|
Year := ResolveEpoch(Year, Epoch);
|
388 |
|
|
|
389 |
|
|
if (Day < 1) or (Year < MinYear) or (Year > MaxYear) then
|
390 |
|
|
Result := False
|
391 |
|
|
else case Month of
|
392 |
|
|
1..12 :
|
393 |
|
|
Result := Day <= DaysInMonth(Month, Year, Epoch);
|
394 |
|
|
else
|
395 |
|
|
Result := False;
|
396 |
|
|
end
|
397 |
|
|
end;
|
398 |
|
|
|
399 |
|
|
function DMYtoStDate(Day, Month, Year, Epoch : Integer) : TStDate;
|
400 |
|
|
{-Convert from day, month, year to a julian date}
|
401 |
|
|
begin
|
402 |
|
|
Year := ResolveEpoch(Year, Epoch);
|
403 |
|
|
|
404 |
|
|
if not ValidDate(Day, Month, Year, Epoch) then
|
405 |
|
|
Result := BadDate
|
406 |
|
|
else if (Year = MinYear) and (Month < 3) then
|
407 |
|
|
if Month = 1 then
|
408 |
|
|
Result := Pred(Day)
|
409 |
|
|
else
|
410 |
|
|
Result := Day+30
|
411 |
|
|
else begin
|
412 |
|
|
if Month > 2 then
|
413 |
|
|
Dec(Month, 3)
|
414 |
|
|
else begin
|
415 |
|
|
Inc(Month, 9);
|
416 |
|
|
Dec(Year);
|
417 |
|
|
end;
|
418 |
|
|
Dec(Year, MinYear);
|
419 |
|
|
Result :=
|
420 |
|
|
((LongInt(Year div 100)*Days400Yr) div 4)+
|
421 |
|
|
((LongInt(Year mod 100)*1461) div 4)+
|
422 |
|
|
(((153*Month)+2) div 5)+Day+First2Months;
|
423 |
|
|
end;
|
424 |
|
|
end;
|
425 |
|
|
|
426 |
|
|
function WeekOfYear(Julian : TStDate) : Byte;
|
427 |
|
|
{-Returns the week number of the year given the Julian Date}
|
428 |
|
|
var
|
429 |
|
|
Day, Month, Year : Integer;
|
430 |
|
|
FirstJulian : TStDate;
|
431 |
|
|
begin
|
432 |
|
|
if (Julian < MinDate) or (Julian > MaxDate) then
|
433 |
|
|
begin
|
434 |
|
|
Result := 0;
|
435 |
|
|
Exit;
|
436 |
|
|
end;
|
437 |
|
|
|
438 |
|
|
Julian := Julian + 3 - ((6 + Ord(DayOfWeek(Julian))) mod 7);
|
439 |
|
|
StDateToDMY(Julian,Day,Month,Year);
|
440 |
|
|
FirstJulian := DMYToStDate(1,1,Year,0);
|
441 |
|
|
Result := 1 + (Julian - FirstJulian) div 7;
|
442 |
|
|
end;
|
443 |
|
|
|
444 |
|
|
function AstJulianDate(Julian : TStDate) : Double;
|
445 |
|
|
{-Returns the Astronomical Julian Date from a TStDate}
|
446 |
|
|
begin
|
447 |
|
|
{Subtract 0.5d since Astronomical JD starts at noon
|
448 |
|
|
while TStDate (with implied .0) starts at midnight}
|
449 |
|
|
Result := Julian - 0.5 + DeltaJD;
|
450 |
|
|
end;
|
451 |
|
|
|
452 |
|
|
|
453 |
|
|
function AstJulianDatePrim(Year, Month, Date : Integer; UT : TStTime) : Double;
|
454 |
|
|
var
|
455 |
|
|
A, B : integer;
|
456 |
|
|
LY,
|
457 |
|
|
GC : Boolean;
|
458 |
|
|
|
459 |
|
|
begin
|
460 |
|
|
Result := -MaxLongInt;
|
461 |
|
|
if (not (Month in [1..12])) or (Date < 1) then
|
462 |
|
|
Exit
|
463 |
|
|
else if (Month in [1, 3, 5, 7, 8, 10, 12]) and (Date > 31) then
|
464 |
|
|
Exit
|
465 |
|
|
else if (Month in [4, 6, 9, 11]) and (Date > 30) then
|
466 |
|
|
Exit
|
467 |
|
|
else if (Month = 2) then begin
|
468 |
|
|
LY := IsLeapYear(Year);
|
469 |
|
|
if ((LY) and (Date > 29)) or (not (LY) and (Date > 28)) then
|
470 |
|
|
Exit;
|
471 |
|
|
end else if ((UT < 0) or (UT >= SecondsInDay)) then
|
472 |
|
|
Exit;
|
473 |
|
|
|
474 |
|
|
if (Month <= 2) then begin
|
475 |
|
|
Year := Year - 1;
|
476 |
|
|
Month := Month + 12;
|
477 |
|
|
end;
|
478 |
|
|
A := abs(Year div 100);
|
479 |
|
|
|
480 |
|
|
if (Year > 1582) then
|
481 |
|
|
GC := True
|
482 |
|
|
else if (Year = 1582) then begin
|
483 |
|
|
if (Month > 10) then
|
484 |
|
|
GC := True
|
485 |
|
|
else if (Month < 10) then
|
486 |
|
|
GC := False
|
487 |
|
|
else begin
|
488 |
|
|
if (Date >= 15) then
|
489 |
|
|
GC := True
|
490 |
|
|
else
|
491 |
|
|
GC := False;
|
492 |
|
|
end;
|
493 |
|
|
end else
|
494 |
|
|
GC := False;
|
495 |
|
|
if (GC) then
|
496 |
|
|
B := 2 - A + abs(A div 4)
|
497 |
|
|
else
|
498 |
|
|
B := 0;
|
499 |
|
|
|
500 |
|
|
Result := Trunc(365.25 * (Year + 4716))
|
501 |
|
|
+ Trunc(30.6001 * (Month + 1))
|
502 |
|
|
+ Date + B - 1524.5
|
503 |
|
|
+ UT / SecondsInDay;
|
504 |
|
|
end;
|
505 |
|
|
|
506 |
|
|
|
507 |
|
|
function AstJulianDatetoStDate(AstJulian : Double; Truncate : Boolean) : TStDate;
|
508 |
|
|
{-Returns a TStDate from an Astronomical Julian Date.
|
509 |
|
|
Truncate TRUE Converts to appropriate 0 hours then truncates
|
510 |
|
|
FALSE Converts to appropriate 0 hours, then rounds to
|
511 |
|
|
nearest;}
|
512 |
|
|
begin
|
513 |
|
|
{Convert to TStDate, adding 0.5d for implied .0d of TStDate}
|
514 |
|
|
AstJulian := AstJulian + 0.5 - DeltaJD;
|
515 |
|
|
if (AstJulian < MinDate) OR (AstJulian > MaxDate) then
|
516 |
|
|
begin
|
517 |
|
|
Result := BadDate;
|
518 |
|
|
Exit;
|
519 |
|
|
end;
|
520 |
|
|
|
521 |
|
|
if Truncate then
|
522 |
|
|
Result := Trunc(AstJulian)
|
523 |
|
|
else
|
524 |
|
|
Result := Trunc(AstJulian + 0.5);
|
525 |
|
|
end;
|
526 |
|
|
|
527 |
|
|
procedure StDateToDMY(Julian : TStDate; var Day, Month, Year : Integer);
|
528 |
|
|
{-Convert from a julian date to month, day, year}
|
529 |
|
|
var
|
530 |
|
|
I, J : LongInt;
|
531 |
|
|
begin
|
532 |
|
|
if Julian = BadDate then begin
|
533 |
|
|
Day := 0;
|
534 |
|
|
Month := 0;
|
535 |
|
|
Year := 0;
|
536 |
|
|
end else if Julian <= First2Months then begin
|
537 |
|
|
Year := MinYear;
|
538 |
|
|
if Julian <= 30 then begin
|
539 |
|
|
Month := 1;
|
540 |
|
|
Day := Succ(Julian);
|
541 |
|
|
end else begin
|
542 |
|
|
Month := 2;
|
543 |
|
|
Day := Julian-30;
|
544 |
|
|
end;
|
545 |
|
|
end else begin
|
546 |
|
|
I := (4*LongInt(Julian-First2Months))-1;
|
547 |
|
|
|
548 |
|
|
J := (4*((I mod Days400Yr) div 4))+3;
|
549 |
|
|
Year := (100*(I div Days400Yr))+(J div 1461);
|
550 |
|
|
I := (5*(((J mod 1461)+4) div 4))-3;
|
551 |
|
|
Day := ((I mod 153)+5) div 5;
|
552 |
|
|
|
553 |
|
|
Month := I div 153;
|
554 |
|
|
if Month < 10 then
|
555 |
|
|
Inc(Month, 3)
|
556 |
|
|
else begin
|
557 |
|
|
Dec(Month, 9);
|
558 |
|
|
Inc(Year);
|
559 |
|
|
end;
|
560 |
|
|
Inc(Year, MinYear);
|
561 |
|
|
end;
|
562 |
|
|
end;
|
563 |
|
|
|
564 |
|
|
function IncDate(Julian : TStDate; Days, Months, Years : Integer) : TStDate;
|
565 |
|
|
{-Add (or subtract) the number of months, days, and years to a date.
|
566 |
|
|
Months and years are added before days. No overflow/underflow
|
567 |
|
|
checks are made}
|
568 |
|
|
var
|
569 |
|
|
Day, Month, Year, Day28Delta : Integer;
|
570 |
|
|
begin
|
571 |
|
|
StDateToDMY(Julian, Day, Month, Year);
|
572 |
|
|
Day28Delta := Day-28;
|
573 |
|
|
if Day28Delta < 0 then
|
574 |
|
|
Day28Delta := 0
|
575 |
|
|
else
|
576 |
|
|
Day := 28;
|
577 |
|
|
|
578 |
|
|
Inc(Year, Years);
|
579 |
|
|
Inc(Year, Months div 12);
|
580 |
|
|
Inc(Month, Months mod 12);
|
581 |
|
|
if Month < 1 then begin
|
582 |
|
|
Inc(Month, 12);
|
583 |
|
|
Dec(Year);
|
584 |
|
|
end
|
585 |
|
|
else if Month > 12 then begin
|
586 |
|
|
Dec(Month, 12);
|
587 |
|
|
Inc(Year);
|
588 |
|
|
end;
|
589 |
|
|
|
590 |
|
|
Julian := DMYtoStDate(Day, Month, Year,0);
|
591 |
|
|
if Julian <> BadDate then begin
|
592 |
|
|
Inc(Julian, Days);
|
593 |
|
|
Inc(Julian, Day28Delta);
|
594 |
|
|
end;
|
595 |
|
|
Result := Julian;
|
596 |
|
|
end;
|
597 |
|
|
|
598 |
|
|
function IncDateTrunc(Julian : TStDate; Months, Years : Integer) : TStDate;
|
599 |
|
|
{-Add (or subtract) the specified number of months and years to a date}
|
600 |
|
|
var
|
601 |
|
|
Day, Month, Year : Integer;
|
602 |
|
|
MaxDay, Day28Delta : Integer;
|
603 |
|
|
begin
|
604 |
|
|
StDateToDMY(Julian, Day, Month, Year);
|
605 |
|
|
Day28Delta := Day-28;
|
606 |
|
|
if Day28Delta < 0 then
|
607 |
|
|
Day28Delta := 0
|
608 |
|
|
else
|
609 |
|
|
Day := 28;
|
610 |
|
|
|
611 |
|
|
Inc(Year, Years);
|
612 |
|
|
Inc(Year, Months div 12);
|
613 |
|
|
Inc(Month, Months mod 12);
|
614 |
|
|
if Month < 1 then begin
|
615 |
|
|
Inc(Month, 12);
|
616 |
|
|
Dec(Year);
|
617 |
|
|
end
|
618 |
|
|
else if Month > 12 then begin
|
619 |
|
|
Dec(Month, 12);
|
620 |
|
|
Inc(Year);
|
621 |
|
|
end;
|
622 |
|
|
|
623 |
|
|
Julian := DMYtoStDate(Day, Month, Year,0);
|
624 |
|
|
if Julian <> BadDate then begin
|
625 |
|
|
MaxDay := DaysInMonth(Month, Year,0);
|
626 |
|
|
if Day+Day28Delta > MaxDay then
|
627 |
|
|
Inc(Julian, MaxDay-Day)
|
628 |
|
|
else
|
629 |
|
|
Inc(Julian, Day28Delta);
|
630 |
|
|
end;
|
631 |
|
|
Result := Julian;
|
632 |
|
|
end;
|
633 |
|
|
|
634 |
|
|
procedure DateDiff(Date1, Date2 : TStDate; var Days, Months, Years : Integer);
|
635 |
|
|
{-Return the difference in days,months,years between two valid julian dates}
|
636 |
|
|
var
|
637 |
|
|
Day1, Day2, Month1, Month2, Year1, Year2 : Integer;
|
638 |
|
|
begin
|
639 |
|
|
{we want Date2 > Date1}
|
640 |
|
|
if Date1 > Date2 then
|
641 |
|
|
ExchangeLongInts(Date1, Date2);
|
642 |
|
|
|
643 |
|
|
{convert dates to day,month,year}
|
644 |
|
|
StDateToDMY(Date1, Day1, Month1, Year1);
|
645 |
|
|
StDateToDMY(Date2, Day2, Month2, Year2);
|
646 |
|
|
|
647 |
|
|
{days first}
|
648 |
|
|
if (Day1 = DaysInMonth(Month1, Year1, 0)) then begin
|
649 |
|
|
Day1 := 0;
|
650 |
|
|
Inc(Month1); {OK if Month1 > 12}
|
651 |
|
|
end;
|
652 |
|
|
if (Day2 = DaysInMonth(Month2, Year2, 0)) then begin
|
653 |
|
|
Day2 := 0;
|
654 |
|
|
Inc(Month2); {OK if Month2 > 12}
|
655 |
|
|
end;
|
656 |
|
|
if (Day2 < Day1) then begin
|
657 |
|
|
Dec(Month2);
|
658 |
|
|
if Month2 = 0 then begin
|
659 |
|
|
Month2 := 12;
|
660 |
|
|
Dec(Year2);
|
661 |
|
|
end;
|
662 |
|
|
Days := Day2 + DaysInMonth(Month2, Year2, 0) - Day1; {!!.02}
|
663 |
|
|
end else
|
664 |
|
|
Days := Day2-Day1;
|
665 |
|
|
|
666 |
|
|
{now months and years}
|
667 |
|
|
if Month2 < Month1 then begin
|
668 |
|
|
Inc(Month2, 12);
|
669 |
|
|
Dec(Year2);
|
670 |
|
|
end;
|
671 |
|
|
Months := Month2-Month1;
|
672 |
|
|
Years := Year2-Year1;
|
673 |
|
|
end;
|
674 |
|
|
|
675 |
|
|
function BondDateDiff(Date1, Date2 : TStDate; DayBasis : TStBondDateType) : TStDate;
|
676 |
|
|
{-Return the difference in days between two valid Julian
|
677 |
|
|
dates using one a specific accrual method}
|
678 |
|
|
var
|
679 |
|
|
Day1,
|
680 |
|
|
Month1,
|
681 |
|
|
Year1,
|
682 |
|
|
Day2,
|
683 |
|
|
Month2,
|
684 |
|
|
Year2 : Integer;
|
685 |
|
|
IY : LongInt;
|
686 |
|
|
begin
|
687 |
|
|
{we want Date2 > Date1}
|
688 |
|
|
if Date1 > Date2 then
|
689 |
|
|
ExchangeLongInts(Date1, Date2);
|
690 |
|
|
|
691 |
|
|
if (DayBasis = bdtActual) then
|
692 |
|
|
Result := Date2-Date1
|
693 |
|
|
else
|
694 |
|
|
begin
|
695 |
|
|
StDateToDMY(Date1, Day1, Month1, Year1);
|
696 |
|
|
StDateToDMY(Date2, Day2, Month2, Year2);
|
697 |
|
|
|
698 |
|
|
if ((DayBasis = bdt30360PSA) and IsLastDayofFeb(Date1)) or (Day1 = 31) then
|
699 |
|
|
Day1 := 30;
|
700 |
|
|
if (DayBasis = bdt30E360) then
|
701 |
|
|
begin
|
702 |
|
|
if (Day2 = 31) then
|
703 |
|
|
Day2 := 30
|
704 |
|
|
end else
|
705 |
|
|
if (Day2 = 31) and (Day1 >= 30) then
|
706 |
|
|
Day2 := 30;
|
707 |
|
|
|
708 |
|
|
IY := 360 * (Year2 - Year1);
|
709 |
|
|
Result := IY + 30 * (Month2 - Month1) + (Day2 - Day1);
|
710 |
|
|
end;
|
711 |
|
|
end;
|
712 |
|
|
|
713 |
|
|
function DayOfWeek(Julian : TStDate) : TStDayType;
|
714 |
|
|
{-Return the day of the week for the date. Returns TStDayType(7) if Julian =
|
715 |
|
|
BadDate.}
|
716 |
|
|
var
|
717 |
|
|
B : Byte;
|
718 |
|
|
begin
|
719 |
|
|
if Julian = BadDate then begin
|
720 |
|
|
B := 7;
|
721 |
|
|
Result := TStDayType(B);
|
722 |
|
|
end else
|
723 |
|
|
Result := TStDayType( (Julian+Ord(FirstDayOfWeek)) mod 7 );
|
724 |
|
|
end;
|
725 |
|
|
|
726 |
|
|
function DayOfWeekDMY(Day, Month, Year, Epoch : Integer) : TStDayType;
|
727 |
|
|
{-Return the day of the week for the day, month, year}
|
728 |
|
|
begin
|
729 |
|
|
Result := DayOfWeek( DMYtoStDate(Day, Month, Year, Epoch) );
|
730 |
|
|
end;
|
731 |
|
|
|
732 |
|
|
procedure StTimeToHMS(T : TStTime; var Hours, Minutes, Seconds : Byte);
|
733 |
|
|
{-Convert a Time variable to Hours, Minutes, Seconds}
|
734 |
|
|
begin
|
735 |
|
|
if T = BadTime then begin
|
736 |
|
|
Hours := 0;
|
737 |
|
|
Minutes := 0;
|
738 |
|
|
Seconds := 0;
|
739 |
|
|
end
|
740 |
|
|
else begin
|
741 |
|
|
Hours := T div SecondsInHour;
|
742 |
|
|
Dec(T, LongInt(Hours)*SecondsInHour);
|
743 |
|
|
Minutes := T div SecondsInMinute;
|
744 |
|
|
Dec(T, LongInt(Minutes)*SecondsInMinute);
|
745 |
|
|
Seconds := T;
|
746 |
|
|
end;
|
747 |
|
|
end;
|
748 |
|
|
|
749 |
|
|
function HMStoStTime(Hours, Minutes, Seconds : Byte) : TStTime;
|
750 |
|
|
{-Convert Hours, Minutes, Seconds to a Time variable}
|
751 |
|
|
var
|
752 |
|
|
T : TStTime;
|
753 |
|
|
begin
|
754 |
|
|
Hours := Hours mod HoursInDay;
|
755 |
|
|
T := (LongInt(Hours)*SecondsInHour)+(LongInt(Minutes)*SecondsInMinute)+Seconds;
|
756 |
|
|
Result := T mod SecondsInDay;
|
757 |
|
|
end;
|
758 |
|
|
|
759 |
|
|
function ValidTime(Hours, Minutes, Seconds : Integer) : Boolean;
|
760 |
|
|
{-Return true if Hours:Minutes:Seconds is a valid time}
|
761 |
|
|
begin
|
762 |
|
|
if (Hours < 0) or (Hours > 23) or
|
763 |
|
|
(Minutes < 0) or (Minutes >= 60) or
|
764 |
|
|
(Seconds < 0) or (Seconds >= 60) then
|
765 |
|
|
Result := False
|
766 |
|
|
else
|
767 |
|
|
Result := True;
|
768 |
|
|
end;
|
769 |
|
|
|
770 |
|
|
function CurrentTime : TStTime;
|
771 |
|
|
{-Returns current time in seconds since midnight}
|
772 |
|
|
begin
|
773 |
|
|
Result := Trunc(SysUtils.Time * SecondsInDay);
|
774 |
|
|
end;
|
775 |
|
|
|
776 |
|
|
procedure TimeDiff(Time1, Time2 : TStTime; var Hours, Minutes, Seconds : Byte);
|
777 |
|
|
{-Return the difference in hours,minutes,seconds between two times}
|
778 |
|
|
begin
|
779 |
|
|
StTimeToHMS(Abs(Time1-Time2), Hours, Minutes, Seconds);
|
780 |
|
|
end;
|
781 |
|
|
|
782 |
|
|
function IncTime(T : TStTime; Hours, Minutes, Seconds : Byte) : TStTime;
|
783 |
|
|
{-Add the specified hours,minutes,seconds to T and return the result}
|
784 |
|
|
begin
|
785 |
|
|
Inc(T, HMStoStTime(Hours, Minutes, Seconds));
|
786 |
|
|
Result := T mod SecondsInDay;
|
787 |
|
|
end;
|
788 |
|
|
|
789 |
|
|
function DecTime(T : TStTime; Hours, Minutes, Seconds : Byte) : TStTime;
|
790 |
|
|
{-Subtract the specified hours,minutes,seconds from T and return the result}
|
791 |
|
|
begin
|
792 |
|
|
Hours := Hours mod HoursInDay;
|
793 |
|
|
Dec(T, HMStoStTime(Hours, Minutes, Seconds));
|
794 |
|
|
if T < 0 then
|
795 |
|
|
Result := T+SecondsInDay
|
796 |
|
|
else
|
797 |
|
|
Result := T;
|
798 |
|
|
end;
|
799 |
|
|
|
800 |
|
|
function RoundToNearestHour(T : TStTime; Truncate : Boolean) : TStTime;
|
801 |
|
|
{-Round T to the nearest hour, or Truncate minutes and seconds from T}
|
802 |
|
|
var
|
803 |
|
|
Hours, Minutes, Seconds : Byte;
|
804 |
|
|
begin
|
805 |
|
|
StTimeToHMS(T, Hours, Minutes, Seconds);
|
806 |
|
|
Seconds := 0;
|
807 |
|
|
if not Truncate then
|
808 |
|
|
if Minutes >= (MinutesInHour div 2) then
|
809 |
|
|
Inc(Hours);
|
810 |
|
|
Minutes := 0;
|
811 |
|
|
Result := HMStoStTime(Hours, Minutes, Seconds);
|
812 |
|
|
end;
|
813 |
|
|
|
814 |
|
|
function RoundToNearestMinute(const T : TStTime; Truncate : Boolean) : TStTime;
|
815 |
|
|
{-Round T to the nearest minute, or Truncate seconds from T}
|
816 |
|
|
var
|
817 |
|
|
Hours, Minutes, Seconds : Byte;
|
818 |
|
|
begin
|
819 |
|
|
StTimeToHMS(T, Hours, Minutes, Seconds);
|
820 |
|
|
if not Truncate then
|
821 |
|
|
if Seconds >= (SecondsInMinute div 2) then
|
822 |
|
|
Inc(Minutes);
|
823 |
|
|
Seconds := 0;
|
824 |
|
|
Result := HMStoStTime(Hours, Minutes, Seconds);
|
825 |
|
|
end;
|
826 |
|
|
|
827 |
|
|
|
828 |
|
|
procedure DateTimeDiff(const DT1 : TStDateTimeRec; var DT2 : TStDateTimeRec; {!!.02}
|
829 |
|
|
var Days : LongInt; var Secs : LongInt);
|
830 |
|
|
{-Return the difference in days and seconds between two points in time}
|
831 |
|
|
var
|
832 |
|
|
tDT1, tDT2 : TStDateTimeRec;
|
833 |
|
|
begin
|
834 |
|
|
tDT1 := DT1;
|
835 |
|
|
tDT2 := DT2;
|
836 |
|
|
{swap if tDT1 later than tDT2}
|
837 |
|
|
if (tDT1.D > tDT2.D) or ((tDT1.D = tDT2.D) and (tDT1.T > tDT2.T)) then
|
838 |
|
|
ExchangeStructs(tDT1, tDT2,sizeof(TStDateTimeRec));
|
839 |
|
|
|
840 |
|
|
{the difference in days is easy}
|
841 |
|
|
Days := tDT2.D-tDT1.D;
|
842 |
|
|
|
843 |
|
|
{difference in seconds}
|
844 |
|
|
if tDT2.T < tDT1.T then begin
|
845 |
|
|
{subtract one day, add 24 hours}
|
846 |
|
|
Dec(Days);
|
847 |
|
|
Inc(tDT2.T, SecondsInDay);
|
848 |
|
|
end;
|
849 |
|
|
Secs := tDT2.T-tDT1.T;
|
850 |
|
|
end;
|
851 |
|
|
|
852 |
|
|
function DateTimeToStDate(DT : TDateTime) : TStDate;
|
853 |
|
|
{-Convert Delphi TDateTime to TStDate}
|
854 |
|
|
var
|
855 |
|
|
Day, Month, Year : Word;
|
856 |
|
|
begin
|
857 |
|
|
DecodeDate(DT, Year, Month, Day);
|
858 |
|
|
Result := DMYToStDate(Day, Month, Year, 0);
|
859 |
|
|
end;
|
860 |
|
|
|
861 |
|
|
function DateTimeToStTime(DT : TDateTime) : TStTime;
|
862 |
|
|
{-Convert Delphi TDateTime to TStTime}
|
863 |
|
|
var
|
864 |
|
|
Hour, Min, Sec, MSec : Word;
|
865 |
|
|
begin
|
866 |
|
|
DecodeTime(DT, Hour, Min, Sec, MSec);
|
867 |
|
|
Result := HMSToStTime(Hour, Min, Sec);
|
868 |
|
|
end;
|
869 |
|
|
|
870 |
|
|
function StDateToDateTime(D : TStDate) : TDateTime;
|
871 |
|
|
{-Convert TStDate to TDateTime}
|
872 |
|
|
var
|
873 |
|
|
Day, Month, Year : Integer;
|
874 |
|
|
begin
|
875 |
|
|
Result := 0;
|
876 |
|
|
if D <> BadDate then begin
|
877 |
|
|
StDateToDMY(D, Day, Month, Year);
|
878 |
|
|
Result := EncodeDate(Year, Month, Day);
|
879 |
|
|
end;
|
880 |
|
|
end;
|
881 |
|
|
|
882 |
|
|
function StTimeToDateTime(T : TStTime) : TDateTime;
|
883 |
|
|
{-Convert TStTime to TDateTime}
|
884 |
|
|
var
|
885 |
|
|
Hour, Min, Sec : Byte;
|
886 |
|
|
begin
|
887 |
|
|
Result := 0;
|
888 |
|
|
if T <> BadTime then begin
|
889 |
|
|
StTimeToHMS(T, Hour, Min, Sec);
|
890 |
|
|
Result := EncodeTime(Hour, Min, Sec, 0);
|
891 |
|
|
end;
|
892 |
|
|
end;
|
893 |
|
|
|
894 |
|
|
procedure IncDateTime(const DT1 : TStDateTimeRec; var DT2 : TStDateTimeRec; {!!.02}
|
895 |
|
|
Days : Integer; Secs : LongInt);
|
896 |
|
|
{-Increment (or decrement) DT1 by the specified number of days and seconds
|
897 |
|
|
and put the result in DT2}
|
898 |
|
|
begin
|
899 |
|
|
DT2 := DT1;
|
900 |
|
|
|
901 |
|
|
{date first}
|
902 |
|
|
Inc(DT2.D, LongInt(Days));
|
903 |
|
|
|
904 |
|
|
if Secs < 0 then begin
|
905 |
|
|
{change the sign}
|
906 |
|
|
Secs := -Secs;
|
907 |
|
|
|
908 |
|
|
{adjust the date}
|
909 |
|
|
Dec(DT2.D, Secs div SecondsInDay);
|
910 |
|
|
Secs := Secs mod SecondsInDay;
|
911 |
|
|
|
912 |
|
|
if Secs > DT2.T then begin
|
913 |
|
|
{subtract a day from DT2.D and add a day's worth of seconds to DT2.T}
|
914 |
|
|
Dec(DT2.D);
|
915 |
|
|
Inc(DT2.T, SecondsInDay);
|
916 |
|
|
end;
|
917 |
|
|
|
918 |
|
|
{now subtract the seconds}
|
919 |
|
|
Dec(DT2.T, Secs);
|
920 |
|
|
end
|
921 |
|
|
else begin
|
922 |
|
|
{increment the seconds}
|
923 |
|
|
Inc(DT2.T, Secs);
|
924 |
|
|
|
925 |
|
|
{adjust date if necessary}
|
926 |
|
|
Inc(DT2.D, DT2.T div SecondsInDay);
|
927 |
|
|
|
928 |
|
|
{force time to 0..SecondsInDay-1 range}
|
929 |
|
|
DT2.T := DT2.T mod SecondsInDay;
|
930 |
|
|
end;
|
931 |
|
|
end;
|
932 |
|
|
|
933 |
|
|
function Convert2ByteDate(TwoByteDate : Word) : TStDate;
|
934 |
|
|
begin
|
935 |
|
|
Result := LongInt(TwoByteDate) + Date1900;
|
936 |
|
|
end;
|
937 |
|
|
|
938 |
|
|
function Convert4ByteDate(FourByteDate : TStDate) : Word;
|
939 |
|
|
begin
|
940 |
|
|
Result := Word(FourByteDate - Date1900);
|
941 |
|
|
end;
|
942 |
|
|
|
943 |
|
|
procedure SetDefaultYear;
|
944 |
|
|
{-Initialize DefaultYear and DefaultMonth}
|
945 |
|
|
var
|
946 |
|
|
Month, Day, Year : Word;
|
947 |
|
|
T : TDateTime;
|
948 |
|
|
begin
|
949 |
|
|
T := Now;
|
950 |
|
|
DecodeDate(T, Year, Month, Day);
|
951 |
|
|
DefaultYear := Year;
|
952 |
|
|
DefaultMonth := Month;
|
953 |
|
|
end;
|
954 |
|
|
|
955 |
|
|
|
956 |
|
|
initialization
|
957 |
|
|
{initialize DefaultYear and DefaultMonth}
|
958 |
|
|
SetDefaultYear;
|
959 |
|
|
end.
|