Changeset 209 for Include/Classes/System/DateTime.ab

Timestamp:

Apr 8, 2007, 8:50:03 PM (18 years ago)

Author:

OverTaker

Message:

#103 DateTimeクラスを再実装。これ以前のバージョンに計算ミスが見つかったので、それらを使うときには注意してください。

File:

• Include/Classes/System/DateTime.ab (modified) (16 diffs)

Include/Classes/System/DateTime.ab

@@ -1 +1 @@
 ' Classes/System/DateTime.ab
-
-#ifndef __SYSTEM_DATETIME_AB__
-#define __SYSTEM_DATETIME_AB__
 
 Class DateTime
     m_Date As Int64
 Public
-    Static MaxValue = 3162240000000000000 As Int64 'Const
-    Static MinValue = 316224000000000 As Int64 'Const
+    Static MaxValue = 3162240000000000000 As Int64 'Const TicksPerDay*366*10000
+    Static MinValue = 316224000000000 As Int64     'Const TicksPerDay*366
 
     Sub DateTime()
-        DateTime(316224000000000)
+        initialize(MinValue, DateTimeKind.Unspecified)
     End Sub
 
     Sub DateTime(ticks As Int64)
-        Ticks = ticks
-        Kind = DateTimeKind.Unspecified
+        initialize(ticks, DateTimeKind.Unspecified)
     End Sub
 
     Sub DateTime(ticks As Int64, kind As DateTimeKind)
-        DateTime(ticks)
-        Kind = kind
+        initialize(ticks, kind)
     End Sub
 
     Sub DateTime(year As Long, month As Long, day As Long)
-        If year < 1 Or year > 9999 Or month < 1 Or month > 12 Or day < 1 Or day > DaysInMonth(year, month) Then
-            'ArgumentOutOfRangeException
-            debug
-        End If
-        DateTime(316224000000000)
-        DateTime( AddYears(year - 1) )
-
-        Dim days As Long
-        Dim i As Long
-        For i = 1 To month - 1
-            days += DaysInMonth(Year, i)
-        Next
-        days += day
-        DateTime( AddDays(days - 1) )
+        initialize(year, month, day, 0, 0, 0, 0, DateTimeKind.Unspecified)
     End Sub
 
     Sub DateTime(year As Long, month As Long, day As Long, kind As DateTimeKind)
-        DateTime(year, month, day)
-        Kind = kind
+        initialize(year, month, day, 0, 0, 0, 0, kind)
     End Sub
 
     Sub DateTime(year As Long, month As Long, day As Long, hour As Long, minute As Long, second As Long)
-        If hour < 0 Or hour > 23 Or minute < 0 Or minute > 59 Or second < 0 Or second > 59 Then
-            'ArgumentOutOfRangeException
-            debug
-        End If
-
-        DateTime(year, month, day)
-        DateTime( AddHours(hour) )
-        DateTime( AddMinutes(minute) )
-        DateTime( AddSeconds(second) )
+        initialize(year, month, day, hour, minute, second, 0, DateTimeKind.Unspecified)
     End Sub
 
     Sub DateTime(year As Long, month As Long, day As Long, hour As Long, minute As Long, second As Long, kind As DateTimeKind)
-        DateTime(year, month, day, hour, minute, second)
-        Kind = kind
+        initialize(year, month, day, hour, minute, second, 0, kind)
     End Sub
 
     Sub DateTime(year As Long, month As Long, day As Long, hour As Long, minute As Long, second As Long, millisecond As Long)
-        DateTime(year, month, day, hour, minute, second)
-        DateTime( AddMilliseconds(millisecond) )
+        initialize(year, month, day, hour, minute, second, millisecond, DateTimeKind.Unspecified)
     End Sub
 
     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)
-        DateTime(year, month, day, hour, minute, second, millisecond)
-        Kind = kind
+        initialize(year, month, day, hour, minute, second, millisecond, kind)
     End Sub
 
     Sub DateTime(ByRef time As SYSTEMTIME)
-        DateTime(time.wYear, time.wMonth, time.wDay, time.wHour, time.wMinute, time.wSecond, time.wMilliseconds)
+        initialize(time.wYear, time.wMonth, time.wDay, time.wHour, time.wMinute, time.wSecond, time.wMilliseconds, DateTimeKind.Unspecified)
     End Sub
 
     Sub DateTime(ByRef time As SYSTEMTIME, kind As DateTimeKind)
