Programing Reference For .Net,Java,C

  Many of the online spread Lunar source code, many, but there were no VB, halo, 
  So.    .    .    .    . 

  Usage: 
  L method to the beginning of the lunar calendar are to begin s methods are calendar 
  To the beginning of the two basic functions: 
  LInitDate: Date Lunar New Year in early target date of 
  SInitDate: calendar years beginning on the date of the object 

  Below other ways of looking at a small bar 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 Single 
  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 May 12, 2047, non-Runru 
  Debug.Print t.lYear 
  If t.IsLeap = False Then 
  Debug.Print t.lMonth 
Else
  Debug.Print "Run" & t.lMonth 
  End If 
  Debug.Print t.CDayStr (t.lDay) 'capital Chinese Lunar calendar 
  Debug.Print t.GanZhi (t.lYear) 'for Ganzhi 
  Debug.Print t.YearAttribute (t.lYear) 'Lunar New Year animal 
  Debug.Print t.sYear 'calendar year 
  Debug.Print t.sMonth 'calendar month 
  Debug.Print t.sDay 'calendar days 
  Debug.Print t.sWeekDay 'calendar week 
  Debug.Print t.Era (t.sYear) 'era calendar 
  Debug.Print t.Constellation (t.sMonth, t.sDay) 'Constellation 
  Debug.Print "Week:" & t.wHoliday 'by the first few weeks of holiday 
  Debug.Print "Solar" & t.sHoliday 'according to the calendar of holidays 
  Debug.Print "Lunar" & t.lHoliday 'calculated according to the lunar calendar holidays 
  Debug.Print t.lSolarTerm 'calculation cycle 

  'Following is the speed test, it quickly. 
  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
