Ir para conteúdo

Arquivado

Este tópico foi arquivado e está fechado para novas respostas.

Patrique

Function Fases da lua

Por , em ASP Clássico

Recommended Posts

Patrique    0

Patrique
Postado

Fala ae galera, tudo tranquilo

 

Consegui umas funções aqui para montar um sistema de fases da lua completinho, e isto em asp é dificilimo de se conseguir.

 

Eu consegui as funções deste site aqui, note como é feito a montagem do sistema de fases da lua

 

http://www.spokanecity.org/services/wx/

 

Ele é bem completo, muito bom, porém eu consegui apenas as functions e não estou conseguindo fazer a montagem pois é muito complicado este source e infelismente eu não tenho gabarito para montar um negocio desse heheheh, portanto venho aqui pedi a ajudo dos amigos, gostaria de saber se alguma alma bondosa não poderia quebrar este galho e me ajudar sem contar que um script deste seria de grande valia para muitos desenvolvedores.

 

Olhem so o script das functions

 

<%
'****************************************************************************
*********************************************************************************
*******************************************
'*****	 Derived math functions not available in VBScript.	 ********************************************************************************
********************************************************
'****************************************************************************
*********************************************************************************
*******************************************
Function Sec(x)
  'Secant
  Sec = 1 / Cos(x)
End Function

Function Cosec(x)
  'Cosecant
  Cosec = 1 / Sin(x)
End Function

Function Cotan(x)
  'Cotangent
  Cotan = 1 / Tan(x)
End Function

Function Arcsin(x)
  'Inverse Sine
  Arcsin = Atn(x / Sqr(-x * x + 1))
End Function

Function Arccos(x)
  'Inverse Cosine
  Arccos = Atn(-x / Sqr(-x * x + 1)) + 2 * Atn(1)
End Function

Function Arcsec(x)
  'Inverse Secant
  Arcsec = Atn(x / Sqr(x * x - 1)) + Sgn((x) -1) * (2 * Atn(1))
End Function

Function Arccosec(x)
  'Inverse Cosecant
  Arccosec = Atn(x / Sqr(x * x - 1)) + (Sgn(x) - 1) * (2 * Atn(1))
End Function

Function Arccotan(x)
  'Inverse Cotangent
  Arccotan = Atn(x) + 2 * Atn(1)
End Function

Function HSin(x)
  'Hyperbolic Sine
  HSin = (Exp(x) - Exp(-x)) / 2 
End Function

Function HCos(x)
  'Hyperbolic Cosine
  HCos = (Exp(x) + Exp(-x)) / 2
End Function

Function HTan(x)
  'Hyperbolic Tangent
  HTan = (Exp(x) - Exp(-x)) / (Exp(x) + Exp(-x))
End Function

Function HSec(x)
  'Hyperbolic Secant
  HSec = 2 / (Exp(x) + Exp(-x))
End Function

Function HCosec(x)
  'Hyperbolic Cosecant
  HCosec = 2 / (Exp(x) - Exp(-x))
End Function

Function HCotan(x)
  'Hyperbolic Cotangent
  HCotan = (Exp(x) + Exp(-x)) / (Exp(x) - Exp(-x))
End Function

Function HArcsin(x)
  'Inverse Hyperbolic Sine
  HArcsin = Log(x + Sqr(x * x + 1))
End Function

Function HArccos(x)
  'Inverse Hyperbolic Cosine
  HArccos = Log(x + Sqr(x * x - 1))
End Function

Function HArctan(x)
  'Inverse Hyperbolic Tangent
  HArctan = Log((1 + x) / (1 - x)) / 2
End Function

Function HArcsec(x)
  'Inverse Hyperbolic Secant
  HArcsec = Log((Sqr(-x * x + 1) + 1) / x)
End Function

Function HArccosec(x)
  'Inverse Hyperbolic Cosecant
  HArccosec = Log((Sgn(x) * Sqr(x * x + 1) +1) / x)
End Function

Function HArccotan(x)
  'Inverse Hyperbolic Cotangent
  HArccotan(x) = Log((x + 1) / (x - 1)) / 2
End Function

Function LogN(x,baseN)
  'Logarithm to base N
  LogN(x) = Log(x) / Log(baseN)
End Function

Function RadDeg(x)
  'Radians to Degrees
  RadDeg =  x * (180 / (4 * Atn(1)))
End Function

Function DegRad(x)
  'Degrees to Radians
  DegRad = x * ((4 * Atn(1)) / 180)
End Function

Function ReduceAngle(x)
  'Reduce large angles to less than 360°
  ReduceAngle = x - 360 * Int(x / 360)
End Function

'****************************************************************************
*********************************************************************************
*******************************************
'*****	 Removes apostrophe's for use in SQL Strings.	 ********************************************************************************
*************************************************************
'****************************************************************************
*********************************************************************************
*******************************************
Function CheckApostrophes(vStr)
  CheckApostrophes = Replace(vStr,"'","''")
End Function

'****************************************************************************
*********************************************************************************
*******************************************
'*****	 Given a valid time, remove the seconds from the time value.	 ********************************************************************************
**********************************************
'****************************************************************************
*********************************************************************************
*******************************************
Function RemoveSeconds(vTime)
  Dim vTimeSeconds
  vTimeSeconds = Second(vTime)
  If vTimeSeconds < 10 Then vTimeSeconds = "0" & vTimeSeconds
  RemoveSeconds = Replace(vTime,":" & vTimeSeconds & " "," ")
End Function

'****************************************************************************
*********************************************************************************
*******************************************
'*****	 Given a default and preferred URL, return the preferred URL if not null.	 ********************************************************************************
*********************************
'****************************************************************************
*********************************************************************************
*******************************************
Function GetURL(vDefault,vURL)
  GetURL = vURL
  If IsNull(GetURL) = True Then 
	GetURL = vDefault
  ElseIf IsNumeric(vURL) = True Then
	Dim RsURL
	Set RsURL = Conn.Execute("SELECT URL FROM Links WHERE (ID = " & vURL & ")")
	GetURL = RsURL("URL")
	RsURL.Close
	Set RsURL = Nothing
  End If
End Function

'****************************************************************************
*********************************************************************************
*******************************************
'*****	 Given a valid date and date range, return true if the date falls in the range.	 ********************************************************************************
***************************
'****************************************************************************
*********************************************************************************
*******************************************
Function CheckDateRange(vDate,vDateFrom,vDateTo)
  CheckDateRange = False
  If CDate(vDate) >= CDate(vDateFrom) And CDate(vDate) <= CDate(vDateTo) Then CheckDateRange = True
End Function

'****************************************************************************
*********************************************************************************
*******************************************
'*****	 Given a news priority level, return the priority level color value.	 ********************************************************************************
**************************************
'****************************************************************************
*********************************************************************************
*******************************************
Function GetNewsFlashPriority(vPriority)
  '-------------------------------------
  'Priority level:
  '-------------------------------------
  'High	 1
  'Medium   2
  'Low	  3
  'Normal   4
  '-------------------------------------
  Select Case vPriority
	Case 1	GetNewsFlashPriority = "FF0000"
	Case 2	GetNewsFlashPriority = "FF9900"
	Case 3	GetNewsFlashPriority = "009900"
	Case Else GetNewsFlashPriority = "0000FF"
  End Select
End Function

'****************************************************************************
*********************************************************************************
*******************************************
'*****	 Given a valid date time value, return the date varification SQL string.	 ********************************************************************************
**********************************
'****************************************************************************
*********************************************************************************
*******************************************
Function VerifyDateTime(vDateTime)
  VerifyDateTime = "((StartDate <= '" & CDate(vDateTime) & "' AND EndDate >= '" & CDate(vDateTime) & "') OR (StartDate <= '" & CDate(vDateTime) & "' AND EndDate IS NULL))"
End Function

Function VerifyCaledarDateTime(vDateTime)
  VerifyDateTime = "((StartDate <= '" & CDate(vDateTime) & "' AND EndDate >= '" & CDate(vDateTime) & "') OR (StartDate = '" & DateValue(vDateTime) & "' AND EndDate IS NULL))"
End Function

Function VerifyArchiveDateTime(vDateTime)
  VerifyDateTime = "(StartDate <= '" & CDate(vDateTime) & "' AND EndDate < '" & CDate(vDateTime) & "')"
End Function

'****************************************************************************
*********************************************************************************
*******************************************
'*****	 Check that URLs contain "http://".'>http://".	 ********************************************************************************
***********************************************************************
'****************************************************************************
*********************************************************************************
*******************************************
Function CheckURL(vStr)
  CheckURL = Replace(vStr,"http://","")'>http://","")
  CheckURL = "http://" & CheckURL
  If CheckURL = "http://" Then CheckURL = Null
End Function

'****************************************************************************
*********************************************************************************
*******************************************
'*****	 Checks for null strings for use in SQL strings.	 ********************************************************************************
**********************************************************
'****************************************************************************
*********************************************************************************
*******************************************
Function CheckNulls(vStr,vType)
  CheckNulls = "NULL"
  If vStr <> "" Then 
	CheckNulls = vStr
	If vType = "text" Then CheckNulls = "'" & CheckApostrophes(CheckNulls) & "'"
  End If
End Function

'****************************************************************************
*********************************************************************************
*******************************************
'*****	 Builds and removes HTML (P tags only) to add and edit forms.	 ********************************************************************************
*********************************************
'****************************************************************************
*********************************************************************************
*******************************************
Function CheckHTML(vStr,cType)
  If vStr <> "" And cType = "HTML" Then
	CheckHTML = Replace(vStr,vbCrLf & vbCrLf,"</p><p>")
	CheckHTML = Replace(CheckHTML,"<p>" & vbCrLf,"<p>")
	CheckHTML = "<p>" & CheckHTML & "</p>"
	CheckHTML = Replace(CheckHTML,"<p></p>","")
	CheckHTML = Replace(CheckHTML,vbCrLf,"")
	CheckHTML = Replace(CheckHTML,"</p><p>","</p>" & vbCrLf & "<p>")
  ElseIf vStr <> "" Then
	CheckHTML = Replace(vStr,"</p>" & vbCrLf & "<p>",vbCrLf & vbCrLf)
	CheckHTML = Right(CheckHTML,(Len(CheckHTML) - 3))
	CheckHTML = Left(CheckHTML,(Len(CheckHTML) - 4))
  End If
