📄 juliancalendar.cls
字号:
VERSION 1.0 CLASS
BEGIN
MultiUse = -1 'True
Persistable = 1 'Persistable
DataBindingBehavior = 0 'vbNone
DataSourceBehavior = 0 'vbNone
MTSTransactionMode = 0 'NotAnMTSObject
END
Attribute VB_Name = "JulianCalendar"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
' CopyRight (c) 2005 Kelly Ethridge
'
' This file is part of VBCorLib.
'
' VBCorLib is free software; you can redistribute it and/or modify
' it under the terms of the GNU Library General Public License as published by
' the Free Software Foundation; either version 2.1 of the License, or
' (at your option) any later version.
'
' VBCorLib is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY; without even the implied warranty of
' MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
' GNU Library General Public License for more details.
'
' You should have received a copy of the GNU Library General Public License
' along with Foobar; if not, write to the Free Software
' Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
'
' Module: JulianCalendar
'
''
' Provides methods to manipulate Julian dates.
'
' @see JulianCalendarStatic
' @see Calendar
'
Option Explicit
Implements IObject
Implements Calendar
Private Const DEF_TWODIGITYEARMAX As Long = 2029
Private Const PROP_TWODIGITYEARMAX As String = "TwoDigitYearMax"
Private Const SECONDS_PER_MINUTE As Long = 60
Private Const MINUTES_PER_HOUR As Long = 60
Private Const HOURS_PER_DAY As Long = 24
Private Const MONTHS_PER_YEAR As Long = 12
Private Const MILLISECONDS_PER_SECOND As Currency = 1000@
Private Const MILLISECONDS_PER_MINUTE As Currency = MILLISECONDS_PER_SECOND * SECONDS_PER_MINUTE
Private Const MILLISECONDS_PER_HOUR As Currency = MILLISECONDS_PER_MINUTE * MINUTES_PER_HOUR
Private Const MILLISECONDS_PER_DAY As Currency = MILLISECONDS_PER_HOUR * HOURS_PER_DAY
Private Const DAYS_PER_YEAR As Long = 365
Private Const DAYS_PER_4_YEARS As Long = DAYS_PER_YEAR * 4 + 1
Private mTwoDigitYearMax As Long
Public Property Get Eras() As Long()
Dim ret(0) As Long
ret(0) = 1
Eras = ret
End Property
Public Property Get TwoDigitYearMax() As Long
TwoDigitYearMax = mTwoDigitYearMax
End Property
Public Property Let TwoDigitYearMax(ByVal RHS As Long)
If RHS < 100 Or RHS > 9999 Then _
Throw Cor.NewArgumentOutOfRangeException("Year must be between 100 and 9999 inclusively.", "TwoDigitYearMax", RHS)
mTwoDigitYearMax = RHS
End Property
Public Function AddDays(ByRef Time As Variant, ByVal Days As Long) As cDateTime
Set AddDays = cDateTime.GetcDateTime(Time).AddDays(Days)
End Function
Public Function AddHours(ByRef Time As Variant, ByVal Hours As Long) As cDateTime
Set AddHours = cDateTime.GetcDateTime(Time).AddHours(Hours)
End Function
Public Function AddMilliseconds(ByRef Time As Variant, ByVal Milliseconds As Double) As cDateTime
Set AddMilliseconds = cDateTime.GetcDateTime(Time).AddMilliseconds(Milliseconds)
End Function
Public Function AddMinutes(ByRef Time As Variant, ByVal Minutes As Long) As cDateTime
Set AddMinutes = cDateTime.GetcDateTime(Time).AddMinutes(Minutes)
End Function
Public Function AddMonths(ByRef Time As Variant, ByVal Months As Long) As cDateTime
If Months < -120000 Or Months > 120000 Then _
Throw Cor.NewArgumentOutOfRangeException("Months must be between -120000 and 120000 inclusively.", "Months", Months)
If Months = 0 Then
Set AddMonths = cDateTime.GetcDateTime(Time)
Exit Function
End If
Dim Month As Long
Dim Year As Long
Dim Day As Long
Call GetDateParts(Time, Complete, Year, Month, Day)
Dim yearsToAdd As Long
yearsToAdd = Int(Months / MONTHS_PER_YEAR)
Dim monthsToAdd As Long
monthsToAdd = Months - yearsToAdd * MONTHS_PER_YEAR
Month = Month + monthsToAdd
Year = Year + yearsToAdd
If Month < 1 Then
Month = Month + MONTHS_PER_YEAR
Year = Year - 1
ElseIf Month > MONTHS_PER_YEAR Then
Month = Month - MONTHS_PER_YEAR
Year = Year + 1
End If
Dim MaxDays As Long
MaxDays = GetDaysInMonth(Year, Month)
If Day > MaxDays Then Day = MaxDays
Dim TOD As Currency
TOD = cDateTime.GetcDateTime(Time).TotalMilliseconds
Set AddMonths = cDateTime.FromMilliseconds(TotalDays(Year, Month, Day) * MILLISECONDS_PER_DAY + Modulus(TOD, MILLISECONDS_PER_DAY))
End Function
Public Function AddSeconds(ByRef Time As Variant, ByVal Seconds As Long) As cDateTime
Set AddSeconds = cDateTime.GetcDateTime(Time).AddSeconds(Seconds)
End Function
Public Function AddWeeks(ByRef Time As Variant, ByVal Weeks As Long) As cDateTime
Set AddWeeks = cDateTime.GetcDateTime(Time).AddDays(Weeks * 7)
End Function
Public Function AddYears(ByRef Time As Variant, ByVal Years As Long) As cDateTime
Set AddYears = AddMonths(Time, Years * 12)
End Function
Public Function GetDayOfMonth(ByRef Time As Variant) As Long
Call GetDateParts(Time, DayPart, , , GetDayOfMonth)
End Function
Public Function GetMonth(ByRef Time As Variant) As Long
Call GetDateParts(Time, MonthPart, , GetMonth)
End Function
Public Function GetYear(ByRef Time As Variant) As Long
Call GetDateParts(Time, YearPart, GetYear)
End Function
Public Function GetHour(ByRef Time As Variant) As Long
GetHour = cDateTime.GetcDateTime(Time).Hour
End Function
Public Function GetMinute(ByRef Time As Variant) As Long
GetMinute = cDateTime.GetcDateTime(Time).Minute
End Function
Public Function GetSecond(ByRef Time As Variant) As Long
GetSecond = cDateTime.GetcDateTime(Time).Second
End Function
Public Function GetMilliseconds(ByRef Time As Variant) As Long
GetMilliseconds = cDateTime.GetcDateTime(Time).Millisecond
End Function
Public Function GetDayOfWeek(ByRef Time As Variant) As DayOfWeek
GetDayOfWeek = cDateTime.GetcDateTime(Time).DayOfWeek
End Function
Public Function GetDaysInYear(ByVal Year As Long, Optional ByRef Era As Variant) As Long
Call VerifyEra(Era)
If IsLeapYear(Year) Then
GetDaysInYear = 366
Else
GetDaysInYear = 365
End If
End Function
Public Function GetDayOfYear(ByRef Time As Variant) As Long
Call GetDateParts(Time, DayOfTheYear, , , , GetDayOfYear)
End Function
Public Function GetEra(ByRef Time As Variant) As Long
Call cDateTime.GetcDateTime(Time)
GetEra = 1
End Function
Public Function GetMonthsInYear(ByVal Year As Long, Optional ByRef Era As Variant) As Long
Call VerifyEra(Era)
Call VerifyYear(Year)
GetMonthsInYear = 12
End Function
Public Function GetDaysInMonth(ByVal Year As Long, ByVal Month As Long, Optional ByRef Era As Variant) As Long
Call VerifyEra(Era)
Call VerifyYear(Year)
Call VerifyMonth(Month)
GetDaysInMonth = cDateTime.DaysInMonth(Year, Month)
If Month = 2 Then
If IsLeapYear(Year) Then
GetDaysInMonth = 29
End If
End If
End Function
Public Function IsLeapYear(ByVal Year As Long, Optional ByRef Era As Variant) As Boolean
Call VerifyEra(Era)
Call VerifyYear(Year)
IsLeapYear = ((Year Mod 4) = 0)
End Function
Public Function IsLeapMonth(ByVal Year As Long, ByVal Month As Long, Optional ByRef Era As Variant) As Boolean
Call VerifyEra(Era)
Call VerifyYear(Year)
Call VerifyMonth(Month)
IsLeapMonth = False
End Function
Public Function IsLeapDay(ByVal Year As Long, ByVal Month As Long, ByVal Day As Long, Optional ByRef Era As Variant) As Boolean
Call VerifyEra(Era)
Call VerifyYear(Year)
Call VerifyMonth(Month)
If Day < 1 Or Day > GetDaysInMonth(Year, Month, Era) Then _
Throw Cor.NewArgumentOutOfRangeException(cString.Format("Day must be between 1 and {0} inclusively.", GetDaysInMonth(Year, Month, Era)), "Day", Day)
If Month = 2 Then
If IsLeapYear(Year, Era) Then
IsLeapDay = (Day = 29)
End If
End If
End Function
Public Function ToDateTime(ByVal Year As Long, ByVal Month As Long, ByVal Day As Long, ByVal Hour As Long, ByVal Minute As Long, ByVal Second As Long, ByVal Millisecond As Long, Optional ByVal Era As Variant) As cDateTime
Call VerifyEra(Era)
Call VerifyYear(Year)
Call VerifyMonth(Month)
If Day < 1 Or Day > GetDaysInMonth(Year, Month) Then _
Throw Cor.NewArgumentOutOfRangeException(cString.Format("Day must be between 1 and {0} inclusively.", GetDaysInMonth(Year, Month)), "Day", Day)
Set ToDateTime = cDateTime.FromMilliseconds(TotalDays(Year, Month, Day) * MILLISECONDS_PER_DAY + TotalTime(Hour, Minute, Second, Millisecond))
End Function
Public Function ToFourDigitYear(ByVal Year As Long) As Long
If Year < 0 Or Year > 9999 Then _
Throw Cor.NewArgumentOutOfRangeException(Environment.GetResourceString(ArgumentOutOfRange_Range, 0, 9999), "Year", Year)
If Year < 100 Then
Dim y As Long
y = Year Mod 100
ToFourDigitYear = (mTwoDigitYearMax \ 100) * 100 + y
If y > mTwoDigitYearMax Mod 100 Then ToFourDigitYear = ToFourDigitYear - 100
Else
ToFourDigitYear = Year
End If
End Function
Public Function GetWeekOfYear(ByRef Time As Variant, ByVal Rule As CalendarWeekRule, ByVal FirstDayOfWeek As DayOfWeek) As Long
GetWeekOfYear = InternalGetWeekOfYear(Time, Rule, FirstDayOfWeek, Me)
End Function
''
' Returns a string representation of this object instance.
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -