'Construction a FORM1, then add a commandbutton, post the following code to do test. Option ExplicitPrivate Sub Command1_Click () DIM T ASDATED DIM D AS LONG DIM ST AS SING DIM ET AS SINGER DIM DA AS DIM J AS LONG DIM RET ASINITDATE 2004, 5, 18 'T.Linitdate 2047, 5, 12, false debug.print T.lyEar if t.isleap = false death 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.Yerattribute (T.lyear) Debug.print T.Syear Debug.print T.SMONTH Debug.print T. SDAY Debug .Print t.sweekday debug.print T.RA (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 set t = nothingnd sub '*********************************** *********************************************************** **************** 'Create a class, the class named ClsdateOption Explicit' 'Clsdate is originally me when I write a software, because of the need, and I want to act on a male calendar module, I wrote it. In 2003, I published it on 9CBS and didn't pay attention, but later I found a lot of people to say it very good, 'I finally learned its meaning. So just plan to maintain it. '' Because I also saw a JSP open source code, I learned about it, so I also made the source code of this small Dongdong, 'I hope everyone can like it. In this class, there are two more important issues that need to be solved. When you understand them, you understand this class' 1, how to make the array data in the VB in the VB, myData = array (,,,,, ,) 'Perhaps you have a better way, although I have also thought of the resources of the resources, but I think the user needs to guide the resource guide, it will be very inconvenient in' use.
'2, the bit operation in VB is "in version 1.0, that is, I published the version on 9CBS, where I need a Bit4vb.dll dynamic library, I used C,' Because everyone said VB is Can't do it, huh, I haven't considered so much, I wrote a dynamic library. As a result, many netizens are coming to the letter 'to have a big half is this DLL. 'When I read Hardcore VB, I found that the original VB is also able to operate. If calculating the cost of the dynamic library and the cost of the interface, the function of VB to write a bit is not more than using C. So I really made Mvarbittest32 This function 'in 1.02 you don't need any DLL to support this class. '' 'Final I hope that you can write a letter to me, let me know that you are using it. Let me have confidence to continue to maintain it. '' E-mail: liuxiaoshi@xtcz.net zhenghesoft@hotmail.com '' '' version of the offer: 'Next I will launch version of VB.NET and VB 6.0 two platforms. 'Remove some methods and properties to re-rename some methods and properties, but the original interface will continue. '' Version history: 'Update version Please note that the update on 9CBS' '' version 1.02 2004-4-15 'Considering the scheme with dynamic DLL does not really increase the speed of the bit operation,' and is subject to the Hardcore VB author, The VB bit operation module that has been made quickly, so it is no longer using Bit4vb.dll 'in this release, only one clsdate is required to actually complete the conversion of public lunar calendar, no other module' 'version 1.01 2004-2 -10 'Increases functions that can be returned for a few words, SweekDayStr' The original SweekDay continues to ensure other users '' '' 'Note' '' /////////////// '// Description: This module can only be used in data conversion from 2049.12.31 from 1900.1.31, otherwise it will be wrong. // '// or the lunar calendar from 1900.1.1 to 2049.12.7 日 //' /// '///'
Private Type Solarholidaystruct Month As Long Day AS Long Recess As Long HolidayName As Stringend Type
Private Type Lunarholidaystruct Month As Long Day As Long Recess As Long HolidayName As Stringend Type
Private Type WeekHolidayStruct Month As Long WeekAtMonth As Long WeekDay As Long HolidayName As StringEnd 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 'partial Copy Private Mvarlmonth As long 'part copy private mvarlday as long' part copy Private mvarisleap as boolean 'local replication
'Private declare function bitright32 lib "bit4vb.dll" (BYVAL X as long) (Byval Num as long) this definition is not using' Defined Class Internal Common Variables
Private SolarMonth As VariantPrivate Gan As VariantPrivate Zhi As VariantPrivate Animals As VariantPrivate SolarTerm As VariantPrivate sTermInfo As VariantPrivate nStr1 As VariantPrivate nStr2 As VariantPrivate MonthName As VariantPrivate LunarInfo (150) As LongPrivate LunarYearDays (150) As LongPrivate sHolidayInfo () As SolarHolidayStructPrivate lHolidayInfo () As LunarHolidayStructPrivate Wholidayinfo () as weekholidaystruct
Private mvardate as date 'internal use standard date variables
Private Bitpower (31) As long '0-31
'Bit test, test bit to 1 return true private function mvarbitst 32 (Number As long, bit as long) as boolean if bit <0 or bit> 31 Then' is not an integer mvarbittest32 = false else ife = = false else f Number and bitpower (bit) Then mvarbittest32 = True else mvarbittest32 = false end if End ingnd function
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 'According to the bit calculation characteristics of VB, the original data bits are expanded, turn it into 32 bit 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, & H 104DD5, & 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, & 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 TempaRay =
Array (_ 384, 354, 355, 383, 354, 355, 384, 354, 384, 354, 354, 384, 354, 355, 384, 355, 384, _354, 354, 384 , 354, 354, 385, 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, 383, 355, 354, _ 384, 355, 354, 384, 355, 353, 384, 355, 384, 354, _ 355, 384, 354, 384, 384, 355, 384, _ 355, 354, 384, 354, 384, 354, 354, 384, 355, 355, _384, 354, 354, 383, 355, 384, 354, 355, 384, 354, 355, 384, 354, 385, 354, 354, 384, 355, 384, 354, 355, 384, 354, 354, 384, 354, 355, 384, 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 LunaryearEardays (i) = Temparray (i) Next Solarmonth = Array (31, 28, 31, 30, 31, 30, 31) GaN = Array ("A", "B", "Ding", "His", "He", "Geng", "Xin", "", "") zhi = array ("子" "Ugly", "", "", "Chen", "", "", "未", "", "", "Hai") Animals = array (" Rat "," Niu "," Tiger "," Rabbit "," Dragon "," Snake "," Horse "," Sheep "," Monkey "," Chicken "," Dog "," Pig ") SOLARTERM = array ("Small Cold", "Big Han", "Li Chun", "Rain Water", "
"The" Spring "," Qingming "," Gu Yu "," Listen "," Small Man "," Mang "," Summer "," Summer "," Summer "," Li Qiu "," Summer "," Bai Lu " "Autumn", "Hanu", "Frost", "Fortune", "Snow", "Snow", "Winter Swarf") Sterminfo = Array (0, 21208, 42467, 638367, 150921, 173149 , 195551, 218072, 240693, 30856, 33103, 353350, 375494, 39744, 4192, 483532, 504758) NSTR1 = Array ("Japanese", "One", "Second", "Three" "Four", "Five", "Six", "Seven", "Eight", "Ten") NSTR2 = Array ("First", "Ten", "", "卅", " ") Monthname = Array (" Jan "," Feb "," Mar "," APR "," May "," Jun "," Jul "," Aug "," SEP "," OCT "," NOV ", "DEC") 'National Calendar Festival * Expressing SFTV = Array (_ 1, 1, 1, "New Year's Day", _ 2, 14, 0, "Valentine's Day", 2, 10, 0, International Meteorological Festival , _ 3, 8, 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, "Nurse Festival", 5, 31, 0, "World No Tobacco Day", _ 6, 1 , 0, "Children's Day", _ 7, 1, 0, "Jianzheng Festival Hong Kong Memorial", _ 8, 1, 0, "Jianjun Festival", 8, 8, 0, "Chinese Men's Day Father's Day", _ 9, 9, 0, "Mao Zedong Dated", 9, 10, 0, "Teacher's Day", 9, 18, 0, "Nine · 18 Incident Memorial Day", 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"
, 12, 20, 0, "Macau Memorial", 12, 24, 0, "Christmas Eve", 12, 25, 0, "Christmas", 12, 26, 0, "Mao Zedong Birth") 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", _ 3, 13, 0, "Gong Dynasty Author's Birthday", _ 5, 5, 0, "Dragon Boat Festival", _ 7, 7, 0, "Valentine's Day", _ 7, 15, 0, "Zhongyuan Festival", _ 8, 15, 0, "Mid-Autumn Festival", _ 9, 9, 0, "Chongyang Festival", _ 12, 8, 0, "Laba Festival", _ 12, 24, 0, "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). Recess = LFTV (i * 4 2) lholidayinfo (i) .holidayName = LFTV (i * 4 3) Next 'Supreme Week WFTV = A Rray (_ 5, 2, 1, "International Mother's Day", _ 5, 3, 1, "National Helping Time", _ 6, 3, 1, "Father's Day", _ 9, 3, 3, "International Peace Japanese, _ 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 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' bit operation primation module function modbit4vb definition for i = 0 to 30 BitPower (i) = 2 ^ i Next Bitpower (31) = & h80000000end SUB
'/
'Calculate the public print of the lunar calendar PUBLIC Property Get Lsolarterm () AS STRING
'// ===== Northern Nights for a few days (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 ())
'// Syringe' TMP1 = STERM (Y, M * 2) - 1 DIM BasedateAndtime AS 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) 'by minute Calculate, the reason why it is not calculated by second because it will overflow if ABS (Datediff ("D", NewDate, Mvardate)) = 0 Tempstr = SOLARTERM (i - 1) EXIT for end if next lsolarterm = tempstrend property 'calculation As a few weeks of time calculation holiday () AS STRING DIM W AS Long Dim i as long Dim B AS Long Dim I as a date 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 equal when the week is also equal, firstday = mvarsmonth & "/" & 1 & "/ "& mvarsyear 'takes the first day of the month IF (Datediff ("WW", Firstday, Mvardate = wholidayinfo (i) .WeekatMonth) THEN TEMPSTR = WholidayInfo (i) .holidayName end if end if end if next whload = tempstrend 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 Lunarian ODATE = mvardate ndate = mvardate 1 Call Sinitdate (Year (NDATE), MONTH (NDATE), DAY (NDATE)) 'Calculate the second day attribute IF Oy = mvarlyear - 1 Then 'If the number of lunar calendars increases 1 Tempstr = "New Year's Eve" Call Sinitdate (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 = TempStrEnd Property 'Public holiday calendar seek 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) Tempstr = sholidayinfo (i) .holidayName EXIT for end If Next Sholiday = Tempstrend Property 'is a lunar month PUBLIC Property Get Isleap () as boolean isleap = mvarislerapnd propertyPublic property get ldayend property () as long LDAY = MvarldayEnd Property
Public Property Get Lmonth () as long lmonth = mvarlmonthend property
Public Property Get lYear () As Long lYear = mvarlYearEnd PropertyPublic Property Get sWeekDay () As Long sWeekDay = WeekDay (mvarDate) End Property 'calculated week Chinese string Public Property Get sWeekDayStr () As String Select Case WeekDay (mvarDate) Case vbSunday sWeekDayStr = "Sunday" Case vbMonday sWeekDayStr = "Monday" Case vbTuesday sWeekDayStr = "Tuesday" Case vbWednesday sWeekDayStr = "Wednesday" Case vbThursday sWeekDayStr = "Thursday" Case vbFriday sWeekDayStr = "Friday" Case vbSaturday sWeekDayStr = "Saturday" End SelectEnd Property
Public property Get SDAY () as long sday = mvarsdayend property
Public property Get Smont () as long smont = mvarsmonthend property
Public property Get Syar () as long syear = mvarsyerend property
'Public Function ISTODAY (Y 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, what is the year, what is the year, As String Dim Tempstr as string if Y <1874 Tempstr =" Unknown "else if Y <= 1908 TEMPSTR =" Qing Dynasty "IF Y = 1874 Tempstr = Tempstr & "First Year" Else Tempstr = Tempstr & Upnumber (CSTR (Y - 1874)) & "New Year" end if else if Y <= 1910 Tempstr = "Qing Dynasty Xuandong" 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 & "Yuan Year "Else Tempstr = Tempstr & Upnumber (CSTR (Y - 1912 1)) &" Year "end if else tempstr =" IF Y = 1949 Tempstr = Tempstr & "" ELSE SELECT CASE Y Case 2000 Tempstr = "Millennium" Case Else Tempstr = Tempstr & Upnumber (CSTR (Y - 1949)) & "Anniversary" End SELECT END IF END IF END IF END IF ERA = TempStrend Function
'Incomputory Num Retrieved Dried Dried Dish, 0 = Num As Long AS STRING DIM TEMPSTR AS STRING DIM I as Long i = (Num - 1864) MOD 60' Computing Dry Supply Tempstr = GaN (I Mod 10) & ZHI (I MOD 12) Ganzhi = Tempstrend Function 'calculating the annual believing string Public Function Yearattribute (Y ask) AS STRING YEARATTRIBUTE = Animals ((Y - 1900) MOD 12 End Function
'Public Function Upnumber (DXS AS String) AS String
'Detecting empty if trim (dxs) = "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" DIM I AS) DXSTR 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" Tenstr = "" 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" Tempstr = "10,000" else tempstr = Tempstr "10,000" end if case 6 if Tempstr = "zero" Tenstr = "zero" Else Tempstr = Tempstr "Ten" end if Case 7 if Tempstr = "zero" Tenstr = "
Zero "Else Tempstr = Tempstr " Hundred "end if case 8 if Tempstr =" zero "THEN TEMPSTR =" zero "Else Tempstr = Tempstr " Qian "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 "one hundred million" DXStr = DXStr Case Else DXStr = tempStr DXStr End Select Else DXStr = tempStr DXStr End If Next UpNumber = DXStrEnd FunctionPrivate Function Converts (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 SelectenD Function 'Chinese Date Public Function CDAYSTR (D As Long) AS String Dim S = "" "Case 10 S =" First Ten "
Case 20 s = "twenty" case 30 s = "thirty" Case Else S = NSTR2 (D / 10) 'Integer S 除 S = S & NSTR1 (D MOD 10) End Select CDaystr = Send Function' Computing Constellation Home PUBLIC Function Constellation (M As Long, D As Long) AS STRING DIM Y AS Long Dim Tempdate As Date Dim ConstellName As String Y = 2000 Tempdate = M & "/" & D & "/" & y
Select Case Tempdate Case # 3/21/2000 # To # 4 of 19/2000 # ConstellName = "White Sheep" Case # 4/20/2000 # To # 5/20/2000 # ConstellName = "Golden" Case # 5 / 21/2000 # To # 6/21/2000 # ConstellName = "Duo" 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 =" Shot "Case # 12/22/2000 # T # 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 = ConstellNameen D function '/' Some functions used inside the class 'Some of the Time of the Logo Y-year PRIVATE FUNCTION LYEARDAYS (BYVAL Y 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 f <> 0 Then' Sumday = Sumday 1 'end if 'I = Bitright16 (i, 1)' loop unsil 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 operations in the future End Function' End Function '. Long, BYVAL M As Long (LunarInfo (Y - 1900) And & Bitright32 (& H10000, M) THEN IF MVARBITTEST32 ((LunarInfo (Y - 1900) and & H1000FFFFFFFf), 16 - m) Then Lmonthdays = 30 else lmonthdays = 29 end ifend function
'传 农 农 月 月 prickage, a year, privacy, as long if leapmonth (y), one if lunarinfo (Y - 1900) And & H10000 Then LeapDays = 30 else LeaPDays = 29 end if else LeapDays = 0 End IFEND FUNCTION
'Back to Lunar Years 1 month 1-12, no 闰 传 0 0Private Function Leapmonth (Y AS Long) As long Dim i as long i = lunarinfo (Y - 1900) And & Hf IF I> 12 Then Debug.print Y End if Leapmonth = IEND FUNCTION
'Calculate Question Soli Months Private Function Solardays (Y AS Long, M As Long) AS Long Dim D As Long IF (Y MOD 4) = 0 TEN' 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 end if solardays = dend function
'//' 'main function, perform the date object in the month of the public calendar, complete the setting of the private object attribute in this function "' // public sub sinitdate (byval y as long) (byval y as long) (Byval Y As Long) , BYVAL D AS Long Dim Off AS Long Mvardate = M & "/" & D & "/" & y mvarsyear = y mvarsmonth = m mvarsday = d 'Lunar Date Calculation Some Leap = 0 Temp = 0 Offset = mvardate - # 1/30/1900 # 'calculates the basic gap for two days for i = 1900 to 2049 temp = lyeardays (i)' Seeking the number of days of the year of the Lunar New Year OFFSET = Offset - Temp IF Offset <1en exit for next offset = Offset Temp mvarlyear = i leap = leapmonth (i) '= = 1 to 12' = (leap 1) and mvarisleap = (Leap 1) And mvarisleap = False kilisleap = true i = i - 1 Temp = LeapDays (mvarlyear) 'calculates the number of months Else mvarisleap = false temp = lmonthdays (mvarlyear, i)' calculates non-leaping month end if offset = offset - Temp if offset <= 0 THEN Exit For next offset = offset temp mvarlmonth = i mvarlday = offset end sub '//' 'main function, using the date object with the Lunar New Year's Day, in this function, complete the settings of private object properties " // Public Sub Linitdate (Byval Y As Long, Byval M 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) ' IF m <> leap the mvarisleap = false 'The current date is not the month Else mvarisleap = Leapflag' Enter is entered whether the month END IF IF (M