End Function

'****************************************************************************
*********************************************************************************
*******************************************
'*****	 Given an interger, return a random number.	 ********************************************************************************
***************************************************************
'****************************************************************************
*********************************************************************************
*******************************************
Function GetRandomNum(vMaxNums)
  randomize
  GetRandomNum = Int((Int(vMaxNums) - 1 + 1) * Rnd + 1)
End Function

'****************************************************************************
*********************************************************************************
*******************************************
'*****	 Given a valid month and year, get the last day of the given month.	 ********************************************************************************
***************************************
'****************************************************************************
*********************************************************************************
*******************************************
Function GetLastMonthDay(vMonth,vYear)
  GetLastMonthDay = DateAdd("d",-1,DateAdd("m",1,CDate(vMonth & "/1/" & vYear)))
End Function

'****************************************************************************
*********************************************************************************
*******************************************
'*****	 Given a valid date, is the year a leap year.	 ********************************************************************************
*************************************************************
'****************************************************************************
*********************************************************************************
*******************************************
Function IsLeapYear(vDate)
  IsLeapYear = False
  If Day(DateAdd("d",-1,"3/1/" & Year(vDate))) = 29 Then IsLeapYear = True
End Function

'****************************************************************************
*********************************************************************************
*******************************************
'*****	 Given two points on the Earth, find the geodesic distance (±150 meters).	 ********************************************************************************
*********************************
'****************************************************************************
*********************************************************************************
*******************************************
Function GetGeodesicDistance(Lat1,Lon1,Lat2,Lon2,rScale)
  Dim er,pr,fl,F,G,L,S,C,W,R,D,H1,H2
  er = 6378.1370000 
  pr = 6356.7523142 
  fl = (er - pr) / er 
  F = (DegRad(Lat1) + DegRad(Lat2)) / 2
  G = (DegRad(Lat1) - DegRad(Lat2)) / 2
  L = (DegRad(Lon1) - DegRad(Lon2)) / 2
  S = Sin(G)^2 * Cos(L)^2 + Cos(F)^2 * Sin(L)^2
  C = Cos(G)^2 * Cos(L)^2 + Sin(F)^2 * Sin(L)^2
  W = Atn(Sqr(S / C))
  R = Sqr(S * C) / W
  D = 2 * W * er
  H1 = (3 * R - 1) / (2 * C)
  H2 = (3 * R + 1) / (2 * S)
  Select Case rScale
	Case "statute"  dScale = 1.60934
	Case "nautical" dScale = 1.85200
	Case "metric"   dScale = 1.00000
	Case Else	   dScale = 1.60934
  End Select
  GetGeodesicDistance = (D * (1 + fl * H1 * Sin(F)^2 * Cos(G)^2 - fl * H2 * Cos(F)^2 * Sin(G)^2)) / dScale
End Function

'****************************************************************************
*********************************************************************************
*******************************************
'*****	 Given a valid date, get the current season.	 ********************************************************************************
**************************************************************
'****************************************************************************
*********************************************************************************
*******************************************
Function GetSeason(vDate)
  Dim MarEqu,JunSol,SepEqu,DecSol
  MarEqu = GetMarEqu(Year(vDate))
  JunSol = GetJunSol(Year(vDate))
  SepEqu = GetSepEqu(Year(vDate))
  DecSol = GetDecSol(Year(vDate))
  If CDate(vDate) < DateValue(JunSol) And CDate(vDate) >= DateValue(MarEqu) Then
	GetSeason = "Spring"
  ElseIf CDate(vDate) < DateValue(SepEqu) And CDate(vDate) >= DateValue(JunSol) Then
	GetSeason = "Summer"
  ElseIf CDate(vDate) < DateValue(DecSol) And CDate(vDate) >= DateValue(SepEqu) Then
	GetSeason = "Autum"
  Else
	GetSeason = "Winter"
  End If
End Function

'****************************************************************************
*********************************************************************************
*******************************************
'*****	 Given a valid date, get the March Equinox (first day of Spring).	 ********************************************************************************
*****************************************
'****************************************************************************
*********************************************************************************
*******************************************
Function GetMarEqu(vYear)
  Dim Y
  Y = ((vYear - 2000) / 1000)
  If vYear > -999 And vYear < 1000 Then
	GetMarEqu = FormatNumber(1721139.29189 + (365242.13740 * Y) + (0.06134 * Y^2) - (0.00111 * Y^3) - (0.00071 * Y^4),5,0,0,0)
  ElseIf vYear > 999 And vYear < 3000 Then
	GetMarEqu = FormatNumber(2451623.80984 + (365242.37404 * Y) + (0.05169 * Y^2) - (0.00411 * Y^3) - (0.00057 * Y^4),5,0,0,0)
  End If
  GetMarEqu = CDate(GetSeasonDay(GetMarEqu))
End Function

'****************************************************************************
*********************************************************************************
*******************************************
'*****	 Given a valid date, get the June Solstice (first day of Summer).	 ********************************************************************************
*****************************************
'****************************************************************************
*********************************************************************************
*******************************************
Function GetJunSol(vYear)
  Dim Y
  Y = ((vYear - 2000) / 1000)
  If vYear > -999 And vYear < 1000 Then
	GetJunSol = FormatNumber(1721233.25401 + (365241.72562 * Y) + (0.05323 * Y^2) - (0.00907 * Y^3) - (0.00025 * Y^4),5,0,0,0)
  ElseIf vYear > 999 And vYear < 3000 Then
	GetJunSol = FormatNumber(2451716.56767 + (365241.62603 * Y) + (0.00325 * Y^2) + (0.00888 * Y^3) - (0.00030 * Y^4),5,0,0,0)
  End If
  GetJunSol = CDate(GetSeasonDay(GetJunSol))
End Function  

'****************************************************************************
*********************************************************************************
*******************************************
'*****	 Given a valid date, get the September Equinox (first day of Autum).	 ********************************************************************************
**************************************
'****************************************************************************
*********************************************************************************
*******************************************
Function GetSepEqu(vYear)
  Dim Y
  Y = ((vYear - 2000) / 1000)
  If vYear > -999 And vYear < 1000 Then
	GetSepEqu = FormatNumber(1721325.70455 + (365242.49558 * Y) + (0.11677 * Y^2) - (0.00297 * Y^3) - (0.00074 * Y^4),5,0,0,0)
  ElseIf vYear > 999 And vYear < 3000 Then
	GetSepEqu = FormatNumber(2451810.21715 + (365242.01767 * Y) - (0.11575 * Y^2) + (0.00337 * Y^3) + (0.00078 * Y^4),5,0,0,0)
  End If
  GetSepEqu = CDate(GetSeasonDay(GetSepEqu))
End Function  

'****************************************************************************
*********************************************************************************
*******************************************
'*****	 Given a valid date, get the December Solstice (first day of Winter).	 ********************************************************************************
*************************************
'****************************************************************************
*********************************************************************************
*******************************************
Function GetDecSol(vYear)
  Dim Y
  Y = ((vYear - 2000) / 1000)
  If vYear > -999 And vYear < 1000 Then
	GetDecSol = FormatNumber(1721414.39987 + (365242.88257 * Y) + (0.00769 * Y^2) - (0.00933 * Y^3) - (0.00006 * Y^4),5,0,0,0)
  ElseIf vYear > 999 And vYear < 3000 Then
	GetDecSol = FormatNumber(2451900.05952 + (365242.74049 * Y) - (0.06223 * Y^2) - (0.00823 * Y^3) + (0.00032 * Y^4),5,0,0,0)
  End If
  GetDecSol = CDate(GetSeasonDay(GetDecSol))
End Function

'****************************************************************************
*********************************************************************************
*******************************************
'*****	 Given an instance of "mean" equinox or solstice, calculate the Julian Ephemeris Day and return it as a calendar date and time (±30 seconds).	 *********************************************
'****************************************************************************
*********************************************************************************
*******************************************
Function GetSeasonDay(SeasonDay)
  Dim T,W,DL,S,JDE
  T = Round((SeasonDay - 2451545.0) / 36525,9)
  W = (DegRad(35999.37) * T) - DegRad(2.47)
  DL = Round(1 + 0.0334 * Cos(W) + 0.0007 * Cos(2 * W),4)
  S = 485 * Cos(DegRad(324.96) + (DegRad(  1934.136) * T)) _
	+ 203 * Cos(DegRad(337.23) + (DegRad( 32964.467) * T)) _
	+ 199 * Cos(DegRad(342.08) + (DegRad(	20.186) * T)) _
	+ 182 * Cos(DegRad( 27.85) + (DegRad(445267.112) * T)) _
	+ 156 * Cos(DegRad( 73.14) + (DegRad( 45036.886) * T)) _
	+ 136 * Cos(DegRad(171.52) + (DegRad( 22518.443) * T)) _
	+  77 * Cos(DegRad(222.54) + (DegRad( 65928.934) * T)) _
	+  74 * Cos(DegRad(296.72) + (DegRad(  3034.906) * T)) _
	+  70 * Cos(DegRad(243.58) + (DegRad(  9037.513) * T)) _
	+  58 * Cos(DegRad(119.81) + (DegRad( 33718.147) * T)) _
	+  52 * Cos(DegRad(297.17) + (DegRad(   150.678) * T)) _
	+  50 * Cos(DegRad( 21.02) + (DegRad(  2281.226) * T)) _
	+  45 * Cos(DegRad(247.54) + (DegRad( 29929.562) * T)) _
	+  44 * Cos(DegRad(325.15) + (DegRad( 31555.956) * T)) _
	+  29 * Cos(DegRad( 60.93) + (DegRad(  4443.417) * T)) _
	+  18 * Cos(DegRad(155.12) + (DegRad( 67555.328) * T)) _
	+  17 * Cos(DegRad(288.79) + (DegRad(  4562.452) * T)) _
	+  16 * Cos(DegRad(198.04) + (DegRad( 62894.029) * T)) _
	+  14 * Cos(DegRad(199.76) + (DegRad( 31436.921) * T)) _
	+  12 * Cos(DegRad( 95.39) + (DegRad( 14577.848) * T)) _
	+  12 * Cos(DegRad(287.11) + (DegRad( 31931.756) * T)) _
	+  12 * Cos(DegRad(320.81) + (DegRad( 34777.259) * T)) _
	+   9 * Cos(DegRad(227.73) + (DegRad(  1222.114) * T)) _
	+   8 * Cos(DegRad( 15.45) + (DegRad( 16859.074) * T))
  JDE = Round(SeasonDay + ((0.00001 * S) / DL),5)
  GetSeasonDay = GetCalendarDate(JDE)