Next
  End With 
  'T.printf 
  Et = Timer 
  Debug.Print et - st 
  Set t = Nothing 
  End Sub 

  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 the value of the local variable attributes 
  Private mvarsYear As Long 'partial reproduction 
  Private mvarsMonth As Long 'partial reproduction 
  Private mvarsDay As Long 'partial reproduction 
  Private mvarlYear As Long 'partial reproduction 
  Private mvarlMonth As Long 'partial reproduction 
  Private mvarlDay As Long 'partial reproduction 
  Private mvarIsLeap As Boolean 'partial reproduction 
  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) As Integer 
  'Common definition of internal variables 
  Private SolarMonth As Variant 
  Private Gan As Variant 
  Private Zhi As Variant 
  Private Animals As Variant 
  Private SolarTerm As Variant 
  Private sTermInfo As Variant 
  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 'criteria for the use of internal date variable 

  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 VB-bit computing features, the expansion of the original data bits, turning it into 32 
  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, & 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 = Array (_ 
  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

  SolarMonth = Array (31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31) 
  Gan = Array ( "A" and "B" and "C" and "D", "E", "f", "G", "Xin", "Ren", "Kuei") 
  Zhi = Array ( "son", "ugly", "c" and "d" and "e", "vi", "afternoon", "no" and "Shen" and "unitary" and "xu", "hai ") 
  Animals = Array ( "mouse", "bull", "tigers", "rabbit", "Dragon", the "snake", "MA", "sheep", "monkey", "chicken" and "dog", "pigs ") 
  SolarTerm = Array ( "Xiao Han," "Dahan," "Beginning," "rain", "Jingzhe", "spring equinox," and "Ching Ming," "Guyu," "Lixia," "Xiaoman", "Wang Chong," "summer solstice , "" the teacher "," Dashu "," Liqiu, "" Chu Shu "," Bai Lu "," Autumnal Equinox, "" Cold Dew, "" Shuangjiang, "" dong "," snow "," Snow "and" Winter Solstice ") 
  STermInfo = Array (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 = Array ( "Day", "1", "two" and "three" and "four" and "five", "six", "7" and "8" and "9" and "10") 
  NStr2 = Array ( "early", "10", "20", "30", "") 
  MonthName = Array ( "JAN", "FEB", "MAR", "APR", "MAY", "JUN", "JUL", "AUG" and "SEP" and "OCT", "NOV", "DEC ") 

  'National calendar, a holiday festival * 
  SFtv = Array (_ 
  1, 1, 1, "New Year's Day" _ 
  2, 14, 0, "Valentine's Day", 2, 10, 0, "International Meteorological Day" _ 
  3, 18, 0, "Women's Day", 3, 12, 0, "Tree Planting Day", 3, 15, 0, "the interests of consumers," _ 
  4, 1, 0, "April Fool's Day" _ 
  5, 1, 1, "Labour Day", 5, 4, 0, "Youth Day", 5, 12, 0, "Hu Shi Jie", 5, 31, 0, "World No Tobacco Day" _ 
  6, 1, 0, "Children's Day" _ 
  7, 1, 0, "to commemorate the founding of the Hong Kong Reunification Festival" _ 
  8, 1, 0, "Army Day", 8, 8, 0, "China men Festival Father's Day" _ 
  9, 9, 0, "to commemorate the death of Mao Zedong", 9, 10, 0, "Teacher's Day", 9, 18, 0, "Mukden Incident Day", 9, 28, 0, "the birth of Confucius." _ 
  10, 1, 0, "National Day International Music Day," 10, 6, 0, "the Festival for the Elderly", 10, 24, 0, "United Nations Day" _ 
  11, 12, 0, "the birth of Dr. Sun Yat-sen Memorial" _ 
  12, 1, 0, "World AIDS Day", 12, 3, 0, "World Day of Disabled Persons", 12, 20, 0, "Macao's return to commemorate the" 12, 24, 0, "Christmas Eve", 12, 25, 0, "Christmas", 12, 26, 0, "the birth of Mao Zedong Memorial") 

  B = UBound (sFtv) + 1 
  ReDim sHolidayInfo (b / 4) 
  For i = 0 To (b / 4) - 1 
  SHolidayInfo (i). Month = sFtv (i * 4) 
  SHolidayInfo (i). SFtv Day = (1 + i * 4) 
  SHolidayInfo (i). Recess = sFtv (i * 4 + 2) 
  SHolidayInfo (i). HolidayName = sFtv (i * 4 + 3) 
Next

  'Lunar New Year festive holidays, * 
  LFtv = Array (_ 
  1, 1, 1, "Spring Festival" _ 
  1, 15, 0, "Lantern Festival" _ 
  5, 5, 0, "Dragon Boat Festival" _ 
  7, 7, 0, "Tanabata Valentine's Day" _ 
  7, 15, 0, "Ghost Festival Bon-odori Day" _ 
  8, 15, 0, "Mid-Autumn Festival" _ 
  9, 9, 0, "Chung Yeung Festival" _ 
  12, 8, 0, "laba" _ 
  12, 24, 0, "small") 
  '12, 31, 0, "New Year's Eve") 'New Year's Eve need to pay attention to other methods of calculation 

  B = UBound (lFtv) + 1 
  ReDim lHolidayInfo (b / 4) 
  For i = 0 To (b / 4) - 1 
  LHolidayInfo (i). Month = lFtv (i * 4) 
  LHolidayInfo (i). LFtv Day = (1 + i * 4) 
  LHolidayInfo (i). Recess = lFtv (i * 4 + 2) 
  LHolidayInfo (i). HolidayName = lFtv (i * 4 + 3) 
Next

  'On the first of a few weeks 
  WFtv = Array (_ 
  5, 2, 1, "International Mother's Day" _ 
  5, 3, 1, "National assistive Day" _ 
  6, 3, 1, "Father's Day" _ 
  9, 3, 3, the "International Day of Peace" _ 
  9, 4, 1, "International Deaf Day" _ 
  10, 1, 2, "international housing Day" _ 
  10, 1, 4, the "International Day for Natural Disaster mitigation" _ 
  11, 4, 5, "Thanksgiving Day") 
  B = UBound (wFtv) + 1 
  ReDim wHolidayInfo (b / 4) 
  For i = 0 To (b / 4) - 1 
  WHolidayInfo (i). Month = wFtv (i * 4) 
  WHolidayInfo (i). WFtv WeekAtMonth = (1 + i * 4) 
  WHolidayInfo (i). WeekDay = wFtv (i * 4 + 2)'1 representatives Sunday 
  WHolidayInfo (i). HolidayName = wFtv (i * 4 + 3) 
Next
  End Sub 
  '///////////////////////////////////////////////// ////////////////////////////////////////////////// ////////// 
  'Calculation of the Lunar New Year feasts 
  Public Property Get lSolarTerm () As String 
  '//===== A year of the first cycle of n for a few days (from the date of Xiaohan 0) 
  '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 ()) 
  '/ / Cycle 
  'STerm tmp1 = (y, m * 2) - 1 

  Dim baseDateAndTime As Date 
  Dim newDate As Date 
  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 basis, is not calculated by seconds, it will overflow 
  If Abs (DateDiff ( "d", newDate, mvarDate)) = 0 Then 
  TempStr = SolarTerm (i - 1) 
  Exit For 
  End If 
Next

  LSolarTerm = tempStr 
  End Property 
  'Calculated by the first few weeks of holiday week 
  Public Property Get wHoliday () As String 
  Dim w As Long 
  Dim i As Long 
  Dim b As Long 
  Dim FirstDay As Date 
  Dim tempStr As String 

  B = UBound (wHolidayInfo) 
  For i = 0 To b 
  If wHolidayInfo (i). Month = mvarsMonth Then 'in a time when 
  W = WeekDay (mvarDate) 
  If wHolidayInfo (i). WeekDay = w Then 'only a few weeks when the same time also 
  FirstDay mvarsMonth & = "/" & 1 & "/" & mvarsYear 'from 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

  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 (Or mvarlDay mvarlDay = 29 = 30) Then 
  '- 
  Oy = mvarlYear 'Save for the Lunar New Year 
  Odate = mvarDate 
  Ndate mvarDate + 1 = 
  Call sInitDate (Year (ndate) Month (ndate), Day (ndate)) 'attributes of the next day 
  If oy = mvarlYear - 1 Then 'If Lunar New Year, an increase of 1 
  TempStr = "New Year's Eve" 
  Call sInitDate (Year (odate) Month (odate), Day (odate)) 'return to the original data today 

  End If 
Else
  For i = 0 To b 
  If (lHolidayInfo (i). Month = mvarlMonth) _ And 
  (LHolidayInfo (i). MvarlDay Day =) Then 
  TempStr = lHolidayInfo (i). HolidayName 
  Exit For 
  End If 
Next
  End If 
  LHoliday = tempStr 
  End Property 
  'For holiday calendar 
  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). MvarsDay Day =) Then 
  TempStr = sHolidayInfo (i). HolidayName 
  Exit For 
  End If 
