source: trunk/Include/Classes/System/DateTime.ab@ 360

Last change on this file since 360 was 275, checked in by dai, 18 years ago

（32ビットコンパイラ）
クラス情報取得時のクラス先読み処理で名前空間の関係が崩れてしまうバグを修正。
インクルードパスに'/'文字を含めたときに'
'として判断するようにした。

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