-        DateTime(time.wYear, time.wMonth, time.wDay, time.wHour, time.wMinute, time.wSecond, time.wMilliseconds, kind)
+        initialize(time.wYear, time.wMonth, time.wDay, time.wHour, time.wMinute, time.wSecond, time.wMilliseconds, kind)
     End Sub
 
     'Copy Constructor
-    Sub DateTime(ByRef datetime As DateTime)
-        This.m_Date = datetime.m_Date
+    Sub DateTime(ByRef dateTime As DateTime)
+        This.m_Date = dateTime.m_Date
     End Sub
 
@@ -90 +60 @@
 
     Function Operator + (ByRef value As TimeSpan) As DateTime
-        Dim date As DateTime(Ticks + value.Ticks)
-        Return date
+        Return New DateTime(Ticks + value.Ticks)
     End Function
 
@@ -99 +68 @@
 
     Function Operator - (ByRef value As TimeSpan) As DateTime
-        Dim date As DateTime(Ticks - value.Ticks)
-        Return date
+        Return New DateTime(Ticks - value.Ticks)
     End Function
 
@@ -143 +111 @@
     End Function
     
-    'Property
+    'Public Properties
     Function Ticks() As Int64
         Return (m_Date And &H3FFFFFFFFFFFFFFF)
@@ -165 +133 @@
 
     Function Day() As Long
-        Dim day As Long
-        day = DayOfYear
-
-        Dim i As Long
-        For i = 1 To Month - 1
-            day -= DaysInMonth(Year, i)
-        Next
-        Return day
+        Return DayOfYear - totalDaysOfMonths(Year, Month - 1)
     End Function
 
     Function Month() As Long
-        Dim year As Long
-        Dim day As Long
-        year = Year
-        day = DayOfYear
-
-        Dim i As Long
-        For i = 1 To 12
-            day -= DaysInMonth(year, i)
-            If day <= 0 Then Return i
-        Next
-        Return 12
+        Dim year = Year As Long
+        Dim day = DayOfYear As Long
+        Dim i = 1 As Long
+        While day > totalDaysOfMonths(year, i)
+            i++
+        Wend
+        Return i
     End Function
 
     Function Year() As Long
-        Dim day As Long
-        day = totalDays()
-        Return Int((day + day \ 36523 - day \ 146097) / 365.25)
-    End Function
-
-    Function DayOfWeek() As Long
-        Return totalDays() Mod 7 - 1
+        Dim day = (Ticks \ TimeSpan.TicksPerDay) As Long
+        Dim year = Int((day + day \ 36524 - day \ 146097) / 365.25) As Long
+        If day - totalDaysOfYears(year) + 1 = 366 Then
+            Return year + 1
+        Else
+            Return year
+        End If
+    End Function
+
+    Function DayOfWeek() As Long 'As DayOfWeek
+        Return (Ticks \ TimeSpan.TicksPerDay) Mod 7 - 1
     End Function
 
@@ -204 +165 @@
 
     Function DayOfYear() As Long
-        Dim day As Long
-        day = totalDays()
-        Return day - Int(Year * 365.25 - day \ 36523 + day \ 146097)
+        Return ((Ticks \ TimeSpan.TicksPerDay) - totalDaysOfYears(Year) + 1) As Long
     End Function
 
     Function Date() As DateTime
-        Dim date As DateTime(Year, Month, Day, Kind)
-        Return date
+        Return New DateTime(Year, Month, Day, Kind)
     End Function
 
@@ -217 +175 @@
         Dim time As SYSTEMTIME
         GetLocalTime(time)
-        Dim date As DateTime(time, DateTimeKind.Local)
-        Return date
+        Return New DateTime(time, DateTimeKind.Local)
     End Function
 
@@ -224 +181 @@
         Dim time As SYSTEMTIME
         GetLocalTime(time)
-        Dim date As DateTime(time.wYear, time.wMonth, time.wDay, DateTimeKind.Local)
-        Return date
+        Return New DateTime(time.wYear, time.wMonth, time.wDay, DateTimeKind.Local)
     End Function
 
@@ -231 +187 @@
         Dim time As SYSTEMTIME
         GetSystemTime(time)
-        Dim date As DateTime(time, DateTimeKind.Utc)
-        Return date
+        Return New DateTime(time, DateTimeKind.Utc)
     End Function
         
-    'method
+    'Public Methods
     Static Function Compare(ByRef t1 As DateTime, ByRef t2 As DateTime) As Int64
         Return t1.Ticks - t2.Ticks
@@ -265 +220 @@
 
     Function AddTicks(value As Int64) As DateTime
