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

Last change on this file since 207 was 207, checked in by dai, 19 years ago

動的型情報（Object.GetType）に対応。
戻り値やクラスメンバがオブジェクトだったとき、その初期値をNothingにした（※戻り値として関数名を使っている部分、要注意！！）。
File size: 12.9 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 Return New DateTime( ticks + value, Kind )
275 End Function
276
277 Function AddMilliseconds(value As Double) As DateTime
278 Return AddTicks((value * TimeSpan.TicksPerMillisecond) As Int64)
279 End Function
280
281 Function AddSeconds(value As Double) As DateTime
282 Return AddTicks((value * TimeSpan.TicksPerSecond) As Int64)
283 End Function
284
285 Function AddMinutes(value As Double) As DateTime
286 Return AddTicks((value * TimeSpan.TicksPerMinute) As Int64)
287 End Function
288
289 Function AddHours(value As Double) As DateTime
290 Return AddTicks((value * TimeSpan.TicksPerHour) As Int64)
291 End Function
292
293 Function AddDays(value As Double) As DateTime
294 Return AddTicks((value * TimeSpan.TicksPerDay) As Int64)
295 End Function
296
297 Function AddYears(value As Double) As DateTime
298 Dim year As Long
299 Dim intValue As Long
300 Dim ticks As Int64
301 year = Year
302 intValue = Int(value)
303 ticks = Ticks + intValue * 315360000000000 + 864000000000 * ((year Mod 4 + intValue) \ 4 - (year Mod 100 + intValue) \ 100 + (year Mod 400 + intValue) \ 400)
304
305 If value < 0 Then
306 If (year Mod 4 + intValue <= 0 And year Mod 100 > 4) Or (year Mod 400 <= 4) Then
307 ticks -= 864000000000
308 End If
309 End If
310 If IsLeapYear(year) = TRUE Then
311 ticks += (value - intValue) * 316224000000000
312 Else
313 ticks += (value - intValue) * 315360000000000
314 End If
315
316 Return New DateTime( ticks, Kind )
317 End Function
318
319 Function Subtract(ByRef value As DateTime) As TimeSpan
320 Return This - value
321 End Function
322
323 Function Subtract(ByRef value As TimeSpan) As DateTime
324 Return This - value
325 End Function
326
327 Static Function DaysInMonth(year As Long, month As Long) As Long
328 If year < 1 Or year > 9999 Or month < 1 Or month > 12 Then
329 'ArgumentOutOfRangeException
330 debug
331 End If
332 If IsLeapYear(year) And month = 2 Then
333 Return 29
334 Else
335 Dim daysInMonth[11] = [31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31] As Byte
336 Return daysInMonth[month - 1]
337 End If
338 End Function
339
340 Static Function IsLeapYear(year As Long) As Boolean
341 If (year Mod 400) = 0 Then Return True
342 If (year Mod 100) = 0 Then Return False
343 If (year Mod 4) = 0 Then Return True
344 Return False
345 End Function
346
347 Function GetDateTimeFormats() As String
348 Return GetDateTimeFormats(NULL)
349 End Function
350
351 Function GetDateTimeFormats(format As *Byte) As String
352 Dim time As SYSTEMTIME
353 With time
354 .wYear = Year As Word
355 .wMonth = Month As Word
356 .wDay = Day As Word
357 .wHour = Hour As Word
358 .wMinute = Minute As Word
359 .wSecond = Second As Word
360 .wMilliseconds = Millisecond As Word
361 .wDayOfWeek = DayOfWeek() As Word
362 End With
363
364 GetDateTimeFormats = New String()
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 Else
484 ' どれにも該当しなかったときはどうなるんでしょうか？？
485 Return DateTimeKind.Local
486 End If
487 End Function
488End Class
489
490Enum DateTimeKind
491 Local
492 Unspecified
493 Utc
494End Enum
495
496Enum DayOfWeek
497 Sunday = 0
498 Monday
499 Tuesday
500 Wednesday
501 Thursday
502 Friday
503 Saturday
504End Enum
505
506#endif '__SYSTEM_DATETIME_AB__
Note: See TracBrowser for help on using the repository browser.