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

Last change on this file since 170 was 166, checked in by イグトランス (egtra), 18 years ago

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