End Function

'****************************************************************************
*********************************************************************************
*******************************************
'*****	 Convert calendar date/time to Julian Day.	 ********************************************************************************
****************************************************************
'****************************************************************************
*********************************************************************************
*******************************************
Function GetJulianDay(vDateTime)
  Dim gY,gM,gD,gA,gB
  gY = Year(vDateTime)
  gM = Month(vDateTime)
  gD = Day(vDateTime) + (Hour(vDateTime) / 24) + (Minute(vDateTime) / 1440) + (Second(vDateTime) / 86400)
  If gM = 1 Or gM = 2 Then
	gM = gM + 12
	gY = gY - 1
  End If
  gA = Int(gY / 100)
  gB = 2 - gA + Int(gA / 4)
  GetJulianDay = Int(365.25 *(gY + 4716)) + Int(30.6001 * (gM + 1)) + gD + gB - 1524.5
End Function

'****************************************************************************
*********************************************************************************
*******************************************
'*****	 Convert Julian Day to calendar date/time.	 ********************************************************************************
****************************************************************
'****************************************************************************
*********************************************************************************
*******************************************
Function GetCalendarDate(JDE)
  Dim JDEint,JDEdec,A,B,C,D,E,jD,jM,jY,jHrs,jMin,jSec
  JDE = JDE + 0.5
  JDEint = Int(JDE)
  JDEdec = Round(JDE - JDEint,5)
  If JDEint < 2299161 Then
	A = JDEint
  ElseIf JDEint >= 2291161 Then
	A = Int((JDEint - 1867216.25) / 36524.25)
	A = JDEint + 1 + A - Int(A / 4)
  End If
  B = A + 1524
  C = Int((B - 122.1) / 365.25)
  D = Int(365.25 * C)
  E = Int((B - D) / 30.6001)
  jD = B - D - Int(30.6001 * E) + JDEdec
  If E < 14 Then
	jM = E - 1
  ElseIf E = 14 Or E = 15 Then
	jM = E - 13
  End If
  If jM > 2 Then
	jY = C - 4716
  ElseIf jM = 1 Or jM = 2 Then
	jY = C - 4715
  End If
  jHrs = (jD - Int(jD)) * 24
  jMin = (jHrs - Int(jHrs)) * 60
  jSec = (jMin - Int(jMin)) * 60
  GetCalendarDate = jM & "/" & Int(jD) & "/" & jY & " " & Int(jHrs) & ":" & Int(jMin) & ":" & Int(jSec)
End Function

'****************************************************************************
*********************************************************************************
*******************************************
'*****	 Given a valid date/time, return the illuminated fraction of the Moon's disk.	 ********************************************************************************
*****************************
'****************************************************************************
*********************************************************************************
*******************************************
Function GetMoonIllumination(vDateTime)
  Dim JDE,T,D,M,M1,i
  JDE = GetJulianDay(vDateTime)
  T = (JDE - 2451545) / 36525
  D = ReduceAngle(297.8501921 + 445267.1114043 * T - 0.0018819 * T^2 + T^3 / 545868 - T^4 / 113065000)
  M = ReduceAngle(357.5291092 + 35999.0502909 * T - 0.0001536 * T^2 + T^3 / 24490000)
  M1 = ReduceAngle(134.9633964 + 477198.8675055 * T + 0.0087414 * T^2 + T^3 / 69699 - T^4 / 14712000)
  i = 180 - D - 6.289 * Sin(DegRad(M1)				) _
			  + 2.100 * Sin(DegRad(M)				 ) _
			  - 1.274 * Sin(2 * DegRad(D) - DegRad(M1)) _
			  - 0.658 * Sin(2 * DegRad(D)			 ) _
			  - 0.214 * Sin(2 * DegRad(M1)			) _
			  - 0.110 * Sin(DegRad(D)				 )
  GetMoonIllumination = (1 + Cos(DegRad(i))) / 2
End Function

'****************************************************************************
*********************************************************************************
*******************************************
'*****	 Given a valid date/time, calculate the current phase or phase date of the Moon (±14 seconds).	 ********************************************************************************
**************************
'****************************************************************************
*********************************************************************************
*******************************************
Function GetMoonPhase(vDateTime,vType)
  Dim k,NewMoon,FirstQuarter,FullMoon,LastQuarter,MoonPhaseDate,MoonPhase
  k = Int((GetDecimalYear(vDateTime) - 2000) * 12.3685)
  NewMoon	  = CalculateMoonPhaseDate(k)
  FirstQuarter = CalculateMoonPhaseDate(k + 0.25)
  FullMoon	 = CalculateMoonPhaseDate(k + 0.50)
  LastQuarter  = CalculateMoonPhaseDate(k + 0.75)
  If CDate(DateValue(vDateTime)) >= CDate(DateValue(NewMoon)) And CDate(DateValue(vDateTime)) < CDate(DateValue(FirstQuarter)) Then
	If CDate(DateValue(vDateTime)) = CDate(DateValue(NewMoon)) Or vType = "major" Then 
	  MoonPhaseDate = NewMoon
	  MoonPhase = "New Moon"
	Else
	  MoonPhaseDate = NewMoon
	  MoonPhase = "Waxing Crescent"
	End If
  ElseIf CDate(DateValue(vDateTime)) >= CDate(DateValue(FirstQuarter)) And CDate(DateValue(vDateTime)) < CDate(DateValue(FullMoon)) Then
	If CDate(DateValue(vDateTime)) = CDate(DateValue(FirstQuarter)) Or vType = "major" Then 
	  MoonPhaseDate = FirstQuarter
	  MoonPhase = "First Quarter"
	Else
	  MoonPhaseDate = FirstQuarter
	  MoonPhase = "Waxing Gibbous"
	End If
  ElseIf CDate(DateValue(vDateTime)) >= CDate(DateValue(FullMoon)) And CDate(DateValue(vDateTime)) < CDate(DateValue(LastQuarter)) Then
	If CDate(DateValue(vDateTime)) = CDate(DateValue(FullMoon)) Or vType = "major" Then 
	  MoonPhaseDate = FullMoon
	  If Month(CalculateMoonPhaseDate((k - 1) + 0.50)) = Month(FullMoon) Then
		MoonPhase = "Full (Blue) Moon"
	  Else	  
		Select Case Month(FullMoon)
		  Case 1  MoonPhase = "Full (Wolf) Moon"
		  Case 2  MoonPhase = "Full (Snow) Moon"
		  Case 3  MoonPhase = "Full (Worm) Moon"
		  Case 4  MoonPhase = "Full (Pink) Moon"
		  Case 5  MoonPhase = "Full (Flower) Moon"
		  Case 6  MoonPhase = "Full (Strawberry) Moon"
		  Case 7  MoonPhase = "Full (Buck) Moon"
		  Case 8  MoonPhase = "Full (Sturgeon) Moon"
		  Case 9  MoonPhase = "Full (Harvest) Moon"
		  Case 10 MoonPhase = "Full (Hunter's) Moon"
		  Case 11 MoonPhase = "Full (Beaver) Moon"
		  Case 12 MoonPhase = "Full (Cold) Moon"
		End Select
	  End If
	Else 
	  MoonPhaseDate = FullMoon
	  MoonPhase = "Waning Gibbous"
	End If
  Else
	If CDate(DateValue(vDateTime)) = CDate(DateValue(LastQuarter)) Or vType = "major" Then
	  MoonPhaseDate = LastQuarter
	  MoonPhase = "Last Quarter"
	Else
	  MoonPhaseDate = LastQuarter
	  MoonPhase = "Waning Crescent"
	End If
  End If
  If LCase(vType) = "phase" Then
	GetMoonPhase = MoonPhase
  Else
	GetMoonPhase = MoonPhaseDate
  End If
End Function

'****************************************************************************
*********************************************************************************
*******************************************
'*****	 Given a valid date/time, calculate the corresponding decimal year value (to the second).	 ********************************************************************************
*****************
'****************************************************************************
*********************************************************************************
*******************************************
Function GetDecimalYear(vDateTime)
  GetDecimalYear = Year(vDateTime) + DateDiff("s","1/1/" & Year(vDateTime) & " " & Hour(vDateTime) & ":" & Minute(vDateTime) & ":" & Second(vDateTime),vDateTime) / DateDiff("s","1/1/" & Year(vDateTime),"1/1/" & (Year(vDateTime) + 1))
End Function

'****************************************************************************
*********************************************************************************
*******************************************
'*****	 Given value k, calculate the date of the phase of the Moon.	 ********************************************************************************
**********************************************
'****************************************************************************
*********************************************************************************
*******************************************
Function CalculateMoonPhaseDate(k)
  Dim T,JDE,E,M,M1,F,Omega
  T = k / 1236.85
  JDE = 2451550.09766 + 29.530588861   * k   _
					  +  0.00015437	* T^2 _
					  -  0.000000150   * T^3 _
					  +  0.00000000073 * T^4
  E = 1 - 0.002516 * T - 0.0000074 * T^2
  M = 2.5534 + 29.10535670 * k   _
			 -  0.0000014  * T^2 _
			 -  0.00000011 * T^3
  M1 = 201.5643 + 385.81693528  * k   _
				+   0.0107582   * T^2 _
				+   0.00001238  * T^3 _
				-   0.000000058 * T^4
  F = 160.7108 + 390.67050284  * k   _
			   -   0.0016118   * T^2 _
			   -   0.00000227  * T^3 _
			   +   0.000000011 * T^4
  Omega = 124.7746 - 1.56375588 * k   _
				   + 0.0020672  * T^2 _
				   + 0.00000215 * T^3
  If (k - Int(k)) = 0 Then
	CalculateMoonPhaseDate = GetCalendarDate(JDE + Round(GetFirstMoonCorrections("new",E,F,M,M1,Omega),5) + Round(GetSecondMoonCorrections(k,T),5))
  ElseIf (k - Int(k)) = 0.25 Then
	CalculateMoonPhaseDate = GetCalendarDate(JDE + Round(GetFirstMoonCorrections("first",E,F,M,M1,Omega),5) + Round(GetQuarterMoonCorrections("first",E,M,M1,F),5) + Round(GetSecondMoonCorrections(k,T),5))
  ElseIf (k - Int(k)) = 0.50 Then
	CalculateMoonPhaseDate = GetCalendarDate(JDE + Round(GetFirstMoonCorrections("full",E,F,M,M1,Omega),5) + Round(GetSecondMoonCorrections(k,T),5))
  ElseIf (k - Int(k)) = 0.75 Then
	CalculateMoonPhaseDate = GetCalendarDate(JDE + Round(GetFirstMoonCorrections("last",E,F,M,M1,Omega),5) + Round(GetQuarterMoonCorrections("last",E,M,M1,F),5) + Round(GetSecondMoonCorrections(k,T),5))
  End If
