home *** CD-ROM | disk | FTP | other *** search
/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / PROG / BASIC / BASWIND8.ZIP / KEYCAL.SUB < prev    next >
Encoding:
Text File  |  1990-09-14  |  5.0 KB  |  127 lines
  1. '
  2. '
  3. '******************************************************************************
  4. '                    Function : KEYCAL                                        *
  5. '                                                                             *
  6. ' Purpose:                                                                    *
  7. '                                                                             *
  8. '                                                                             *
  9. ' Results:                                                                    *
  10. '                                                                             *
  11. ' Usage  :                                                                    *
  12. '                                                                             *
  13. '                                                                             *
  14. ' Date Written : 09/01/90 - Date Tested: 09/01/90 - Author: James P Morgan    *
  15. ' Date Modified:          -            :          -       :                   *
  16. '-----------------------------------------------------------------------------*
  17. ' NOTE:                                                                       *
  18. '******************************************************************************
  19. '                                                                             *
  20. '     SUB PROGRAM NAME          (PARAMETERS)                 STATIC/RECURSIVE *
  21. '-----------------------------------------------------------------------------*
  22. '                                                                             *
  23. SUB    KEYCAL(MONTH%,YEAR%,QUADRANT$,FORE%,BACK%,SHADOW%,RETURN.CODE%)              STATIC
  24.  
  25.        DEFINT A-Z                             'make all short intergers by default
  26.  
  27.        RETURN.CODE%=0
  28.  
  29.        IF (MONTH%<1) OR (MONTH%>12) THEN      'edit month for validity
  30.            RETURN.CODE%=-2
  31.          GOTO KEYCAL.EXIT
  32.        END IF
  33.  
  34.        IF YEAR%<0 THEN                        'edit year for validity
  35.            RETURN.CODE%=-3
  36.          GOTO KEYCAL.EXIT
  37.        END IF
  38.  
  39.        GOSUB KEYCAL.DISPCAL                   'display the calendar for this month/year
  40.  
  41. '
  42. KEYCAL.TESTKEYS:
  43.        IF RETURN.CODE%<0 THEN
  44.          GOTO KEYCAL.EXIT
  45.        END IF
  46.  
  47.        Q$=INKEY$                              'wait for user to press a key
  48.        IF Q$="" THEN
  49.           GOTO KEYCAL.TESTKEYS
  50.        END IF
  51.  
  52.        IF Q$=CHR$(13)  THEN                   'an Enter key pressed?
  53.          GOTO KEYCAL.EXIT
  54.        END IF
  55.  
  56.        IF Q$=CHR$(27) THEN                    'an ESC key pressed?
  57.             RETURN.CODE%=-1
  58.          GOTO KEYCAL.EXIT
  59.        END IF
  60.  
  61.        IF LEN(Q$)=1 THEN                      'only an extended function key allowed
  62.             GOSUB KEYCAL.SOUNDOFF
  63.           GOTO KEYCAL.TESTKEYS
  64.        END IF
  65.  
  66.        KEY.VAL=ASC(RIGHT$(Q$,1))              'strip out the extended key code
  67.  
  68.        IF KEY.VAL=77 THEN                     'cursor right key pressed?
  69.              MONTH%=MONTH%+1                  'we want the next month
  70.             IF MONTH%=13 THEN                 'did the month roll over?
  71.                 MONTH%=1
  72.                 GOSUB KEYCAL.DISPCAL          'display the calendar
  73.               GOTO KEYCAL.TESTKEYS
  74.            ELSE
  75.                 GOSUB KEYCAL.DISPCAL          'display the calendar
  76.               GOTO KEYCAL.TESTKEYS
  77.            END IF
  78.        END IF
  79.  
  80.        IF KEY.VAL=75 THEN                     'cursor left key pressed?
  81.                 MONTH%=MONTH%-1               'we want the previous month
  82.            IF MONTH%=0 THEN                   'did the monthy roll back?
  83.                 MONTH%=12
  84.                 GOSUB KEYCAL.DISPCAL          'display the calendar
  85.               GOTO KEYCAL.TESTKEYS
  86.            ELSE
  87.                 GOSUB KEYCAL.DISPCAL          'display the calendar
  88.              GOTO KEYCAL.TESTKEYS
  89.            END IF
  90.        END IF
  91.  
  92.        IF KEY.VAL=80 THEN                      'cursor down key pressed?
  93.              YEAR%=YEAR%-1                     'we want the previous year, same month
  94.            IF YEAR%>=0 THEN
  95.                 GOSUB KEYCAL.DISPCAL           'display the calendar
  96.               GOTO KEYCAL.TESTKEYS
  97.            ELSE
  98.                 GOSUB KEYCAL.SOUNDOFF          'year would be invalid
  99.               GOTO KEYCAL.TESTKEYS
  100.            END IF
  101.        END IF
  102.  
  103.        IF KEY.VAL=72 THEN                      'cursor up  key pressed?
  104.            YEAR%=YEAR%+1                       'we want the next year, same month
  105.            GOSUB KEYCAL.DISPCAL                'display the calendar
  106.          GOTO KEYCAL.TESTKEYS
  107.        END IF
  108.  
  109.        GOSUB KEYCAL.SOUNDOFF                   'invalid extended key pressed
  110.        GOTO KEYCAL.TESTKEYS
  111.  
  112. '
  113. KEYCAL.DISPCAL:
  114.        CALL CALENDAR(MONTH%,YEAR%,QUADRANT$,FORE%,BACK%,SHADOW%,RETURN.CODE%)
  115.        RETURN
  116.  
  117. '
  118. KEYCAL.SOUNDOFF:
  119.        SOUND 1000,1                           'alter user to problem/error
  120.        SOUND 1500,2
  121.        SOUND 500,1
  122.        RETURN
  123.  
  124. KEYCAL.EXIT:
  125.  
  126. END SUB
  127.