|
网上流传很多计算公农历的源代码，很多，但是居然没有VB的，晕，
所以。。。。。
用法：
以l开始的方法均为阴历，以s开始的方法均为公历
基本的两个初使函数：
lInitDate：用农历年月日初使化日期对象
sInitDate: 用公历年月日初使化日期对象
其它的方法看下面的一小段代码吧
示例代码
Private Sub Command1_Click()
Dim t As clsDate
Dim y As Long
Dim m As Long
Dim d As Long
Dim st As Single
Dim et As Single
Dim da As Date
Dim j As Long
Dim ret As Long
Set t = New clsDate
''''t.sInitDate 1900, 1, 1
t.lInitDate 2047, 5, 12, False ''''农历2047年5月12日，非闰月
Debug.Print t.lYear
If t.IsLeap = False Then
Debug.Print t.lMonth
Else
Debug.Print " 闰 " & t.lMonth
End If
Debug.Print t.CDayStr(t.lDay) ''''农历日期中文大写
Debug.Print t.GanZhi(t.lYear) ''''求干支
Debug.Print t.YearAttribute(t.lYear) ''''农历年的属相
Debug.Print t.sYear '''' 公历年
Debug.Print t.sMonth '''' 公历月
Debug.Print t.sDay '''' 公历日
Debug.Print t.sWeekDay ''''公历星期
Debug.Print t.Era(t.sYear)'''' 公历纪元
Debug.Print t.Constellation(t.sMonth, t.sDay) '''' 星座
Debug.Print "Week:" & t.wHoliday '''' 按第几个星期几计算的假日
Debug.Print "Solar" & t.sHoliday '''' 按公历计算的假日
Debug.Print "Lunar" & t.lHoliday '''' 按阴历计算的假日
Debug.Print t.lSolarTerm '''' 计算节气
''''以下为速度测试，很快吧。
st = Timer
With t
For y = 1900 To 2049
For m = 1 To 12
For d = 1 To 28
.lInitDate y, m, d, False
Next
Next
Next
End With
''''t.printf
et = Timer
Debug.Print et - st
Set t = Nothing
End Sub
以下为代码:
Option Explicit
Private Type SolarHolidayStruct
Month As Long
Day As Long
Recess As Long
HolidayName As String
End Type
Private Type LunarHolidayStruct
Month As Long
Day As Long
Recess As Long
HolidayName As String
End Type
Private Type WeekHolidayStruct
Month As Long
WeekAtMonth As Long
WeekDay As Long
HolidayName As String
End Type
''''保持属性值的局部变量
Private mvarsYear As Long ''''局部复制
Private mvarsMonth As Long ''''局部复制
Private mvarsDay As Long ''''局部复制
Private mvarlYear As Long ''''局部复制
Private mvarlMonth As Long ''''局部复制
Private mvarlDay As Long ''''局部复制
Private mvarIsLeap As Boolean ''''局部复制
Private Declare Function BitRight32 Lib "Bit4VB.DLL" (ByVal x As Long, ByVal num As Long) As Long
''''Private Declare Function BitRight16 Lib "Bit4VB.DLL" (ByVal x As Integer, ByVal num As Integer) As Integer
''''定义类内部用公用变量
Private SolarMonth As Variant
Private Gan As Variant
Private Zhi As Variant
Private Animals As Variant
Private SolarTerm As Variant
Private sTermInfo As Variant
Private nStr1 As Variant
Private nStr2 As Variant
Private MonthName As Variant
Private LunarInfo(150) As Long
Private LunarYearDays(150) As Long
Private sHolidayInfo() As SolarHolidayStruct
Private lHolidayInfo() As LunarHolidayStruct
Private wHolidayInfo() As WeekHolidayStruct
Private mvarDate As Date ''''内部使用标准的日期变量
Private Sub Class_Initialize()
Dim tempArray As Variant
Dim i As Long
Dim b As Long
Dim sFtv As Variant
Dim lFtv As Variant
Dim wFtv As Variant
''''根据VB的位计算特点,故扩充原有的数据位,将其变成32位
tempArray = Array( _
&H104BD8, &H104AE0, &H10A570, &H1054D5, &H10D260, &H10D950, &H116554, &H1056A0, &H109AD0, &H1055D2, _
&H104AE0, &H10A5B6, &H10A4D0, &H10D250, &H11D255, &H10B540, &H10D6A0, &H10ADA2, &H1095B0, &H114977, _
&H104970, &H10A4B0, &H10B4B5, &H106A50, &H106D40, &H11AB54, &H102B60, &H109570, &H1052F2, &H104970, _
&H106566, &H10D4A0, &H10EA50, &H106E95, &H105AD0, &H102B60, &H1186E3, &H1092E0, &H11C8D7, &H10C950, _
&H10D4A0, &H11D8A6, &H10B550, &H1056A0, &H11A5B4, &H1025D0, &H1092D0, &H10D2B2, &H10A950, &H10B557, _
&H106CA0, &H10B550, &H115355, &H104DA0, &H10A5D0, &H114573, &H1052D0, &H10A9A8, &H10E950, &H106AA0, _
&H10AEA6, &H10AB50, &H104B60, &H10AAE4, &H10A570, &H105260, &H10F263, &H10D950, &H105B57, &H1056A0, _
&H1096D0, &H104DD5, &H104AD0, &H10A4D0, &H10D4D4, &H10D250, &H10D558, &H10B540, &H10B5A0, &H1195A6, _
&H1095B0, &H1049B0, &H10A974, &H10A4B0, &H10B27A, &H106A50, &H106D40, &H10AF46, &H10AB60, &H109570, _
&H104AF5, &H104970, &H1064B0, &H1074A3, &H10EA50, &H106B58, &H1055C0, &H10AB60, &H1096D5, &H1092E0, _
&H10C960, &H10D954, &H10D4A0, &H10DA50, &H107552, &H1056A0, &H10ABB7, &H1025D0, &H1092D0, &H10CAB5, _
&H10A950, &H10B4A0, &H10BAA4, &H10AD50, &H1055D9, &H104BA0, &H10A5B0, &H115176, &H1052B0, &H10A930, _
&H107954, &H106AA0, &H10AD50, &H105B52, &H104B60, &H10A6E6, &H10A4E0, &H10D260, &H10EA65, &H10D530, _
&H105AA0, &H1076A3, &H1096D0, &H104BD7, &H104AD0, &H10A4D0, &H11D0B6, &H10D250, &H10D520, &H10DD45, _
&H10B5A0, &H1056D0, &H1055B2, &H1049B0, &H10A577, &H10A4B0, &H10AA50, &H11B255, &H106D20, &H10ADA0)
For i = 0 To 149
LunarInfo(i) = tempArray(i)
Next
tempArray = Array( _
384, 354, 355, 383, 354, 355, 384, 354, 355, 384, _
354, 384, 354, 354, 384, 354, 355, 384, 355, 384, _
354, 354, 384, 354, 354, 385, 354, 355, 384, 354, _
383, 354, 355, 384, 355, 354, 384, 354, 384, 354, _
354, 384, 355, 354, 385, 354, 354, 384, 354, 384, _
354, 355, 384, 354, 355, 384, 354, 383, 355, 354, _
384, 355, 354, 384, 355, 353, 384, 355, 384, 354, _
355, 384, 354, 354, 384, 354, 384, 354, 355, 384, _
355, 354, 384, 354, 384, 354, 354, 384, 355, 355, _
384, 354, 354, 383, 355, 384, 354, 355, 384, 354, _
&nb
[1] [2] [3] [4] [5] [6] 下一页 |