End Function

'****************************************************************************
*********************************************************************************
*******************************************
'*****	 For Moon Phase Function - Calculate the Quarter Moon set of corrections (in days) to add the the JDE.	 ********************************************************************************
****
'****************************************************************************
*********************************************************************************
*******************************************
Function GetQuarterMoonCorrections(vPhase,E,M,M1,F)
  GetQuarterMoonCorrections = 0.00306 - 0.00038 * E * Cos(DegRad(M)) + 0.00026 * Cos(DegRad(M1)) - 0.00002 * Cos(DegRad(M1) - DegRad(M)) + 0.00002 * Cos(DegRad(M1) + DegRad(M)) + 0.00002 * Cos(2 * DegRad(F))
  If LCase(vPhase) = "first" Then
	GetQuarterMoonCorrections = +GetQuarterMoonCorrections 
  ElseIf LCase(vPhase) = "last" Then
	GetQuarterMoonCorrections = -GetQuarterMoonCorrections
  End If
End Function

'****************************************************************************
*********************************************************************************
*******************************************
'*****	 For Moon Phase Function - Calculate the first set of corrections (in days) to add the the JDE.	 ********************************************************************************
***********
'****************************************************************************
*********************************************************************************
*******************************************
Function GetFirstMoonCorrections(vPhase,E,F,M,M1,Omega)
  If LCase(vPhase) = "new" Then
	GetFirstMoonCorrections = -0.40720 *	   Sin(DegRad(M1)							) _
							  +0.17241 * E   * Sin(DegRad(M)							 ) _
							  +0.01608 *	   Sin(2 * DegRad(M1)						) _
							  +0.01039 *	   Sin(2 * DegRad(F)						 ) _
							  +0.00739 * E   * Sin(DegRad(M1) - DegRad(M)				) _
							  -0.00514 * E   * Sin(DegRad(M1) + DegRad(M)				) _
							  +0.00208 * E^2 * Sin(2 * DegRad(M)						 ) _
							  -0.00111 *	   Sin(DegRad(M1) - 2 * DegRad(F)			) _
							  -0.00057 *	   Sin(DegRad(M1) + 2 * DegRad(F)			) _
							  +0.00056 * E   * Sin(2 * DegRad(M1) + DegRad(M)			) _
							  -0.00042 *	   Sin(3 * DegRad(M1)						) _
							  +0.00042 * E   * Sin(DegRad(M) + 2 * DegRad(F)			 ) _
							  +0.00038 * E   * Sin(DegRad(M) - 2 * DegRad(F)			 ) _
							  -0.00024 * E   * Sin(2 * DegRad(M1) - DegRad(M)			) _
							  -0.00017 *	   Sin(DegRad(Omega)						 ) _
							  -0.00007 *	   Sin(DegRad(M1) + 2 * DegRad(M)			) _
							  +0.00004 *	   Sin(2 * DegRad(M1) - 2 * DegRad(F)		) _
							  +0.00004 *	   Sin(3 * DegRad(M)						 ) _
							  +0.00003 *	   Sin(DegRad(M1) + DegRad(M) - 2 * DegRad(F)) _
							  +0.00003 *	   Sin(2 * DegRad(M1) + 2 * DegRad(F)		) _
							  -0.00003 *	   Sin(DegRad(M1) + DegRad(M) + 2 * DegRad(F)) _
							  +0.00003 *	   Sin(DegRad(M1) - DegRad(M) + 2 * DegRad(F)) _
							  -0.00002 *	   Sin(DegRad(M1) - DegRad(M) - 2 * DegRad(F)) _
							  -0.00002 *	   Sin(3 * DegRad(M1) + DegRad(M)			) _
							  +0.00002 *	   Sin(4 * DegRad(M1)						)
  ElseIf  LCase(vPhase) = "full" Then
	GetFirstMoonCorrections = -0.40614 *	   Sin(DegRad(M1)							) _
							  +0.17302 * E   * Sin(DegRad(M)							 ) _
							  +0.01614 *	   Sin(2 * DegRad(M1)						) _
							  +0.01043 *	   Sin(2 * DegRad(F)						 ) _
							  +0.00734 * E   * Sin(DegRad(M1) - DegRad(M)				) _
							  -0.00515 * E   * Sin(DegRad(M1) + DegRad(M)				) _
							  +0.00209 * E^2 * Sin(2 * DegRad(M)						 ) _
							  -0.00111 *	   Sin(DegRad(M1) - 2 * DegRad(F)			) _
							  -0.00057 *	   Sin(DegRad(M1) + 2 * DegRad(F)			) _
							  +0.00056 * E   * Sin(2 * DegRad(M1) + DegRad(M)			) _
							  -0.00042 *	   Sin(3 * DegRad(M1)						) _
							  +0.00042 * E   * Sin(DegRad(M) + 2 * DegRad(F)			 ) _
							  +0.00038 * E   * Sin(DegRad(M) - 2 * DegRad(F)			 ) _
							  -0.00024 * E   * Sin(2 * DegRad(M1) - DegRad(M)			) _
							  -0.00017 *	   Sin(DegRad(Omega)						 ) _
							  -0.00007 *	   Sin(DegRad(M1) + 2 * DegRad(M)			) _
							  +0.00004 *	   Sin(2 * DegRad(M1) - 2 * DegRad(F)		) _
							  +0.00004 *	   Sin(3 * DegRad(M)						 ) _
							  +0.00003 *	   Sin(DegRad(M1) + DegRad(M) - 2 * DegRad(F)) _
							  +0.00003 *	   Sin(2 * DegRad(M1) + 2 * DegRad(F)		) _
							  -0.00003 *	   Sin(DegRad(M1) + DegRad(M) + 2 * DegRad(F)) _
							  +0.00003 *	   Sin(DegRad(M1) - DegRad(M) + 2 * DegRad(F)) _
							  -0.00002 *	   Sin(DegRad(M1) - DegRad(M) - 2 * DegRad(F)) _
							  -0.00002 *	   Sin(3 * DegRad(M1) + DegRad(M)			) _
							  +0.00002 *	   Sin(4 * DegRad(M1)						)
  Else
	GetFirstMoonCorrections = -0.62801 *	   Sin(DegRad(M1)							) _
							  +0.17172 * E   * Sin(DegRad(M)							 ) _
							  -0.01183 * E   * Sin(DegRad(M1) + DegRad(M)				) _
							  +0.00862 *	   Sin(2 * DegRad(M1)						) _
							  +0.00804 *	   Sin(2 * DegRad(F)						 ) _
							  +0.00454 * E   * Sin(DegRad(M1) - DegRad(M)				) _
							  +0.00204 * E^2 * Sin(2 * DegRad(M)						 ) _
							  -0.00180 *	   Sin(DegRad(M1) - 2 * DegRad(F)			) _
							  -0.00070 *	   Sin(DegRad(M1) + 2 * DegRad(F)			) _
							  -0.00040 *	   Sin(3 * DegRad(M1)						) _
							  -0.00034 * E   * Sin(2 * DegRad(M1) - DegRad(M)			) _
							  +0.00032 * E   * Sin(DegRad(M) + 2 * DegRad(F)			 ) _
							  +0.00032 * E   * Sin(DegRad(M) - 2 * DegRad(F)			 ) _
							  -0.00028 * E^2 * Sin(DegRad(M1) + 2 * DegRad(M)			) _
							  +0.00027 * E   * Sin(2 * DegRad(M1) + DegRad(M)			) _
							  -0.00017 *	   Sin(DegRad(Omega)						 ) _
							  -0.00005 *	   Sin(DegRad(M1) - DegRad(M) - 2 * DegRad(F)) _
							  +0.00004 *	   Sin(2 * DegRad(M1) + 2 * DegRad(F)		) _
							  -0.00004 *	   Sin(DegRad(M1) + DegRad(M) + 2 * DegRad(F)) _
							  +0.00004 *	   Sin(DegRad(M1) - 2 * DegRad(M)			) _
							  +0.00003 *	   Sin(DegRad(M1) + DegRad(M) - 2 * DegRad(F)) _
							  +0.00003 *	   Sin(3 * DegRad(M)						 ) _
							  +0.00002 *	   Sin(2 * DegRad(M1) - 2 * DegRad(F)		) _
							  +0.00002 *	   Sin(DegRad(M1) - DegRad(M) + 2 * DegRad(F)) _
							  -0.00002 *	   Sin(3 * DegRad(M1) + DegRad(M)			)
  End If	
End Function

