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

Last change on this file since 164 was 163, checked in by dai, 18 years ago

Thisへの代入をコンストラクタ呼び出しに変更。
デフォルトコンストラクタを追加。
File size: 12.7 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 Function Add(ByRef value As TimeSpan) As DateTime
259 Return This + value
260 End Function
261
262 Function AddTicks(value As Int64) As DateTime
263 Dim ticks As Int64
264 ticks = Ticks
265 If (ticks > MaxValue - value) Or (ticks < MinValue - value) Then
266 'ArgumentOutOfRangeException
267 debug
268 End If
269
270 AddTicks.Ticks = ticks + value
271 AddTicks.Kind = Kind
272 End Function
273
274 Function AddMilliseconds(value As Double) As DateTime
275 Return AddTicks((value * TimeSpan.TicksPerMillisecond) As Int64)
276 End Function
277
278 Function AddSeconds(value As Double) As DateTime
279 Return AddTicks((value * TimeSpan.TicksPerSecond) As Int64)
280 End Function
281
282 Function AddMinutes(value As Double) As DateTime
283 Return AddTicks((value * TimeSpan.TicksPerMinute) As Int64)
284 End Function
285
286 Function AddHours(value As Double) As DateTime
287 Return AddTicks((value * TimeSpan.TicksPerHour) As Int64)
288 End Function
289
290 Function AddDays(value As Double) As DateTime
291 Return AddTicks((value * TimeSpan.TicksPerDay) As Int64)
292 End Function
293
294 Function AddYears(value As Double) As DateTime
295 Dim year As Long
296 Dim intValue As Long
297 Dim ticks As Int64
298 year = Year
299 intValue = Int(value)
300 ticks = Ticks + intValue * 315360000000000 + 864000000000 * ((year Mod 4 + intValue) \ 4 - (year Mod 100 + intValue) \ 100 + (year Mod 400 + intValue) \ 400)
301
302 If value < 0 Then
303 If (year Mod 4 + intValue <= 0 And year Mod 100 > 4) Or (year Mod 400 <= 4) Then
304 ticks -= 864000000000
305 End If
306 End If
307 If IsLeapYear(year) = TRUE Then
308 ticks += (value - intValue) * 316224000000000
309 Else
310 ticks += (value - intValue) * 315360000000000
311 End If
312
313 AddYears.Ticks = ticks
314 AddYears.Kind = Kind
315 End Function
316
317 Function Subtract(ByRef value As DateTime) As TimeSpan
318 Return This - value
319 End Function
320
321 Function Subtract(ByRef value As TimeSpan) As DateTime
322 Return This - value
323 End Function
324
325 Static Function DaysInMonth(year As Long, month As Long) As Long
326 If year < 1 Or year > 9999 Or month < 1 Or month > 12 Then
327 'ArgumentOutOfRangeException
328 debug
329 End If
330 If IsLeapYear(year) And month = 2 Then
331 Return 29
332 Else
333 Dim daysInMonth[11] = [31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31] As Byte
334 Return daysInMonth[month - 1]
335 End If
336 End Function
337
338 Static Function IsLeapYear(year As Long) As Boolean
339 If (year Mod 400) = 0 Then Return True
340 If (year Mod 100) = 0 Then Return False
341 If (year Mod 4) = 0 Then Return True
342 Return False
343 End Function
344
345 Function GetDateTimeFormats() As String
346 Return GetDateTimeFormats(NULL)
347 End Function
348
349 Function GetDateTimeFormats(format As *Byte) As String
350 Dim time As SYSTEMTIME
351 With time
352 .wYear = Year As Word
353 .wMonth = Month As Word
354 .wDay = Day As Word
355 .wHour = Hour As Word
356 .wMinute = Minute As Word
357 .wSecond = Second As Word
358 .wMilliseconds = Millisecond As Word
359 .wDayOfWeek = DayOfWeek() As Word
360 End With
361
362 Dim size As Long
363 size = GetDateFormat(LOCALE_USER_DEFAULT, 0, time, format, NULL, 0)
364 GetDateTimeFormats.ReSize(size - 1)
365 GetDateFormat(LOCALE_USER_DEFAULT, 0, time, format, GetDateTimeFormats, size)
366
367 Dim temp As String
368 If format = NULL Then
369 size = GetTimeFormat(LOCALE_USER_DEFAULT, 0, time, format, NULL, 0)
370 temp.ReSize(size - 1)
371 GetTimeFormat(LOCALE_USER_DEFAULT, 0, time, format, temp, size)
372 GetDateTimeFormats = GetDateTimeFormats + " " + temp
373 Else
374 size = GetTimeFormat(LOCALE_USER_DEFAULT, 0, time, GetDateTimeFormats, NULL, 0)
375 temp.ReSize(size - 1)
376 GetTimeFormat(LOCALE_USER_DEFAULT, 0, time, GetDateTimeFormats, temp, size)
377 GetDateTimeFormats = temp
378 End If
379 End Function
380
381 Static Function FromBinary(dateData As Int64) As DateTime
382 Dim date As DateTime((dateData And &H3FFFFFFFFFFFFFFF), kindFromBinary(dateData))
383 Return date
384 End Function
385
386 Function ToBinary() As Int64
387 Return m_Date
388 End Function
389
390 Static Function FromFileTime(fileTime As FILETIME) As DateTime
391 Dim localTime As FILETIME
392 Dim time As SYSTEMTIME
393 FileTimeToLocalFileTime(fileTime, localTime)
394 FileTimeToSystemTime(localTime, time)
395
396 Dim date As DateTime(time, DateTimeKind.Local)
397 Return date
398 End Function
399
400 Function ToFileTime() As FILETIME
401 Dim time As SYSTEMTIME
402 With time
403 .wYear = Year As Word
404 .wMonth = Month As Word
405 .wDayOfWeek = DayOfWeek As Word
406 .wDay = Day As Word
407 .wHour = Hour As Word
408 .wMinute = Minute As Word
409 .wSecond = Second As Word
410 .wMilliseconds = Millisecond As Word
411 End With
412 Dim fileTime As FILETIME
413 SystemTimeToFileTime(time, fileTime)
414 Return fileTime
415 End Function
416
417 Static Function FromFileTimeUtc(fileTime As FILETIME) As DateTime
418 Dim time As SYSTEMTIME
419 FileTimeToSystemTime(fileTime, time)
420
421 Dim date As DateTime(time, DateTimeKind.Utc)
422 Return date
423 End Function
424
425 Function ToFileTimeUtc() As FILETIME
426 Dim fileTime As FILETIME
427 fileTime = ToFileTime()
428 If Kind = DateTimeKind.Utc Then
429 ToFileTimeUtc = fileTime
430 Else
431 LocalFileTimeToFileTime(fileTime, ToFileTimeUtc) 'Return
432 End If
433 End Function
434
435 Function ToLocalTime() As DateTime
436 If Kind = DateTimeKind.Local Then
437 ToLocalTime = This
438 Else
439 ToLocalTime = DateTime.FromFileTime(ToFileTime())
440 ToLocalTime.Kind = DateTimeKind.Local
441 End If
442 End Function
443
444 Function ToUniversalTime() As DateTime
445 If Kind = DateTimeKind.Utc Then
446 ToUniversalTime = This
447 Else
448 ToUniversalTime = DateTime.FromFileTimeUtc(ToFileTimeUtc())
449 ToUniversalTime.Kind = DateTimeKind.Utc
450 End If
451 End Function
452Private
453 Sub Ticks(value As Int64)
454 Dim kind As DateTimeKind
455 kind = Kind
456 m_Date = value
457 Kind = kind
458 End Sub
459
460 Sub Kind(kind As DateTimeKind)
461 Dim temp As Int64
462 temp = kind
463 temp = (temp << 62) And &HC000000000000000
464 m_Date = (m_Date And &H3FFFFFFFFFFFFFFF) Or temp
465 End Sub
466
467 Function totalDays() As Long
468 Return (Ticks \ TimeSpan.TicksPerDay) As Long
469 End Function
470
471 Function kindFromBinary(dateData As Int64) As DateTimeKind
472 dateData = (dateData >> 62) And &H03
473 If dateData = &H01 Then
474 Return DateTimeKind.Local
475 ElseIf dateData = &H02 Then
476 Return DateTimeKind.Unspecified
477 ElseIf dateData = &H03 Then
478 Return DateTimeKind.Utc
479 End If
480 End Function
481End Class
482
483Enum DateTimeKind
484 Local
485 Unspecified
486 Utc
487End Enum
488
489Enum DayOfWeek
490 Sunday = 0
491 Monday
492 Tuesday
493 Wednesday
494 Thursday
495 Friday
496 Saturday
497End Enum
498
499#endif '__SYSTEM_DATETIME_AB__
Note: See TracBrowser for help on using the repository browser.