常用函数集农历函数
常用函數(shù)集
農(nóng)歷函數(shù)
原來是vb代碼，重新整理為VB.NET版的，并在VS2003中編譯通過
Imports System.Math
Public Class UCnCalendar
Private Structure SolarHolidayStruct
Dim Month As Integer
Dim Day As Integer
Dim Recess As Integer
Dim HolidayName As String
End Structure
Private Structure LunarHolidayStruct
Dim Month As Integer
Dim Day As Integer
Dim Recess As Integer
Dim HolidayName As String
End Structure
Private Structure WeekHolidayStruct
Dim Month As Integer
Dim WeekAtMonth As Integer
Dim WeekDay As Integer
Dim HolidayName As String
End Structure
'保持屬性值的局部變量
Private mvarSolarYear As Integer'局部復(fù)制
Private mvarSolarMonth As Integer'局部復(fù)制
Private mvarSolarDay As Integer'局部復(fù)制
Private mvarLunarYear As Integer'局部復(fù)制
Private mvarLunarMonth As Integer'局部復(fù)制
Private mvarLunarDay As Integer'局部復(fù)制
Private mvarIsLeap As Boolean'局部復(fù)制
Private mvarDate As Date'內(nèi)部使用標準的日期變量
'定義類內(nèi)部用公用變量
Private SolarMonthObject As Object '每月最多天數(shù)
Private mvarLunarGan As Object'天干
Private mvarLunarZhi As Object'地支
Private mvarLunarAnimals As Object'生肖
Private mvarLunarTerm As Object'節(jié)氣
Private mvarLunarTermInfo As Object
Private MonthName As Object'英文月名
Private LunarInfo(150) As Integer
Private LunarYearDays(150) As Integer
Private SolarHolidayInfo() As SolarHolidayStruct
Private LunarHolidayInfo() As LunarHolidayStruct
Private WeekHolidayInfo() As WeekHolidayStruct
Private nStr1 As Object
Private nStr2 As Object
Public Sub New()
'Dim tempArray As Object
Dim i As Integer
Dim b As Integer
'Dim sFtv As Object
'Dim lFtv As Object
'Dim wFtv As Object
'根據(jù)VB的位計算特點,故擴充原有的數(shù)據(jù)位,將其變成32位
Dim tempArray() As Object = { _
&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 = New Object() { _
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, _
354, 384, 354, 355, 384, 354, 385, 354, 354, 384, _
354, 354, 384, 355, 384, 354, 355, 384, 354, 354, _
384, 354, 355, 384, 354, 384, 354, 354, 384, 355, _
354, 384, 355, 384, 354, 354, 384, 354, 354, 384, _
355, 355, 384, 354, 384, 354, 354, 384, 354, 355}
For i = 0 To 149
LunarYearDays(i) = tempArray(i)
Next
SolarMonthObject = New Object() {31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31}
mvarLunarGan = New Object() {"甲", "乙", "丙", "丁", "戊", "己", "庚", "辛", "壬", "癸"}
mvarLunarZhi = New Object() {"子", "丑", "寅", "卯", "辰", "巳", "午", "未", "申", "酉", "戌", "亥"}
mvarLunarAnimals = New Object() {"鼠", "牛", "虎", "兔", "龍", "蛇", "馬", "羊", "猴", "雞", "狗", "豬"}
mvarLunarTerm = New Object() {"小寒", "大寒", "立春", "雨水", "驚蟄", "春分", "清明", "谷雨", "立夏", "小滿", "芒種", "夏至", "小暑", "大暑", "立秋", "處暑", "白露", "秋分", "寒露", "霜降", "立冬", "小雪", "大雪", "冬至"}
mvarLunarTermInfo = New Object() {0, 21208, 42467, 63836, 85337, 107014, 128867, 150921, 173149, 195551, 218072, 240693, 263343, 285989, 308563, 331033, 353350, 375494, 397447, 419210, 440795, 462224, 483532, 504758}
nStr1 = New Object() {"日", "一", "二", "三", "四", "五", "六", "七", "八", "九", "十"}
nStr2 = New Object() {"初", "十", "廿", "卅", " "}
MonthName = New Object() {"JAN", "FEB", "MAR", "APR", "MAY", "JUN", "JUL", "AUG", "SEP", "OCT", "NOV", "DEC"}
'國歷節(jié)日 *表示放假日
Dim sFtv() As Object = { _
1, 1, 1, "元旦", _
2, 14, 0, "情人節(jié)", _
2, 10, 0, "國際氣象節(jié)", _
3, 18, 0, "婦女節(jié)", _
3, 12, 0, "植樹節(jié)", _
3, 15, 0, "消費者權(quán)益日", _
4, 1, 0, "愚人節(jié)", _
5, 1, 1, "勞動節(jié)", _
5, 4, 0, "青年節(jié)", _
5, 12, 0, "護士節(jié)", _
5, 31, 0, "世界無煙日", _
6, 1, 1, "兒童節(jié)", _
7, 1, 0, "建黨節(jié) 香港回歸紀念", _
8, 1, 0, "建軍節(jié)", _
8, 8, 0, "中國男子節(jié) 父親節(jié)", _
9, 9, 0, "毛澤東逝世紀念", _
9, 10, 0, "教師節(jié)", _
9, 18, 0, "九·一八事變紀念日", _
9, 28, 0, "孔子誕辰", _
10, 1, 1, "國慶節(jié) 國際音樂日", _
10, 6, 0, "老人節(jié)", _
10, 24, 0, "聯(lián)合國日", _
11, 12, 0, "孫中山誕辰紀念", _
12, 1, 0, "世界艾滋病日", _
12, 3, 0, "世界殘疾人日", _
12, 20, 0, "澳門回歸紀念", _
12, 24, 0, "平安夜", _
12, 25, 0, "圣誕節(jié)", _
12, 26, 0, "毛澤東誕辰紀念"}
b = UBound(sFtv) + 1
ReDim SolarHolidayInfo(b / 4)
For i = 0 To (b / 4) - 1
SolarHolidayInfo(i).Month = sFtv(i * 4)
SolarHolidayInfo(i).Day = sFtv(i * 4 + 1)
SolarHolidayInfo(i).Recess = sFtv(i * 4 + 2)
SolarHolidayInfo(i).HolidayName = sFtv(i * 4 + 3)
Next
'農(nóng)歷節(jié)日 *表示放假日
Dim lFtv() As Object = { _
1, 1, 1, "春節(jié) 彌勒佛圣誕", _
1, 6, 0, "定光佛圣誕", _
1, 15, 1, "元宵節(jié)", _
2, 8, 0, "釋迦牟尼佛出家", _
2, 9, 0, "海空上師生日", _
2, 15, 0, "釋迦牟尼佛涅槃", _
2, 19, 0, "觀世音菩薩圣誕", _
2, 21, 0, "普賢菩薩圣誕", _
3, 4, 0, "清海上師圓寂日", _
3, 16, 0, "準提菩薩圣誕", _
4, 4, 0, "文殊菩薩圣誕 海空上師出家", _
4, 8, 0, "釋迦牟尼佛圣誕", _
4, 15, 0, "佛吉祥日", _
5, 5, 0, "端午節(jié)", _
5, 13, 0, "伽藍菩薩圣誕", _
6, 3, 0, "護法韋馱尊天菩薩圣誕", _
6, 19, 0, "觀世音菩薩成道", _
7, 7, 0, "七夕情人節(jié)", _
7, 13, 0, "大勢至菩薩圣誕", _
7, 15, 0, "中秋節(jié) 盂蘭盆節(jié)", _
8, 22, 0, "燃燈佛圣誕", _
7, 24, 0, "龍樹菩薩圣誕", _
7, 30, 0, "地藏菩薩圣誕", _
8, 15, 0, "中秋節(jié)", _
9, 9, 0, "重陽節(jié)", _
9, 19, 0, "觀世音菩薩出家紀念日", _
9, 30, 0, "藥師琉璃光如來圣誕", _
10, 5, 0, "達摩祖師圣誕", _
11, 7, 0, "阿彌陀佛圣誕", _
12, 8, 0, "臘八節(jié) 釋迦如來成道日", _
12, 24, 0, "小年", _
12, 29, 0, "華嚴菩薩圣誕"}
'12, 31, 0, "除夕") '注意除夕需要其它方法進行計算
b = UBound(lFtv) + 1
ReDim LunarHolidayInfo(b / 4)
For i = 0 To (b / 4) - 1
LunarHolidayInfo(i).Month = lFtv(i * 4)
LunarHolidayInfo(i).Day = lFtv(i * 4 + 1)
LunarHolidayInfo(i).Recess = lFtv(i * 4 + 2)
LunarHolidayInfo(i).HolidayName = lFtv(i * 4 + 3)
Next
'某月的第幾個星期幾
Dim wFtv() As Object = { _
5, 2, 1, "國際母親節(jié)", _
5, 3, 1, "全國助殘日", _
6, 3, 1, "父親節(jié)", _
9, 3, 3, "國際和平日", _
9, 4, 1, "國際聾人節(jié)", _
10, 1, 2, "國際住房日", _
10, 1, 4, "國際減輕自然災(zāi)害日", _
11, 4, 5, "感恩節(jié)"}
b = UBound(wFtv) + 1
ReDim WeekHolidayInfo(b / 4)
For i = 0 To (b / 4) - 1
WeekHolidayInfo(i).Month = wFtv(i * 4)
WeekHolidayInfo(i).WeekAtMonth = wFtv(i * 4 + 1)
WeekHolidayInfo(i).WeekDay = wFtv(i * 4 + 2) '1 代表星期天
WeekHolidayInfo(i).HolidayName = wFtv(i * 4 + 3)
Next
End Sub
'/
'計算農(nóng)歷上的節(jié)氣
ReadOnly Property LunarTerm() As String
Get
'//===== 某年的第n個節(jié)氣為幾日(從0小寒起算)
'function sTerm(y,n) {
' var offDate = new Date( ( 31556925974.7*(y-1900) + LunarTermInfo[n]*60000 ) + Date.UTC(1900,0,6,2,5) )
' return(offDate.getUTCDate())
'//節(jié)氣
' tmp1 = sTerm(y, m * 2) - 1
Dim baseDateAndTime As Date
Dim newDate As Date
Dim num As Double
Dim y As Integer
Dim tempStr As String
baseDateAndTime = #1/6/1900 2:05:00 AM#
y = mvarSolarYear
tempStr = ""
Dim i As Integer
For i = 1 To 24
num = 525948.76 * (y - 1900) + mvarLunarTermInfo(i - 1)
newDate = DateAdd("n", num, baseDateAndTime) '按分鐘計算,之所以不按秒鐘計算，是因為會溢出
If Abs(DateDiff("d", newDate, mvarDate)) = 0 Then
tempStr = mvarLunarTerm(i - 1)
Exit For
End If
Next
LunarTerm = tempStr
End Get
End Property
'計算按第幾周星期幾計算的節(jié)日
ReadOnly Property WeekHoliday() As String
Get
Dim w As Integer
Dim i As Integer
Dim b As Integer
Dim FirstDay As Date
Dim tempStr As String
b = UBound(WeekHolidayInfo)
For i = 0 To b
If WeekHolidayInfo(i).Month = mvarSolarMonth Then '當月份相當時
w = Weekday(mvarDate)
If WeekHolidayInfo(i).WeekDay = w Then '僅當星期幾也相等時
FirstDay = mvarSolarMonth & "/" & 1 & "/" & mvarSolarYear '取當月第一天
If (DateDiff("ww", FirstDay, mvarDate) = WeekHolidayInfo(i).WeekAtMonth) Then
tempStr = WeekHolidayInfo(i).HolidayName
End If
End If
End If
Next
WeekHoliday = tempStr
End Get
End Property
ReadOnly Property LunarHoliday() As String
Get
Dim i As Integer
Dim b As Integer
Dim tempStr As String
Dim oy As Integer
Dim odate As Date
Dim ndate As Date
tempStr = ""
b = UBound(LunarHolidayInfo)
If mvarLunarMonth = 12 And (mvarLunarDay = 29 Or mvarLunarDay = 30) Then
oy = mvarLunarYear '保存農(nóng)歷年數(shù)
odate = mvarDate
ndate = mvarDate.AddDays(1)
Call SolarInitDate(Year(ndate), Month(ndate), Microsoft.VisualBasic.DateAndTime.Day(ndate)) '計算第二天的屬性
If oy = mvarLunarYear - 1 Then '如果農(nóng)歷年數(shù)增加了1
tempStr = "除夕"
Call SolarInitDate(Year(odate), Month(odate), Microsoft.VisualBasic.DateAndTime.Day(odate)) '恢復(fù)到今天原有數(shù)據(jù)
End If
Else
For i = 0 To b
If (LunarHolidayInfo(i).Month = mvarLunarMonth) And _
(LunarHolidayInfo(i).Day = mvarLunarDay) Then
tempStr = LunarHolidayInfo(i).HolidayName
Exit For
End If
Next
End If
LunarHoliday = tempStr
End Get
End Property
'求公歷節(jié)日
ReadOnly Property SolarHoliday() As String
Get
Dim i As Integer
Dim b As Integer
Dim tempStr As String
tempStr = ""
b = UBound(SolarHolidayInfo)
For i = 0 To b
If (SolarHolidayInfo(i).Month = mvarSolarMonth) And _
(SolarHolidayInfo(i).Day = mvarSolarDay) Then
tempStr = SolarHolidayInfo(i).HolidayName
Exit For
End If
Next
SolarHoliday = tempStr
End Get
End Property
'是否是農(nóng)歷的閏月
ReadOnly Property IsLeap() As Boolean
Get
IsLeap = mvarIsLeap
End Get
End Property
ReadOnly Property LunarDay() As Integer
Get
LunarDay = mvarLunarDay
End Get
End Property
ReadOnly Property LunarMonth() As Integer
Get
LunarMonth = mvarLunarMonth
End Get
End Property
ReadOnly Property LunarYear() As Integer
Get
LunarYear = mvarLunarYear
End Get
End Property
ReadOnly Property SolarWeekDay() As Integer
Get
SolarWeekDay = Weekday(mvarDate)
End Get
End Property
ReadOnly Property SolarDay() As Integer
Get
SolarDay = mvarSolarDay
End Get
End Property
ReadOnly Property SolarMonth() As Integer
Get
SolarMonth = mvarSolarMonth
End Get
End Property
ReadOnly Property SolarYear() As Integer
Get
SolarYear = mvarSolarYear
End Get
End Property
'
Public Function IsToday(ByVal y As Integer, ByVal m As Integer, ByVal d As Integer) As Boolean
If (Year(Today) = y) And _
(Month(Today) = m) And _
(Microsoft.VisualBasic.DateAndTime.Day(Today) = d) Then
IsToday = True
Else
IsToday = False
End If
End Function
'根據(jù)年份不同計算當年屬于什么朝代
Public Function CNEra(ByVal y As Integer) As String
Dim tempStr As String
If y < 1874 Then
tempStr = "未知"
Else
If y <= 1908 Then
tempStr = "清朝光緒"
If y = 1874 Then
tempStr = tempStr & "元年"
Else
tempStr = tempStr & CNNumber(CStr(y - 1874)) & "年"
End If
Else
If y <= 1910 Then
tempStr = "清朝宣統(tǒng)"
If y = 1909 Then
tempStr = tempStr & "元年"
Else
tempStr = tempStr & CNNumber(CStr(y - 1909 + 1)) & "年"
End If
Else
If y < 1949 Then
tempStr = "中華民國"
If y = 1912 Then
tempStr = tempStr & "元年"
Else
tempStr = tempStr & CNNumber(CStr(y - 1912 + 1)) & "年"
End If
Else
tempStr = "中華人民共和國成立"
If y = 1949 Then
tempStr = tempStr & "了"
Else
Select Case y
Case 2000
tempStr = "千禧年"
Case Else
tempStr = tempStr & CNNumber(CStr(y - 1949)) & "周年"
End Select
End If
End If
End If
End If
End If
CNEra = tempStr
End Function
' 傳入 num 傳回干支, 0=甲子
Public Function LunarGanZhi(ByVal num As Integer) As String
Dim tempStr As String
Dim i As Integer
i = (num - 1864) Mod 60 '計算干支
tempStr = mvarLunarGan(i Mod 10) & mvarLunarZhi(i Mod 12)
LunarGanZhi = tempStr
End Function
'計算年的屬相字串
Public Function YearAttribute(ByVal y As Integer) As String
YearAttribute = mvarLunarAnimals((y - 1900) Mod 12)
End Function
'將數(shù)字漢化
Public Function CNNumber(ByVal Dxs As String) As String
'檢測為空時
If Trim(Dxs) = "" Then
CNNumber = ""
Exit Function
End If
Dim Sw As Integer, SzUp As Integer, tempStr As String, DXStr As String
Sw = Len(Trim(Dxs))
Dim i As Integer
For i = 1 To Sw
tempStr = Right(Trim(Dxs), i)
tempStr = Left(tempStr, 1)
tempStr = Converts(tempStr)
Select Case i
Case 1
If tempStr = "零" Then
tempStr = ""
Else
tempStr = tempStr + ""
End If
Case 2
If tempStr = "零" Then
tempStr = "零"
Else
tempStr = tempStr + "十"
End If
Case 3
If tempStr = "零" Then
tempStr = "零"
Else
tempStr = tempStr + "百"
End If
Case 4
If tempStr = "零" Then
tempStr = "零"
Else
tempStr = tempStr + "千"
End If
Case 5
If tempStr = "零" Then
tempStr = "萬"
Else
tempStr = tempStr + "萬"
End If
Case 6
If tempStr = "零" Then
tempStr = "零"
Else
tempStr = tempStr + "十"
End If
Case 7
If tempStr = "零" Then
tempStr = "零"
Else
tempStr = tempStr + "百"
End If
Case 8
If tempStr = "零" Then
tempStr = "零"
Else
tempStr = tempStr + "千"
End If
Case 9
If tempStr = "零" Then
tempStr = "億"
Else
tempStr = tempStr + "億"
End If
End Select
Dim TempA As String
TempA = Left(Trim(DXStr), 1)
If tempStr = "零" Then
Select Case TempA
Case "零"
DXStr = DXStr
Case "萬"
DXStr = DXStr
Case "億"
DXStr = DXStr
Case Else
DXStr = tempStr + DXStr
End Select
Else
DXStr = tempStr + DXStr
End If
Next
CNNumber = DXStr
End Function
Private Function Converts(ByVal NumStr As String) As String
Select Case Val(NumStr)
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 CNDayStr(ByVal d As Integer) 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) '整數(shù)除法
s = s & nStr1(d Mod 10)
End Select
CNDayStr = s
End Function
'中文月份
Public Function CNMonthStr(ByVal d As Integer) As String
If d < 10 Then
CNMonthStr = Converts(d Mod 10)
ElseIf d = 10 Then
CNMonthStr = "十"
Else
CNMonthStr = "十" & Converts(d Mod 10)
End If
End Function
'中文年份
Public Function CNYearStr(ByVal d As Integer) As String
Dim i As Integer
CNYearStr = ""
Dim l As Integer = Len(d.ToString)
For i = 1 To l
CNYearStr &= Converts(Mid(d.ToString, i, 1))
Next
End Function
'中文星期
Public Function CNWeekDayStr()
Dim arrWeek() As Object = {"一", "日", "一", "二", "三", "四", "五", "六"}
CNWeekDayStr = "星期" & arrWeek(Weekday(mvarDate))
End Function
'計算星座歸屬
Public Function Constellation(ByVal m As Integer, ByVal d As Integer) As String
Dim y As Integer
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
'/
'以下為類內(nèi)部使用的一些函數(shù)
'傳回農(nóng)歷 y年的總天數(shù)
Private Function lYearDays(ByVal y As Integer) As Integer
' Dim i As Integer
' Dim f As Integer
' Dim sumDay As Integer
' Dim info As Integer
' 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) '先計算出每年的天數(shù),并形成數(shù)組,以減少以后的運算時間
End Function
'傳回農(nóng)歷 y年m月的總天數(shù)
Private Function lMonthDays(ByVal y As Integer, ByVal m As Integer) As Integer
If (LunarInfo(y - 1900) And &H1000FFFF) And (&H10000 >> m) Then
lMonthDays = 30
Else
lMonthDays = 29
End If
End Function
'傳回農(nóng)歷 y年閏月的天數(shù)
Private Function leapDays(ByVal y As Integer) As Integer
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
'傳回農(nóng)歷 y年閏哪個月 1-12 , 沒閏傳回 0
Private Function leapMonth(ByVal y As Integer) As Integer
Dim i As Integer
i = LunarInfo(y - 1900) And &HF
If i > 12 Then
End If
leapMonth = i
End Function
'計算公歷年月的天數(shù)
Private Function SolarDays(ByVal y As Integer, ByVal m As Integer) As Integer
Dim d As Integer
If (y Mod 4) = 0 Then '閏年
If m = 2 Then
d = 29
Else
d = SolarMonthObject(m - 1)
End If
Else
If m = 2 Then
d = 28
Else
d = SolarMonthObject(m - 1)
End If
End If
SolarDays = d
End Function
'//
'
'主要的函數(shù),用公歷年月日對日期對象進行初使化,在此函數(shù)內(nèi)部完成對私有對象屬性的設(shè)置
'
'//
Public Sub SolarInitDate(ByVal y As Integer, ByVal m As Integer, ByVal d As Integer)
Dim i As Integer
Dim leap As Integer
Dim Temp As Integer
Dim offset As Integer
mvarDate = New Date(y, m, d)
mvarSolarYear = y
mvarSolarMonth = m
mvarSolarDay = d
'農(nóng)歷日期計算部分
leap = 0
Temp = 0
offset = mvarDate.Subtract(New System.DateTime(1900, 1, 30)).Days '計算兩天的基本差距
For i = 1900 To 2049
Temp = lYearDays(i) '求當年農(nóng)歷年天數(shù)
offset = offset - Temp
If offset < 1 Then Exit For
Next
offset = offset + Temp
mvarLunarYear = 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(mvarLunarYear) '計算閏月天數(shù)
Else
Temp = lMonthDays(mvarLunarYear, i) '計算非閏月天數(shù)
End If
offset = offset - Temp
If offset <= 0 Then Exit For
Next
offset = offset + Temp
mvarLunarMonth = i
mvarLunarDay = offset
End Sub
'//
'
'主要的函數(shù),用農(nóng)歷年月日對日期對象進行初使化,在此函數(shù)內(nèi)部完成對私有對象屬性的設(shè)置
'
'//
Public Sub LunarInitDate(ByVal y As Integer, ByVal m As Integer, ByVal d As Integer, Optional ByVal LeapFlag As Boolean = False)
Dim i As Integer
Dim leap As Integer
Dim Temp As Integer
Dim offset As Integer
mvarLunarYear = y
mvarLunarMonth = m
mvarLunarDay = d
offset = 0
For i = 1900 To y - 1
Temp = LunarYearDays(i - 1900) '求當年農(nóng)歷年天數(shù)
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) '計算非閏月天數(shù)
offset = offset + Temp
Next
Else '在閏月后
If mvarIsLeap = False Then '用戶要計算非閏月的月份
For i = 1 To m - 1
Temp = lMonthDays(y, i) '計算非閏月天數(shù)
offset = offset + Temp
Next
If m > leap Then
Temp = leapDays(y) '計算閏月天數(shù)
offset = offset + Temp
End If
Else '此時只有mvarisleap=ture,
For i = 1 To m
Temp = lMonthDays(y, i) '計算非閏月天數(shù)
offset = offset + Temp
Next
End If
End If
offset = offset + d '加上當月的天數(shù)
mvarDate = DateAdd("d", offset, #1/30/1900#)
mvarSolarYear = Year(mvarDate)
mvarSolarMonth = Month(mvarDate)
mvarSolarDay = Microsoft.VisualBasic.DateAndTime.Day(mvarDate)
End Sub
'本模塊用于打印出1900-2049年 每年農(nóng)歷的天數(shù),可以用于數(shù)組初使化
'Public Sub printf()
'Dim i As Integer, j As Integer
'Dim temp(10) As Integer
'Dim base As Integer
'base = 1900
'For i = 1 To 15
'For j = 1 To 10
'temp(j - 1) = lYearDays((i - 1) * 10 + (j - 1) + base) '求當年農(nóng)歷年天數(shù)
'Next
'Debug.Print CStr(temp(0)) & " , " & CStr(temp(1)) & " , " & CStr(temp(2)) & " , " & CStr(temp(3)) & " , " & CStr(temp(4)) & " , " & CStr(temp(5)) & " , " & CStr(temp(6)) & " , " & CStr(temp(7)) & " , " & CStr(temp(8)) & " , " & CStr(temp(9)) & " , " & " _ "
'Next
'End Sub
End Class
總結(jié)
- 上一篇： 常用函数集
- 下一篇： 区分C语言中getch、getche、f