Next
  SHoliday = tempStr 
  End Property 
  'Is Lunar Runru 
  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 
  LYear = mvarlYear 
  End Property 
  Public Property Get sWeekDay () As Long 
  WeekDay sWeekDay = (mvarDate) 
  End Property 
  Public Property Get sDay () As Long 
  SDay = mvarsDay 
  End Property 
  Public Property 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 _ 
  (Day (Date) = d) Then 
  IsToday = True 
Else
  IsToday = False 
  End If 

  End Function 

  'Was calculated according to different years of what dynasties 
  Public Function Era (y As Long) As String 
  Dim tempStr As String 

  If y <1874 Then 
  TempStr = "unknown" 
Else
  If y <= 1908 Then 
  TempStr = "Qing Dynasty Emperor Guangxu" 
  Then If y = 1874 
  TempStr tempStr & = "Year" 
Else
  TempStr = tempStr & UpNumber (CStr (y - 1874)) & "" 
  End If 
Else
  If y <= 1910 Then 
  TempStr = "Qing Xuantong Period" 
  Then If y = 1909 
  TempStr tempStr & = "Year" 
Else
  TempStr = tempStr & UpNumber (CStr (y - 1909 + 1)) & "" 
  End If 
Else
  If y <1949 Then 
  TempStr = "Republic of China" 
  Then If y = 1912 
  TempStr tempStr & = "Year" 
Else
  TempStr = tempStr & UpNumber (CStr (y - 1912 + 1)) & "" 
  End If 
Else
  TempStr = "the founding of the PRC" 
  Then If y = 1949 
  TempStr tempStr & = "" 
Else
  Select Case y 
  Case 2000 
  TempStr = "New Millennium" 
  Case Else 
  TempStr = tempStr & UpNumber (CStr (y - 1949)) & "anniversary" 
  End Select 
  End If 
  End If 
  End If 
  End If 
  End If 

  Era = tempStr 
  End Function 
  'Num came back to Ganzhi, 0 = Jiazi 
  Public Function GanZhi (num As Long) As String 
  Dim tempStr As String 
  Dim i As Long 
  I = (num - 1864) Mod 60 'calculation Ganzhi 
  TempStr = Gan (i Mod 10) & Zhi (i Mod 12) 
  GanZhi = tempStr 
  End Function 
  'String of the animal 
  Public Function YearAttribute (y As Long) As String 
  Animals YearAttribute = ((y - 1900) Mod 12) 
  End Function 
  'Digital Han 
  Public Function UpNumber (Dxs As String) As String 
  'Detection empty 
  If Trim (Dxs) = "" Then 
  UpNumber = "" 
  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 + = "10" 
  End If 
  Case 3 
  If tempStr = "zero" Then 
  TempStr = "zero" 
