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

'Calend4.BAS
'These routines let the user move around the one-month calendar
'$INCLUDE: 'CALEND.BI'

SUB Calendar 'Main keyboard loop -- let user move in 1-month
'calendar
CurDay = Today& MOD 100
CurYear = Today& \ 10000
CurMonth = (Today& \ 100) MOD 100
SetCalendarScreen
DO
Ch = GetKey
SELECT CASE Ch
CASE -75: SelectDay (CurDay - 1) 'Left-Arrow
CASE -77: SelectDay (CurDay + 1) 'Right-Arrow
CASE -72: SelectDay (CurDay - 7) 'Up Arrow
CASE -80: SelectDay (CurDay + 7) 'Dn Arrow
CASE -73: SelectMonth (CurMonth - 1) 'PgUp
CASE -81: SelectMonth (CurMonth + 1) 'PgDn
CASE -71: SelectMonth (1) 'Home
CASE -79: SelectMonth (12) 'End
CASE -21: GetNewYear 'Alt-Y
CASE -18: EditDiary 'Alt-E
CASE -45: EXIT SUB 'Alt-E
CASE -38 'Alt-L
CALL LCalend(CurMonth, CurYear)
SetCalendarScreen
CASE -32 'Alt-D
CalenLink = CalenLink XOR -1
SelectDay (CurDay)
END SELECT
LOOP
END SUB

SUB SetCalendarScreen 'Set up the main calendar screen
DIM MnthBox AS BoxType
COLOR Normal, Background, Background
CLS
SetHelpBox
SetTitleBox
HighlightBox (MonthBox)
NormalBox (DiaryBox)
CALL BoxCoords(MonthBox, MnthBox)
CALL OneMonth(CurYear, CurMonth, MnthBox.TopRow + 1, MnthBox.LftCol + 1)
SelectDay (CurDay)
END SUB

SUB OneMonth (Year, Mnth, Row, Col) 'Display a 1-month calendar
CONST D$ = "Su Mo Tu We Th Fr Sa"
IF Mnth = 2 THEN
Count = Month(Mnth).days + -1 * LpYear(Year)
ELSE
Count = Month(Mnth).days
END IF
Mn$ = RTRIM$(Month(Mnth).Mname$) + STR$(Year)
LOCATE Row, Col + (20 - LEN(Mn$)) / 2
PRINT Mn$;
LOCATE Row + 1, Col
PRINT D$;
r = Row + 2
posn = DayOfWeek(YMD2Lday&(Year, Mnth, 1))
FOR Lp = 1 TO Count
LOCATE r, Col + posn * 3
PRINT USING "## "; Lp;
posn = posn + 1
IF posn > 6 THEN
posn = 0
r = r + 1
END IF
NEXT Lp
LastMonth = Mnth
LastYear = Year
LastDay = 0
LastRow = Row
LastCol = Col
END SUB

SUB SelectDay (DayNum) 'Select a day and display diary page
Count = Month(CurMonth).days + LpDay(CurYear, CurMonth)
IF DayNum >= 1 AND DayNum <= Count THEN
HighlightDay (DayNum)
CurDay = DayNum
CurDayNum = DayNumber(YMD2Lday&(CurYear, CurMonth, CurDay))
IF CalenLink = TRUE AND FileOpen = TRUE THEN
CALL SetDiaryPage(CurYear, CurMonth, CurDay, CurDayNum)
ELSE
ClearBox (DiaryBox)
END IF
END IF
END SUB

SUB SelectMonth (MonthNum) 'Select a new month
IF MonthNum >= 1 AND MonthNum <= 12 THEN
ClearBox (MonthBox)
CALL OneMonth(CurYear, MonthNum, LastRow, LastCol)
CurMonth = MonthNum
Count = Month(MonthNum).days + LpDay(CurYear, MonthNum)
IF CurDay > Count THEN CurDay = Count
SelectDay (CurDay)
END IF
END SUB

SUB GetNewYear 'Start a new year
CONST GY$ = "Enter year ==> "
DIM Box AS BoxType
CALL BoxCoords(HelpBox, Box)
DO
ClearBox (HelpBox)
LOCATE Box.TopRow + 1, Box.LftCol + 1
PRINT GY$;
LINE INPUT NewYear$
NewYear = VAL(NewYear$)
LOOP UNTIL NewYear >= 1600
CurYear = NewYear
CurMonth = 1
CurDay = 1
OpenYear (NewYear)
SetCalendarScreen
END SUB

SUB HighlightDay (Day) 'Highlight one day's date
Y = LastYear
M = LastMonth
IF LastDay <> 0 THEN
CALL WeekPos(YMD2Lday(Y, M, LastDay), week, posn)
LOCATE LastRow + 2 + week, LastCol + posn * 3
PRINT USING "## "; LastDay;
END IF
CALL WeekPos(YMD2Lday(Y, M, Day), week, posn)
COLOR Background, Normal
LOCATE LastRow + 2 + week, LastCol + posn * 3
PRINT USING "## "; Day
COLOR Normal, Background
LastDay = Day
END SUB