'****************************************************************************
*********************************************************************************
*******************************************
'*****	 For Moon Phase Function - Calculate the second set of corrections (in days) to add the the JDE.	 ********************************************************************************
**********
'****************************************************************************
*********************************************************************************
*******************************************
Function GetSecondMoonCorrections(k,T)
  Dim A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,A13,A14
  A1  = 299.77 +  0.107408 * k - 0.009173 * T^2
  A2  = 251.88 +  0.016321 * k
  A3  = 251.83 + 26.651886 * k
  A4  = 349.42 + 36.412478 * k
  A5  =  84.66 + 18.206239 * k
  A6  = 141.74 + 53.303771 * k
  A7  = 207.14 +  2.453732 * k
  A8  = 154.84 +  7.306860 * k
  A9  =  34.52 + 27.261239 * k
  A10 = 207.19 +  0.121824 * k
  A11 = 291.34 +  1.844379 * k
  A12 = 161.72 + 24.198154 * k
  A13 = 239.56 + 25.513099 * k
  A14 = 331.55 +  3.592518 * k
  GetSecondMoonCorrections = + 0.000325 * Sin(DegRad(A1) ) _
							 + 0.000165 * Sin(DegRad(A2) ) _
							 + 0.000164 * Sin(DegRad(A3) ) _
							 + 0.000126 * Sin(DegRad(A4) ) _
							 + 0.000110 * Sin(DegRad(A5) ) _
							 + 0.000062 * Sin(DegRad(A6) ) _
							 + 0.000060 * Sin(DegRad(A7) ) _
							 + 0.000056 * Sin(DegRad(A8) ) _
							 + 0.000047 * Sin(DegRad(A9) ) _
							 + 0.000042 * Sin(DegRad(A10)) _
							 + 0.000040 * Sin(DegRad(A11)) _
							 + 0.000037 * Sin(DegRad(A12)) _
							 + 0.000035 * Sin(DegRad(A13)) _
							 + 0.000023 * Sin(DegRad(A14))
End Function

'****************************************************************************
*********************************************************************************
*******************************************
'*****	 Given a valid date/time, return an image chip of the moon.	 ********************************************************************************
***********************************************
'****************************************************************************
*********************************************************************************
*******************************************
Function GetMoonPhaseImage(vDateTime,vType)
  Dim MoonIllumination,MoonPhaseName,MoonPhase
  MoonIllumination = Int(GetMoonIllumination(vDateTime) * 100)
  MoonPhaseName = GetMoonPhase(vDateTime,"phase")
  MoonPhase = LCase(Replace(MoonPhaseName," ",""))
  If InStr(1,MoonPhase,"full",1) <> 0 Then
	If InStr(1,MoonPhase,"blue",1) <> 0 Then
	  MoonPhase = "bluemoon"
	Else
	  MoonPhase = "fullmoon"
	End If				
  ElseIf vType <> "basic" Then
	Select Case MoonPhase
	  Case "waxingcrescent","waningcrescent" Select Case MoonIllumination
							  Case 0,1,2,3,4,5	MoonPhase = MoonPhase & 5
							  Case 6,7,8,9,10	 MoonPhase = MoonPhase & 10
							  Case 11,12,13,14,15 MoonPhase = MoonPhase & 15
							  Case 16,17,18,19,20 MoonPhase = MoonPhase & 20
							  Case 21,22,23,24,25 MoonPhase = MoonPhase & 25
							  Case 26,27,28,29,30 MoonPhase = MoonPhase & 30
							  Case 31,32,33,34,35 MoonPhase = MoonPhase & 35
							  Case 36,37,38,39,40 MoonPhase = MoonPhase & 40
							  Case 41,42,43,44,45 MoonPhase = MoonPhase & 45
							  Case 46,47,48,49,50 MoonPhase = MoonPhase & 50
							End Select
				  
	  Case "waxinggibbous","waninggibbous"  Select Case MoonIllumination
							  Case 50,51,52,53,54,55	MoonPhase = MoonPhase & 50
							  Case 56,57,58,59,60	   MoonPhase = MoonPhase & 55
							  Case 61,62,63,64,65	   MoonPhase = MoonPhase & 60
							  Case 66,67,68,69,70	   MoonPhase = MoonPhase & 65
							  Case 71,72,73,74,75	   MoonPhase = MoonPhase & 70
							  Case 76,77,78,79,80	   MoonPhase = MoonPhase & 75
							  Case 81,82,83,84,85	   MoonPhase = MoonPhase & 80
							  Case 86,87,88,89,90	   MoonPhase = MoonPhase & 85
							  Case 91,92,93,94,95	   MoonPhase = MoonPhase & 90
							  Case 96,97,98,99,100	  MoonPhase = MoonPhase & 95
							End Select
	End Select	
  Else
	Select Case MoonPhase
	  Case "waxingcrescent","waningcrescent","waxinggibbous","waninggibbous" MoonPhase = MoonPhase & MoonIllumination
	  Case Else MoonPhase = MoonPhase
	End Select
  End If
  GetMoonPhaseImage = MoonPhase
End Function

'****************************************************************************
*********************************************************************************
*******************************************
'*****	 Given a valid date, return the daylight difference in minutes.	 ********************************************************************************
*******************************************
'****************************************************************************
*********************************************************************************
*******************************************
Function GetDaylightMins(Lat1,Lon1,Lat2,Lon2,vDate1,vDate2,vType)
  Dim Sunrise1,Sunset1,sLength1,Sunrise2,Sunset2,sLength2,MinDiff,DaylightMins,Dayligh
tMinsMsg
  Sunrise1 = GetSunRiseSet("official","rise",Lat1,Lon1,CDate(vDate1))
  Sunset1 = GetSunRiseSet("official","set",Lat1,Lon1,CDate(vDate1))
  sLength1 = DateDiff("n",Sunrise1,Sunset1)
  Sunrise2 = GetSunRiseSet("official","rise",Lat2,Lon2,CDate(vDate2))
  Sunset2 = GetSunRiseSet("official","set",Lat2,Lon2,CDate(vDate2))
  sLength2 = DateDiff("n",Sunrise2,Sunset2)
  MinDiff = sLength1 - sLength2 
  If MinDiff >= 0 Then MinDiff = "+" & MinDiff
  Select Case LCase(vType)
	Case "phrase"
	  DaylightMins = MinDiff
	  If FormatNumber(DaylightMins,0) >= 0 Then
		DaylightMinsMsg = "Gain of"
	  Else
		DaylightMinsMsg = "Loss of"
		DaylightMins = Abs(DaylightMins)
	  End If
	  If DaylightMins < 9 Then
		Select Case DaylightMins
		  Case 0 DaylightMinsMsg = "No significant gain or loss from yesterday."
		  Case 1 DaylightMinsMsg = DaylightMinsMsg & " one minute of daylight from yesterday."
		  Case 2 DaylightMinsMsg = DaylightMinsMsg & " two minutes of daylight from yesterday."
		  Case 3 DaylightMinsMsg = DaylightMinsMsg & " three minutes of daylight from yesterday."
		  Case 4 DaylightMinsMsg = DaylightMinsMsg & " four minutes of daylight from yesterday."
		  Case 5 DaylightMinsMsg = DaylightMinsMsg & " five minutes of daylight from yesterday."
		  Case 6 DaylightMinsMsg = DaylightMinsMsg & " six minutes of daylight from yesterday."
		  Case 7 DaylightMinsMsg = DaylightMinsMsg & " seven minutes of daylight from yesterday."
		  Case 8 DaylightMinsMsg = DaylightMinsMsg & " eight minutes of daylight from yesterday."
		  Case 9 DaylightMinsMsg = DaylightMinsMsg & " nine minutes of daylight from yesterday."
		End Select
	  Else
		DaylightMinsMsg = DaylightMinsMsg & " " & DaylightMins & " minutes of daylight from yesterday."
	  End If
	Case Else
	  DaylightMinsMsg = MinDiff
  End Select
  GetDaylightMins = DaylightMinsMsg  
End Function

'****************************************************************************
*********************************************************************************
*******************************************
'*****	 Given a valid date/time, return a sunrise/sunset time (±1 minute).	 ********************************************************************************
***************************************************
'****************************************************************************
*********************************************************************************
*******************************************
Function GetSunRiseSet(vType,vSunType,Lat,Lon,vDateTime)
  Dim zenith,OffsetHr,N1,N2,N3,N,lngHour,t1,M,L,RA,Lquadrant,RAquadrant,sinDec,cosDec,
cosH,H,T,UT,gHrs,gMins,gSecs
  Select Case LCase(vType)
	Case "official"	 zenith = 90.8331099907314
	Case "civil"		zenith = 96
	Case "nautical"	 zenith = 102
	Case "astronomical" zenith = 108
  End Select
  OffsetHr = -8
  If CDate(vDateTime) >= CDate(GetDaylightSavingsStart(Year(vDateTime))) And CDate(vDateTime) < CDate(GetDaylightSavingsEnd(Year(vDateTime))) Then OffsetHr = OffsetHr + 1
  N1 = Int(275 * Month(vDateTime) / 9)
  N2 = Int((Month(vDateTime) + 9) / 12)
  N3 = (1 + Int((Year(vDateTime) - 4 * Int(Year(vDateTime) / 4) + 2) / 3))
  N = N1 - (N2 * N3) + Day(vDateTime) - 30
  lngHour = Lon / 15
  If LCase(vSunType) = "rise" Then
	t1 = N + ((6 - lngHour) / 24)
  ElseIf LCase(vSunType) = "set" Then
	t1 = N + ((18 - lngHour) / 24)
  End If
  M = (0.9856 * t1) - 3.289
  L = M + (1.916 * Sin(DegRad(M))) + (0.020 * Sin(2 * DegRad(M))) + 282.634
  If L < 0 Then
	L = L + 360
  ElseIf L > 360 Then
	L = L - 360
  End If
  RA = RadDeg(Atn(0.91764 * Tan(DegRad(L))))
  If RA < 0 Then
	RA = RA + 360
  ElseIf RA > 360 Then
	RA = RA - 360
  End If
  Lquadrant  = (Int( L / 90)) * 90
  RAquadrant = (Int(RA / 90)) * 90
  RA = RA + (Lquadrant - RAquadrant)
  RA = RA / 15
  sinDec = 0.39782 * sin(DegRad(L))
  cosDec = Cos(Arcsin(sinDec))
  cosH = (Cos(DegRad(zenith)) - (sinDec * Sin(DegRad(Lat)))) / (cosDec * Cos(DegRad(Lat)))
  If (cosH > 1) Then
	GetSunRiseSet = "The sun never rises on this location (" & DateValue(vDateTime) & ")."
  ElseIf (cosH < -1) Then
	GetSunRiseSet = "The sun never sets on this location (" & DateValue(vDateTime) & ")."
  Else
	If LCase(vSunType) = "rise" Then
	  H = 360 - RadDeg(Arccos(cosH))
	ElseIf LCase(vSunType) = "set" Then
	  H = RadDeg(Arccos(cosH))
	End If
	H = H / 15
	T = H + RA - (0.06571 * t1) - 6.622
	UT = T - lngHour
	If UT < 0 Then
	  UT = UT + 24
	ElseIf UT > 24 Then
	  UT = UT - 24
	End If
	gHrs = UT
	gMins = (gHrs - Int(gHrs)) * 60
	gSecs = (gMins - Int(gMins)) * 60
	GetSunRiseSet = TimeValue(DateAdd("h",OffsetHr,DateValue(vDateTime) & " " & Int(gHrs) & ":" & Int(gMins) & ":" & Int(gSecs)))
  End If
