Changeset 209 for Include/Classes


Ignore:
Timestamp:
Apr 8, 2007, 8:50:03 PM (18 years ago)
Author:
OverTaker
Message:

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

File:
1 edited

Legend:

Unmodified
Added
Removed

  • Include/Classes/System/DateTime.ab

    r207 r209  
    11' Classes/System/DateTime.ab
    2 
    3 #ifndef __SYSTEM_DATETIME_AB__
    4 #define __SYSTEM_DATETIME_AB__
    52
    63Class DateTime
    74    m_Date As Int64
    85Public
    9     Static MaxValue = 3162240000000000000 As Int64 'Const
    10     Static MinValue = 316224000000000 As Int64 'Const
     6    Static MaxValue = 3162240000000000000 As Int64 'Const TicksPerDay*366*10000
     7    Static MinValue = 316224000000000 As Int64     'Const TicksPerDay*366
    118
    129    Sub DateTime()
    13         DateTime(316224000000000)
     10        initialize(MinValue, DateTimeKind.Unspecified)
    1411    End Sub
    1512
    1613    Sub DateTime(ticks As Int64)
    17         Ticks = ticks
    18         Kind = DateTimeKind.Unspecified
     14        initialize(ticks, DateTimeKind.Unspecified)
    1915    End Sub
    2016
    2117    Sub DateTime(ticks As Int64, kind As DateTimeKind)
    22         DateTime(ticks)
    23         Kind = kind
     18        initialize(ticks, kind)
    2419    End Sub
    2520
    2621    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) )
     22        initialize(year, month, day, 0, 0, 0, 0, DateTimeKind.Unspecified)
    4123    End Sub
    4224
    4325    Sub DateTime(year As Long, month As Long, day As Long, kind As DateTimeKind)
    44         DateTime(year, month, day)
    45         Kind = kind
     26        initialize(year, month, day, 0, 0, 0, 0, kind)
    4627    End Sub
    4728
    4829    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) )
     30        initialize(year, month, day, hour, minute, second, 0, DateTimeKind.Unspecified)
    5831    End Sub
    5932
    6033    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
     34        initialize(year, month, day, hour, minute, second, 0, kind)
    6335    End Sub
    6436
    6537    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) )
     38        initialize(year, month, day, hour, minute, second, millisecond, DateTimeKind.Unspecified)
    6839    End Sub
    6940
    7041    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
     42        initialize(year, month, day, hour, minute, second, millisecond, kind)
    7343    End Sub
    7444
    7545    Sub DateTime(ByRef time As SYSTEMTIME)
    76         DateTime(time.wYear, time.wMonth, time.wDay, time.wHour, time.wMinute, time.wSecond, time.wMilliseconds)
     46        initialize(time.wYear, time.wMonth, time.wDay, time.wHour, time.wMinute, time.wSecond, time.wMilliseconds, DateTimeKind.Unspecified)
    7747    End Sub
    7848
    7949    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)
     50        initialize(time.wYear, time.wMonth, time.wDay, time.wHour, time.wMinute, time.wSecond, time.wMilliseconds, kind)
    8151    End Sub
    8252
    8353    'Copy Constructor
    84     Sub DateTime(ByRef datetime As DateTime)
    85         This.m_Date = datetime.m_Date
     54    Sub DateTime(ByRef dateTime As DateTime)
     55        This.m_Date = dateTime.m_Date
    8656    End Sub
    8757
    … …  
    9060
    9161    Function Operator + (ByRef value As TimeSpan) As DateTime
    92         Dim date As DateTime(Ticks + value.Ticks)
    93         Return date
     62        Return New DateTime(Ticks + value.Ticks)
    9463    End Function
    9564
    … …  
    9968
    10069    Function Operator - (ByRef value As TimeSpan) As DateTime
    101         Dim date As DateTime(Ticks - value.Ticks)
    102         Return date
     70        Return New DateTime(Ticks - value.Ticks)
    10371    End Function
    10472
    … …  
    143111    End Function
    144112   
    145     'Property
     113    'Public Properties
    146114    Function Ticks() As Int64
    147115        Return (m_Date And &H3FFFFFFFFFFFFFFF)
    … …  
    165133
    166134    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
     135        Return DayOfYear - totalDaysOfMonths(Year, Month - 1)
    175136    End Function
    176137
    177138    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
     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
    189146    End Function
    190147
    191148    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
     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
     156    End Function
     157
     158    Function DayOfWeek() As Long 'As DayOfWeek
     159        Return (Ticks \ TimeSpan.TicksPerDay) Mod 7 - 1
    199160    End Function
    200161
    … …  
    204165
    205166    Function DayOfYear() As Long
    206         Dim day As Long
    207         day = totalDays()
    208         Return day - Int(Year * 365.25 - day \ 36523 + day \ 146097)
     167        Return ((Ticks \ TimeSpan.TicksPerDay) - totalDaysOfYears(Year) + 1) As Long
    209168    End Function
    210169
    211170    Function Date() As DateTime
    212         Dim date As DateTime(Year, Month, Day, Kind)
    213         Return date
     171        Return New DateTime(Year, Month, Day, Kind)
    214172    End Function
    215173
    … …  
    217175        Dim time As SYSTEMTIME
    218176        GetLocalTime(time)
    219         Dim date As DateTime(time, DateTimeKind.Local)
    220         Return date
     177        Return New DateTime(time, DateTimeKind.Local)
    221178    End Function
    222179
    … …  
    224181        Dim time As SYSTEMTIME
    225182        GetLocalTime(time)
    226         Dim date As DateTime(time.wYear, time.wMonth, time.wDay, DateTimeKind.Local)
    227         Return date
     183        Return New DateTime(time.wYear, time.wMonth, time.wDay, DateTimeKind.Local)
    228184    End Function
    229185
    … …  
    231187        Dim time As SYSTEMTIME
    232188        GetSystemTime(time)
    233         Dim date As DateTime(time, DateTimeKind.Utc)
    234         Return date
     189        Return New DateTime(time, DateTimeKind.Utc)
    235190    End Function
    236191       
    237     'method
     192    'Public Methods
    238193    Static Function Compare(ByRef t1 As DateTime, ByRef t2 As DateTime) As Int64
    239194        Return t1.Ticks - t2.Ticks
    … …  
    265220
    266221    Function AddTicks(value As Int64) As DateTime
    267         Dim ticks As Int64
    268         ticks = Ticks
    269         If (ticks > MaxValue - value) Or (ticks < MinValue - value) Then
    270             'ArgumentOutOfRangeException
    271             debug
    272         End If
    273 
    274         Return New DateTime( ticks + value, Kind )
     222        Return New DateTime(Ticks + value, Kind )
    275223    End Function
    276224
    … …  
    296244
    297245    Function AddYears(value As Double) As DateTime
    298         Dim year As Long
    299         Dim intValue As Long
    300         Dim ticks As Int64
    301         year = Year
    302         intValue = Int(value)
    303         ticks = Ticks + intValue * 315360000000000 + 864000000000 * ((year Mod 4 + intValue) \ 4 - (year Mod 100 + intValue) \ 100 + (year Mod 400 + intValue) \ 400)
    304 
    305         If value < 0 Then
    306             If (year Mod 4 + intValue <= 0 And year Mod 100 > 4) Or (year Mod 400 <= 4) Then
    307                 ticks -= 864000000000
    308             End If
    309         End If
    310         If IsLeapYear(year) = TRUE Then
    311             ticks += (value - intValue) * 316224000000000
    312         Else
    313             ticks += (value - intValue) * 315360000000000
    314         End If
    315        
    316         Return New DateTime( ticks, Kind )
     246        Dim additionYear = Year + Int(value)
     247        Dim ticks = totalDaysOfYears(additionYear) * TimeSpan.TicksPerDay + DayOfYear() * TimeSpan.TicksPerDay
     248
     249        If IsLeapYear(additionYear) Then
     250            ticks += (value - Int(value)) * 366 * TimeSpan.TicksPerDay
     251        Else
     252            ticks += (value - Int(value)) * 365 * TimeSpan.TicksPerDay
     253        End If
     254   
     255        Return New DateTime(ticks, Kind)
    317256    End Function
    318257
    319258    Function Subtract(ByRef value As DateTime) As TimeSpan
    320         Return This - value
     259        Return New DateTime(This - value)
    321260    End Function
    322261
    323262    Function Subtract(ByRef value As TimeSpan) As DateTime
    324         Return This - value
     263        Return New DateTime(This - value)
    325264    End Function
    326265
    … …  
    330269            debug
    331270        End If
     271
    332272        If IsLeapYear(year) And month = 2 Then
    333273            Return 29
    … …  
    346286
    347287    Function GetDateTimeFormats() As String
    348         Return GetDateTimeFormats(NULL)
    349     End Function
    350 
    351     Function GetDateTimeFormats(format As *Byte) As String
    352         Dim time As SYSTEMTIME
    353         With time
    354             .wYear = Year As Word
    355             .wMonth = Month As Word
    356             .wDay = Day As Word
    357             .wHour = Hour As Word
    358             .wMinute = Minute As Word
    359             .wSecond = Second As Word
    360             .wMilliseconds = Millisecond As Word
    361             .wDayOfWeek = DayOfWeek() As Word
    362         End With
    363 
    364         GetDateTimeFormats = New String()
    365 
    366         Dim size As Long
    367         size = GetDateFormat(LOCALE_USER_DEFAULT, 0, time, format, NULL, 0)
    368         GetDateTimeFormats.ReSize(size - 1)
    369         GetDateFormat(LOCALE_USER_DEFAULT, 0, time, format, GetDateTimeFormats, size)
    370 
    371         Dim temp As String     
    372         If format = NULL Then
    373             size = GetTimeFormat(LOCALE_USER_DEFAULT, 0, time, format, NULL, 0)
    374             temp.ReSize(size - 1)
    375             GetTimeFormat(LOCALE_USER_DEFAULT, 0, time, format, temp, size)
    376             GetDateTimeFormats = GetDateTimeFormats + " " + temp
    377         Else
    378             size = GetTimeFormat(LOCALE_USER_DEFAULT, 0, time, GetDateTimeFormats, NULL, 0)
    379             temp.ReSize(size - 1)
    380             GetTimeFormat(LOCALE_USER_DEFAULT, 0, time, GetDateTimeFormats, temp, size)
    381             GetDateTimeFormats = temp
    382         End If
    383     End Function
    384 
    385     Static Function FromBinary(dateData As Int64) As DateTime
    386         Dim date As DateTime((dateData And &H3FFFFFFFFFFFFFFF), kindFromBinary(dateData))
    387         Return date
     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)
     297    End Function
     298
     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)
     304
     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)
     308
     309        Return New String(dateTimeFormats)
     310    End Function
     311
     312    Static Function FromBinary(date As Int64) As DateTime
     313        Return New DateTime((date And &H3FFFFFFFFFFFFFFF), kindFromBinary(date))
    388314    End Function
    389315
    … …  
    392318    End Function
    393319
    394     Static Function FromFileTime(fileTime As FILETIME) As DateTime
     320    Static Function FromFileTime(ByRef fileTime As FILETIME) As DateTime
    395321        Dim localTime As FILETIME
    396322        Dim time As SYSTEMTIME
    397323        FileTimeToLocalFileTime(fileTime, localTime)
    398324        FileTimeToSystemTime(localTime, time)
    399 
    400         Dim date As DateTime(time, DateTimeKind.Local)
    401         Return date
     325        Return New DateTime(time, DateTimeKind.Local)
    402326    End Function
    403327
    404328    Function ToFileTime() As FILETIME
     329        Dim time = getSystemTime() 'As SYSTEMTIME を記述すると内部エラーが発生 rev.207
     330        Dim fileTime As FILETIME
     331        SystemTimeToFileTime(time, fileTime)
     332        Return fileTime
     333    End Function
     334
     335    Static Function FromFileTimeUtc(ByRef fileTime As FILETIME) As DateTime
     336        Dim time As SYSTEMTIME
     337        FileTimeToSystemTime(fileTime, time)
     338        Return New DateTime(time, DateTimeKind.Utc)
     339    End Function
     340
     341    Function ToFileTimeUtc() As FILETIME
     342        Dim fileTime = ToFileTime() 'As FILETIME を記述すると内部エラー rev.207
     343        If Kind = DateTimeKind.Utc Then
     344            Return fileTime
     345        Else
     346            Dim utcTime As FILETIME
     347            LocalFileTimeToFileTime(fileTime, utcTime)
     348            Return utcTime
     349        End If
     350    End Function
     351
     352    Function ToLocalTime() As DateTime
     353        If Kind = DateTimeKind.Local Then
     354            Return New DateTime(This)
     355        Else
     356            Dim fileTime = ToFileTime() '直接入れると計算できなくなります。 rev.207
     357            Return DateTime.FromFileTime(fileTime)
     358        End If
     359    End Function
     360
     361    Function ToUniversalTime() As DateTime
     362        If Kind = DateTimeKind.Utc Then
     363            Return New DateTime(m_Date)
     364        Else
     365            Dim fileTime = ToFileTimeUtc() '直接入れると計算できなくなります。 rev.207
     366            Return DateTime.FromFileTimeUtc(fileTime)
     367        End If
     368    End Function
     369
     370Private
     371    Sub initialize(ticks As Int64, kind As DateTimeKind)
     372        Kind = kind
     373        Ticks = ticks
     374    End Sub
     375
     376    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)
     377        If month < 1 Or month > 12 _
     378            Or day < 1 Or day > DaysInMonth(year, month) _
     379            Or hour < 0 Or hour => 24 _
     380            Or minute < 0 Or minute => 60 _
     381            Or second < 0 Or second => 60 _
     382            Or millisecond < 0 Or millisecond  => 1000 Then
     383            debug 'ArgumentOutOfRangeException
     384        End If
     385
     386        initialize(
     387            totalDaysOfYears(year) * TimeSpan.TicksPerDay _
     388            + totalDaysOfMonths(year, month - 1) * TimeSpan.TicksPerDay _
     389            + (day - 1) * TimeSpan.TicksPerDay _
     390            + hour * TimeSpan.TicksPerHour _
     391            + minute * TimeSpan.TicksPerMinute _
     392            + second * TimeSpan.TicksPerSecond _
     393            + millisecond * TimeSpan.TicksPerMillisecond,
     394            kind
     395            )
     396    End Sub
     397
     398    Sub Ticks(value As Int64)
     399        If value < MinValue Or value > MaxValue Then
     400            debug 'ArgumentOutOfRangeException
     401        End If
     402
     403        Dim temp = Kind As DateTimeKind
     404        m_Date = value
     405        Kind = temp
     406    End Sub
     407
     408    Sub Kind(kind As DateTimeKind)
     409        Dim temp As Int64
     410        temp = kind
     411        temp = (temp << 62) And &HC000000000000000
     412        m_Date = (m_Date And &H3FFFFFFFFFFFFFFF) Or temp
     413    End Sub
     414
     415    Static Function kindFromBinary(date As Int64) As DateTimeKind
     416        date = (date >> 62) And &H03
     417        If date = &H01 Then
     418            Return DateTimeKind.Local
     419        ElseIf date = &H02 Then
     420            Return DateTimeKind.Unspecified
     421        ElseIf date = &H03 Then
     422            Return DateTimeKind.Utc
     423        End If
     424    End Function
     425
     426    Function getSystemTime() As SYSTEMTIME
    405427        Dim time As SYSTEMTIME
    406428        With time
    … …  
    414436            .wMilliseconds = Millisecond As Word
    415437        End With
    416         Dim fileTime As FILETIME
    417         SystemTimeToFileTime(time, fileTime)
    418         Return fileTime
    419     End Function
    420 
    421     Static Function FromFileTimeUtc(fileTime As FILETIME) As DateTime
    422         Dim time As SYSTEMTIME
    423         FileTimeToSystemTime(fileTime, time)
    424 
    425         Dim date As DateTime(time, DateTimeKind.Utc)
    426         Return date
    427     End Function
    428 
    429     Function ToFileTimeUtc() As FILETIME
    430         Dim fileTime As FILETIME
    431         fileTime = ToFileTime()
    432         If Kind = DateTimeKind.Utc Then
    433             ToFileTimeUtc = fileTime
    434         Else
    435             LocalFileTimeToFileTime(fileTime, ToFileTimeUtc) 'Return
    436         End If
    437     End Function
    438 
    439     Function ToLocalTime() As DateTime
    440         If Kind = DateTimeKind.Local Then
    441             ToLocalTime = This
    442         Else
    443             ToLocalTime = DateTime.FromFileTime(ToFileTime())
    444             ToLocalTime.Kind = DateTimeKind.Local
    445         End If
    446     End Function
    447 
    448     Function ToUniversalTime() As DateTime
    449         If Kind = DateTimeKind.Utc Then
    450             ToUniversalTime = This
    451         Else
    452             ToUniversalTime = DateTime.FromFileTimeUtc(ToFileTimeUtc())
    453             ToUniversalTime.Kind = DateTimeKind.Utc
    454         End If
    455     End Function
    456 Private
    457     Sub Ticks(value As Int64)
    458         Dim kind As DateTimeKind
    459         kind = Kind
    460         m_Date = value
    461         Kind = kind
    462     End Sub
    463 
    464     Sub Kind(kind As DateTimeKind)
    465         Dim temp As Int64
    466         temp = kind
    467         temp = (temp << 62) And &HC000000000000000
    468         m_Date = (m_Date And &H3FFFFFFFFFFFFFFF) Or temp
    469     End Sub
    470 
    471     Function totalDays() As Long
    472         Return (Ticks \ TimeSpan.TicksPerDay) As Long
    473     End Function
    474 
    475     Function kindFromBinary(dateData As Int64) As DateTimeKind
    476         dateData = (dateData >> 62) And &H03
    477         If dateData = &H01 Then
    478             Return DateTimeKind.Local
    479         ElseIf dateData = &H02 Then
    480             Return DateTimeKind.Unspecified
    481         ElseIf dateData = &H03 Then
    482             Return DateTimeKind.Utc
    483         Else
    484             ' どれにも該当しなかったときはどうなるんでしょうか？？
    485             Return DateTimeKind.Local
    486         End If
     438        Return time
     439    End Function
     440
     441    Static Function totalDaysOfYears(year As Long) As Long
     442        Return (Int(year * 365.25) - Int(year * 0.01) + Int(year * 0.0025))
     443    End Function
     444
     445    Static Function totalDaysOfMonths(year As Long, month As Long) As Long
     446        Dim days As Long
     447        Dim i As Long
     448        For i = 1 To month
     449            days += DaysInMonth(year, i)
     450        Next
     451        Return days
    487452    End Function
    488453End Class
    … …  
    503468    Saturday
    504469End Enum
    505 
    506 #endif '__SYSTEM_DATETIME_AB__
Note: See TracChangeset for help on using the changeset viewer.