XProfan

*******************************************************
* 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