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

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

StringBuilderを追加。String不変へ。共通の文字列操作関数をActiveBasic.Strings内に配置（設計に検討の余地あり）。
File size: 13.6 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(dateTime As DateTime)
55 This.m_Date = dateTime.m_Date
56 End Sub
57
58 Sub ~DateTime()
59 End Sub
60
61 Function Operator + (value As TimeSpan) As DateTime
62 Return New DateTime(Ticks + value.Ticks)
63 End Function
64
65 Function Operator - (value As DateTime) As TimeSpan
66 Return TimeSpan.FromTicks(Ticks - value.Ticks)
67 End Function
68
69 Function Operator - (value As TimeSpan) As DateTime
70 Return New DateTime(Ticks - value.Ticks)
71 End Function
72
73 Function Operator == (value As DateTime) As Boolean
74 Return Equals(value)
75 End Function
76
77 Function Operator <> (value As DateTime) As Boolean
78 Return Not Equals(value)
79 End Function
80
81 Function Operator > (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 < (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 >= (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 <= (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 - totalDaysOfMonth(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 > totalDaysOfMonth(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) + 1 As Long
151 If day - yearToDay(year - 1) + 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) As Long + 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) - yearToDay(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(t1 As DateTime, t2 As DateTime) As Int64
194 Return t1.Ticks - t2.Ticks
195 End Function
196
197 Function Equals(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(t1 As DateTime, 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(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 date = New DateTime(Year + Int(value), Month, Day, Hour, Minute, Second, Millisecond, Kind)
247 Dim ticks = Ticks _
248 - (yearToDay(Year) + totalDaysOfMonth(Year, Month - 1) + Day - 1) * TimeSpan.TicksPerDay _
249 - Hour * TimeSpan.TicksPerHour _
250 - Minute * TimeSpan.TicksPerMinute _
251 - Second * TimeSpan.TicksPerSecond _
252 - Millisecond * TimeSpan.TicksPerMillisecond As Int64
253 If IsLeapYear(Year + Int(value)) Then
254 ticks += (value - Int(value)) * 366 * TimeSpan.TicksPerDay
255 Else
256 ticks += (value - Int(value)) * 365 * TimeSpan.TicksPerDay
257 End If
258 Return date.AddTicks(ticks)
259 End Function
260
261 Function Subtract(value As DateTime) As TimeSpan
262 Return This - value
263 End Function
264
265 Function Subtract(value As TimeSpan) As DateTime
266 Return This - value
267 End Function
268
269 Static Function DaysInMonth(year As Long, month As Long) As Long
270 If year < 1 Or year > 9999 Or month < 1 Or month > 12 Then
271 'ArgumentOutOfRangeException
272 debug
273 End If
274
275 If IsLeapYear(year) And month = 2 Then
276 Return 29
277 Else
278 Dim daysInMonth[11] = [31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31] As Byte
279 Return daysInMonth[month - 1]
280 End If
281 End Function
282
283 Static Function IsLeapYear(year As Long) As Boolean
284 If (year Mod 400) = 0 Then Return True
285 If (year Mod 100) = 0 Then Return False
286 If (year Mod 4) = 0 Then Return True
287 Return False
288 End Function
289
290 Function GetDateTimeFormats() As String
291 Dim time = getSystemTime() 'As SYSTEMTIME を記述すると内部エラーが発生
292 Dim dateFormatSize = GetDateFormat(LOCALE_USER_DEFAULT, 0, time, NULL, NULL, 0)
293 Dim timeFormatSize = GetTimeFormat(LOCALE_USER_DEFAULT, 0, time, NULL, NULL, 0)
294 Dim strLength = dateFormatSize + timeFormatSize
295 Dim dateTimeFormats = GC_malloc_atomic(SizeOf (TCHAR) * (strLength)) As PTSTR
296 GetDateFormat(LOCALE_USER_DEFAULT, 0, time, NULL, dateTimeFormats, dateFormatSize)
297 dateTimeFormats[dateFormatSize - 1] = Asc(" ")
298 GetTimeFormat(LOCALE_USER_DEFAULT, 0, time, NULL, dateTimeFormats + dateFormatSize, timeFormatSize)
299'Debug
300 Return New String(dateTimeFormats, strLength)
301 End Function
302
303 Function GetDateTimeFormats(format As *TCHAR) As String
304 Dim time = getSystemTime() 'As SYSTEMTIME を記述すると内部エラーが発生
305 Dim dateFormatSize = GetDateFormat(LOCALE_USER_DEFAULT, 0, time, format, NULL, 0)
306 Dim dateFormats = malloc(dateFormatSize) As PTSTR
307 GetDateFormat(LOCALE_USER_DEFAULT, 0, time, format, dateFormats, dateFormatSize)
308
309 Dim dateTimeFormatSize = GetTimeFormat(LOCALE_USER_DEFAULT, 0, time, dateFormats, NULL, 0)
310 Dim dateTimeFormats = malloc(dateTimeFormatSize) As PTSTR
311 GetTimeFormat(LOCALE_USER_DEFAULT, 0, time, dateFormats, dateTimeFormats, dateTimeFormatSize)
312
313 Return New String(dateTimeFormats)
314 End Function
315
316 Static Function FromBinary(date As Int64) As DateTime
317 Return New DateTime((date And &H3FFFFFFFFFFFFFFF), kindFromBinary(date))
318 End Function
319
320 Function ToBinary() As Int64
321 Return m_Date
322 End Function
323
324 Static Function FromFileTime(ByRef fileTime As FILETIME) As DateTime
325 Dim localTime As FILETIME
326 Dim time As SYSTEMTIME
327 FileTimeToLocalFileTime(fileTime, localTime)
328 FileTimeToSystemTime(localTime, time)
329 Return New DateTime(time, DateTimeKind.Local)
330 End Function
331
332 Function ToFileTime() As FILETIME
333 Dim time = getSystemTime() 'As SYSTEMTIME を記述すると内部エラーが発生 rev.207
334 Dim fileTime As FILETIME
335 SystemTimeToFileTime(time, fileTime)
336 Return fileTime
337 End Function
338
339 Static Function FromFileTimeUtc(ByRef fileTime As FILETIME) As DateTime
340 Dim time As SYSTEMTIME
341 FileTimeToSystemTime(fileTime, time)
342 Return New DateTime(time, DateTimeKind.Utc)
343 End Function
344
345 Function ToFileTimeUtc() As FILETIME
346 Dim fileTime = ToFileTime() 'As FILETIME を記述すると内部エラー rev.207
347 If Kind = DateTimeKind.Utc Then
348 Return fileTime
349 Else
350 Dim utcTime As FILETIME
351 LocalFileTimeToFileTime(fileTime, utcTime)
352 Return utcTime
353 End If
354 End Function
355
356 Function ToLocalTime() As DateTime
357 If Kind = DateTimeKind.Local Then
358 Return New DateTime(This)
359 Else
360 Dim fileTime = ToFileTime() '直接入れると計算できなくなります。 rev.207
361 Return DateTime.FromFileTime(fileTime)
362 End If
363 End Function
364
365 Override Function ToString() As String
366 Return GetDateTimeFormats()
367 End Function
368
369 Function ToUniversalTime() As DateTime
370 If Kind = DateTimeKind.Utc Then
371 Return New DateTime(m_Date)
372 Else
373 Dim fileTime = ToFileTimeUtc() '直接入れると計算できなくなります。 rev.207
374 Return DateTime.FromFileTimeUtc(fileTime)
375 End If
376 End Function
377
378Private
379 Sub initialize(ticks As Int64, kind As DateTimeKind)
380 Kind = kind
381 Ticks = ticks
382 End Sub
383
384 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)
385 If month < 1 Or month > 12 _
386 Or day < 1 Or day > DaysInMonth(year, month) _
387 Or hour < 0 Or hour => 24 _
388 Or minute < 0 Or minute => 60 _
389 Or second < 0 Or second => 60 _
390 Or millisecond < 0 Or millisecond => 1000 Then
391 debug 'ArgumentOutOfRangeException
392 End If
393
394 initialize(
395 yearToDay(year) * TimeSpan.TicksPerDay _
396 + totalDaysOfMonth(year, month - 1) * TimeSpan.TicksPerDay _
397 + (day - 1) * TimeSpan.TicksPerDay _
398 + hour * TimeSpan.TicksPerHour _
399 + minute * TimeSpan.TicksPerMinute _
400 + second * TimeSpan.TicksPerSecond _
401 + millisecond * TimeSpan.TicksPerMillisecond,
402 kind
403 )
404 End Sub
405
406 Sub Ticks(value As Int64)
407 If value < MinValue Or value > MaxValue Then
408 debug 'ArgumentOutOfRangeException
409 End If
410
411 Dim temp = Kind As DateTimeKind
412 m_Date = value
413 Kind = temp
414 End Sub
415
416 Sub Kind(kind As DateTimeKind)
417 Dim temp As Int64
418 temp = kind
419 temp = (temp << 62) And &HC000000000000000
420 m_Date = (m_Date And &H3FFFFFFFFFFFFFFF) Or temp
421 End Sub
422
423 Static Function kindFromBinary(date As Int64) As DateTimeKind
424 date = (date >> 62) And &H03
425 If date = &H01 Then
426 Return DateTimeKind.Local
427 ElseIf date = &H02 Then
428 Return DateTimeKind.Unspecified
429 ElseIf date = &H03 Then
430 Return DateTimeKind.Utc
431 End If
432
433 ' ここにはこないはず
434 debug
435 End Function
436
437 Function getSystemTime() As SYSTEMTIME
438 Dim time As SYSTEMTIME
439 With time
440 .wYear = Year As Word
441 .wMonth = Month As Word
442 .wDayOfWeek = DayOfWeek As Word
443 .wDay = Day As Word
444 .wHour = Hour As Word
445 .wMinute = Minute As Word
446 .wSecond = Second As Word
447 .wMilliseconds = Millisecond As Word
448 End With
449 Return time
450 End Function
451
452 Static Function yearToDay(year As Long) As Long
453 year--
454 Return (Int(year * 365.25) - Int(year * 0.01) + Int(year * 0.0025))
455 End Function
456
457 Static Function totalDaysOfMonth(year As Long, month As Long) As Long
458 Dim days As Long
459 Dim i As Long
460 For i = 1 To month
461 days += DaysInMonth(year, i)
462 Next
463 Return days
464 End Function
465End Class
466
467Enum DateTimeKind
468 Local
469 Unspecified
470 Utc
471End Enum
472
473Enum DayOfWeek
474 Sunday = 0
475 Monday
476 Tuesday
477 Wednesday
478 Thursday
479 Friday
480 Saturday
481End Enum
Note: See TracBrowser for help on using the repository browser.