posted October 18, 2002 02:00 AM            

' *******************************************************
' * Function Julian - returns Julian Day Number (JDN)   *
' * Actually it counts days elapsed since "11/25/-4713" *
' * (= Nov. 25, 4714 BCE)                               *
' *******************************************************
FUNCTION Julian(BYVAL year AS LONG, _
                BYVAL month AS LONG, _
                BYVAL day AS LONG) AS LONG
  LOCAL Days AS LONG, yearsBC AS LONG, yearsAD AS LONG
  
  IF month < 3 THEN                               ' January or February?
    month = month + 12                            ' 13th or 14th month ....
    DECR year                                     ' .... of prev. year
  END IF
  
  yearsBC = 4714 - 1                              ' 4713 BC thru 1 BC
  yearsAD = year - 1                              ' 1 AD thru (year of date minus 1)
  Days = INT((yearsBC + yearsAD) * 365.25)        ' calculate days in years
  Days = Days - (year \ 100)                      ' substract century leapdays
  Days = Days + (year \ 400)                      ' re-add valid ones
  Days = Days + INT(30.6 * (month - 1) + .2)      ' days in months elapsed (+ adjustment)
  FUNCTION = Days + day                           ' days in month of date
END FUNCTION   
 
' ***********************************************
' * Function DayOfWeek returns day of the week, *
' * where Monday = 1 .... Sunday = 7            *
' ***********************************************
FUNCTION DayOfWeek(JDN AS LONG) AS BYTE
  FUNCTION = JDN MOD 7 + 1
END FUNCTION
 
' ***********************************************************************
' * Function WeekOne returns first day of first week for the given year *
' * Note: This is only a helper function for WeekNumber                 *
' ***********************************************************************
FUNCTION WeekOne(BYVAL year AS LONG) AS LONG
  LOCAL temp AS LONG, Thursday AS BYTE
  Thursday = 4
  temp = Julian(year, 1, 1) - 1                ' Dec. 31 of prev. year
  DO
    INCR temp
  LOOP UNTIL DayOfWeek(temp) = Thursday        ' until first Thursday of year is found
  FUNCTION = temp - 3                          ' first day of first week is a Monday
END FUNCTION
 
' *********************************************************************
' * Function WeekNumber returns ISO-proof weeknumber for a given date *
' *********************************************************************
FUNCTION WeekNumber(BYVAL year AS LONG, _
                    BYVAL month AS LONG, _
                    BYVAL day AS LONG) AS BYTE
  LOCAL FirstDay AS LONG, FinalDay AS LONG, ToDay AS LONG
  LOCAL WkNumber AS BYTE
  FirstDay = WeekOne(year)
  FinalDay = WeekOne(year + 1) - 1
  ToDay    = Julian(year, month, day)
  SELECT CASE ToDay
    CASE < FirstDay
      ' it is week 52 or 53, but which one?
      ' therefore we need week one of previous year as a starting point
      FirstDay = WeekOne(year - 1)
    CASE > FinalDay
      ' there is only one possibility: week nbr 1
      FUNCTION = 1
      EXIT FUNCTION
  END SELECT
  FUNCTION = ((ToDay - FirstDay) \ 7) + 1
END FUNCTION
 
FUNCTION PBMain() AS LONG
  MSGBOX "Dec. 31, 1997 falls in week " & FORMAT$(WeekNumber(1997, 12, 31)) & $CRLF & _
         "Jan.  1, 1999 in week " & FORMAT$(WeekNumber(1999,  1,  1))
END FUNCTION