End Function

'****************************************************************************
*********************************************************************************
*******************************************
'*****	 Given a valid year and recurrence variables, return the requested date.	 ********************************************************************************
**********************************
'****************************************************************************
*********************************************************************************
*******************************************
Function GetWeekdayInterval(OccurInterval,OccurDay,OccurMonth,vYear)
  Dim OccurDate,OccurIntervalCount
  If LCase(OccurInterval) = "last" Then
	OccurDate = GetLastMonthDay(OccurMonth,vYear)
	While Weekday(OccurDate) <> OccurDay
	  OccurDate = DateAdd("d",-1,OccurDate)	
	Wend
	GetWeekdayInterval = OccurDate
  Else
	OccurDate = CDate(OccurMonth & "/1/" & vYear)
	While OccurIntervalCount < OccurInterval
	  If Weekday(OccurDate) = OccurDay Then OccurIntervalCount = OccurIntervalCount + 1
	  If OccurIntervalCount < OccurInterval Then OccurDate = DateAdd("d",1,OccurDate)	
	Wend
	GetWeekdayInterval = CDate(OccurDate)
  End If
End Function

'****************************************************************************
*********************************************************************************
*******************************************
'*****	 Christian observances, including Easter Sunday and related feasts.	 ********************************************************************************
***************************************
'****************************************************************************
*********************************************************************************
*******************************************
'Given a valid year greater than AD 1583, get the date of Easter.
Function GetEasterSunday(vYear)
  'Derived from Oudin's Algorithm for calculating the date of Easter.
  Dim century,G,K,I,J,L,EasterMonth,EasterDay
  century = Int(vYear / 100)
  G = vYear Mod 19
  K = Int((century - 17) / 25)
  I = (century - Int(century / 4) - Int((century - K) / 3) + 19 * G + 15) Mod 30
  I = I - Int(I / 28) * (1 - Int(I / 28) * Int(29 / (I + 1)) * Int((21 - G) / 11))
  J = (vYear + Int(vYear / 4) + I + 2 - century + Int(century / 4)) Mod 7
  L = I - J
  EasterMonth = 3 + Int((L + 40) / 44)
  EasterDay = L + 28 - 31 * Int(EasterMonth / 4)
  GetEasterSunday = CDate(Int(EasterMonth) & "/" & EasterDay & "/" & vYear)
End Function

'Easter related feasts.
Function GetSeptuagesima(vYear)
  'Septuagesima: 63 days before Easter
  GetSeptuagesima = CDate(DateAdd("d",-63,GetEasterSunday(vYear)))
End Function

Function GetQuinquagesima(vYear)
  'Quinquagesima: 49 days before Easter
  GetQuinquagesima = CDate(DateAdd("d",-49,GetEasterSunday(vYear)))
End Function

Function GetAshWednesday(vYear)
  'Ash Wednesday: 46 days before Easter
  GetAshWednesday = CDate(DateAdd("d",-46,GetEasterSunday(vYear)))
End Function

Function GetPalmSunday(vYear)
  'Palm Sunday: 7 days before Easter
  GetPalmSunday = CDate(DateAdd("d",-7,GetEasterSunday(vYear)))
End Function

Function GetGoodFriday(vYear)
  'Good Friday: 2 days before Easter
  GetGoodFriday = CDate(DateAdd("d",-2,GetEasterSunday(vYear)))
End Function

Function GetRogationSunday(vYear)
  'Rogation Sunday: 35 days after Easter
  GetRogationSunday = CDate(DateAdd("d",35,GetEasterSunday(vYear)))
End Function

Function GetAscension(vYear)
  'Ascension: 39 days after Easter
  GetAscension = CDate(DateAdd("d",39,GetEasterSunday(vYear)))
End Function

Function GetPentecost(vYear)
  'Pentecost: 49 days after Easter
  GetPentecost = CDate(DateAdd("d",49,GetEasterSunday(vYear)))
End Function

Function GetTrinitySunday(vYear)
  'Trinity Sunday: 56 days after Easter
  GetTrinitySunday = CDate(DateAdd("d",56,GetEasterSunday(vYear)))
End Function

Function GetCorpusChristi(vYear)
  'Corpus Christi: 60 days after Easter
  GetCorpusChristi = CDate(DateAdd("d",60,GetEasterSunday(vYear)))
End Function
 
'****************************************************************************
*********************************************************************************
*******************************************
'*****	 Federal holidays solved programmatically.	 ********************************************************************************
****************************************************************
'****************************************************************************
*********************************************************************************
*******************************************
Function GetInaugurationDay(vYear)
  If vYear = 1789 Then
	'First Inauguration Day: George Washington, 4/30/1789.
	GetInaugurationDay = CDate("4/30/" & vYear)
  ElseIf vYear > 1937 Then
	'Inauguration Day: January 20th every four years, starting in 1937.
	If ((vYear - 1) Mod 4) = 0 Then GetInaugurationDay = CDate("1/20/" & vYear)
  ElseIf vYear > 1789 Then
	'Inauguration Day: March 4th every four years, pre-1937. 
	If ((vYear - 1) Mod 4) = 0 Then GetInaugurationDay = CDate("3/4/" & vYear)
  End If
End Function

Function GetKingJrDay(vYear)
  'Martin Luther King Jr. Day: 3rd Monday in January
  GetKingJrDay = GetWeekdayInterval(3,vbMonday,1,vYear)
End Function

Function GetPresidentsDay(vYear)
  'Presidents' Day/Washington's Birthday: 3rd Monday in February
  GetPresidentsDay = GetWeekdayInterval(3,vbMonday,2,vYear)
End Function

Function GetMemorialDay(vYear)
  'Memorial Day: Last Monday in May
  GetMemorialDay = GetWeekdayInterval("last",vbMonday,5,vYear)
End Function

Function GetLaborDay(vYear)
  'Labor Day: 1st Monday in September
  GetLaborDay = GetWeekdayInterval(1,vbMonday,9,vYear)
End Function

Function GetColumbusDay(vYear)
  'Columbus Day: 2nd Monday in October
  GetColumbusDay = GetWeekdayInterval(2,vbMonday,10,vYear)
End Function

Function GetThanksgivingDay(vYear)
  'Thanksgiving Day: 4th Thursday in November
  GetThanksgivingDay = GetWeekdayInterval(4,vbThursday,11,vYear)
End Function

