Name As String
y = 2000
tempDate = m & "/" & d & "/" & y
Select Case tempDate
Case #3/21/2003# To #4/19/2000#
ConstellName = "白羊"
Case #4/20/2000# To #5/20/2000#
ConstellName = "金牛"
Case #5/21/2000# To #6/21/2000#
ConstellName = "双子"
Case #6/22/2000# To #7/22/2000#
ConstellName = "巨蟹"
Case #7/23/2000# To #8/22/2000#
ConstellName = "狮子"
Case #8/23/2000# To #9/22/2000#
ConstellName = "处女"
Case #9/23/2000# To #10/23/2000#
ConstellName = "天秤"
Case #10/24/2000# To #11/21/2000#
ConstellName = "天蝎"
Case #11/22/2000# To #12/21/2000#
ConstellName = "射手"
Case #12/22/2000# To #12/31/2000#
ConstellName = "摩蝎"
Case #1/1/2000# To #1/19/2000#
ConstellName = "摩蝎"
Case #1/20/2000# To #2/18/2000#
ConstellName = "水瓶"
Case #2/19/2000# To #3/20/2000#
ConstellName = "双鱼"
Case Else
ConstellName = ""
End Select
Constellation = ConstellName
End Function
''''/////////////////////////////////////////////////////////////////////////////////////////////////////////
''''以下为类内部使用的一些函数
''''传回农历 y年的总天数
Private Function lYearDays(ByVal y As Long) As Long
'''' Dim i As Long
'''' Dim f As Long
'''' Dim sumDay As Long
'''' Dim info As Long
'''' sumDay = 348
'''' i = &H8000
'''' info = LunarInfo(y - 1900) And &H1000FFFF ''''屏蔽高位,
'''' Do
'''' f = info And i
'''' If f <> 0 Then
'''' sumDay = sumDay + 1
'''' End If
'''' i = BitRight16(i, 1)
'''' Loop Until i < &H10
'''' lYearDays = sumDay + leapDays(y)
lYearDays = LunarYearDays(y - 1900) ''''先计算出每年的天数,并形成数组,以减少以后的运算时间
End Function
''''传回农历 y年m月的总天数
Private Function lMonthDays(ByVal y As Long, ByVal m As Long) As Long
If (LunarInfo(y - 1900) And &H1000FFFF) And BitRight32(&H10000, m) Then
lMonthDays = 30
Else
lMonthDays = 29
End If
End Function
''''传回农历 y年闰月的天数
Private Function leapDays(y As Long) As Long
If leapMonth(y) Then
If LunarInfo(y - 1900) And &H10000 Then
leapDays = 30
Else
leapDays = 29
End If
Else
leapDays = 0
End If
End Function
''''传回农历 y年闰哪个月 1-12 , 没闰传回 0
Private Function leapMonth(y As Long) As Long
Dim i As Long
i = LunarInfo(y - 1900) And &HF
If i > 12 Then
Debug.Print y
End If
leapMonth = i
End Function
''''计算公历年月的天数
Private Function SolarDays(y As Long, m As Long) As Long
Dim d As Long
If (y Mod 4) = 0 Then ''''闰年
If m = 2 Then
d = 29
Else
d = SolarMonth(m - 1)
End If
Else
If m = 2 Then
d = 28
Else
d = SolarMonth(m - 1)
End If
End If
SolarDays = d
End Function
''''//////////////////////////////////////////////////////////////////////////////////////////////////
''''
''''主要的函数,用公历年月日对日期对象进行初使化,在此函数内部完成对私有对象属性的设置
''''
''''//////////////////////////////////////////////////////////////////////////////////////////////////
Public Sub sInitDate(ByVal y As Long, ByVal m As Long, ByVal d As Long)
Dim i As Long
Dim leap As Long
Dim Temp As Long
Dim offset As Long
mvarDate = m & "/" & d & "/" & y
mvarsYear = y
mvarsMonth = m
mvarsDay = d
''''农历日期计算部分
leap = 0
Temp = 0
offset = mvarDate - #1/30/1900# ''''计算两天的基本差距
For i = 1900 To 2049
''''temp = lYearDays(i) ''''求当年农历年天数
offset = offset - Temp
If offset < 1 Then Exit For
Next
offset = offset + Temp
mvarlYear = i
leap = leapMonth(i) ''''闰哪个月
mvarIsLeap = False
For i = 1 To 12
''''闰月
If leap > 0 And i = (leap + 1) And mvarIsLeap = False Then
mvarIsLeap = True
i = i - 1
Temp = leapDays(mvarlYear) ''''计算闰月天数
Else
Temp = lMonthDays(mvarlYear, i) ''''计算非闰月天数
End If
offset = offset - Temp
If offset <= 0 Then Exit For
Next
offset = offset + Temp
mvarlMonth = i
mvarlDay = offset
End Sub
''''//////////////////////////////////////////////////////////////////////////////////////////////////
''''
''''主要的函数,用农历年月日对日期对象进行初使化,在此函数内部完成对私有对象属性的设置
''''
''''//////////////////////////////////////////////////////////////////////////////////////////////////
Public Sub lInitDate(ByVal y As Long, ByVal m As Long, ByVal d As Long, Optional LeapFlag As Boolean = False)
Dim i As Long
Dim leap As Long
Dim Temp As Long
Dim offset As Long
mvarlYear = y
mvarlMonth = m
mvarlDay = d
offset = 0
For i = 1900 To y - 1
Temp = LunarYearDays(i - 1900) ''''求当年农历年天数
offset = offset + Temp
Next
leap = leapMonth(y) ''''闰哪个月
上一页 [1] [2] [3] [4] [5] [6] 下一页 |