-        Dim ticks As Int64
-        ticks = Ticks
-        If (ticks > MaxValue - value) Or (ticks < MinValue - value) Then
-            'ArgumentOutOfRangeException
-            debug
-        End If
-
-        Return New DateTime( ticks + value, Kind )
+        Return New DateTime(Ticks + value, Kind )
     End Function
 
@@ -296 +244 @@
 
     Function AddYears(value As Double) As DateTime
-        Dim year As Long
-        Dim intValue As Long
-        Dim ticks As Int64
-        year = Year
-        intValue = Int(value)
-        ticks = Ticks + intValue * 315360000000000 + 864000000000 * ((year Mod 4 + intValue) \ 4 - (year Mod 100 + intValue) \ 100 + (year Mod 400 + intValue) \ 400)
-
-        If value < 0 Then
-            If (year Mod 4 + intValue <= 0 And year Mod 100 > 4) Or (year Mod 400 <= 4) Then
-                ticks -= 864000000000
-            End If
-        End If
-        If IsLeapYear(year) = TRUE Then
-            ticks += (value - intValue) * 316224000000000
-        Else
-            ticks += (value - intValue) * 315360000000000
-        End If
-        
-        Return New DateTime( ticks, Kind )
+        Dim additionYear = Year + Int(value)
+        Dim ticks = totalDaysOfYears(additionYear) * TimeSpan.TicksPerDay + DayOfYear() * TimeSpan.TicksPerDay
+
+        If IsLeapYear(additionYear) Then
+            ticks += (value - Int(value)) * 366 * TimeSpan.TicksPerDay
+        Else
+            ticks += (value - Int(value)) * 365 * TimeSpan.TicksPerDay
+        End If
+    
+        Return New DateTime(ticks, Kind)
     End Function
 
     Function Subtract(ByRef value As DateTime) As TimeSpan
-        Return This - value
+        Return New DateTime(This - value)
     End Function
 
     Function Subtract(ByRef value As TimeSpan) As DateTime
-        Return This - value
+        Return New DateTime(This - value)
     End Function
 
@@ -330 +269 @@
             debug
         End If
+
         If IsLeapYear(year) And month = 2 Then
             Return 29
@@ -346 +286 @@
 
     Function GetDateTimeFormats() As String
-        Return GetDateTimeFormats(NULL)
-    End Function
-
-    Function GetDateTimeFormats(format As *Byte) As String
-        Dim time As SYSTEMTIME
-        With time
-            .wYear = Year As Word
-            .wMonth = Month As Word
-            .wDay = Day As Word
-            .wHour = Hour As Word
-            .wMinute = Minute As Word
-            .wSecond = Second As Word
-            .wMilliseconds = Millisecond As Word
-            .wDayOfWeek = DayOfWeek() As Word
-        End With
-
-        GetDateTimeFormats = New String()
-
-        Dim size As Long
-        size = GetDateFormat(LOCALE_USER_DEFAULT, 0, time, format, NULL, 0)
-        GetDateTimeFormats.ReSize(size - 1)
-        GetDateFormat(LOCALE_USER_DEFAULT, 0, time, format, GetDateTimeFormats, size)
-
-        Dim temp As String      
-        If format = NULL Then
-            size = GetTimeFormat(LOCALE_USER_DEFAULT, 0, time, format, NULL, 0)
-            temp.ReSize(size - 1)
-            GetTimeFormat(LOCALE_USER_DEFAULT, 0, time, format, temp, size)
-            GetDateTimeFormats = GetDateTimeFormats + " " + temp
-        Else
-            size = GetTimeFormat(LOCALE_USER_DEFAULT, 0, time, GetDateTimeFormats, NULL, 0)
-            temp.ReSize(size - 1)
-            GetTimeFormat(LOCALE_USER_DEFAULT, 0, time, GetDateTimeFormats, temp, size)
-            GetDateTimeFormats = temp
-        End If
-    End Function
-
-    Static Function FromBinary(dateData As Int64) As DateTime
-        Dim date As DateTime((dateData And &H3FFFFFFFFFFFFFFF), kindFromBinary(dateData))
-        Return date
+        Dim time = getSystemTime() 'As SYSTEMTIME を記述すると内部エラーが発生
+        Dim dateFormatSize = GetDateFormat(LOCALE_USER_DEFAULT, 0, time, NULL, NULL, 0)
+        Dim timeFormatSize = GetTimeFormat(LOCALE_USER_DEFAULT, 0, time, NULL, NULL, 0)
+        Dim dateTimeFormats = malloc(dateFormatSize + timeFormatSize) As PTSTR
+        GetDateFormat(LOCALE_USER_DEFAULT, 0, time, NULL, dateTimeFormats, dateFormatSize)
+        dateTimeFormats[dateFormatSize - 1] = Asc(" ")
+        GetTimeFormat(LOCALE_USER_DEFAULT, 0, time, NULL, dateTimeFormats + dateFormatSize, timeFormatSize)
+
+        Return New String(dateTimeFormats)
+    End Function
+
+    Function GetDateTimeFormats(format As *TCHAR) As String
+        Dim time = getSystemTime() 'As SYSTEMTIME を記述すると内部エラーが発生
+        Dim dateFormatSize = GetDateFormat(LOCALE_USER_DEFAULT, 0, time, format, NULL, 0)
+        Dim dateFormats = malloc(dateFormatSize) As PTSTR
+        GetDateFormat(LOCALE_USER_DEFAULT, 0, time, format, dateFormats, dateFormatSize)
+
+        Dim dateTimeFormatSize = GetTimeFormat(LOCALE_USER_DEFAULT, 0, time, dateFormats, NULL, 0)
+        Dim dateTimeFormats = malloc(dateTimeFormatSize) As PTSTR
+        GetTimeFormat(LOCALE_USER_DEFAULT, 0, time, dateFormats, dateTimeFormats, dateTimeFormatSize)
+
+        Return New String(dateTimeFormats)
+    End Function
+
+    Static Function FromBinary(date As Int64) As DateTime
+        Return New DateTime((date And &H3FFFFFFFFFFFFFFF), kindFromBinary(date))
     End Function
 
