home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Shareware Overload
/
ShartewareOverload.cdr
/
windows
/
baswind8.zip
/
KEYCAL.SUB
< prev
next >
Wrap
Text File
|
1990-09-14
|
5KB
|
127 lines
'
'
'******************************************************************************
' Function : KEYCAL *
' *
' Purpose: *
' *
' *
' Results: *
' *
' Usage : *
' *
' *
' Date Written : 09/01/90 - Date Tested: 09/01/90 - Author: James P Morgan *
' Date Modified: - : - : *
'-----------------------------------------------------------------------------*
' NOTE: *
'******************************************************************************
' *
' SUB PROGRAM NAME (PARAMETERS) STATIC/RECURSIVE *
'-----------------------------------------------------------------------------*
' *
SUB KEYCAL(MONTH%,YEAR%,QUADRANT$,FORE%,BACK%,SHADOW%,RETURN.CODE%) STATIC
DEFINT A-Z 'make all short intergers by default
RETURN.CODE%=0
IF (MONTH%<1) OR (MONTH%>12) THEN 'edit month for validity
RETURN.CODE%=-2
GOTO KEYCAL.EXIT
END IF
IF YEAR%<0 THEN 'edit year for validity
RETURN.CODE%=-3
GOTO KEYCAL.EXIT
END IF
GOSUB KEYCAL.DISPCAL 'display the calendar for this month/year
'
KEYCAL.TESTKEYS:
IF RETURN.CODE%<0 THEN
GOTO KEYCAL.EXIT
END IF
Q$=INKEY$ 'wait for user to press a key
IF Q$="" THEN
GOTO KEYCAL.TESTKEYS
END IF
IF Q$=CHR$(13) THEN 'an Enter key pressed?
GOTO KEYCAL.EXIT
END IF
IF Q$=CHR$(27) THEN 'an ESC key pressed?
RETURN.CODE%=-1
GOTO KEYCAL.EXIT
END IF
IF LEN(Q$)=1 THEN 'only an extended function key allowed
GOSUB KEYCAL.SOUNDOFF
GOTO KEYCAL.TESTKEYS
END IF
KEY.VAL=ASC(RIGHT$(Q$,1)) 'strip out the extended key code
IF KEY.VAL=77 THEN 'cursor right key pressed?
MONTH%=MONTH%+1 'we want the next month
IF MONTH%=13 THEN 'did the month roll over?
MONTH%=1
GOSUB KEYCAL.DISPCAL 'display the calendar
GOTO KEYCAL.TESTKEYS
ELSE
GOSUB KEYCAL.DISPCAL 'display the calendar
GOTO KEYCAL.TESTKEYS
END IF
END IF
IF KEY.VAL=75 THEN 'cursor left key pressed?
MONTH%=MONTH%-1 'we want the previous month
IF MONTH%=0 THEN 'did the monthy roll back?
MONTH%=12
GOSUB KEYCAL.DISPCAL 'display the calendar
GOTO KEYCAL.TESTKEYS
ELSE
GOSUB KEYCAL.DISPCAL 'display the calendar
GOTO KEYCAL.TESTKEYS
END IF
END IF
IF KEY.VAL=80 THEN 'cursor down key pressed?
YEAR%=YEAR%-1 'we want the previous year, same month
IF YEAR%>=0 THEN
GOSUB KEYCAL.DISPCAL 'display the calendar
GOTO KEYCAL.TESTKEYS
ELSE
GOSUB KEYCAL.SOUNDOFF 'year would be invalid
GOTO KEYCAL.TESTKEYS
END IF
END IF
IF KEY.VAL=72 THEN 'cursor up key pressed?
YEAR%=YEAR%+1 'we want the next year, same month
GOSUB KEYCAL.DISPCAL 'display the calendar
GOTO KEYCAL.TESTKEYS
END IF
GOSUB KEYCAL.SOUNDOFF 'invalid extended key pressed
GOTO KEYCAL.TESTKEYS
'
KEYCAL.DISPCAL:
CALL CALENDAR(MONTH%,YEAR%,QUADRANT$,FORE%,BACK%,SHADOW%,RETURN.CODE%)
RETURN
'
KEYCAL.SOUNDOFF:
SOUND 1000,1 'alter user to problem/error
SOUND 1500,2
SOUND 500,1
RETURN
KEYCAL.EXIT:
END SUB