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

Last change on this file since 211 was 209, checked in by OverTaker, 18 years ago

#103 DateTimeクラスを再実装。これ以前のバージョンに計算ミスが見つかったので、それらを使うときには注意してください。

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