Changeset 209
- Timestamp:
- Apr 8, 2007, 8:50:03 PM (18 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
Include/Classes/System/DateTime.ab
r207 r209 1 1 ' Classes/System/DateTime.ab 2 3 #ifndef __SYSTEM_DATETIME_AB__4 #define __SYSTEM_DATETIME_AB__5 2 6 3 Class DateTime 7 4 m_Date As Int64 8 5 Public 9 Static MaxValue = 3162240000000000000 As Int64 'Const 10 Static MinValue = 316224000000000 As Int64 'Const6 Static MaxValue = 3162240000000000000 As Int64 'Const TicksPerDay*366*10000 7 Static MinValue = 316224000000000 As Int64 'Const TicksPerDay*366 11 8 12 9 Sub DateTime() 13 DateTime(316224000000000)10 initialize(MinValue, DateTimeKind.Unspecified) 14 11 End Sub 15 12 16 13 Sub DateTime(ticks As Int64) 17 Ticks = ticks 18 Kind = DateTimeKind.Unspecified 14 initialize(ticks, DateTimeKind.Unspecified) 19 15 End Sub 20 16 21 17 Sub DateTime(ticks As Int64, kind As DateTimeKind) 22 DateTime(ticks) 23 Kind = kind 18 initialize(ticks, kind) 24 19 End Sub 25 20 26 21 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) 41 23 End Sub 42 24 43 25 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) 46 27 End Sub 47 28 48 29 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) 58 31 End Sub 59 32 60 33 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) 63 35 End Sub 64 36 65 37 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) 68 39 End Sub 69 40 70 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) 71 DateTime(year, month, day, hour, minute, second, millisecond) 72 Kind = kind 42 initialize(year, month, day, hour, minute, second, millisecond, kind) 73 43 End Sub 74 44 75 45 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) 77 47 End Sub 78 48 79 49 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) 81 51 End Sub 82 52 83 53 'Copy Constructor 84 Sub DateTime(ByRef date time As DateTime)85 This.m_Date = date time.m_Date54 Sub DateTime(ByRef dateTime As DateTime) 55 This.m_Date = dateTime.m_Date 86 56 End Sub 87 57 … … 90 60 91 61 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) 94 63 End Function 95 64 … … 99 68 100 69 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) 103 71 End Function 104 72 … … 143 111 End Function 144 112 145 'P roperty113 'Public Properties 146 114 Function Ticks() As Int64 147 115 Return (m_Date And &H3FFFFFFFFFFFFFFF) … … 165 133 166 134 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) 175 136 End Function 176 137 177 138 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 189 146 End Function 190 147 191 148 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 199 160 End Function 200 161 … … 204 165 205 166 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 209 168 End Function 210 169 211 170 Function Date() As DateTime 212 Dim date As DateTime(Year, Month, Day, Kind) 213 Return date 171 Return New DateTime(Year, Month, Day, Kind) 214 172 End Function 215 173 … … 217 175 Dim time As SYSTEMTIME 218 176 GetLocalTime(time) 219 Dim date As DateTime(time, DateTimeKind.Local) 220 Return date 177 Return New DateTime(time, DateTimeKind.Local) 221 178 End Function 222 179 … … 224 181 Dim time As SYSTEMTIME 225 182 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) 228 184 End Function 229 185 … … 231 187 Dim time As SYSTEMTIME 232 188 GetSystemTime(time) 233 Dim date As DateTime(time, DateTimeKind.Utc) 234 Return date 189 Return New DateTime(time, DateTimeKind.Utc) 235 190 End Function 236 191 237 ' method192 'Public Methods 238 193 Static Function Compare(ByRef t1 As DateTime, ByRef t2 As DateTime) As Int64 239 194 Return t1.Ticks - t2.Ticks … … 265 220 266 221 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 ) 275 223 End Function 276 224 … … 296 244 297 245 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) 317 256 End Function 318 257 319 258 Function Subtract(ByRef value As DateTime) As TimeSpan 320 Return This - value259 Return New DateTime(This - value) 321 260 End Function 322 261 323 262 Function Subtract(ByRef value As TimeSpan) As DateTime 324 Return This - value263 Return New DateTime(This - value) 325 264 End Function 326 265 … … 330 269 debug 331 270 End If 271 332 272 If IsLeapYear(year) And month = 2 Then 333 273 Return 29 … … 346 286 347 287 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)) 388 314 End Function 389 315 … … 392 318 End Function 393 319 394 Static Function FromFileTime( fileTime As FILETIME) As DateTime320 Static Function FromFileTime(ByRef fileTime As FILETIME) As DateTime 395 321 Dim localTime As FILETIME 396 322 Dim time As SYSTEMTIME 397 323 FileTimeToLocalFileTime(fileTime, localTime) 398 324 FileTimeToSystemTime(localTime, time) 399 400 Dim date As DateTime(time, DateTimeKind.Local) 401 Return date 325 Return New DateTime(time, DateTimeKind.Local) 402 326 End Function 403 327 404 328 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 370 Private 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 405 427 Dim time As SYSTEMTIME 406 428 With time … … 414 436 .wMilliseconds = Millisecond As Word 415 437 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 487 452 End Function 488 453 End Class … … 503 468 Saturday 504 469 End Enum 505 506 #endif '__SYSTEM_DATETIME_AB__
Note:
See TracChangeset
for help on using the changeset viewer.