|
Str)
Case 0
Converts = "零"
Case 1
Converts = "一"
Case 2
Converts = "二"
Case 3
Converts = "三"
Case 4
Converts = "四"
Case 5
Converts = "五"
Case 6
Converts = "六"
Case 7
Converts = "七"
Case 8
Converts = "八"
Case 9
Converts = "九"
End Select
End Function
''''中文日期
Public Function CDayStr(d As Long) As String
Dim s As String
Select Case d
Case 0
s = ""
Case 10
s = "初十"
Case 20
s = "二十"
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/2000# 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
If mvarBitTest32((LunarInfo(y - 1900) And &H1000FFFF), 16 - 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
mvarIsLeap = False
Temp = lMonthDays(mvarlYear, i) ''''计算非闰月天数
End If
offset = offset - Temp
If offset <= 0 Then Exit For
Next
offset = offset + Temp
mvar
上一页 [1] [2] [3] [4] [5] [6] 下一页
[系统软件]用RegDllView揪出所有已注册的dll/ocx [系统软件]Windows系统的活动大陆基石 细看DLL文件
[系统软件]Windows的活动大陆：细看DLL文件 [常用软件]利用msdvm.dll实现微软虚拟桌面
[VB.NET程序]使用VB6.0设计ActiveX DLL事件 [VB.NET程序]Crystal Report(水晶报表)的报表封装成VB的DLL
[VB.NET程序]用diskid.dll和disk32.dll获得硬盘序列号 [Delphi程序]输出SHELL32.DLL的图标
[Delphi程序]把图标存储在SHELL32.DLL [Delphi程序]DLL 應用 - 設計可抽換的模組
| 
注：本站部分文章源于互联网，版权归原作者所有！如有侵权，请原作者与本站联系，本站将立即删除！ 本站文章除特别注明外均可转载，但需注明出处！ [MinTao学以致用网] 
