There are a lot of source code for calculating public lunar calendars, but there is no VB, halo, so. . . . . Usage: The method started with L. The method started by S, the method of Sheng's basic, the basic calendar: Linitdate: Date ObjectDate by the Lunar New Year's Day Objects Other Methods Looking at the following small section Code Sample Code 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 SINGER 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' lunar calendar on May 12, 2047, Non-leap moon debug.print T.lyear if t.isleap = False thrint t.lmonth else debug.print "" & t.lmonth end if debug.print t.cdaystr (t.lday) 'Lunar dates Chinese capital debug.print t.Ganzhi (T.lyear)' Dried DEBUG.PRINT T.YEARATTRIBUTE (T. Freeear) 'Lunar Year of the Lunar New Year DEBUG.PRINT T.SYEAR' Questionnaire DEBUG.PRINT T.SMONTH 'Queen Debug.print T. SDAY' Quita Debug.print T.Sweekday 'Queu Week Debug.print T.RA (T.SYEAR)' Qi Caus Debug.Print T. Constellation (T.SMONTH, T.SDAY) 'Constellation Debug.print "Week:" & T.Wholiday' as the first Holiday Debug.Print "Solar" & T.sholid AY 'Calculate the holiday debug.print "Lunar" & t.lholiday' by the question calendar Debug.print T.lsolaterm 'calculates the throne test, soon. 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 neger debug.printf et = timer debug.print et = Timer debug.print et - st Set T = Nothing end Sub The following is the code:
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 'maintain local variable attribute values Private mvarsYear As Long' local copy Private mvarsMonth As Long 'local copy Private mvarsDay As Long' local copy Private mvarlYear As Long 'local copy Private mvarlMonth As Long' local copy Private mvarlDay As Long ' local copy Private mvarIsLeap As Boolean 'local copy 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 'Define Class Internal Use Common Variable Private SolarMonth As Variant Private Gan As Variant Private Zhi AS Variant Private Animals As Variant Private Solarterm As Variant Private Sterminfo As Varia nt 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 ' Internal use of standard Date Variables Private Sub Class_Initialize () DIM TEMPARRAY AS VARIANT DIM I AS Long Dim B AS VARIANT DIM WFTV AS VARIANT 'According to the bit calculation characteristics of VB, so the original data bit is expanded. Turn it into 32-bit Temparray = Array (_ & H104BD8, & H104AE0, & H10A570, & H1054D5, & H10D260, & H10D950, & H116554, & H1056A0, & H109AD0, & H1056A0, & H109AD0, & H1056A0, & H109AD0, & H1056A0, & H109AD0, & 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, & 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, 355, 384, _ 354, 384, 354, 354, 384, 354, 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, 384, 354, 355, 384, 354, 355, 384, 354, 383, 355, 354, _ 384 , 355, 354, 384, 355, 384, 354, _ 355, 384, 354, 354, 384, 354, 384, 354, 355, 384, 354, 384 , 354, 354, 384, 355, 355, _ 384, 354, 354, 383, 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, 384, 354, 354, 384, 355, _ 354, 384, 355, 384, 354, 354, 384, 354, 354, 384, _ 355 , 355, 384, 354, 384, 354, 355) FOR i = 0 to 149 LunaryEardays (i) = Temparray (i) Next Solarmonth = Array (31, 28, 31, 30, 31, 30 , 31, 31, 30, 31, 30, 31) GaN = Array ("A", "B", "C", "Ding", "His", "Heng", "Geng", "
Xin "," "," ") zhi = array (" 子 "," ugly "," 寅 "," "," "," "," noon "," not "," Shen " "酉", "", "Hai") Animals = array ("rat", "牛", "tiger", "rabbit", "", "snake", "horse", "sheep", " Monkey "," Chicken "," Dog "," Pig ") Solarterm = Array (" Small Cold "," Big Han "," Li Spring "," Rain "," Spring "," Qingming "," Gu Yu " "Lixia", "Small Man", "Mang", "Summer", "Little Summer", "Summer", "Bai Lu", "Autumn", "Hanu", "Frost", " Dong Dong, "Snow", "Snow", "Winter Swarf") Sterminfo = Array (0, 21208, 42467, 63836, 85337, 10701, 173149, 195551, 178072, 240693, 263343, 285989, 308563, 331033 , 353350, 375494, 440795, 462224, 483532, 504758) NSTR1 = Array ("Japan", "One", "Two", "Three", "Four", "Five", "Six", " Seven "," eight "," nine "," ten ") nstr2 = array (" first "," ten "," 廿 "," 卅 "," ") Monthname = array (" jan "," feb ", "Mar", "APR", "May", "Jun", "Jul", "Aug", "Sep", "Oct", "NOV", "DEC") 'National Calendar Festival * indicates that the holiday sftv = Array (_ 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, "Arbor Day", 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, "
Nurses' Day, 5, 31, 0, "World No Tobacco Day", _ 6, 1, 0, "Children's Day", _ 7, 1, 0, "Jianzheng Festival Hong Kong Return Memorial", _ 8, 1, 0 "Jianjun Festival", 8, 8, 0, "Chinese Men's Day Father's Day", _ 9, 9, 0, "Mao Zedong Due to Memorial", 9, 10, 0, "Teacher's Day", 9, 18, 0 "Nine · 18 Incident Memorial", 9, 28, 0, "Confucius Birth", _ 10, 1, 0, "National Day International Music Day", 10, 6, 0, "Elderly", 10, 24, 0, "United Nations Day", _ 11, 12, 0, "Sun Yat-sen Birth", _ 12, 1, 0, "World AIDS", 12, 3, 0, "World Disabled Day", 12, 20, 0, "Macau Return Memorial", 12, 24, 0, "Christmas Eve", 12, 25, 0, "Christmas", 12, 26, 0, "Mao Zedong Birthday") B = Ubound (SFTV) 1 redim sholidayinfo (b / 4) for i = 0 to (b / 4) - 1 sholidayinfo (i) .month = sftv (i * 4) sholidayinfo (i) .day = sftv (i * 4 1) SholidayInfo (i) .reat = sftv (i * 4 2) Sholidayinfo (i) .holidayName = SFTV (i * 4 3) Next 'Lunar Festival * Represents a holiday LFTV = array (_ 1, 1, 1, "Spring Festival ", _ 1, 15, 0," Lantern Festival ", _ 5, 5, 0," Dragon Boat Festival ", _ 7, 7, 0," Valentine's Day Valentine's Day ", _ 7, 15, 0," Zhongyuan Festival兰 Bin Festival ", _ 8, 15, 0," Mid-Autumn Festival ", _ 9, 9, 0," Chongyang Festival ", _ 12, 8, 0," Laba Festival ", _ 12, 24, 0, "Small New Year") '12, 31, 0, "New Year's Eve") 'Note New Year's Eve requires other methods to calculate B = Ubound (LFTV) 1 redim lholidayinfo (b / 4) for i = 0 to (B / 4) - 1 lholidayinfo (i) .MONTH = LFTV (i * 4) lholidayinfo (i) .day = LFTV (i * 4 1) lholidayinfo (i) .reat = LFTV (i * 4 2) Lholidayinfo (i) .holidayName = LFTV (i * 4 3) Next 'Supreme Week WFTV = array (_ 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, 4," International Reduction Natural Disaster Day ", _ 11, 4, 5," Thanksgiving ") B = Ubound (WFTV) 1 redim wholidayinfo (b / 4) for i = 0 to (b / 4) - 1 wholidayinfo (i) .MONTH = WFTV (i * 4) wholidayinfo (i) .weekatmonth = WFTV (i * 4 1) wholidayinfo ( i) .weekday = WFTV (i * 4 2) '1 represents Sunday Wholidayinfo (i) .holidayName = WFTV (i * 4 3) Next End Sub' / 'Computing Lunar Air Public Property Get Lsolarterm () AS String '// ===== Nth throttle of a year (from 0 small cold)' Function STERM (Y, N) {'var offdate = new date ((31556925974.7 * (Y-1900) Sterminfo [n] * 60000) Date.utc (1900, 0, 6, 2, 5)) 'Return (Offdate.getutcdate ())' // Hoisting 'TMP1 = STERM (Y, M * 2) - 1 DIM BasedateAndTime As Date Dim NewDate AS DIM NUM AS DOUBLE DIM Y AS Long Dim Tempstr As String BasedateAndtime = # 1/6/1900 2:05:00 AM # y = mvarsyear Tempstr = "" DIM I as long for i = 1 to 24 num = 525948.76 * (Y - 1900) Sterminfo (i - 1) newdate = dateadd ("n", num, basedateandtime) 'According to minutes, the reason is not Calculated by seconds because it will overflow if ABS (Datediff ("D", NewDate, Mvardate) = 0 Tempstr = SOLARTERM (i - 1) EXIT for end if Next Lsolarterm = Tempstr End Property '
Calculate holiday as a few weeks of Times Get Wholiday () AS STRING DIM W AS Long Dim i as long Dim B AS Long Dim Firstday As DIM TEMPSTR AS STRING B = Ubound (WholidayInfo) for i = 0 to B If WholidayInfo (i) .MONTH = mvarsmonth Ten 'is quite W = Weekday (mvardate) if wholidayinfo (i) .WeekDay = W THEN' is only equally equal when the week is also equal, firstday = mvarsmonth & "/" & 1 & " / "& mvarsYear 'taken first of the month If (DateDiff (" ww ", FirstDay, mvarDate) = wHolidayInfo (i) .WeekAtMonth) Then tempStr = wHolidayInfo (i) .HolidayName End If End If End If Next wHoliday = tempStr End Property Public Property Get lHoliday () As String Dim i As Long Dim b As Long Dim tempStr As String Dim oy As Long Dim odate As Date Dim ndate As Date tempStr = "" b = UBound (lHolidayInfo) If mvarlMonth = 12 And (mvarlDay = 29 or mvarlday = 30) Then 'guarantees OY = mvarlyear' Save the Lunar New Year Odate = mvardate ndate = mvardate 1 Call Sinitdate (NDATE), MONTH (NDATE), DAY (NDATE)) 'Calculate the second day of the attribute if = mvarlyear - 1 Then' If the number of lunar calendars increases 1 Tempstr = " New Year's Eve "Call Sinitdate (Year (Odate), Month (Odate), DAY (ODATE)) 'Restore to today's original data end if else for i = 0 to b if (lholidayinfo (i) .month = mvarlmonth) and _ ( LholidayInfo (i) .day = mvarlday) THEN TEMPSTR =
lHolidayInfo (i) .HolidayName Exit For End If Next End If lHoliday = tempStr End Property 'holiday calendar request Public Property Get sHoliday () As String Dim i As Long Dim b As Long Dim tempStr As String tempStr = "" b = UBound ( sHolidayInfo) For i = 0 To b If (sHolidayInfo (i) .Month = mvarsMonth) And _ (sHolidayInfo (i) .Day = mvarsDay) Then tempStr = sHolidayInfo (i) .HolidayName Exit For End If Next sHoliday = tempStr End Property 'is an lunar leap month Public Property Get IsLeap () As Boolean IsLeap = mvarIsLeap End Property Public Property Get lDay () As Long lDay = mvarlDay End Property Public Property Get lMonth () As Long lMonth = mvarlMonth End Property Public Property Get lYear ( ) As long = mvarly peekday () as long searchty = weekday (mvardate) End property public property get sday () as long sday = mvarsday End Property public P roperty Get sMonth () As Long sMonth = mvarsMonth End Property Public Property Get sYear () As Long sYear = mvarsYear End Property 'Public Function IsToday (y As Long, m As Long, d As Long) As Boolean If (Year (Date) = Y) AND _ (MONTH (DATE) = m) and _ (date) = d) Then iStoday = true else iStoday = false end if End function 'According to the year different calculations, what is the dynasty public function ERA (Y AS Long) AS STRING DIM TEMPSTR AS STRING IF Y <1874 Tenstr = "Unknown" else if Y <= 1908 THEN TEMPSTR = "Qing Dynasty" IF Y =
1874 Tempstr = Tempstr & "First Year" Else Tempstr = Tempstr & Upnumber (CSTR (Y - 1874)) & "Year" end if else if Y <= 1910 Tempstr = "Qing Dynasty Xuantong" if y = 1909 Tempstr = Tempstr & "First Year" Else Tempstr = Tempstr & Upnumber (CSTR (Y - 1909 1)) & "Year" end if else if Y <1949 Tempstr = "China" IF Y = 1912 Tempstr = Tempstr & " First Year "Else Tempstr = Tempstr & Upnumber (CSTR (Y - 1912 1)) &" Year "end if else tempstr =" The People's Republic of China "if y = 1949 Tempstr = Tempstr &" "Else Select Case Y" ELSE SELECT CASE Y Case 2000 Tempstr = "Millennium" Case Else Tempstr = Tempstr & UPNUMBER (CSTR (Y - 1949)) & "Anniversary" End SELECT END END IF END IF END IF ERA = Tempstr End Function 'Incoming Num Recurns Dry Branch, 0 = 甲 号 Public Function Ganzhi (Num As Long) AS String Dim Tempstr AS String Dim i as long i = (NUM - 1864) MOD 60 'Computing Dry Support Tempstr = GaN (I Mod 10) & zhi (i MOD 12) Ganzhi = Tempstr End Function' calculates the annual believing string PUBLIC FUNCTION Yearattribute (Y As Long) AS String Yerattribute =
Animals ((Y - 1900) MOD 12) End Function 'Detects DXS AS String AS String' to detect if TRIM (DXS) = "" "UPNUMBER =" EXIT FUNCTION END IF DIM SW AS Integer, Szup As Integer, DXSTR 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" Tempstr = "Else Tempstr = Tempstr " "END IF Case 2 if Tempstr =" zero "Tempstr =" zero "else tempstr = Tempstr "Ten" end if case 3 if tempstr = "zero" Tempstr = "zero" Else Tempstr = Tempstr "Hundred" end if case 4 If Tempstr = "Zero" 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" thrse Tempstr = Tempstr "100" end if case 8 if Tempstr = "zero" THEN TEMPSTR = "zero" Else Tempstr = Tempstr "Qian" end if case 9 if Tempstr = "zero" 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" Wan "DXStr = DXStr Case" one hundred million "DXStr = DXStr Case Else DXStr = tempStr DXStr End Select Else DXStr = tempStr DXStr End If Next UpNumber = DXStr End Function Private f Unformation convers (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 Date Public Function CDAYSTR (D As Long) AS String Dim S = "" "" Case 10 S = "Twenty" Case 20 S = "Twenty" CASE 30 s = "thirty" case else s = nSTR2 (D / 10) 'integer division S = S & NSTR1 (D MOD 10) End select cdaystr = s end function' calculates the constellation attribact PUBLIC FUNCTION CONSTELLATION (M as Long, D As Long, AS STRING DATE DIM CONSTELLNAME AS STRING Y = 2000 Tempdate = M & "/" & "& y Select Case Tempdate Case # 3/21/2003 # To # 4 / 19/2000 # ConstellName = "White Sheep" Case # 4/20/2000 # To # 5/20/2000 # ConstellName = "Golden" Case # 5/21/2000 # To # 6/21/2000 # ConstellName = " Double "Case # 6 of 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 of 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 use some functions used in the class "Back Lunar Y Year of the year 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 'Shield High,' Do 'F = Info and I' IF <> 0 TEN 'SUMDAY = SUMDAY 1' End IF 'I = BitRight16 (i, 1)' LOOP Until i <& H10 'lyeardays = Sumday LeapDays (Y) LyearDays = LunaryEardAys (Y - 1900) first calculates the annual number of days, and forms an array to reduce the number of calculation times End function 'to return to the Lunu Calenda Month Time Private function LMONTHDAYS (ByVal) Y As Long, Byval M As Long) AS Long IF (Y - 1900) And & H1000FFFF) And Bitright32 (& H10000, M) Then Lmonthdays = 30 else lmonthdays = 29 end if End function 'Back to Lunar Yenda 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 'Back Lunar Calendar Y, 1st 1-12, no 闰 0 0 0 Private function LeapMonth As Long Dim I as long i = lunarinfo (Y - 1900) And & Hf I> 12 Then Debug.print y end if leapmonth = i end function 'Calculate the number of days of the Queen month Price SolarDays (Y as long, M as long? as long (y mod 4) = 0 THEN 'leap year 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 SolarDays = D End function '//' 'main Function, the date object is performed on the date of the month, in this function, complete the setting of the private object attribute "'// public sub sinitdate (Byval D As Long) DIM in this function. 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 'Lunar Date Computing section Leap = 0 TEMP = 0 Offset = mvardate - # 1/30/1900 # 'calculates the basic gap for I = 1900 to 2049' Temp = learDays (i) 'Seeking the number of days of the year of the Lunar New Year OFFSET = Offset - Temp IF Offset <1 THEN EXIT for Next OFFSET = Offset Temp mvarlyear = I leap = leapmonth (i) '哪 闰 m = 1 to 12' 月 If leap> 0 and i = (leap 1) And mvarisleap = false the mvarisl EAP = true i = i - 1 Temp = LeapDays (mvarlyear) 'calculates the number of else temp = lmonthdays (mvarlyear, i)' calculation of non-russ = offset - temp if offset <= 0 THEN EXIT for next offset = Offset Temp Mvarlmonth = I mvarlday = offset end sub '//' The main function, the date object is performed with the date object in the Lunar New Year, and the settings of the private object attribute in this function '// public sub Linitdate (Byval Y As Long, Byval D As long, Optional Leapflag as boolean =
FALSE) DIM I As Long Dim Leap As Long Dim Temp As Long Dim Offset As Long Mvarlyear = Y Mvarlmonth = m Mvarlday = D Offset = 0 for i = 1900 to Y - 1 Temp = LunaryEardAys (i - 1900) 'Seeking the Lunar New Year Number of days Offset = Offset Temp next leap = leapmonth (y) What month IF m <> leap dam the mvarisleap = false 'The current date is not the month ELSE MVARILAP = LeApFlag' Enter is entered whether the month END IF IF (M < Leap) or (leap = 0) THEN 'When the month is in the current date for i = 1 to m - 1 TEMP = LMONTHDAYS (Y, I)' calculates non-hosaka days Offset = Offset Temp next else 'after the month after the month IF MVARISLEAP = False Ten 'user to calculate the month for non-leap month for i = 1 to m - 1 Temp = LMONTHDAYS (Y, I)' calculates Non-Leading Moon Day Offset = Offset Temp Next IF M> Leap Ten Temp = LeapDays (Y) ' Calculate the number of months of the month OFFSET = Offset Temp end if else 'This time is only mvarisleap = ture, For i = 1 to m temp = lmonthdays (y, i) 'calculates non-leaping months Offset = Offset Temp next end if end if offset = offset d' plus the number of days of the day mvardate = dateadd ("d", offset, # 1/30/1900 #) mvarsyear = year (mvardate) mvarsmonth = month (mvardate) mvarsday = day (mvardate) End sub 'This module is used to print out the number of days of the annual lunar calendar in 1900 - 2049, can be used in array initial 'PUBLIC SUB PRINTF ()' DIM I as Long, J AS Long 'DIM TEMP (10) As long' DIM BASE AS long 'base =
