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

Last change on this file since 246 was 246, checked in by dai, 17 years ago

Objectクラス、Stringクラスの定義をSystem名前空間に入れると共に、コンパイラ側で両者のクラスをSystem名前空間に依存しない特殊型として扱うようにした。
System.Diagnostics名前空間を導入した。
Namespaceステートメントのコード補間機能に対応。

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