@@ -392 +318 @@
     End Function
 
-    Static Function FromFileTime(fileTime As FILETIME) As DateTime
+    Static Function FromFileTime(ByRef fileTime As FILETIME) As DateTime
         Dim localTime As FILETIME
         Dim time As SYSTEMTIME
         FileTimeToLocalFileTime(fileTime, localTime)
         FileTimeToSystemTime(localTime, time)
-
-        Dim date As DateTime(time, DateTimeKind.Local)
-        Return date
+        Return New DateTime(time, DateTimeKind.Local)
     End Function
 
     Function ToFileTime() As FILETIME
+        Dim time = getSystemTime() 'As SYSTEMTIME を記述すると内部エラーが発生 rev.207
+        Dim fileTime As FILETIME
+        SystemTimeToFileTime(time, fileTime)
+        Return fileTime
+    End Function
+
+    Static Function FromFileTimeUtc(ByRef fileTime As FILETIME) As DateTime
+        Dim time As SYSTEMTIME
+        FileTimeToSystemTime(fileTime, time)
+        Return New DateTime(time, DateTimeKind.Utc)
+    End Function
+
+    Function ToFileTimeUtc() As FILETIME
+        Dim fileTime = ToFileTime() 'As FILETIME を記述すると内部エラー rev.207
+        If Kind = DateTimeKind.Utc Then
+            Return fileTime
+        Else
+            Dim utcTime As FILETIME
+            LocalFileTimeToFileTime(fileTime, utcTime)
+            Return utcTime
+        End If
+    End Function
+
+    Function ToLocalTime() As DateTime
+        If Kind = DateTimeKind.Local Then
+            Return New DateTime(This)
+        Else
+            Dim fileTime = ToFileTime() '直接入れると計算できなくなります。 rev.207
+            Return DateTime.FromFileTime(fileTime)
+        End If
+    End Function
+
+    Function ToUniversalTime() As DateTime
+        If Kind = DateTimeKind.Utc Then
+            Return New DateTime(m_Date)
+        Else
+            Dim fileTime = ToFileTimeUtc() '直接入れると計算できなくなります。 rev.207
+            Return DateTime.FromFileTimeUtc(fileTime)
+        End If
+    End Function
+
+Private
+    Sub initialize(ticks As Int64, kind As DateTimeKind)
+        Kind = kind
+        Ticks = ticks
+    End Sub
+
+    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)
+        If month < 1 Or month > 12 _
+            Or day < 1 Or day > DaysInMonth(year, month) _
+            Or hour < 0 Or hour => 24 _
+            Or minute < 0 Or minute => 60 _
+            Or second < 0 Or second => 60 _
+            Or millisecond < 0 Or millisecond  => 1000 Then
+            debug 'ArgumentOutOfRangeException
+        End If
+
+        initialize(
+            totalDaysOfYears(year) * TimeSpan.TicksPerDay _
+            + totalDaysOfMonths(year, month - 1) * TimeSpan.TicksPerDay _
+            + (day - 1) * TimeSpan.TicksPerDay _
+            + hour * TimeSpan.TicksPerHour _
+            + minute * TimeSpan.TicksPerMinute _
+            + second * TimeSpan.TicksPerSecond _
+            + millisecond * TimeSpan.TicksPerMillisecond,
+            kind
+            )
+    End Sub
+
+    Sub Ticks(value As Int64)
+        If value < MinValue Or value > MaxValue Then
+            debug 'ArgumentOutOfRangeException
+        End If
+
+        Dim temp = Kind As DateTimeKind
+        m_Date = value
+        Kind = temp
+    End Sub
+
+    Sub Kind(kind As DateTimeKind)
+        Dim temp As Int64
+        temp = kind
+        temp = (temp << 62) And &HC000000000000000
+        m_Date = (m_Date And &H3FFFFFFFFFFFFFFF) Or temp
+    End Sub
+
+    Static Function kindFromBinary(date As Int64) As DateTimeKind
+        date = (date >> 62) And &H03
+        If date = &H01 Then
+            Return DateTimeKind.Local
+        ElseIf date = &H02 Then
+            Return DateTimeKind.Unspecified
+        ElseIf date = &H03 Then
+            Return DateTimeKind.Utc
+        End If
+    End Function
+
+    Function getSystemTime() As SYSTEMTIME
         Dim time As SYSTEMTIME
         With time