Else
  TempStr tempStr + = "100" 
  End If 
  Case 4 
  If tempStr = "zero" Then 
  TempStr = "zero" 
Else
  TempStr tempStr + = "1000" 
  End If 
  Case 5 
  If tempStr = "zero" Then 
  TempStr = "10000" 
Else
  TempStr tempStr + = "10000" 
  End If 
  Case 6 
  If tempStr = "zero" Then 
  TempStr = "zero" 
Else
  TempStr tempStr + = "10" 
  End If 
  Case 7 
  If tempStr = "zero" Then 
  TempStr = "zero" 
Else
  TempStr tempStr + = "100" 
  End If 
  Case 8 
  If tempStr = "zero" Then 
  TempStr = "zero" 
Else
  TempStr tempStr + = "1000" 
  End If 
  Case 9 
  If tempStr = "zero" Then 
  TempStr = "100000000" 
Else
  TempStr tempStr + = "100000000" 
  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 "10000" 
  DXStr = DXStr 
  Case "billion" 
  DXStr = DXStr 
  Case Else 
  DXStr + = tempStr DXStr 
  End Select 
Else
  DXStr + = tempStr DXStr 
  End If 
Next

  UpNumber = DXStr 
  End Function 
  Private Function Converts (NumStr As String) As String 
  Select Case val (NumStr) 
  Case 0 
  Converts = "zero" 
  Case 1 
  Converts = "1" 
  Case 2 
  Converts = "2" 
  Case 3 
  Converts = "3" 
  Case 4 
  Converts = "4" 
  Case 5 
  Converts = "5" 
  Case 6 
  Converts = "6" 
  Case 7 
  Converts = "7" 
  Case 8 
  Converts = "8" 
  Case 9 
  Converts = "9" 
  End Select 
  End Function 
  'Chinese Date 
  Public Function CDayStr (d As Long) As String 
  Dim s As String 
  Select Case d 
  Case 0 
  S = "" 
  Case 10 
  S = "10th" 
  Case 20 
  S = "20" 
  Case 30 
  S = "30" 
  Case Else 
  S = nStr2 (d \ 10) 'integer division 
  S = s & nStr1 (d Mod 10) 
  End Select 
  CDayStr = s 
  End Function 
  'Attribution of Constellation 
  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 # # To 3/21/2003 # # 4/19/2000 
  ConstellName = "Baekyangsa" 
  Case # # To 4/20/2000 # # 5/20/2000 
  ConstellName = "Elegant" 
  Case # # To 5/21/2000 # # 6/21/2000 
  ConstellName = "Gemini" 
  Case # # To 6/22/2000 # # 7/22/2000 
  ConstellName = "Cancer" 
  Case # # To 7/23/2000 # # 8/22/2000 
  ConstellName = "lion" 
  Case # # To 8/23/2000 # # 9/22/2000 
  ConstellName = "virgin" 
  Case # # 10/23/2000 To 9/23/2000 # # 
  ConstellName = "scales" 
  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 = "Mount scorpion" 
  Case # # To 1/1/2000 # # 1/19/2000 
  ConstellName = "Mount scorpion" 
  Case # # To 1/20/2000 # # 2/18/2000 
  ConstellName = "bottle" 
  Case # # To 2/19/2000 # # 3/20/2000 
  ConstellName = "Pisces" 
  Case Else 
  ConstellName = "" 
  End Select 
  Constellation = ConstellName 
  End Function 
  '///////////////////////////////////////////////// ////////////////////////////////////////////////// ////// 
  'Following is the internal use of some type function 
  'Back to the Lunar y, the total number of days 
  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 
  'LunarInfo info = (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) 

  LunarYearDays lYearDays = (y - 1900) 'to calculate the number of days each year, and formed an array, in order to reduce the computing time after 
  End Function 
  'Back to the Lunar y m, the total number of days 
  Private Function lMonthDays (ByVal y As Long, ByVal m As Long) As Long 
  If (LunarInfo (y - 1900) And & H1000FFFF) And BitRight32 (& H10000, m) Then 
  LMonthDays = 30 
