1)近日因興趣要寫一支可以處理如兩千年中西曆轉換的程式，部份對照資料己在網路
找到，請眾網友測試最基本的天干地支星期函數(DateSerial_RC)
測試方法 ?dateSerial_RC(年,月,日)
資料範圍為西元1年1月日~
2)有錯誤者，請告知。
Public Enum Spencia_Month_value
Normal_Feb = 1
Leap_Feb = 2
Special_Sep = 5
Sepecial_Oct = 6
End Enum
Public Enum Normal_Month_Value
Jan = 1
Feb = 2
Mar = 3
Apr = 4
May = 5
Jun = 6
Jul = 7
Aug = 8
Sep = 9
Oct = 10
Nov = 11
Dec = 12
End Enum
Public Enum Normal_Week_Value
Sunday = 1
Monday = 2
Tuesday = 3
Wednesday = 4
Thursday = 5
Friday = 6
Saturday = 0
End Enum
' ----------------------------
' Global Variables
' ----------------------------
Public gstrMonths(1 To 12) As String
Public gintMonth_Days(1 To 12) As Long
'
'=========================================================================================
' 目 的: 計算天數--天主教國家算法。
' 假 設:
' 效 果:
' 輸 入 值: Integer: lngYear
' Integer lngMonth
' Integer lngDay
' 傳 回 值: Long: DateSerial_AD
' 參考資料: the Mandelbrot Set (International) Limited, "Advanced Microsoft Visual Basic
' Secode Edition", Chapter 8.
'
' 測試資料: (4/2/29),(1582/10/3),(1582/10/4)(1582/10/15)
'
' 日 期 By COMMENT
' ---------- ---- -------
' 2000/11/17 SY 建立
'=========================================================================================
Public Function DateSerial_RC(ByVal lngYear As Long, ByVal lngMonth As Long, ByVal lngDay As Long) As Long
Dim intCount As Integer
Dim lngKan_Day As Long
Dim lngKan_Year As Long
Dim lngLeapYear As Long
Dim lngToYearDay As Long
Dim lngToMonthDay As Long
Dim lngToTotalDay As Long
Dim lngWeekDay As Long
Dim strKan_Year As String
Dim strKan_Day As String
Dim strWeek As String
' 給陣列起始值。
gintMonth_Days(1) = 31
gintMonth_Days(2) = 28
gintMonth_Days(3) = 31
gintMonth_Days(4) = 30
gintMonth_Days(5) = 31
gintMonth_Days(6) = 30
gintMonth_Days(7) = 31
gintMonth_Days(8) = 31
gintMonth_Days(9) = 30
gintMonth_Days(10) = 31
gintMonth_Days(11) = 30
gintMonth_Days(12) = 31
' 給零的起始值。
lngToYearDay = 0
' 先行計算[參數：年]之前，有多少個閏年。
' Int 和 Fix 都會去掉 number 的小數部份而傳回剩下的整數。
Select Case lngYear
Case 4
lngLeapYear = 0
Case 5 To 1582
lngLeapYear = (lngYear - 1) \ 4 - 1
Case Is ＞= 1583
lngLeapYear = Fix((lngYear - 1) / 4 - (lngYear - 1) / 100 + (lngYear - 1) / 400) + 1
End Select
' 計算[參數：年]是否為閏年。
If Leap_RC(lngYear) = Leap_Feb Then
gintMonth_Days(Feb) = 29
End If
' 因為1582年10月只有21天(少10天)。
If lngYear = 1582 Then
gintMonth_Days(Oct) = 21
End If
' 計算年的數字。
lngToYearDay = lngLeapYear + (lngYear - 1) * 365
' 計算月的數字。
For intCount = 1 To lngMonth - 1
lngToMonthDay = lngToMonthDay + gintMonth_Days(intCount)
Next intCount
' 計算天數。
lngToTotalDay = lngToYearDay + lngToMonthDay + lngDay
DateSerial_RC = lngToTotalDay
' 計算星期。
lngWeekDay = lngToTotalDay Mod 7
' 計算天支地支的序號--歲次。
lngKan_Year = (lngYear + 57) Mod 60
' 計算天支地支的序號--紀日。
lngKan_Day = (lngToTotalDay + 14) Mod 60
Select Case lngWeekDay
Case Sunday
strWeek = "星期日"
Case Monday
strWeek = "星期一"
Case Tuesday
strWeek = "星期二"
Case Wednesday
strWeek = "星期三"
Case Thursday
strWeek = "星期四"
Case Friday
strWeek = "星期五"
Case Saturday
strWeek = "星期六"
End Select
strKan_Year = KanChih(lngKan_Year)
strKan_Day = KanChih(lngKan_Day)
Debug.Print "星期: ", strWeek, "歲次", strKan_Year, "紀日: ", strKan_Day
End Function
'=========================================================================================
' 目 的: 判斷是否為閏年--天主教國家算法。
' 假 設:
' 效 果:
' 輸 入 值: Long: lngYear
' 傳 回 值: Long: Leap_RC
' 參考資料:
' 測試資料: 4,8,100,400,1582,1600,1700
'
' 日 期 By COMMENT
' ---------- ---- -------
' 2000/11/17 SY 建立
'=========================================================================================
Public Function Leap_RC(ByVal lngYear As Integer) As Long
If lngYear ＜＞ 4 Then
Select Case (lngYear - 1582)
Case Is ＜ 0
If (lngYear Mod 4 = 0) Then
Leap_RC = Leap_Feb
Else
Leap_RC = Normal_Feb
End If
Case Is ＞ 0
If ((lngYear Mod 4 = 0) And (lngYear Mod 100 ＜＞ 0) Or (lngYear Mod 400 = 0)) Then
Leap_RC = Leap_Feb
Else
Leap_RC = Normal_Feb
End If
Case Is = 0
Leap_RC = Normal_Feb
End Select
Else
' 西曆4年（該年為閏年：被4整除且不被100整除），因羅馬皇帝「奧古斯都帝」停閏，故該年
' 二月只有二十八天，而非二十九天
Leap_RC = Normal_Feb
End If
End Function
'=========================================================================================
' 目 的: 判斷是否為閏年。(1899/12/30 00:00:00之後算法)
' 參考資料: 簡易型。
'
' 日 期 By COMMENT
' ---------- ---- -------
' 2000/11/17 SY 建立
'=========================================================================================
Public Function IsLeapYear(TestYear As Integer) As Boolean
IsLeapYear = (Day(DateSerial(TestYear, 3, 0)) = 29)
End Function
'=========================================================================================
' 目 的: 列示天干地支字串。
' 參考資料:
'
' 日 期 By COMMENT
' ---------- ---- -------
' 2000/11/17 SY 建立
'=========================================================================================
Public Function KanChih(ByVal lngKan As Long) As String
Dim strKan(1 To 60) As String
strKan(1) = "甲子"
strKan(2) = "乙丑"
strKan(3) = "丙寅"
strKan(4) = "丁卯"
strKan(5) = "戊辰"
strKan(6) = "己巳"
strKan(7) = "庚午"
strKan(8) = "辛未"
strKan(9) = "壬申"
strKan(10) = "癸酉"
strKan(11) = "甲戌"
strKan(12) = "乙亥"
strKan(13) = "丙子"
strKan(14) = "丁丑"
strKan(15) = "戊寅"
strKan(16) = "己卯"
strKan(17) = "庚辰"
strKan(18) = "辛巳"
strKan(19) = "壬午"
strKan(20) = "癸未"
strKan(21) = "甲申"
strKan(22) = "乙酉"
strKan(23) = "丙戌"
strKan(24) = "丁亥"
strKan(25) = "戊子"
strKan(26) = "己丑"
strKan(27) = "庚寅"
strKan(28) = "辛卯"
strKan(29) = "壬辰"
strKan(30) = "癸巳"
strKan(31) = "甲午"
strKan(32) = "乙未"
strKan(33) = "丙申"
strKan(34) = "丁酉"
strKan(35) = "戊戌"
strKan(36) = "己亥"
strKan(37) = "庚子"
strKan(38) = "辛丑"
strKan(39) = "壬寅"
strKan(40) = "癸卯"
strKan(41) = "甲辰"
strKan(42) = "乙巳"
strKan(43) = "丙午"
strKan(44) = "丁未"
strKan(45) = "戊申"
strKan(46) = "己酉"
strKan(47) = "庚戌"
strKan(48) = "辛亥"
strKan(49) = "壬子"
strKan(50) = "癸丑"
strKan(51) = "甲寅"
strKan(52) = "乙卯"
strKan(53) = "丙辰"
strKan(54) = "丁巳"
strKan(55) = "戊午"
strKan(56) = "己未"
strKan(57) = "庚申"
strKan(58) = "辛酉"
strKan(59) = "壬戌"
strKan(60) = "癸亥"
KanChih = strKan(lngKan)
End Function