Commonly used functions set the lunar calendar is the VB code, reintertoring to VB.NET version, and compiling in VS2003 through the Imports System.mathpublic Class Ucsecalendar
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 in
DIM Weekday As Integer
Dim HolidayName as string
End structure
'Maintaining local variables of attribute values
Private mvarsolaryear as in
'Local copy
Private mvarsolamonth as in
'Local copy
Private mvarsolarday as integer
'Local copy
Private mvarlunaryear as integer
'Local copy
Private mvarlunarmonth as in
'Local copy
Private mvarlunarday as in
'Local copy
Private mvarisleap as boolean
'Local copy
Private mvardate as date
'Internal use standard date variable
'Define public variables within the class
Private SolarMonthobject As Object 'Monthly Number of days
Private mvarlunargan As Object
'天 干
Private mvarlunarzhi as object
Floor support
Private mvarlunaranimals as object
'Zodiac
Private Mvarlunarterm as Object
'
Private Mvarlunarterminfo As Object
Private Monthname as Object
'English and moon
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
'According to the bit calculation characteristics of VB, the original data bits are expanded, turn it into 32 bits.
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, & H10D4A0, & H106E5, & 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, & H1074EA50, & 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 () {"A", "B", "C", "Ding", "His", "Heng", "Xin", "", ""}
Mvarlunarzhi = New Object () {"子", "ugly", "寅", "", "", "", "noon", "no", "Shen", "", "" , "Hai"} mvarlunaranimals = new object () {"Rat", "Niu", "Tiger", "Rabbit", "Dragon", "Snake", "Horse", "Sheep", "Monkey", "Chicken "," Dog "," Pig "}
MvarlunartERM = New Object () {"Little Cold", "Big Han", "Li Shu", "Spring", "Spring", "Qingming", "Tu Yue", "Little Man", "Small", "Mang" "Summer to", "Xiaoxie", "Da Summer", "Autumn", "Summer", "Bai Lu", "Autumn", "Cold", "Frost", "Snow", "Snow", " Winter solstice "}
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 () {"Japan", "One", "Two", "Three", "Four", "Five", "Six", "Seven", "Eight", "Nine", "Ten" }
NSTR2 = New Object () {"First", "Ten", "", "卅", "}
Monthname = new object () {"Jan", "Feb", "Mar", "APR", "May", "Jun", "JUL", "AUG", "SEP", "OCT", "NOV" , "Dec"}
'National Calendar Festival * Expressing the holiday
DIM sftv () as object = {_
1, 1, 1, "New Year's Day", _
2, 14, 0, "Valentine's Day", _
2, 10, 0, "International Meteorological Festival", _
3, 18, 0, "Women's Day", _
3, 12, 0, "Tree Plant Festival", _
3, 15, 0, "Consumer Rights Day", _
4, 1, 0, "April Fool's Day", _
5, 1, 1, "Labor Day", _
5, 4, 0, "Youth Festival", _
5, 12, 0, "nurse festival", _
5, 31, 0, "World No Tobacco Day", _
6, 1, 1, "Children's Day", _
7, 1, 0, "Jiancian Festival Hong Kong Memorial", _
8, 1, 0, "Jianjun Festival", _
8, 8, 0, "Chinese Men's Day Father's Day", _
9, 9, 0, "Mao Zedong died commemorative", _
9, 10, 0, "Teacher's Day", _
9, 18, 0, "Nine · 18 Incident Memorial Day", _
9, 28, 0, "Confucius Birth", _
10, 1, 1, "National Day International Music Day", _
10, 6, 0, "Elderly", _
10, 24, 0, "United Nations Day", _
11, 12, 0, "Sun Yat-sen's Birth", _
12, 1, 0, "World AIDS Day", _
12, 3, 0, "World Disabled Day", _
12, 20, 0, "Macau Memorial", _
12, 24, 0, "Christmas Eve", _
12, 25, 0, "Christmas", _
12, 26, 0, "Mao Zedong Birthday"}
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) .reat = SFTV (i * 4 2)
Solarholidayinfo (i) .holidayName = SFTV (i * 4 3)
NEXT
'Lunar New Year * Expressing the holiday
Dim lftv () as object = {_
1, 1, 1, "Spring Festival Maitreya Christmas", _
1, 6, 0, "Dingguang Buddha Christmas", _
1, 15, 1, "Lantern Festival", _
2, 8, 0, "Sakyamuni Buddha", _
2, 9, 0, "Sea Air, Teacher Birthday", _
2, 15, 0, "Sakyamun Nikne", _
2, 19, 0, "Watching Sound Bodhisattva Christmas", _
2, 21, 0, "Puxian Bodhisattva Christmas", _
3, 4, 0, "Qinghai, the dead day", _
3, 16, 0, "Free Bodhisattva Christmas", _
4, 4, 0, "Manjushri Christmas Sea Air of the teacher", _
4, 8, 0, "Sakyamuni Buddha Christmas", _
4, 15, 0, "Buddha Day", _
5, 5, 0, "Dragon Boat Festival", _
5, 13, 0, "Gala Blue Bodhisattva", _
6, 3, 0, "Protecting the Maxi Wei Wei Zun Tian Bodhisattva Christmas", _
6, 19, 0, "Guanyin Bodhisattva", _
7, 7, 0, "Tanabata Valentine's Day", _
7, 13, 0, "Great to Bodhisattva Christmas", _
7, 15, 0, "Mid-Autumn Festival Basin Festival", _
8, 22, 0, "burning Buddha Christmas", _
7, 24, 0, "Dragon Tree Bodhisattva Christmas", _
7, 30, 0, "Tibetan Buddha Christmas", _
8, 15, 0, "Mid-Autumn Festival", _
9, 9, 0, "Chongyang Festival", _
9, 19, 0, "Guan Xi Yin Bodhisattva Women's Memorial Day", _9, 30, 0, "Pharmacist Liuluo is like Christmas", _
10, 5, 0, "Dadozu Master Christmas", _
11, 7, 0, "Amitabha Christmas", _
12, 8, 0, "Laba Festival Sakyamo is coming to Chengdao", _
12, 24, 0, "small year", _
12, 29, 0, "Hua Yan Bodhisattva Christmas"}
'12, 31, 0, "New Year's Eve") 'Pay attention to New Year's Eve requires other methods to calculate
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) .reat = LFTV (i * 4 2)
Lunarholidayinfo (i) .holidayName = LFTV (i * 4 3)
NEXT
'The first day of the month
DIM WFTV () as object = {_
5, 2, 1, "International Mother's Day", _
5, 3, 1, "National Helping Time", _
6, 3, 1, "Father's Day", _
9, 3, 3, "International Peace Day", _
9, 4, 1, "International Deaf", _
10, 1, 2, "International Housing Day", _
10, 1, 4, "International Diffusion Natural Disaster Day", _
11, 4, 5, "Thanksgiving"}
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 represents Sunday
WeekholidayInfo (i) .holidayName = WFTV (i * 4 3)
NEXT
End Sub
'/
'Calculate the throttle of the lunar calendar
Readonly Property Lunarterm () AS STRING
Get
'// ===== Nth throttle of a year (from 0 small cold)
'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 ())
'//
'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) 'The reason why it is calculated by minute, because it will overflow
IF ABS (Datediff ("D", NewDate, Mvardate) = 0 THEN
Tempstr = mvarlunarterm (i - 1)
EXIT for
END IF
NEXT
Lunarterm = Tempstr
END GET
End Property
'Calculate the festival calculated as a few weeks
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 = mvarsolamonth the 'is quite time
w = weekday (mvardate)
If weekholidayinfo (i) .weekday = w life 'only when the week is also equal
Firstday = mvarsolamonth & "/" & 1 & "& mvarsolaryear 'takes the first day of the month
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 o 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 'Save the Lunar New Year
Odate = mvardate
NDATE = mvardate.adddays (1)
Call Solarinitdate (Year (NDATE), MONTH (NDATE), Microsoft.visualBasic.dateAndTime.day (ndate)) 'calculates the second day's properties
If = mvarlunaryear - 1 Then 'If the number of lunar calendars has increased 1
Tempstr = "New Year's Eve"
Call Solarinitdate (Year (Odate), Month (Odate), Microsoft.visualBasic.dateAndTime.day (Odate)) 'Restore to today's original data 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
'Ask the Queen Festival
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 = mvarsolamonth) and _
(Solarholidayinfo (i) .day = mvarsolarday) THEN
Tempstr = Solarholidayinfo (i) .holidayName
EXIT for
END IF
NEXT
Solarholiday = Tempstr
END GET
End Property
'Is it a lunar month?
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 = mvarsolamonth
END GET
End Property
Readonly Property Solaryear () AS Integer
Get
Solaryear = mvarsolaryear
END GET
End Property
'
Public Function ISTODAY (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
'Different in the year, what is the dynasty?
Public Function Cnera (byval y as integer) AS STRING
Dim Tempstr As String
IF Y <1874 THEN
Tempstr = "Unknown"
Else
IF Y <= 1908 THEN
Tempstr = "Qing Dynasty"
IF Y = 1874 THEN
Tempstr = Tempstr & "First Year"
Else
Tempstr = Tempstr & CNNUMBER (CSTR (Y - 1874)) & "Year"
END IF
Else
IF Y <= 1910 THEN
Tempstr = "Qing Dynasty Xuansong"
IF Y = 1909 THEN
Tempstr = Tempstr & "First Year"
Else
Tempstr = Tempstr & CNNUMBER (CSTR (Y - 1909 1)) & "Year"
END IF
Else
IF Y <1949 THEN
Tempstr = "Republic of China"
IF Y = 1912 THEN
Tempstr = Tempstr & "First Year"
Else
Tempstr = Tempstr & CNNUMBER (CSTR (Y - 1912 1)) & "Year"
END IF
Else
Tempstr = "The People's Republic of China was established"
IF Y = 1949 THEN
Tempstr = Tempstr & "Oh"
Else
SELECT CASE Y
Case 2000
Tempstr = "Millennium"
Case Else
Tempstr = Tempstr & CNNUMBER (CSTR (Y - 1949)) & "Anniversary"
End SELECT
END IF
END IF
END IF
END IF
END IF
Cnera = Tempstr
END FUNCTION
'Incontinent Num back to dry, 0 = 甲子
Public Function Lunarganzhi (Byval Num As Integer) AS String
Dim Tempstr As String
DIM I as integer
I = (NUM - 1864) MOD 60 'Computing Dry Support
Tempstr = mvarlunargan (i mod 10) & mvarlunarzhi (i mod 12)
Lunarganzhi = Tempstr
END FUNCTION
'Calculating the year of the column string
Public Function YearatTribute (byval y as integer) AS STRING
Yearattribute = mvarlunaranimals ((Y - 1900) MOD 12)
END FUNCTION
'Public Function CNNumber (Byval Dxs as String) AS String
'When detected as empty
IF TRIM (DXS) = "" ""
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 = "Zero" THEN
Tempstr = ""
Else
Tempstr = Tempstr ""
END IF
Case 2
IF Tempstr = "Zero" THEN
Tempstr = "zero"
Else
Tempstr = Tempstr "Ten"
END IF
Case 3
IF Tempstr = "Zero" THEN
Tempstr = "zero"
Else
Tempstr = TempStr "Hundred"
END IF
Case 4
IF Tempstr = "Zero" THEN
Tempstr = "zero"
Else
Tempstr = Tempstr "Thousand"
END IF
Case 5
IF Tempstr = "Zero" THEN
Tempstr = "10,000"
Else
Tempstr = Tempstr "10,000"
END IF
Case 6
IF Tempstr = "Zero" THEN
Tempstr = "zero"
Else
Tempstr = Tempstr "Ten"
END IF
Case 7
IF Tempstr = "Zero" THEN
Tempstr = "zero"
Else
Tempstr = TempStr "Hundred"
END IF
Case 8
IF Tempstr = "Zero" THEN
Tempstr = "zero"
Else
Tempstr = Tempstr "Thousand"
END IF
Case 9
IF Tempstr = "Zero" THEN
Tempstr = "100 million"
Else
Tempstr = Tempstr "100 million"
END IF
End SELECT
DIM TEMPA AS STRING
Tempa = Left (TRIM (DXSTR), 1)
IF Tempstr = "Zero" THEN
SELECT CASE TEMPA
Case "zero"
DXSTR = DXSTR
Case "10,000"
DXSTR = DXSTR
Case "100 million"
DXSTR = DXSTR
Case Else
DXSTR = Tempstr DXSTR
End SELECT
Else
DXSTR = Tempstr DXSTR
END IF
NEXT
Cnnumber = dxstr
END FUNCTION
Private function convers (Byval Numstr As String) AS String
Select Case Val (NUMSTR)
Case 0
CONVERTS = "zero"
Case 1
Converts = "one"
Case 2
Converts = "two"
Case 3
Converts = "Three"
Case 4
CONVERTS = "four"
Case 5
Converts = "five"
Case 6
Converts = "six"
Case 7
Converts = "seven"
Case 8
Converts = "eight"
Case 9
Converts = "nine"
End SELECT
END FUNCTION
'Chinese dates
Public Function CnDaystr (Byval D AS Integer) AS String
DIM S As String
SELECT CASE D
Case 0
s = ""
Case 10
s = "first ten"
Case 20
s = "twenty"
Case 30
S = "thirty"
Case Else
S = NSTR2 (D / 10) 'integer division
S = S & NSTR1 (D mod 10)
End SELECT
CNDAYSTR = S
END FUNCTION
'Chinese month
Public Function CNMONTHSTR (BYVAL D AS Integer) AS String
IF D <10 THEN
CNMONTHSTR = Converts (D Mod 10)
Elseif D = 10 THEN
CNMONTHSTR = "Ten"
Else
CNMONTHSTR = "Ten" & Converts (D Mod 10)
END IF
END FUNCTION
'Chinese year
Public Function CNYAARSTR (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. Tnowtring, i, 1))
NEXT
END FUNCTION
'Chinese weeks
Public Function CNWeekDaystr ()
DIM arrweek () as object = {"1", "Japan", "One", "Two", "Three", "Four", "Five", "Six"}
CNWeekDaystr = "Week" & Arrweek (Weekday (mvardate))
END FUNCTION
'Computing constellations attributing (byval m 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 = "White Sheep"
Case # 4/20/2000 # to # 5/20/2000 #
ConstellName = "Golden cattle"
Case # 5/21/2000 # To # 6/21/2000 #
ConstellName = "Double Sub"
Case # 6/22/2000 # to # 7/22/2000 #
ConstellName = "Cancer"
Case # 7/23/2000 # to # 8/22/2000 #
ConstellName = "Lion"
Case # 8/23/2000 # to # 9/22/2000 #
ConstellName = "Virgin"
Case # 9/23/2000 # to # 10/23/2000 #
ConstellName = "Libra"
Case # 10/24/2000 # To # 11/21/2000 #
Constellname = "Scorpio"
Case # 11/22/2000 # to # 12/21/2000 #
ConstellName = "shooter"
Case # 12/22/2000 # to # 12/31/2000 #
Constellname = "Mosa"
Case # 1/1/2000 # to # 1/19/2000 #
Constellname = "Mosa"
Case # 1/20/2000 # to # 2/18/2000 #
ConstellName = "Water Bottle"
Case # 2/19/2000 # to # 3/20/2000 #
ConstellName = "Pisces"
Case Else
ConstellName = "" "
End SELECT
Constellation = constellname
END FUNCTION
'/
'The following functions used inside the class
'The total number of days of passing the lunar calendar Y
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' Shielding high,
'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) first calculates the number of days per year and form an array to reduce future operation time.
END FUNCTION
'The total number of times that passed the Lunar Calendar Y
Private function lmonthdays (byval y as integer) AS Integer
IF (LunarInfo (Y - 1900) And & H1000FFFF) and (& H10000 >> M) THEN
LMONTHDAYS = 30
Else
LMONTHDAYS = 29
END IF
END FUNCTION
'Back to the Lunar Year of the Year
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
'Remove the lunar calendar y, which month 1-12, no 传 0 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
'Calculate the number of days of the month
Private function solardays (byval y as integer) AS integer
DIM D AS INTEGER
IF (y mod 4) = 0 THEN 'leap year
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
'//
'
'The main function, the date object is performed in the month of the month of the month, and the settings for private object properties are completed inside this function.
'
'//
Public Sub Solarinitdate (Byval M as Integer, Byval D AS INTEGER)
DIM I as integer
Dim Leap as in Integer
DIM TEMP AS INTEGER
DIM Offset As INTEGER
mvardate = new date (y, m, d)
mvarsolaryear = Y
mvarsolarmnth = m
mvarsolarday = d
'Lunar Date Calculation section
LEAP = 0
Temp = 0
Offset = mvardate.subtract (New System.datetime (1900, 1, 30)). Days' calculates the basic gap between two days
For i = 1900 to 2049
Temp = LyearDays (i) 'Asking for the number of days of lunar calendar
Offset = Offset - Tempif Offset <1 THEN EXIT for
NEXT
OFFSET = Offset Temp
mvarlunaryear = i
Leap = leapmonth (i) '
mvarisleap = false
FOR i = 1 to 12
'Take the month
If Leap> 0 and i = (leap 1) and mvarisleap = false kil
mvarisleap = true
i = i - 1
Temp = LeapDays (mvarlunaryear) 'calculates the number of months
Else
Temp = lmonthdays (mvarlunaryear, i) 'calculates non-leap monthly days
END IF
OFFSET = Offset - Temp
IF offset <= 0 THEN EXIT for
NEXT
OFFSET = Offset Temp
mvarlunarmonth = i
mvarlunarday = offset
End Sub
'//
'
'The main function, the date object is performed with the date of the Lunar New Year, and the settings for private object properties are completed inside this function.
'
'//
Public Sub Lunarinitdate (Byval M as Integer, ByVal D As Integer, Optional Byval LeaPflag As Boolean = FALSE)
DIM I as integer
Dim Leap as in 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) 'Seeking the number of days of lunar calendar
OFFSET = Offset Temp
NEXT
Leap = Leapmonth (Y) 'What months
IF m <> leap then
mvarisleap = false 'The current date is not a month
Else
MVARISLAP = LeApflag 'Enter is entered by the user
END IF
IF (M For i = 1 to m - 1 Temp = lmonthdays (y, i) 'calculates non-leap monthly days OFFSET = Offset Temp NEXT Else 'after the month If mvarisleap = false the 'user wants to calculate the month of non-leap month For i = 1 to m - 1 Temp = lmonthdays (y, i) 'calculates non-leap monthly days OFFSET = Offset Temp NEXT IF m> Leap Then Temp = leapdays (y) 'calculates the number of months OFFSET = Offset Temp END IF Else 'only mvarisleap = Ture, For i = 1 to m Temp = lmonthdays (y, i) 'calculates non-leap month days OFFSET = Offset Temp NEXT END IF END IF OFFSET = Offset D 'plus the number of days of the month Mvardate = dateadd ("d", offset, # 1/30/1900 #) mvarsolaryear = Year (mvardate) Mvarsolarmonth = Month (mvardate) mvarsolarday = microsoft.visualbasic.dateAndTime.day (mvardate) End Sub 'This module is used to print out the number of days of the annual lunar calendar in 1900-2049, which can be used in the initiality of the array. '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) 'See the number of days of the lunar calendar ' 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 Subend Class