Else
  LMonthDays = 29 
  End If 
  End Function 
  'Lunar y back to the number of days in Runru 
  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 
  'Lunar y back to the 1-12 Run, which, not back to Run 0 
  Private 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 = i 
  End Function 
  'Calculation of the number of days calendar years 
  Private Function SolarDays (y As Long, m As Long) As Long 
  Dim d As Long 

  If (y Mod 4) = 0 Then 'leap year 
  Then If m = 2 
  D = 29 
Else
  D = SolarMonth (m - 1) 
  End If 
Else
  Then If m = 2 
  D = 28 
Else
  D = SolarMonth (m - 1) 
  End If 
  End If 

  SolarDays = d 
  End Function 

  '///////////////////////////////////////////////// ///////////////////////////////////////////////// 
'
  'The main function, using the calendar years beginning on the date of the objects, in the completion of this internal function object attribute private settings 
'
  '///////////////////////////////////////////////// ///////////////////////////////////////////////// 
  Public Sub sInitDate (ByVal y As Long, ByVal m As Long, ByVal d As Long) 
  Dim 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 part of the date of 
  Leap = 0 
  Temp = 0 

  Offset = mvarDate - 1/30/1900 # # 'calculation of the basic two-day gap 

  For i = 1900 To 2049 
  'Temp = lYearDays (i)' for the number of days that the Lunar New Year 

  Offset = offset - Temp 
  If offset <1 Then Exit For 
Next

  Offset = offset + Temp 
  MvarlYear = i 

  LeapMonth leap = (i) 'Run, which 
  MvarIsLeap = False 
  For i = 1 To 12 
  'Runru 
  If leap> And i = 0 (leap + 1) = False Then And mvarIsLeap 
  MvarIsLeap = True 
  I = i - 1 
  Temp = leapDays (mvarlYear) 'calculation of the number of days Runru 
Else
  Temp = lMonthDays (mvarlYear, i) 'calculation of the number of days non-Runru 
  End If 

  Offset = offset - Temp 
  If offset <= 0 Then Exit For 
Next

  Offset = offset + Temp 
  MvarlMonth = i 
  MvarlDay offset = 

  End Sub 
  '///////////////////////////////////////////////// ///////////////////////////////////////////////// 
'
  'The main function, with the Lunar New Year Date Date targets in early, in the completion of this internal function object attribute private settings 
'
  '///////////////////////////////////////////////// ///////////////////////////////////////////////// 
  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) 'for the number of days that the Lunar New Year 
  Offset = offset + Temp 
Next

  LeapMonth leap = (y) 'Run, which 
  If m <> leap Then 
  MvarIsLeap = False 'current date is not Runru 
Else
  MvarIsLeap = LeapFlag 'use of user input in whether Runru 
  End If 

  If (m <leap) Or (leap = 0) Then 'When the current date Runru 
  For i = 1 To m - 1 
  Temp = lMonthDays (y, i) 'calculation of the number of days non-Runru 
  Offset = offset + Temp 
Next
  Else 'after the Runru 
  If mvarIsLeap = False Then 'users in the calculation of non-Runru 
  For i = 1 To m - 1 
  Temp = lMonthDays (y, i) 'calculation of the number of days non-Runru 
  Offset = offset + Temp 
Next
  If m> leap Then 
  Temp = leapDays (y) 'calculation of the number of days Runru 
  Offset = offset + Temp 
  End If 

  Else 'at this time only mvarisleap = ture, 
  For i = 1 To m 
  Temp = lMonthDays (y, i) 'calculation of the number of days non-Runru 
  Offset = offset + Temp 
Next
  End If 
  End If 

  Offset = offset + d 'with the number of days the month 
  MvarDate = DateAdd ( "d", offset, # # 1/30/1900) 
  MvarsYear = Year (mvarDate) 
  MvarsMonth = Month (mvarDate) 
  MvarsDay = Day (mvarDate) 
  End Sub 
  'This module for printing from 1900-2049, the number of days in each of the Lunar and can be used in the beginning of the array of 
  'Public Sub printf () 
  'Dim i As Long, j As Long 
  'Dim temp (10) As Long 
  'Dim base As Long 

  'Base = 1900 
  'For i = 1 To 15 
  'For j = 1 To 10 
  'Temp (j - 1) = lYearDays ((i - 1) * 10 + (j - 1) + base)' for the number of days that the Lunar New Year 
  '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 

Tags: vb

Releated Articles

• Vb in achieving Mouse Gestures
• A revenue PDF printer (VB source)!
• VB can show that the preparation of a percentage of the progress since the definition of control
• VB: Making snow stunt scenes
• VB create cool personalized menu (2)