home *** CD-ROM | disk | FTP | other *** search
/ World of Shareware - Software Farm 2 / wosw_2.zip / wosw_2 / QBAS / WNDTOOL5.ZIP / KEYCAL.SUB < prev    next >
Text File  |  1989-04-26  |  5KB  |  117 lines

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