Category : BASIC Source Code
Archive   : QB_CAL.ZIP
Filename : CALEND2.BAS

'Calend2.BAS This file contains date manipulation routines
'$INCLUDE: 'Calend.Bi'

FUNCTION YMD2Lday& (Year%, Month%, Day%) 'Create internal day format
YMD2Lday& = 10000& * Year% + 100& * Month% + Day%
END FUNCTION

FUNCTION Date2Lday& (Dat$) 'Turn a date into internal day format
m = VAL(LEFT$(Dat$, 2))
d = VAL(MID$(Dat$, 4, 2))
y = VAL(RIGHT$(Dat$, 4))
Date2Lday& = YMD2Lday&(y, m, d)
END FUNCTION

FUNCTION DayOfWeek (Lday&) 'Find day of the week using Zeller's Congruence
y = Lday& \ 10000
m = (Lday& \ 100) MOD 100 - 2
d = Lday& MOD 100
IF m < 1 THEN
m = m + 12
y = y - 1
END IF
cent = (y \ 100)
y = y MOD 100
temp = INT(2.6 * m - .19) + d + y + (y \ 4)
DayNum = (temp + (cent \ 4) - cent - cent) MOD 7
IF DayNum < 0 THEN DayNum = DayNum + 7
DayOfWeek = DayNum
END FUNCTION

FUNCTION DayNumber (Lday&) 'Find day number in year
DayNumber = Month((Lday& \ 100) MOD 100).day0 + Lday& MOD 100
END FUNCTION

FUNCTION LpYear (Yr) 'Is Yr a leap year?
LpYear = (Yr MOD 400 = 0) OR ((Yr MOD 4 = 0) AND (Yr MOD 100 <> 0))
END FUNCTION

FUNCTION LpDay (Yr, Mnth) 'Is today Feb. 29th or later in a leap year?
LpDay = -1 * ((Mo > 3) AND LpYear(Yr))
END FUNCTION

SUB WeekPos (Lday&, week, DayPos) 'Day's position on a monthly calendar
y = Lday& \ 10000
m = (Lday& \ 100) MOD 100
d = Lday& MOD 100
first = DayOfWeek(YMD2Lday&(y, m, 1))
week = (d - 1) \ 7
DayPos = first + (d - 1) MOD 7
DO WHILE DayPos > 6
week = week + 1
DayPos = DayPos - 7
LOOP
END SUB