@@ -414 +436 @@
             .wMilliseconds = Millisecond As Word
         End With
-        Dim fileTime As FILETIME
-        SystemTimeToFileTime(time, fileTime)
-        Return fileTime
-    End Function
-
-    Static Function FromFileTimeUtc(fileTime As FILETIME) As DateTime
-        Dim time As SYSTEMTIME
-        FileTimeToSystemTime(fileTime, time)
-
-        Dim date As DateTime(time, DateTimeKind.Utc)
-        Return date
-    End Function
-
-    Function ToFileTimeUtc() As FILETIME
-        Dim fileTime As FILETIME
-        fileTime = ToFileTime()
-        If Kind = DateTimeKind.Utc Then
-            ToFileTimeUtc = fileTime
-        Else
-            LocalFileTimeToFileTime(fileTime, ToFileTimeUtc) 'Return
-        End If
-    End Function
-
-    Function ToLocalTime() As DateTime
-        If Kind = DateTimeKind.Local Then
-            ToLocalTime = This
-        Else
-            ToLocalTime = DateTime.FromFileTime(ToFileTime())
-            ToLocalTime.Kind = DateTimeKind.Local
-        End If
-    End Function
-
-    Function ToUniversalTime() As DateTime
-        If Kind = DateTimeKind.Utc Then
-            ToUniversalTime = This
-        Else
-            ToUniversalTime = DateTime.FromFileTimeUtc(ToFileTimeUtc())
-            ToUniversalTime.Kind = DateTimeKind.Utc
-        End If
-    End Function
-Private
-    Sub Ticks(value As Int64)
-        Dim kind As DateTimeKind
-        kind = Kind
-        m_Date = value
-        Kind = kind
-    End Sub
-
-    Sub Kind(kind As DateTimeKind)
-        Dim temp As Int64
-        temp = kind
-        temp = (temp << 62) And &HC000000000000000
-        m_Date = (m_Date And &H3FFFFFFFFFFFFFFF) Or temp
-    End Sub
-
-    Function totalDays() As Long
-        Return (Ticks \ TimeSpan.TicksPerDay) As Long
-    End Function
-
-    Function kindFromBinary(dateData As Int64) As DateTimeKind
-        dateData = (dateData >> 62) And &H03
-        If dateData = &H01 Then
-            Return DateTimeKind.Local
-        ElseIf dateData = &H02 Then
-            Return DateTimeKind.Unspecified
-        ElseIf dateData = &H03 Then
-            Return DateTimeKind.Utc
-        Else
-            ' どれにも該当しなかったときはどうなるんでしょうか？？
-            Return DateTimeKind.Local
-        End If
+        Return time
+    End Function
+
+    Static Function totalDaysOfYears(year As Long) As Long
+        Return (Int(year * 365.25) - Int(year * 0.01) + Int(year * 0.0025))
+    End Function
+
+    Static Function totalDaysOfMonths(year As Long, month As Long) As Long
+        Dim days As Long
+        Dim i As Long
+        For i = 1 To month
+            days += DaysInMonth(year, i)
+        Next
+        Return days
     End Function
 End Class
@@ -503 +468 @@
     Saturday
 End Enum
-
-#endif '__SYSTEM_DATETIME_AB__