home *** CD-ROM | disk | FTP | other *** search
/ Simtel MSDOS - Coast to Coast / simteldosarchivecoasttocoast2.iso / calculat / rqm121.zip / RQMSMPL4.DTA < prev    next >
Text File  |  1991-02-15  |  12KB  |  316 lines
  1. %(), Element%, SegPtr%, OffPtr%)
  2. DECLARE SUB VWindow (Lines$(), LineLen, FldNo)
  3. DECLARE SUB VerEdScreen (RetArray$(), FirstFld%, LastFld%, FldNo%, FCode$, FChanged%, index%, YrsTo90%, curpos%)
  4.  
  5.  
  6. '----- The following arrays are mandatory -------------------------------
  7. REDIM ScrnArray(1)                      'holds the library of screens
  8. REDIM FormArray(1)                      'holds the field definitions
  9. REDIM ScrBuf(2000)                      'saves screen during multiple choice
  10.   DIM Choice$(1, 1)                     'must include
  11. '------------------------------------------------------------------------
  12.   DIM SHARED Col!(1 TO 10, -1 TO 70)
  13.   DIM SHARED FileName$
  14.   DIM SHARED HelpFlag
  15.   DIM SHARED index%(-1 TO 70)
  16.   DIM SHARED Lines$(9)
  17.   DIM SHARED Page%
  18.   DIM SHARED Pr$(9)
  19.   DIM SHARED Rec$(20)
  20.   DIM SHARED RecNum%
  21.   DIM SHARED ScrnName$
  22.   DIM SHARED Value$(10)
  23.   DIM SHARED Value#(80)
  24.  
  25.   DIM Lib(1)
  26.   DIM Item$(5)
  27.  
  28. DEF SEG = 0                             'look in low memory
  29. IF (PEEK(1040) AND 48) = 48 THEN        'check the monitor type
  30.     LOCATE , , 0, 0, 7                 'the mono cursor size if Pause is used
  31. ELSE
  32.     LOCATE , , 0, 1, 6                  'color cursor size
  33. END IF
  34.  
  35.  
  36. '****** MenuOne lines *********
  37.  
  38. '****** prompt lines
  39. Pr$(1) = " F1= Help "
  40. Pr$(2) = " F1= Help                  F3= Recalc"
  41. Pr$(3) = " F1= Help     F2= Menu     F3= Recalc     F6= Erase Page      F10= Next Screen"
  42. Pr$(4) = " F1= Help     F2= Menu     F3= Recalc     F9= Prev Screen"
  43. Pr$(5) = " F1= Help    F3= Recalc   F6= Erase Page   F9= Prev Screen    F10= Next Screen"
  44. Pr$(7) = " F1= Intro    F2= Menu"
  45. Pr$(8) = " Edit the form as necessary.  Press <Esc> when finished"
  46. '----------- Set initial values
  47. 'LibName$ = "Ver1scr"
  48. LibName$ = "Ver2scr"
  49. '-----------------Executable code starts here_____________________
  50. 'restart:
  51.  
  52. CLS
  53. '----- Load the library and field definitions
  54.  
  55. CALL LoadLib(LibName$, ErrFlag)         'load the one library for this prgm
  56. IF ErrFlag THEN
  57.    PRINT "The Screen formats are not on this disk"
  58.    END
  59. END IF
  60.  
  61. '_________ Title screen
  62.         IF F2Flag = 0 THEN
  63.               ScrnName$ = "Title1"
  64.                 CALL DisplayScrn(ScrnName$, ErrFlag)
  65.               SLEEP (15): keyhit$ = INKEY$
  66.                 CLS
  67.         END IF
  68.  
  69. '_____ Define F1 as event (Help)
  70. ON KEY(1) GOSUB Help
  71. KEY(1) ON
  72.  
  73. '---------- Initial display
  74. CALL PageOne(RecNum%, Rec$(), F2Flag)
  75.  
  76.  
  77. DO                                 'PRIMARY DO-LOOP to wait for a key
  78. '    LOCATE 25, 60: PRINT "Pg/Flag="; Page%; "/"; F2Flag;
  79.  
  80.     DO
  81.        keyhit$ = INKEY$
  82.     LOOP UNTIL keyhit$ <> ""
  83.  
  84. '------ Check for special keys and establish scancode% for Pages
  85.         IF LEFT$(keyhit$, 1) = CHR$(0) THEN
  86.            scancode% = ASC(RIGHT$(keyhit$, 1))
  87.           
  88.            IF scancode% = 60 THEN                             'F2 menu key
  89.                  LOCATE 25, 1: PRINT SPACE$(80);              'clears line 25
  90.                    IF Page% = 1 THEN
  91.                      CALL Pg1Menu(Choice, F2Flag)
  92.                    ELSEIF Page% = 3 THEN
  93.                      CALL Pg3Menu(Choice, F2Flag)
  94.                    END IF
  95.                KEY(1) ON
  96.            ELSEIF scancode% = 61 AND RecNum% <> 0 THEN       'F3 same screen
  97.               CALL Pages(Page%, scancode%)
  98.            ELSEIF scancode% = 64 AND RecNum% <> 0 THEN       'F6 erase screen
  99.               CALL Pages(Page%, scancode%)
  100.            ELSEIF scancode% = 68 AND RecNum% <> 0 THEN       'F10 next screen
  101.               CALL Pages(Page%, scancode%)
  102. '           ELSEIF scancode% = 66 AND RecNum% <> 0 THEN       'F8 temp exit
  103. '              END
  104.            ELSEIF scancode% = 67 AND RecNum% <> 0 THEN       'F9 prev screen
  105.               CALL Pages(Page%, scancode%)
  106.            ELSEIF scancode% = 47 AND RecNum% <> 0 THEN       'hidden ver #
  107.               IF Page% = 1 THEN
  108.                  LOCATE 25, 1: PRINT "Ver. 1.1 Copyright 1990 Rod Hoisington. s/n XXXXXXX. Dated 10-1-90";
  109.                  DO: LOOP UNTIL LEN(INKEY$)
  110.                  LOCATE 25, 1: PRINT SPACE$(80);              'clears line 25
  111.               END IF
  112.            END IF
  113.         END IF
  114. LOOP
  115. END
  116.  
  117. Help:
  118. ' ********** Display the Help Screens
  119. IF HelpFlag = 0 THEN CALL ScrSave
  120. CALL Help(Page%, F2Flag%, LastFld)
  121. IF HelpFlag = 0 THEN CALL ScrRest(1, 25)
  122. RETURN
  123.  
  124. '*********** Error Routines (activate before compiling)
  125. handler1:                                       ' for page3 calc
  126.   SELECT CASE ERR
  127.     
  128.      CASE 6                                      'overflow
  129.        LOCATE 25, 1: CALL MQPrint(SPACE$(80), -1)
  130.        LOCATE 25, 1: CALL MQPrint("   Overlimit - please wait ", -1)
  131.        RESUME NEXT
  132.     
  133.      CASE 11                                     'division by zero
  134.        LOCATE 25, 1: CALL MQPrint(SPACE$(80), -1)
  135.        LOCATE 25, 1: CALL MQPrint("Division by zero", -1)
  136.        RESUME NEXT
  137.  
  138.      CASE ELSE                    'temp leave in runtime
  139.        ON ERROR GOTO 0
  140.   END SELECT
  141.  
  142. handler2:                                        'for PrtPlan
  143.   SELECT CASE ERR
  144.     
  145.      CASE 24
  146.        COLOR 7, 0                                'required
  147.        CLS
  148.        LOCATE 10, 11: COLOR 7, 0
  149.          PRINT "Device timeout.":
  150.            DO: LOOP UNTIL LEN(INKEY$)
  151. '         PRINT "                      or press <ESC> to restart     ":
  152. '           DO: keyhit$ = INKEY$: LOOP UNTIL keyhit$ <> ""
  153. '             IF keyhit$ = CHR$(27) THEN F2Flag = 9': GOTO RESTART
  154. '                   IF RecNum% = 99 THEN F2Flag = 3       'skip Choices
  155.          RESUME NEXT
  156.     
  157.      CASE 25
  158.        COLOR 7, 0                                'required
  159.        CLS
  160.        LOCATE 10, 11: COLOR 7, 0
  161.          PRINT "Turn Printer on, then press any key to continue.":
  162.            DO: LOOP UNTIL LEN(INKEY$)
  163. '         PRINT "                           or press <ESC> to restart     ":
  164. '           DO: keyhit$ = INKEY$: LOOP UNTIL keyhit$ <> ""
  165. '           IF keyhit$ = CHR$(27) THEN F2Flag = 9: GOTO restart
  166. '                 IF RecNum% = 99 THEN F2Flag = 3       'skip Choices
  167.          RESUME
  168.     
  169.      CASE 27
  170.        COLOR 7, 0                                'required
  171.        CLS
  172.        LOCATE 10, 11: COLOR 7, 0
  173.          PRINT "Out of paper.  Correct and press any key to continue.":
  174.            DO: LOOP UNTIL LEN(INKEY$)
  175. '         PRINT "                                or press <ESC> to restart     ":
  176. '           DO: keyhit$ = INKEY$: LOOP UNTIL keyhit$ <> ""
  177. '            IF keyhit$ = CHR$(27) THEN F2Flag = 9': GOTO RESTART
  178. '                  IF RecNum% = 99 THEN F2Flag = 3       'skip Choices
  179.          RESUME
  180.     
  181.      CASE 68
  182.        COLOR 7, 0                                'required
  183.        CLS
  184.        LOCATE 10, 11: COLOR 7, 0
  185.          PRINT "Turn Printer on, then press any key to continue.":
  186.            DO: LOOP UNTIL LEN(INKEY$)
  187. '         PRINT "                           or press <ESC> to restart     ":
  188. '           DO: keyhit$ = INKEY$: LOOP UNTIL keyhit$ <> ""
  189. '           IF keyhit$ = CHR$(27) THEN F2Flag = 9: GOTO restart
  190. '                 IF RecNum% = 99 THEN F2Flag = 3       'skip Choices
  191.          RESUME
  192.      CASE ELSE                  'temp leave in runtime
  193.        COLOR 7, 0                                'required
  194.        CLS
  195.        LOCATE 10, 11: COLOR 7, 0
  196.        PRINT "A system error occurred, #" + STR$(ERR)
  197.            DO: LOOP UNTIL LEN(INKEY$)
  198.        ON ERROR GOTO 0
  199.   END SELECT
  200.  
  201. END
  202.  
  203. SUB Help (Page%, F2Flag%, LastFld)
  204.  
  205. KEY(1) OFF
  206.  
  207.     'LastFld not xferring from PageOne to this module - fix later
  208. '    IF LastFld = 0 THEN LastFld = 1
  209.     row = CSRLIN                                'saves position
  210.      IF row = 25 THEN row = 24
  211.     Col = POS(0)                                'saves position
  212.      IF Col = 1 THEN Col = 80
  213.  
  214.     CALL ScrSave
  215.      CLS
  216.     IF Page% <= 1 AND F2Flag = 0 THEN
  217.         LOCATE , , 0
  218.                 ScrnName$ = "Intro1"
  219.                 CALL DisplayScrn(ScrnName$, ErrFlag)
  220.            DO: keyhit$ = INKEY$: LOOP UNTIL keyhit$ <> ""
  221.                 ScrnName$ = "Intro2"
  222.                 CALL DisplayScrn(ScrnName$, ErrFlag)
  223.            DO: keyhit$ = INKEY$: LOOP UNTIL keyhit$ <> ""
  224.                 CLS
  225.                 Choice = 1
  226.                 CALL ScrRest(1, 25)
  227. '                LOCATE row, Col, 1                     'restores position
  228.                 KEY(1) ON
  229.                 EXIT SUB
  230.     ELSEIF Page% <= 1 THEN
  231.         LOCATE , , 0
  232.         ScrnName$ = "Helppg1"
  233.         CALL DisplayScrn(ScrnName$, ErrFlag)
  234.            DO: keyhit$ = INKEY$: LOOP UNTIL keyhit$ <> ""
  235.                 CLS
  236.                 Choice = 1
  237.                 CALL ScrRest(1, 25)
  238.                 LOCATE row, Col, 1                     'restores position
  239.                 KEY(1) ON
  240.                 EXIT SUB
  241.     ELSEIF Page% = 2 THEN
  242.         LOCATE , , 0
  243.         ScrnName$ = "Helppg2"
  244.         CALL DisplayScrn(ScrnName$, ErrFlag)
  245.            DO: keyhit$ = INKEY$: LOOP UNTIL keyhit$ <> ""
  246.                    CLS
  247.                 Choice = 1
  248.                 CALL ScrRest(1, 25)
  249.                 LOCATE row, Col, 1                     'restores position
  250.                 KEY(1) ON
  251.                 EXIT SUB
  252.     ELSEIF Page% = 3 THEN
  253.         LOCATE , , 0
  254. backto1:
  255.         ScrnName$ = "Helppg3a"
  256.         CALL DisplayScrn(ScrnName$, ErrFlag)
  257.            DO: keyhit$ = INKEY$: LOOP UNTIL keyhit$ <> ""
  258.                IF LEFT$(keyhit$, 1) = CHR$(0) THEN
  259.                    scancode% = ASC(RIGHT$(keyhit$, 1))
  260.                    IF scancode% = 59 THEN                         'F1 again
  261. backto2:             
  262.                       ScrnName$ = "Helppg3b"
  263.                       CALL DisplayScrn(ScrnName$, ErrFlag)
  264.                       DO: keyhit$ = INKEY$: LOOP UNTIL keyhit$ <> ""
  265.                       IF keyhit$ = CHR$(27) THEN GOTO backto1
  266.                    END IF
  267.                END IF
  268.                IF LEFT$(keyhit$, 1) = CHR$(0) THEN
  269.                    IF scancode% = 59 THEN                         'F1 again
  270.                       ScrnName$ = "Helppg3c"
  271.                       CALL DisplayScrn(ScrnName$, ErrFlag)
  272.                       DO: keyhit$ = INKEY$: LOOP UNTIL keyhit$ <> ""
  273.                       IF keyhit$ = CHR$(27) THEN GOTO backto2
  274.                    END IF
  275.                END IF
  276.                 CLS
  277.                 Choice = 1
  278.                 CALL ScrRest(1, 25)
  279.                 KEY(1) ON
  280.                 EXIT SUB
  281.     END IF
  282. END SUB
  283.  
  284. '*************************** SUB PageOne ***************************
  285. SUB PageOne (RecNum%, Rec$(), F2Flag)
  286.        '-----------------------------------
  287.        ' F2flag = 0                        -
  288.        ' F2flag = 1 load record            -
  289.        ' F2flag = 2 create record          -
  290.        ' F2flag = 3 demo                   -
  291.        ' F2flag = 4 display loaded record then exit      -
  292.        ' F2flag = 5 appendix               -
  293.        ' F2flag = 6 erase page             -
  294.        ' F2flag = 7 used in PrtPlan        -
  295.        ' F2flag = 9 loaded record-skip choices  -
  296.        ' F2flag = 10 #1 pension has cola
  297.        ' F2flag = 11 #2 pension has cola
  298.        '------------------------------------
  299.   STATIC LastChoice%
  300.   SHARED FormArray()
  301.   SHARED Item$()
  302.  
  303. '----- The following arrays are mandatory
  304. REDIM ScrnArray(1)                      'holds the library of screens
  305. REDIM FormArray(1)                      'holds the field definitions
  306. REDIM ScrBuf(2000)                      'saves screen during multiple choice
  307.   DIM Choice$(1, 1)                     'must include
  308. '----------------------------------------
  309.   DIM amt$(50)
  310.   DIM amt#(50)
  311.   DIM cnt%(50)
  312.   DIM NumRecs%(20)
  313.   DIM RecLen
  314.  
  315. '**              
  316.                                "    %  '  )Mr. Retiree                   These three additional        lines are available for       comments if desired.