p; Case 30 s = "三十" Case Else s = nStr2(d \ 10) ''''整数除法 s = s & nStr1(d Mod 10) End Select CDayStr = s End Function ''''计算星座归属 Public Function Constellation(m As Long, d As Long) As String Dim y As Long Dim tempDate As Date Dim ConstellName 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) ''''闰哪个月 If m <> leap Then mvarIsLeap = False ''''当前日期并非闰月 Else mvarIsLeap = LeapFlag ''''使用用户输入的是否闰月月份 End If If (m < leap) Or (leap = 0) Then ''''当闰月在当前日期后 For i = 1 To m - 1 Temp = lMonthDays(y, i) ''''计算非闰月天数 &n 上一页 [1] [2] [3] [4] [5] [6] 下一页 没有相关教程
|