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

'Calend5.BAS: Routines for the large calendar display, LCalend
'$INCLUDE: 'Calend.Bi'

SUB LCalend (Month%, Year%) 'Start large calendar for given month & year
m = Month
y = Year
IF m < 7 THEN m = 1 ELSE m = 7
SetLCalendScreen
CALL DisplayLCalend(m, y)
DO
Ch = GetKey
SELECT CASE Ch
CASE -45: EXIT SUB 'Alt-X
CASE -21 'Alt-Y
y = GetNewLYear
CALL DisplayLCalend(m, y)
CASE -75, -72, -73
m = m - 6
IF m < 1 THEN
m = 7
y = y - 1
END IF
CALL DisplayLCalend(m, y)
CASE -77, -80, -81
m = m + 6
IF m > 7 THEN
m = 1
y = y + 1
END IF
CALL DisplayLCalend(m, y)
CASE ELSE
END SELECT
LOOP
END SUB

SUB SetLCalendScreen 'Set up large calendar screen
CLS
FOR Lp = LastBox - 5 TO LastBox
NormalBox (Lp)
NEXT Lp
SetLCalendHelpBox
END SUB

SUB DisplayLCalend (Month, Year) 'Display 6 months on the screen
DIM Box AS BoxType
FirstB = LastBox - 5
FOR Lp = 0 TO 5
BoxNum = Lp + FirstB
ClearBox (BoxNum)
CALL BoxCoords(BoxNum, Box)
CALL OneMonth(Year, Month + Lp, Box.TopRow + 1, Box.LftCol + 1)
NEXT Lp
END SUB

FUNCTION GetNewLYear 'Display a new year as a large calendar
CONST GN$ = "Enter year ==> "
DIM Box AS BoxType
CALL BoxCoords(LCalendHelp, Box)
DO
ClearBox (LCalendHelp)
LOCATE Box.TopRow + 1, Box.LftCol + 1
PRINT GN$;
LINE INPUT NewYear$
NewYear = VAL(NewYear$)
LOOP UNTIL NewYear > 1581
ClearBox (LCalendHelp)
SetLCalendHelpBox
GetNewLYear = NewYear
END FUNCTION