'****************************************************************************
*********************************************************************************
*******************************************
'*****	 Other holidays and observances solved programmatically.	 ********************************************************************************
**************************************************
'****************************************************************************
*********************************************************************************
*******************************************
Function GetAdminProfessionalsDay(vYear)
  'Administrative Professionals' Day (formerly Secretaries' Day): Wednesday of the last full week of April  
  GetAdminProfessionalsDay = DateAdd("d",-4,GetWeekdayInterval("last",vbSunday,4,vYear))
End Function

Function GetNationalDayOfPrayer(vYear)
  'National Day of Prayer: 1st Thursday in May
  GetNationalDayOfPrayer = GetWeekdayInterval(1,vbThursday,5,vYear)
End Function

Function GetMothersDay(vYear)
  'Mothers' Day: 2nd Sunday in May
  GetMothersDay = GetWeekdayInterval(2,vbSunday,5,vYear)
End Function

Function GetArmedForcesDay(vYear)
  'Armed Forces Day: 3rd Saturday in May
  GetArmedForcesDay = GetWeekdayInterval(3,vbSaturday,5,vYear)
End Function

Function GetFathersDay(vYear)
  'Fathers' Day: 3rd Sunday in June
  GetFathersDay = GetWeekdayInterval(3,vbSunday,6,vYear)
End Function

Function GetParentsDay(vYear)
  'Parents' Day: 4th Sunday in July
  GetParentsDay = GetWeekdayInterval(4,vbSunday,7,vYear)
End Function

Function GetFriendshipDay(vYear)
  'Friendship Day: 1st Sunday in August
  GetFriendshipDay = GetWeekdayInterval(1,vbSunday,8,vYear)
End Function

Function GetGrandparentsDay(vYear)
  'Grandparents' Day: Sunday after Labor Day
  GetGrandparentsDay = CDate(DateAdd("d",6,GetLaborDay(vYear)))
End Function

Function GetNationalChildrensDay(vYear)
  'National Children's Day: 2nd Sunday in October
  GetNationalChildrensDay = GetWeekdayInterval(2,vbSunday,10,vYear)
End Function

Function GetSweetestDay(vYear)
  'Sweetest Day: 3rd Saturday in October
  GetSweetestDay = GetWeekdayInterval(3,vbSaturday,10,vYear)
End Function

Function GetDaylightSavingsStart(vYear)
  'Daylight Savings time begins: 1st Sunday in April 
  GetDaylightSavingsStart = GetWeekdayInterval(1,vbSunday,4,vYear)
End Function

Function GetDaylightSavingsEnd(vYear)
  'Daylight Savings time ends: last Sunday in October 
  GetDaylightSavingsEnd = GetWeekdayInterval("last",vbSunday,10,vYear)
End Function

Function GetFedTaxDay(vYear)
  'Federal Income Taxes Due are due April 15th
  Dim TaxDay
  TaxDay = CDate("4/15/" & vYear)
  'If the 15th is a Saturday or Sunday, then the due date is the Monday after the 15th.
  If WeekDay(TaxDay) = vbSaturday Then 
	TaxDay = DateAdd("d",2,TaxDay)
  ElseIf WeekDay(TaxDay) = vbSunday Then
	TaxDay = DateAdd("d",1,TaxDay)	
  End If
  GetFedTaxDay = TaxDay
End Function

Function GetElectionDay(vYear)
  'Election Day: Tuesday on or after November 2
  If (vYear Mod 2) = 0 Then
	If Weekday(CDate("11/2/" & vYear)) = vbTuesday Then
	  GetElectionDay = CDate("11/2/" & vYear)
	ElseIf Weekday(CDate("11/1/" & vYear)) = vbTuesday Then
	  GetElectionDay = GetWeekdayInterval(2,vbTuesday,11,vYear)
	Else
	  GetElectionDay = GetWeekdayInterval(1,vbTuesday,11,vYear)
	End If
  End If
End Function

Function GetPrimaryElectionDay(vYear)
  'Primary Election Day: Tuesday on or after May 2
  If (vYear Mod 2) = 0 Then
	If Weekday(CDate("5/2/" & vYear)) = vbTuesday Then
	  GetPrimaryElectionDay = CDate("5/2/" & vYear)
	ElseIf Weekday(CDate("5/1/" & vYear)) = vbTuesday Then
	  GetPrimaryElectionDay = GetWeekdayInterval(2,vbTuesday,5,vYear)
	Else
	  GetPrimaryElectionDay = GetWeekdayInterval(1,vbTuesday,5,vYear)
	End If
  End If
End Function

'****************************************************************************
*********************************************************************************
*******************************************
'*****	 Given a valid date, return whether or not it's considered a holiday, observance, or special event.	 ********************************************************************************
*******
'****************************************************************************
*********************************************************************************
*******************************************
Function CheckHolidays(vDate)
  'NOTE: Events added here must also have a corresponding listing (same title) in the events table of the main SQL database.
  Select Case Month(vDate)
	Case 1  If CDate(vDate) = CDate("1/1/" & Year(vDate))				  Then CheckHolidays = AddHoliday(CheckHolidays,"New Year's Day")
			If CDate(vDate) = CDate(GetKingJrDay(Year(vDate)))			 Then CheckHolidays = AddHoliday(CheckHolidays,"Martin Luther King Jr. Day")
			If CDate(vDate) = CDate(GetInaugurationDay(vYear))			 Then CheckHolidays = AddHoliday(CheckHolidays,"Inauguration Day")
	
	Case 2  If CDate(vDate) = CDate("2/2/" & Year(vDate))				  Then CheckHolidays = AddHoliday(CheckHolidays,"Groundhog Day")
			If CDate(vDate) = CDate("2/14/" & Year(vDate))				 Then CheckHolidays = AddHoliday(CheckHolidays,"Valentine's Day")
			If CDate(vDate) = CDate(GetPresidentsDay(Year(vDate)))		 Then CheckHolidays = AddHoliday(CheckHolidays,"Presidents' Day")
	
	Case 3  If CDate(vDate) = CDate("3/17/" & Year(vDate))				 Then CheckHolidays = AddHoliday(CheckHolidays,"St. Patrick's Day")
			If CDate(vDate) = CDate(GetInaugurationDay(vYear))			 Then CheckHolidays = AddHoliday(CheckHolidays,"Inauguration Day")
			If CDate(vDate) = DateValue(GetMarEqu(Year(CDate(vDate))))	 Then CheckHolidays = AddHoliday(CheckHolidays,"First Day of Spring")
	
	Case 4  If CDate(vDate) = CDate(GetInaugurationDay(vYear))			 Then CheckHolidays = AddHoliday(CheckHolidays,"Inauguration Day")
			If CDate(vDate) = CDate("4/1/" & Year(vDate))				  Then CheckHolidays = AddHoliday(CheckHolidays,"April Fools' Day")
			If CDate(vDate) = CDate(GetDaylightSavingsStart(Year(vDate)))  Then CheckHolidays = AddHoliday(CheckHolidays,"Daylight Savings time starts (Add 1 hour)")
			If CDate(vDate) = CDate(GetFedTaxDay(Year(vDate)))			 Then CheckHolidays = AddHoliday(CheckHolidays,"Federal Income Tax Due")
			If CDate(vDate) = CDate(GetAdminProfessionalsDay(Year(vDate))) Then CheckHolidays = AddHoliday(CheckHolidays,"Administrative Professionals' Day (formerly Secretaries' Day)")
			If CDate(vDate) = CDate("4/22/" & Year(vDate))				 Then CheckHolidays = AddHoliday(CheckHolidays,"Earth Day")
	
	Case 5  If CDate(vDate) = CDate("5/6/" & Year(vDate))				  Then CheckHolidays = AddHoliday(CheckHolidays,"Nurses' Day")
			If CDate(vDate) = CDate(GetNationalDayOfPrayer(Year(vDate)))   Then CheckHolidays = AddHoliday(CheckHolidays,"National Day of Prayer")
			If CDate(vDate) = CDate(GetMothersDay(Year(vDate)))			Then CheckHolidays = AddHoliday(CheckHolidays,"Mothers' Day")
			If CDate(vDate) = CDate(GetPrimaryElectionDay(Year(vDate)))	Then CheckHolidays = AddHoliday(CheckHolidays,"Primary Election Day")
			If CDate(vDate) = CDate(GetArmedForcesDay(Year(vDate)))		Then CheckHolidays = AddHoliday(CheckHolidays,"Armed Forces Day")
			If CDate(vDate) = CDate(GetMemorialDay(Year(vDate)))		   Then CheckHolidays = AddHoliday(CheckHolidays,"Memorial Day")
	
	Case 6  If CDate(vDate) = CDate("6/14/" & Year(vDate))				 Then CheckHolidays = AddHoliday(CheckHolidays,"Army Day")
			If CDate(vDate) = CDate("6/19/" & Year(vDate))				 Then CheckHolidays = AddHoliday(CheckHolidays,"Juneteenth (Liberation of Slaves)")
			If CDate(vDate) = CDate(GetFathersDay(Year(vDate)))			Then CheckHolidays = AddHoliday(CheckHolidays,"Fathers' Day")
			If CDate(vDate) = CDate("6/14/" & Year(vDate))				 Then CheckHolidays = AddHoliday(CheckHolidays,"Flag Day")
			If CDate(vDate) = DateValue(GetJunSol(Year(CDate(vDate))))	 Then CheckHolidays = AddHoliday(CheckHolidays,"First Day of Summer")
	
	Case 7  If CDate(vDate) = CDate(GetParentsDay(Year(vDate)))			Then CheckHolidays = AddHoliday(CheckHolidays,"Parents' Day")
			If CDate(vDate) = CDate("7/4/" & Year(vDate))				  Then CheckHolidays = AddHoliday(CheckHolidays,"Independence Day")
	
	Case 8  If CDate(vDate) = CDate("8/1/" & Year(vDate))				  Then CheckHolidays = AddHoliday(CheckHolidays,"Air Force Day")
			If CDate(vDate) = CDate(GetFriendshipDay(Year(vDate)))		 Then CheckHolidays = AddHoliday(CheckHolidays,"Friendship Day")
			If CDate(vDate) = CDate("8/4/" & Year(vDate))				  Then CheckHolidays = AddHoliday(CheckHolidays,"Coast Guard Day")
			If CDate(vDate) = CDate("8/15/" & Year(vDate))				 Then CheckHolidays = AddHoliday(CheckHolidays,"Assumption of the Blessed Virgin Mary")
  
	Case 9  If CDate(vDate) = CDate(GetGrandparentsDay(Year(vDate)))	   Then CheckHolidays = AddHoliday(CheckHolidays,"Grandparents' Day")
			If CDate(vDate) = CDate("9/17/" & Year(vDate))				 Then CheckHolidays = AddHoliday(CheckHolidays,"Citizenship Day or Constitution Day")
			If CDate(vDate) = CDate(GetLaborDay(Year(vDate)))			  Then CheckHolidays = AddHoliday(CheckHolidays,"Labor Day")
			If CDate(vDate) = DateValue(GetSepEqu(Year(CDate(vDate))))	 Then CheckHolidays = AddHoliday(CheckHolidays,"First Day of Autum")
	
	Case 10 If CDate(vDate) = CDate("10/16/" & Year(vDate))				Then CheckHolidays = AddHoliday(CheckHolidays,"Bosses' Day")
			If CDate(vDate) = CDate(GetSweetestDay(Year(vDate)))		   Then CheckHolidays = AddHoliday(CheckHolidays,"Sweetest Day")
			If CDate(vDate) = CDate(GetNationalChildrensDay(Year(vDate)))  Then CheckHolidays = AddHoliday(CheckHolidays,"National Children's Day")
			If CDate(vDate) = CDate("10/24/" & Year(vDate))				Then CheckHolidays = AddHoliday(CheckHolidays,"United Nations Day")
			If CDate(vDate) = CDate("10/26/" & Year(vDate))				Then CheckHolidays = AddHoliday(CheckHolidays,"Mother-in-Law's Day")
			If CDate(vDate) = CDate(GetDaylightSavingsEnd(Year(vDate)))	Then CheckHolidays = AddHoliday(CheckHolidays,"Daylight Savings time ends (Subtract 1 hour)")
			If CDate(vDate) = CDate("10/27/" & Year(vDate))				Then CheckHolidays = AddHoliday(CheckHolidays,"Navy Day")
			If CDate(vDate) = CDate("10/31/" & Year(vDate))				Then CheckHolidays = AddHoliday(CheckHolidays,"Halloween")
			If CDate(vDate) = CDate(GetColumbusDay(Year(vDate)))		   Then CheckHolidays = AddHoliday(CheckHolidays,"Columbus Day")
	
	Case 11 If CDate(vDate) = CDate("11/1/" & Year(vDate))				 Then CheckHolidays = AddHoliday(CheckHolidays,"All Saints Day")
			If CDate(vDate) = CDate("11/2/" & Year(vDate))				 Then CheckHolidays = AddHoliday(CheckHolidays,"All Souls Day")
			If CDate(vDate) = CDate("11/11/" & Year(vDate))				Then CheckHolidays = AddHoliday(CheckHolidays,"Veterans' Day")
			If CDate(vDate) = CDate(GetElectionDay(Year(vDate)))		   Then CheckHolidays = AddHoliday(CheckHolidays,"Election Day")
			If CDate(vDate) = CDate("11/10/" & Year(vDate))				Then CheckHolidays = AddHoliday(CheckHolidays,"Marine Corps Day")
			If CDate(vDate) = CDate(GetThanksgivingDay(Year(vDate)))	   Then CheckHolidays = AddHoliday(CheckHolidays,"Thanksgiving Day")
			
	Case 12 If CDate(vDate) = CDate("12/7/" & Year(vDate))				 Then CheckHolidays = AddHoliday(CheckHolidays,"Pearl Harbor Remembrance Day (7 December, 1941)")
			If CDate(vDate) = CDate("12/24/" & Year(vDate))				Then CheckHolidays = AddHoliday(CheckHolidays,"Christmas Eve")
			If CDate(vDate) = CDate("12/26/" & Year(vDate))				Then CheckHolidays = AddHoliday(CheckHolidays,"Boxing Day")
			If CDate(vDate) = CDate("12/26/" & Year(vDate))				Then CheckHolidays = AddHoliday(CheckHolidays,"St. Stephen's Day")
			If CDate(vDate) = CDate("12/26/" & Year(vDate))				Then CheckHolidays = AddHoliday(CheckHolidays,"Kwanzaa begins")
			If CDate(vDate) = CDate("12/31/" & Year(vDate))				Then CheckHolidays = AddHoliday(CheckHolidays,"New Year's Eve")
			If CDate(vDate) = CDate("12/31/" & Year(vDate))				Then CheckHolidays = AddHoliday(CheckHolidays,"Kwanzaa ends")
			If CDate(vDate) = CDate("12/25/" & Year(vDate))				Then CheckHolidays = AddHoliday(CheckHolidays,"Christmas Day")
			If CDate(vDate) = DateValue(GetDecSol(Year(CDate(vDate))))	 Then CheckHolidays = AddHoliday(CheckHolidays,"First Day of Winter")
  End Select
  
  'Check current major Moon phase.
  Dim MoonPhase
  If CDate(vDate) = DateValue(GetMoonPhase(CDate(vDate),"major")) Then
	MoonPhase = GetMoonPhase(CDate(vDate),"phase")
	Select Case MoonPhase
	  Case "New Moon" CheckHolidays = AddHoliday(CheckHolidays,"New Moon")
	  Case "First Quarter" CheckHolidays = AddHoliday(CheckHolidays,"First Quarter Moon")
	  Case "Last Quarter" CheckHolidays = AddHoliday(CheckHolidays,"Last Quarter Moon")
	  Case Else If InStr(1,MoonPhase,"full",1) <> 0 Then CheckHolidays = AddHoliday(CheckHolidays,MoonPhase)
	End Select  
  End If
  
  'Check Western Christian observances.
  If CheckDateRange(CDate(vDate),CDate("3/22/" & Year(vDate)),CDate("4/25/" & Year(vDate))) = True Then If CDate(vDate) = CDate(GetEasterSunday(Year(vDate)))   Then CheckHolidays = AddHoliday(CheckHolidays,"Easter")
  If CheckDateRange(CDate(vDate),CDate("1/18/" & Year(vDate)),CDate("2/21/" & Year(vDate))) = True Then If CDate(vDate) = CDate(GetSeptuagesima(Year(vDate)))   Then CheckHolidays = AddHoliday(CheckHolidays,"Septuagesima")
  If CheckDateRange(CDate(vDate),CDate("2/1/" & Year(vDate)),CDate("3/7/" & Year(vDate)))   = True Then If CDate(vDate) = CDate(GetQuinquagesima(Year(vDate)))  Then CheckHolidays = AddHoliday(CheckHolidays,"Quinquagesima")
  If CheckDateRange(CDate(vDate),CDate("2/4/" & Year(vDate)),CDate("3/10/" & Year(vDate)))  = True Then If CDate(vDate) = CDate(GetAshWednesday(Year(vDate)))   Then CheckHolidays = AddHoliday(CheckHolidays,"Ash Wednesday")
  If CheckDateRange(CDate(vDate),CDate("3/15/" & Year(vDate)),CDate("4/18/" & Year(vDate))) = True Then If CDate(vDate) = CDate(GetPalmSunday(Year(vDate)))	 Then CheckHolidays = AddHoliday(CheckHolidays,"Palm Sunday")
  If CheckDateRange(CDate(vDate),CDate("3/20/" & Year(vDate)),CDate("4/23/" & Year(vDate))) = True Then If CDate(vDate) = CDate(GetGoodFriday(Year(vDate)))	 Then CheckHolidays = AddHoliday(CheckHolidays,"Good Friday")
  If CheckDateRange(CDate(vDate),CDate("4/26/" & Year(vDate)),CDate("5/30/" & Year(vDate))) = True Then If CDate(vDate) = CDate(GetRogationSunday(Year(vDate))) Then CheckHolidays = AddHoliday(CheckHolidays,"Rogation Sunday")
  If CheckDateRange(CDate(vDate),CDate("4/30/" & Year(vDate)),CDate("6/3/" & Year(vDate)))  = True Then If CDate(vDate) = CDate(GetAscension(Year(vDate)))	  Then CheckHolidays = AddHoliday(CheckHolidays,"Ascension")
  If CheckDateRange(CDate(vDate),CDate("5/10/" & Year(vDate)),CDate("6/13/" & Year(vDate))) = True Then If CDate(vDate) = CDate(GetPentecost(Year(vDate)))	  Then CheckHolidays = AddHoliday(CheckHolidays,"Pentecost")
  If CheckDateRange(CDate(vDate),CDate("5/17/" & Year(vDate)),CDate("6/20/" & Year(vDate))) = True Then If CDate(vDate) = CDate(GetTrinitySunday(Year(vDate)))  Then CheckHolidays = AddHoliday(CheckHolidays,"Trinity Sunday")
  If CheckDateRange(CDate(vDate),CDate("5/21/" & Year(vDate)),CDate("6/24/" & Year(vDate))) = True Then If CDate(vDate) = CDate(GetCorpusChristi(Year(vDate)))  Then CheckHolidays = AddHoliday(CheckHolidays,"Corpus Christi")
End Function

Function AddHoliday(CheckStr,vStr)
  AddHoliday = CheckStr & vbCrLf & vStr
  If CheckStr = "" Then AddHoliday = vStr
End Function

'****************************************************************************
*********************************************************************************
*******************************************
'*****	 Given a valid time, return a friendly welcome.	 ********************************************************************************
***********************************************************
'****************************************************************************
*********************************************************************************
*******************************************
Function GetWelcome(vTime)
  If Hour(vTime) >= 1 And Hour(vTime) < 12 Then
	GetWelcome = "Good Morning"
  ElseIf Hour(vTime) >= 12 And Hour(vTime) < 17 Then
	GetWelcome = "Good Afternoon"
  Else
	GetWelcome = "Good Evening"
  End If
End Function

'****************************************************************************
*********************************************************************************
*******************************************
'*****	 Fixes City Charter section numbers.	 ********************************************************************************
**********************************************************************
'****************************************************************************
*********************************************************************************
*******************************************
Function FixFrac(vStr)
  FixFrac = Replace(vStr,".25","¼")
  FixFrac = Replace(vStr,".5","½")
  FixFrac = Replace(vStr,".75","¾")
End Function
  
'****************************************************************************
*********************************************************************************
*******************************************
'*****	 Builds superscript for footnotes.	 ********************************************************************************
************************************************************************
'****************************************************************************
*********************************************************************************
*******************************************
Function FindSuperScript(vStr)
  FindSuperScript = Replace(vStr,"{","<sup><a href=""#Footnotes"">")
  FindSuperScript = Replace(FindSuperScript,"}","</a></sup>")
End Function
%>

Alguém ae entende este code? alguém ae poderia quebrar este galho?

 

Desde já agradeço,

Patrique

Compartilhar este post

Link para o post
Compartilhar em outros sites

hargon    64

hargon
Postado

Depois seria interessante você analisar a função e deixar somente o que é útil, pois o código possui várias funções que não são utilizadas.

 

Para saber a fase da lua é só informar a data atual e o valor "phase" na função abaixo:

Response.Write GetMoonPhase(Now,"phase")

Para saber que dia começou a fase você deve informar

Response.Write GetMoonPhase(Now,"major")

Lembrando que está tudo em inglês, você terá que traduzir.

 

Obs. Esse código tem uma função que procuro a décadas: Calcular distância entre dois pontos usando latitude e longitude. Depois vou postar no laboratório essa função.

Compartilhar este post

Link para o post
Compartilhar em outros sites

Patrique    0

Patrique
Postado

E ai hargon, eu também procurava uma função desta a um bom tempo, você viu naquela page como o sistema e completo? ele aponto até a porcentagem atual em que a lua esta coberta, simplesmente demais, eu vou tentar montar aqui da forma com que você passou.

 

Obrigado pela ajuda.

 

[]'s

Compartilhar este post

Link para o post
Compartilhar em outros sites

hargon    64

hargon
Postado

Vi sim. Essas funções já estão todas prontas aí. Todas que iniciam com Get vão te retornar algo. É só você passar os parâmetros.

Response.Write GetMoonIllumination(Now)

Compartilhar este post

Link para o post
Compartilhar em outros sites

xanburzum    169

xanburzum
Postado

olha esse tipo http://www.paulsadowski.com/moonphases/default.asp

 

mostra:

Saturday, April 11, 2009

 

Moon's age (days): 16

Distance (Earth radii): 61.53

Percent Illumination 96.96%

Ecliptic latitude (degrees): -5.09

Ecliptic longitude (degrees): 223.98

Compartilhar este post

Link para o post
Compartilhar em outros sites

xanburzum    169

xanburzum
Postado

mano Pratique, sei k tenho esse code, tb, mas naun to axando, assim que encontrar irei disponibilizar no laboratório

Compartilhar este post

Link para o post
Compartilhar em outros sites

xanburzum    169

xanburzum
Postado

achando , posto e mando um MP, pra ti...

existe tb este site, onde você pode obter informaçõesdas fases lunares , incluindo o link

Compartilhar este post

Link para o post
Compartilhar em outros sites
Ir para a lista de tópicos ASP Clássico
×

Informação importante

Ao usar o fórum, você concorda com nossos Termos e condições.

  Aceito