source: Include/Classes/System/DateTime.ab@ 121

Last change on this file since 121 was 107, checked in by OverTaker, 19 years ago

TimeSpanに伴う変更と、Addメソッドの仕様変更。
File size: 12.6 KB
Line 
1' Classes/System/DateTime.ab
2
3#ifndef __SYSTEM_DATETIME_AB__
4#define __SYSTEM_DATETIME_AB__
5
6
7Class DateTime
8 m_Date As Int64
9Public
10 Static MaxValue = 3162240000000000000 As Int64 'Const
11 Static MinValue = 316224000000000 As Int64 'Const
12
13 Sub DateTime(ticks As Int64)
14 Ticks = ticks
15 Kind = DateTimeKind.Unspecified
16 End Sub
17
18 Sub DateTime(ticks As Int64, kind As DateTimeKind)
19 DateTime(ticks)
20 Kind = kind
21 End Sub
22
23 Sub DateTime(year As Long, month As Long, day As Long)
24 If year < 1 Or year > 9999 Or month < 1 Or month > 12 Or day < 1 Or day > DaysInMonth(year, month) Then
25 'ArgumentOutOfRangeException
26 debug
27 End If
28 DateTime(316224000000000)
29 This = AddYears(year - 1)
30
31 Dim days As Long
32 Dim i As Long
33 For i = 1 To month - 1
34 days += DaysInMonth(Year, i)
35 Next
36 days += day
37 This = AddDays(days - 1)
38 End Sub
39
40 Sub DateTime(year As Long, month As Long, day As Long, kind As DateTimeKind)
41 DateTime(year, month, day)
42 Kind = kind
43 End Sub
44
45 Sub DateTime(year As Long, month As Long, day As Long, hour As Long, minute As Long, second As Long)
46 If hour < 0 Or hour > 23 Or minute < 0 Or minute > 59 Or second < 0 Or second > 59 Then
47 'ArgumentOutOfRangeException
48 debug
49 End If
50 DateTime(year, month, day)
51 This = AddHours(hour)
52 This = AddMinutes(minute)
53 This = AddSeconds(second)
54 End Sub
55
56 Sub DateTime(year As Long, month As Long, day As Long, hour As Long, minute As Long, second As Long, kind As DateTimeKind)
57 DateTime(year, month, day, hour, minute, second)
58 Kind = kind
59 End Sub
60
61 Sub DateTime(year As Long, month As Long, day As Long, hour As Long, minute As Long, second As Long, millisecond As Long)
62 DateTime(year, month, day, hour, minute, second)
63 This = AddMilliseconds(millisecond)
64 End Sub
65
66 Sub DateTime(year As Long, month As Long, day As Long, hour As Long, minute As Long, second As Long, millisecond As Long, kind As DateTimeKind)
67 DateTime(year, month, day, hour, minute, second, millisecond)
68 Kind = kind
69 End Sub
70
71 Sub DateTime(ByRef time As SYSTEMTIME)
72 DateTime(time.wYear, time.wMonth, time.wDay, time.wHour, time.wMinute, time.wSecond, time.wMilliseconds)
73 End Sub
74
75 Sub DateTime(ByRef time As SYSTEMTIME, kind As DateTimeKind)
76 DateTime(time.wYear, time.wMonth, time.wDay, time.wHour, time.wMinute, time.wSecond, time.wMilliseconds, kind)
77 End Sub
78
79 'Copy Constructor
80 Sub DateTime( ByRef datetime As DateTime )
81 This.m_Date = datetime.m_Date
82 End Sub
83
84 Sub ~DateTime()
85 End Sub
86
87 Function Operator+ (ByRef value As TimeSpan) As DateTime
88 Dim date As DateTime(Ticks + value.Ticks)
89 Return date
90 End Function
91
92 Function Operator- (ByRef value As DateTime) As TimeSpan
93 Return TimeSpan.FromTicks(Ticks - value.Ticks)
94 End Function
95
96 Function Operator- (ByRef value As TimeSpan) As DateTime
97 Dim date As DateTime(Ticks - value.Ticks)
98 Return date
99 End Function
100
101 Function Operator == (ByRef value As DateTime) As Boolean
102 Return Equals(value)
103 End Function
104
105 Function Operator <> (ByRef value As DateTime) As Boolean
106 Return Not Equals(value)
107 End Function
108
109 Function Operator > (ByRef value As DateTime) As Boolean
110 If DateTime.Compare(This, value) > 0 Then
111 Return True
112 Else
113 Return False
114 End If
115 End Function
116
117 Function Operator < (ByRef value As DateTime) As Boolean
118 If DateTime.Compare(This, value) < 0 Then
119 Return True
120 Else
121 Return False
122 End If
123 End Function
124
125 Function Operator >= (ByRef value As DateTime) As Boolean
126 If DateTime.Compare(This, value) => 0 Then
127 Return True
128 Else
129 Return False
130 End If
131 End Function
132
133 Function Operator <= (ByRef value As DateTime) As Boolean
134 If DateTime.Compare(This, value) <= 0 Then
135 Return True
136 Else
137 Return False
138 End If
139 End Function
140
141 'Property
142 Function Ticks() As Int64
143 Return (m_Date And &H3FFFFFFFFFFFFFFF)
144 End Function
145
146 Function Millisecond() As Long
147 Return (Ticks \ TimeSpan.TicksPerMillisecond Mod 1000) As Long
148 End Function
149
150 Function Second() As Long
151 Return (Ticks \ TimeSpan.TicksPerSecond Mod 60) As Long
152 End Function
153
154 Function Minute() As Long
155 Return (Ticks \ TimeSpan.TicksPerMinute Mod 60) As Long
156 End Function
157
158 Function Hour() As Long
159 Return (Ticks \ TimeSpan.TicksPerHour Mod 24) As Long
160 End Function
161
162 Function Day() As Long
163 Dim day As Long
164 day = DayOfYear
165
166 Dim i As Long
167 For i = 1 To Month - 1
168 day -= DaysInMonth(Year, i)
169 Next
170 Return day
171 End Function
172
173 Function Month() As Long
174 Dim year As Long
175 Dim day As Long
176 year = Year
177 day = DayOfYear
178
179 Dim i As Long
180 For i = 1 To 12
181 day -= DaysInMonth(year, i)
182 If day <= 0 Then Return i
183 Next
184 Return 12
185 End Function
186
187 Function Year() As Long
188 Dim day As Long
189 day = totalDays()
190 Return Int((day + day \ 36523 - day \ 146097) / 365.25)
191 End Function
192
193 Function DayOfWeek() As Long
194 Return totalDays() Mod 7 - 1
195 End Function
196
197 Function Kind() As DateTimeKind
198 Return kindFromBinary(m_Date)
199 End Function
200
201 Function DayOfYear() As Long
202 Dim day As Long
203 day = totalDays()
204 Return day - Int(Year * 365.25 - day \ 36523 + day \ 146097)
205 End Function
206
207 Function Date() As DateTime
208 Dim date As DateTime(Year, Month, Day, Kind)
209 Return date
210 End Function
211
212 Static Function Now() As DateTime
213 Dim time As SYSTEMTIME
214 GetLocalTime(time)
215 Dim date As DateTime(time, DateTimeKind.Local)
216 Return date
217 End Function
218
219 Static Function ToDay() As DateTime
220 Dim time As SYSTEMTIME
221 GetLocalTime(time)
222 Dim date As DateTime(time.wYear, time.wMonth, time.wDay, DateTimeKind.Local)
223 Return date
224 End Function
225
226 Static Function UtcNow() As DateTime
227 Dim time As SYSTEMTIME
228 GetSystemTime(time)
229 Dim date As DateTime(time, DateTimeKind.Utc)
230 Return date
231 End Function
232
233 'method
234 Static Function Compare(ByRef t1 As DateTime, ByRef t2 As DateTime) As Int64
235 Return t1.Ticks - t2.Ticks
236 End Function
237
238 Function Equals(ByRef value As DateTime) As Boolean
239 If value.m_Date = m_Date Then
240 Return True
241 Else
242 Return False
243 End If
244 End Function
245
246 Static Function Equals(ByRef t1 As DateTime, ByRef t2 As DateTime) As Boolean
247 If t1.m_Date = t2.m_Date Then
248 Return True
249 Else
250 Return False
251 End If
252 End Function
253
254 Function Add(ByRef value As TimeSpan) As DateTime
255 Return This + value
256 End Function
257
258 Function AddTicks(value As Int64) As DateTime
259 Dim ticks As Int64
260 ticks = Ticks
261 If (ticks > MaxValue - value) Or (ticks < MinValue - value) Then
262 'ArgumentOutOfRangeException
263 debug
264 End If
265
266 AddTicks.Ticks = ticks + value
267 AddTicks.Kind = Kind
268 End Function
269
270 Function AddMilliseconds(value As Double) As DateTime
271 Return AddTicks((value * TimeSpan.TicksPerMillisecond) As Int64)
272 End Function
273
274 Function AddSeconds(value As Double) As DateTime
275 Return AddTicks((value * TimeSpan.TicksPerSecond) As Int64)
276 End Function
277
278 Function AddMinutes(value As Double) As DateTime
279 Return AddTicks((value * TimeSpan.TicksPerMinute) As Int64)
280 End Function
281
282 Function AddHours(value As Double) As DateTime
283 Return AddTicks((value * TimeSpan.TicksPerHour) As Int64)
284 End Function
285
286 Function AddDays(value As Double) As DateTime
287 Return AddTicks((value * TimeSpan.TicksPerDay) As Int64)
288 End Function
289
290 Function AddYears(value As Double) As DateTime
291 Dim year As Long
292 Dim intValue As Long
293 Dim ticks As Int64
294 year = Year
295 intValue = Int(value)
296 ticks = Ticks + intValue * 315360000000000 + 864000000000 * ((year Mod 4 + intValue) \ 4 - (year Mod 100 + intValue) \ 100 + (year Mod 400 + intValue) \ 400)
297
298 If value < 0 Then
299 If (year Mod 4 + intValue <= 0 And year Mod 100 > 4) Or (year Mod 400 <= 4) Then
300 ticks -= 864000000000
301 End If
302 End If
303 If IsLeapYear(year) = TRUE Then
304 ticks += (value - intValue) * 316224000000000
305 Else
306 ticks += (value - intValue) * 315360000000000
307 End If
308
309 AddYears.Ticks = ticks
310 AddYears.Kind = Kind
311 End Function
312
313 Function Subtract(ByRef value As DateTime) As TimeSpan
314 Return This - value
315 End Function
316
317 Function Subtract(ByRef value As TimeSpan) As DateTime
318 Return This - value
319 End Function
320
321 Static Function DaysInMonth(year As Long, month As Long) As Long
322 If year < 1 Or year > 9999 Or month < 1 Or month > 12 Then
323 'ArgumentOutOfRangeException
324 debug
325 End If
326 If IsLeapYear(year) And month = 2 Then
327 Return 29
328 Else
329 Dim daysInMonth[11] = [31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31] As Byte
330 Return daysInMonth[month - 1]
331 End If
332 End Function
333
334 Static Function IsLeapYear(year As Long) As Boolean
335 If (year Mod 400) = 0 Then Return True
336 If (year Mod 100) = 0 Then Return False
337 If (year Mod 4) = 0 Then Return True
338 Return False
339 End Function
340
341 Function GetDateTimeFormats() As String
342 Return GetDateTimeFormats(NULL)
343 End Function
344
345 Function GetDateTimeFormats(format As *Byte) As String
346 Dim time As SYSTEMTIME
347 With time
348 .wYear = Year As Word
349 .wMonth = Month As Word
350 .wDay = Day As Word
351 .wHour = Hour As Word
352 .wMinute = Minute As Word
353 .wSecond = Second As Word
354 .wMilliseconds = Millisecond As Word
355 .wDayOfWeek = DayOfWeek() As Word
356 End With
357
358 Dim size As Long
359 size = GetDateFormat(LOCALE_USER_DEFAULT, 0, time, format, NULL, 0)
360 GetDateTimeFormats.ReSize(size - 1)
361 GetDateFormat(LOCALE_USER_DEFAULT, 0, time, format, GetDateTimeFormats, size)
362
363 Dim temp As String
364 If format = NULL Then
365 size = GetTimeFormat(LOCALE_USER_DEFAULT, 0, time, format, NULL, 0)
366 temp.ReSize(size - 1)
367 GetTimeFormat(LOCALE_USER_DEFAULT, 0, time, format, temp, size)
368 GetDateTimeFormats = GetDateTimeFormats + " " + temp
369 Else
370 size = GetTimeFormat(LOCALE_USER_DEFAULT, 0, time, GetDateTimeFormats, NULL, 0)
371 temp.ReSize(size - 1)
372 GetTimeFormat(LOCALE_USER_DEFAULT, 0, time, GetDateTimeFormats, temp, size)
373 GetDateTimeFormats = temp
374 End If
375 End Function
376
377 Static Function FromBinary(dateData As Int64) As DateTime
378 Dim date As DateTime((dateData And &H3FFFFFFFFFFFFFFF), kindFromBinary(dateData))
379 Return date
380 End Function
381
382 Function ToBinary() As Int64
383 Return m_Date
384 End Function
385
386 Static Function FromFileTime(fileTime As FILETIME) As DateTime
387 Dim localTime As FILETIME
388 Dim time As SYSTEMTIME
389 FileTimeToLocalFileTime(fileTime, localTime)
390 FileTimeToSystemTime(localTime, time)
391
392 Dim date As DateTime(time, DateTimeKind.Local)
393 Return date
394 End Function
395
396 Function ToFileTime() As FILETIME
397 Dim time As SYSTEMTIME
398 With time
399 .wYear = Year As Word
400 .wMonth = Month As Word
401 .wDayOfWeek = DayOfWeek As Word
402 .wDay = Day As Word
403 .wHour = Hour As Word
404 .wMinute = Minute As Word
405 .wSecond = Second As Word
406 .wMilliseconds = Millisecond As Word
407 End With
408 Dim fileTime As FILETIME
409 SystemTimeToFileTime(time, fileTime)
410 Return fileTime
411 End Function
412
413 Static Function FromFileTimeUtc(fileTime As FILETIME) As DateTime
414 Dim time As SYSTEMTIME
415 FileTimeToSystemTime(fileTime, time)
416
417 Dim date As DateTime(time, DateTimeKind.Utc)
418 Return date
419 End Function
420
421 Function ToFileTimeUtc() As FILETIME
422 Dim fileTime As FILETIME
423 fileTime = ToFileTime()
424 If Kind = DateTimeKind.Utc Then
425 ToFileTimeUtc = fileTime
426 Else
427 LocalFileTimeToFileTime(fileTime, ToFileTimeUtc) 'Return
428 End If
429 End Function
430
431 Function ToLocalTime() As DateTime
432 If Kind = DateTimeKind.Local Then
433 ToLocalTime = This
434 Else
435 ToLocalTime = DateTime.FromFileTime(ToFileTime())
436 ToLocalTime.Kind = DateTimeKind.Local
437 End If
438 End Function
439
440 Function ToUniversalTime() As DateTime
441 If Kind = DateTimeKind.Utc Then
442 ToUniversalTime = This
443 Else
444 ToUniversalTime = DateTime.FromFileTimeUtc(ToFileTimeUtc())
445 ToUniversalTime.Kind = DateTimeKind.Utc
446 End If
447 End Function
448Private
449 Sub Ticks(value As Int64)
450 Dim kind As DateTimeKind
451 kind = Kind
452 m_Date = value
453 Kind = kind
454 End Sub
455
456 Sub Kind(kind As DateTimeKind)
457 Dim temp As Int64
458 temp = kind
459 temp = (temp << 62) And &HC000000000000000
460 m_Date = (m_Date And &H3FFFFFFFFFFFFFFF) Or temp
461 End Sub
462
463 Function totalDays() As Long
464 Return (Ticks \ TimeSpan.TicksPerDay) As Long
465 End Function
466
467 Function kindFromBinary(dateData As Int64) As DateTimeKind
468 dateData = (dateData >> 62) And &H03
469 If dateData = &H01 Then
470 Return DateTimeKind.Local
471 ElseIf dateData = &H02 Then
472 Return DateTimeKind.Unspecified
473 ElseIf dateData = &H03 Then
474 Return DateTimeKind.Utc
475 End If
476 End Function
477End Class
478
479Enum DateTimeKind
480 Local
481 Unspecified
482 Utc
483End Enum
484
485Enum DayOfWeek
486 Sunday = 0
487 Monday
488 Tuesday
489 Wednesday
490 Thursday
491 Friday
492 Saturday
493End Enum
494
495#endif '__SYSTEM_DATETIME_AB__
Note: See TracBrowser for help on using the repository browser.