home *** CD-ROM | disk | FTP | other *** search
/ Black Box 4 / BlackBox.cdr / database / datamage.arj / CODE.ZIP / MAILLIB.BAS < prev    next >
Encoding:
BASIC Source File  |  1990-11-18  |  20.1 KB  |  910 lines
  1.      COMMON SHARED K%(), FTOT%(), HDG$(), MC%, BYTES%
  2.     
  3.      DECLARE SUB INPT (MAX%, MC%, SEEDSW%, CTRL$, X$)
  4.      DECLARE SUB DECODER (TT1$, IS$)
  5.      DECLARE SUB MINPUT (CPTY%, X%, MAX%, ISRSW%, MISW%, ATTR%, CTRL$, PASS$, X$)
  6.      DECLARE SUB ROUNDOFF (DECS%, RIN#, ROUT#, ROUT$)
  7.      DECLARE SUB PARSE.DATE (REV%, WFG%, DC$, T1$, T2$, TT1$, TT2$, DC#)
  8.      DECLARE SUB CNTRSTRP (PTL%, CNTR%, CR1$, CR2$, TT1$, TT2$, CR$)
  9.  
  10.      DECLARE FUNCTION GET.CHOICE (LIMIT%, PMPT$())
  11.  
  12.      SUB CNTRSTRP (PTL%, CNTR%, CR1$, CR2$, TT1$, TT2$, CR$)
  13.  
  14.      TT1$ = RTRIM$(CR1$)
  15.      IF LEN(TT1$) = 0 THEN GOTO 4920
  16.  
  17. 4915 CR$ = TT1$ + " "
  18.      IF WFG9% = 1 THEN CR$ = CR$ + " ": GOTO 4940
  19.  
  20. 4920 TT2$ = RTRIM$(CR2$)
  21.      IF LEN(TT2$) = 0 THEN GOTO 4950
  22.  
  23. 4940 CR$ = CR$ + TT2$
  24.      KKK% = LEN(CR$): ZZZ% = KKK% MOD 2
  25.      IF ZZZ% = 1 AND LEN(TT1$) > 0 THEN WFG9% = 1: GOTO 4915
  26.      CNTR% = ((80 - KKK%) / 2) + 1
  27.  
  28. 4950 IF PTL% THEN LOCATE PTL%, CNTR%: PRINT CR$;
  29.  
  30. 4965 END SUB
  31.  
  32. SUB DECODER (TT1$, IS$)
  33.     
  34.      IS$ = ""
  35.   
  36.      FOR M% = 1 TO LEN(TT1$)
  37.   
  38.      B$ = MID$(TT1$, M%, 1): Y% = ASC(B$)
  39.   
  40.      IF M% = 1 THEN GOTO 7640
  41.   
  42.      C$ = MID$(TT1$, M% - 1, 1): IF C$ = B$ THEN GOTO 7650
  43.  
  44. 7640 IF Y% > 96 AND Y% < 123 THEN Y% = Y% - 32: GOTO 7645
  45.   
  46.      IF Y% > 64 AND Y% < 91 OR Y% > 47 AND Y% < 58 THEN GOTO 7645
  47.   
  48.      GOTO 7650
  49.  
  50. 7645 IS$ = IS$ + CHR$(Y%)
  51.  
  52. 7650 NEXT M%
  53.  
  54. END SUB
  55.  
  56. FUNCTION GET.CHOICE (LIMIT%, PMPT$())
  57.  
  58.      REDIM START%(10)
  59.    
  60.      CR1$ = PMPT$(0): CR2$ = ""
  61.  
  62.      FOR D% = 1 TO LIMIT%
  63.  
  64.           START%(D%) = LEN(CR2$)
  65.         
  66.           CR2$ = CR2$ + PMPT$(D%) + "  "
  67.  
  68.      NEXT
  69.  
  70.      CALL WW(ATTR%, 23, 78, 21, 1, 0, 7)
  71.  
  72.      CALL CNTRSTRP(23, CNTR%, CR1$, CR2$, TT1$, TT2$, CR$)
  73.  
  74.      X% = CNTR% + INSTR(CR$, PMPT$(1)) - 1
  75.  
  76.      FOR D% = 1 TO LIMIT%: START%(D%) = START%(D%) + X%: NEXT
  77.  
  78.      X% = 1
  79.    
  80.      LOCATE 23, START%(X%)
  81.      COLOR 0, 7: PRINT PMPT$(X%)
  82.  
  83.      WHILE WFG% = 0
  84.  
  85.           I$ = ""
  86.  
  87.           WHILE I$ = "": I$ = INKEY$: WEND
  88.  
  89.           IF LEN(I$) = 1 THEN
  90.         
  91.                A% = VAL(I$)
  92.         
  93.                IF A% AND A% <= LIMIT% THEN
  94.  
  95.                     GET.CHOICE = A%: WFG% = 1
  96.                     GOTO END.LOOP
  97.  
  98.                END IF
  99.         
  100.                IF ASC(I$) = 13 THEN
  101.         
  102.                     GET.CHOICE = X%: WFG% = 1
  103.                     GOTO END.LOOP
  104.  
  105.                END IF
  106.  
  107.                BEEP: GOTO END.LOOP
  108.         
  109.           END IF
  110.         
  111.           SELECT CASE ASC(MID$(I$, 2, 1))
  112.         
  113.           CASE 75:
  114.                   
  115.  
  116.                LOCATE 23, START%(X%)
  117.                COLOR MC%, 0: PRINT PMPT$(X%)
  118.  
  119.                IF X% > 1 THEN X% = X% - 1 ELSE X% = LIMIT%
  120.                            
  121.                LOCATE 23, START%(X%)
  122.                COLOR 0, 7: PRINT PMPT$(X%)
  123.  
  124.           CASE 77:
  125.                   
  126.  
  127.                LOCATE 23, START%(X%)
  128.                COLOR MC%, 0: PRINT PMPT$(X%)
  129.  
  130.                IF X% < LIMIT% THEN X% = X% + 1 ELSE X% = 1
  131.                            
  132.                LOCATE 23, START%(X%)
  133.                COLOR 0, 7: PRINT PMPT$(X%)
  134.  
  135.           CASE ELSE: BEEP
  136.  
  137.           END SELECT
  138.  
  139. END.LOOP:
  140.    
  141.      WEND
  142.  
  143.      COLOR MC%, 0
  144.  
  145.      EXIT FUNCTION
  146.  
  147. END FUNCTION
  148.  
  149. 100 SUB INPT (MAX%, MC%, SEEDSW%, CTRL$, X$)
  150.  
  151.     IF MC% < 8 THEN MC1% = MC% + 8 ELSE MC1% = MC%
  152.  
  153.     CL% = CSRLIN: CC% = POS(X)
  154.  
  155. 110 CHIN% = 0: CCC% = CC%: INST% = 0
  156.  
  157.     COLOR 12: A% = CC% + MAX%
  158.  
  159.     LOCATE CL%, A%: PRINT CHR$(186);
  160.     LOCATE CL% - 1, A%: PRINT CHR$(187);
  161.     LOCATE CL% + 1, A%: PRINT CHR$(188);
  162.  
  163.     A% = A% - 1
  164.  
  165.     FOR B% = A% TO CC% STEP -1
  166.     LOCATE CL% - 1, B%: PRINT CHR$(205);
  167.     LOCATE CL% + 1, B%: PRINT CHR$(205);
  168.     NEXT
  169.  
  170.     A% = CC% - 1
  171.     LOCATE CL%, A%: PRINT CHR$(186);
  172.     LOCATE CL% - 1, A%: PRINT CHR$(201);
  173.     LOCATE CL% + 1, A%: PRINT CHR$(200);
  174.   
  175.     LOCATE CL%, CC%: COLOR MC1%
  176.   
  177.      IF SEEDSW% = 1 THEN
  178.   
  179.           A$ = RTRIM$(X$)
  180.        
  181.           X$ = SPACE$(MAX%)
  182.           LSET X$ = A$
  183.   
  184.           CHIN% = LEN(A$)
  185.  
  186.           PRINT X$: SEEDSW% = 0
  187.  
  188.           CCC% = CC% + CHIN%
  189.  
  190.           LOCATE CL%, CCC%
  191.   
  192.           B% = INSTR(X$, ".")
  193.           IF B% THEN POINTSW% = 1
  194.    
  195.      ELSE X$ = SPACE$(MAX%)
  196.   
  197.      END IF
  198.   
  199.     WFG% = 0
  200.   
  201.     WHILE WFG% = 0
  202.  
  203.     IF INST% = 0 THEN GOSUB 420 ELSE GOSUB 430
  204.   
  205.     A$ = "": WHILE A$ = "": A$ = INKEY$: WEND
  206.  
  207.     IF LEN(A$) = 2 THEN
  208.   
  209.           B$ = RIGHT$(A$, 1): IA% = ASC(B$)
  210.           
  211. 220       SELECT CASE IA%
  212.  
  213.           CASE 71:
  214.   
  215.                CCC% = CC%
  216.   
  217.           CASE 82:
  218.   
  219.                IF INST% = 0 THEN INST% = 1 ELSE INST% = 0
  220.         
  221.           CASE 75:
  222.    
  223.                IF CCC% > CC% THEN
  224.         
  225.                     CCC% = CCC% - 1
  226.         
  227.                ELSE BEEP
  228.   
  229.                END IF
  230.  
  231.           CASE 77:
  232.   
  233.                IF (CCC% - CC%) < CHIN% THEN
  234.              
  235.                     CCC% = CCC% + 1
  236.         
  237.                ELSE BEEP
  238.   
  239.                END IF
  240.   
  241.           CASE 79:
  242.   
  243.                CCC% = CC% + CHIN%
  244.   
  245.           CASE 83:
  246.  
  247.                IC% = POS(X): A$ = MID$(X$, CCC% - CC% + 1, 1)
  248.  
  249.                IF CHIN% = 0 OR CCC% > MAX% + CC% OR CCC% - CC% > CHIN% - 1 THEN BEEP: GOTO 405
  250.  
  251.                FOR D5% = (CCC% - CC% + 1) TO MAX% - 1
  252.                   
  253.                     MID$(X$, D5%, 1) = MID$(X$, (D5% + 1), 1)
  254.   
  255.                NEXT
  256.  
  257.                MID$(X$, CHIN%, 1) = " "
  258.                CHIN% = CHIN% - 1
  259.                PRINT MID$(X$, CCC% - CC% + 1);
  260.  
  261.                LOCATE CL%, IC%
  262.              
  263.                IF A$ = "." THEN POINTSW% = 0
  264.  
  265.           CASE ELSE:
  266.  
  267.                BEEP
  268.  
  269.     END SELECT
  270.  
  271.     LOCATE CL%, CCC%
  272.   
  273.     GOTO 405
  274.   
  275.     END IF
  276.  
  277.     IX% = ASC(A$)
  278.  
  279.     SELECT CASE IX%
  280.   
  281.     CASE 13:  '  RETURN - EXIT
  282.   
  283.           WFG% = 2
  284.   
  285.     CASE 34: BEEP
  286.   
  287.     CASE 27:  '  ESCAPE - RESTART
  288.   
  289.           BEEP: LOCATE CL%, CC%
  290.           PRINT STRING$(MAX%, " "); : LOCATE CL%, CC%
  291.           WFG% = 1
  292.   
  293.     CASE 8:  '  DELETE
  294.   
  295.           IF CCC% > CC% THEN
  296.         
  297.                CCC% = CCC% - 1
  298.                LOCATE CL%, CCC%
  299.              
  300.                IA% = 83
  301.              
  302.                GOTO 220
  303.  
  304.           ELSE BEEP
  305.         
  306.           END IF
  307.  
  308.      CASE ELSE: GOTO 320
  309.  
  310.      END SELECT
  311.  
  312.      GOTO 405
  313.  
  314. 320  IF CTRL$ = "S" THEN
  315.    
  316.           IF IX% < 32 OR IX% > 125 THEN BEEP: GOTO 405
  317.    
  318.      ELSE
  319.  
  320.           SELECT CASE IX%
  321.    
  322.           CASE 45:
  323.   
  324.                IF CCC% <> CC% OR INST% = 1 AND MID$(X$, 1, 1) = "-" THEN BEEP: GOTO 405
  325.         
  326.           CASE 46:
  327.   
  328.                IF POINTSW% = 0 THEN
  329.                   
  330.                     POINTSW% = 1
  331.         
  332.                ELSE
  333.              
  334.                     IF MID$(X$, CCC% - CC% + 1, 1) <> "." THEN BEEP: GOTO 405
  335.              
  336.                END IF
  337.         
  338.           CASE ELSE:
  339.  
  340.                IF IX% < 48 OR IX% > 57 THEN BEEP: GOTO 405
  341.  
  342.           END SELECT
  343.  
  344.      END IF
  345.  
  346.      IF INST% = 0 THEN
  347.  
  348.           Y% = CCC% - CC% + 1
  349.  
  350.           IF Y% > MAX% THEN BEEP: GOTO 405
  351.  
  352.           IF Y% > CHIN% THEN CHIN% = CHIN% + 1
  353.       
  354.           IF MID$(X$, Y%, 1) = "." AND A$ <> "." THEN POINTSW% = 0
  355.        
  356.           MID$(X$, Y%, 1) = A$: CCC% = CCC% + 1
  357.       
  358.           PRINT A$;
  359.         
  360.      ELSE
  361.   
  362.           IF CHIN% = MAX% THEN BEEP: GOTO 405
  363.  
  364.           IC% = (CCC% - CC% + 1): CHIN% = CHIN% + 1
  365.  
  366.           IF IC% > CHIN% - 1 THEN INST% = 0
  367.  
  368.   
  369.           FOR Y% = MAX% TO IC% + 1 STEP -1
  370.   
  371.                MID$(X$, Y%, 1) = MID$(X$, Y% - 1, 1)
  372.   
  373.           NEXT
  374.  
  375.           MID$(X$, IC%, 1) = CHR$(IX%)
  376.   
  377.           LOCATE CL%, CC%: PRINT X$;
  378.   
  379.           CCC% = CCC% + 1
  380.   
  381.      END IF
  382.  
  383.      LOCATE CL%, CCC%
  384.  
  385. 405 WEND
  386.  
  387.     IF WFG% = 1 THEN WFG% = 0: POINTSW% = 0: GOTO 110
  388.   
  389.     WFG% = 0
  390.     COLOR MC%: POINTSW% = 0: GOSUB 440
  391.     A$ = RTRIM$(X$): X$ = A$
  392.     GOTO 455
  393.  
  394. 420 CALL WW(0, 0, 0, 6, 7, 0, 1): RETURN
  395.  
  396. 430 CALL WW(0, 0, 0, 0, 7, 0, 1): RETURN
  397.  
  398. 440 CALL WW(0, 0, 0, 32, 0, 0, 1): RETURN
  399.  
  400. 455 END SUB
  401.  
  402.      SUB MINPUT (CPTY%, X%, MAX%, ISRSW%, MISW%, ATTR%, CTRL$, PASS$, X$)
  403.    
  404.      IF MC% < 8 THEN MC1% = MC% + 8 ELSE MC1% = MC%
  405.    
  406.      CL% = CSRLIN: CC% = POS(X)
  407.  
  408. RESTART:
  409.  
  410.      CHIN% = 0: INST% = 0: CCC% = CC%: POINTSW% = 0: GOSUB 8550
  411.    
  412.      IF PASS$ = SPACE$(LEN(PASS$)) OR PASS$ = STRING$(MAX%, CHR$(0)) THEN PASS$ = ""
  413.    
  414.      IF LEN(PASS$) THEN
  415.    
  416.           IF CTRL$ = "N" THEN
  417.    
  418.           IF VAL(PASS$) = 0 THEN PASS$ = ""
  419.    
  420.                B% = INSTR(PASS$, ".")
  421.                IF B% THEN POINTSW% = 1
  422.  
  423.           END IF
  424.  
  425.           IF LEN(PASS$) > MAX% THEN A$ = PASS$: PASS$ = MID$(A$, 1, MAX%)
  426.         
  427.           LSET X$ = PASS$: CHIN% = LEN(PASS$): PASS$ = ""
  428.  
  429.      ELSE X$ = SPACE$(MAX%)
  430.    
  431.      END IF
  432.  
  433.      IF ISRSW% = 0 THEN GOSUB 8580
  434.    
  435.      IF MISW% = 1 THEN BC% = 12 ELSE BC% = 6
  436.    
  437.      BSRSW% = 1: GOSUB 8320: COLOR MC1%
  438.    
  439.      LOCATE CL%, CC% + CHIN%: CCC% = POS(X)
  440.    
  441.      IF ISRSW% = 1 THEN ISRSW% = 0: GOTO 8350
  442.    
  443.      WFG% = 0
  444.    
  445.      WHILE WFG% = 0
  446.  
  447. 8065 IF INST% = 0 THEN GOSUB 8550 ELSE GOSUB 8560
  448.   
  449.      A$ = "": WHILE A$ = "": A$ = INKEY$: WEND
  450.    
  451.      IF LEN(A$) = 2 THEN
  452.    
  453.           B$ = RIGHT$(A$, 1): IA% = ASC(B$)
  454.    
  455. 8155      SELECT CASE IA%
  456.    
  457.           CASE 71:
  458.    
  459.                CCC% = CC%
  460.    
  461.           CASE 82:
  462.    
  463.                IF INST% = 0 THEN INST% = 1 ELSE INST% = 0
  464.         
  465.           CASE 75:
  466.    
  467.                IF CCC% > CC% THEN
  468.         
  469.                     CCC% = CCC% - 1
  470.         
  471.                ELSE BEEP: GOTO 8065
  472.  
  473.                END IF
  474.  
  475.           CASE 77:
  476.    
  477.                IF (CCC% - CC%) < CHIN% THEN
  478.         
  479.                     CCC% = CCC% + 1
  480.    
  481.                ELSE BEEP: GOTO 8065
  482.  
  483.                END IF
  484.  
  485.           CASE 79:
  486.    
  487.                CCC% = CC% + CHIN%: INST% = 0
  488.    
  489.           CASE 83:
  490.    
  491.                IC% = POS(X): A$ = MID$(X$, CCC% - CC% + 1, 1)
  492.  
  493.                IF CHIN% = 0 OR CCC% > MAX% + CC% OR CCC% - CC% > CHIN% - 1 THEN BEEP: GOTO 8270
  494.  
  495.                FOR D5% = (CCC% - CC% + 1) TO MAX% - 1
  496.                  
  497.                     MID$(X$, D5%, 1) = MID$(X$, (D5% + 1), 1)
  498.  
  499.                NEXT
  500.  
  501.                MID$(X$, CHIN%, 1) = " "
  502.                CHIN% = CHIN% - 1
  503.                PRINT MID$(X$, CCC% - CC% + 1);
  504.  
  505.                LOCATE CL%, IC%
  506.             
  507.                IF A$ = "." THEN POINTSW% = 0
  508.              
  509.           CASE ELSE: BEEP
  510.  
  511.           END SELECT
  512.         
  513.           LOCATE CL%, CCC%
  514.  
  515.           GOTO 8270
  516.  
  517.      END IF
  518.  
  519.      IX% = ASC(A$)
  520.   
  521.      SELECT CASE IX%
  522.    
  523.      CASE 13:
  524.    
  525.           WFG% = 1
  526.           GOTO 8270
  527.    
  528.      CASE 34:
  529.    
  530.           BEEP: GOTO 8065
  531.  
  532.      CASE 27:
  533.         
  534.           BEEP: WFG% = 2
  535.           GOTO 8270
  536.  
  537.      CASE 8:
  538.  
  539.           IF CCC% > CC% THEN
  540.              
  541.                IA% = 83
  542.              
  543.                CCC% = CCC% - 1
  544.                LOCATE CL%, CCC%
  545.              
  546.                GOTO 8155
  547.  
  548.           END IF
  549.  
  550.      CASE ELSE:
  551.  
  552.           GOTO 8185
  553.  
  554.      END SELECT
  555.  
  556.      GOTO 8270
  557.  
  558. 8185 IF CTRL$ = "S" THEN
  559.    
  560.           IF IX% < 32 OR IX% > 125 THEN BEEP: GOTO 8270
  561.    
  562.      ELSE
  563.  
  564.           Z% = 0
  565.         
  566. 8200      SELECT CASE IX%
  567.    
  568.           CASE 45:
  569.              
  570.                IF CCC% <> CC% OR INST% = 1 OR MID$(X$, 1, 1) = "-" THEN BEEP: GOTO 8270
  571.              
  572.           CASE 46:
  573.   
  574.                IF POINTSW% = 0 THEN
  575.              
  576.                     POINTSW% = 1
  577.                   
  578.                ELSE
  579.              
  580.                     IF MID$(X$, CCC% - CC% + 1, 1) <> "." THEN BEEP: GOTO 8270
  581.  
  582.                END IF
  583.   
  584.           CASE 65, 97: Z% = 1: T$ = "ADDED,"
  585.              
  586.           CASE 83, 115: Z% = 2: T$ = "SUBTRACTED,"
  587.              
  588.           CASE 77, 109: Z% = 3: T$ = "MULTIPLY,"
  589.              
  590.           CASE 68, 100: Z% = 4: T$ = "DIVIDE,"
  591.   
  592.           CASE ELSE:
  593.             
  594.                IF IX% < 48 OR IX% > 57 THEN BEEP: GOTO 8270
  595.  
  596.           END SELECT
  597.  
  598.      END IF
  599.  
  600.      IF Z% THEN GOSUB 8500: GOTO 8270
  601.  
  602.      IF INST% = 0 THEN
  603.  
  604.           Y% = CCC% - CC% + 1
  605.  
  606.           IF Y% > MAX% THEN BEEP: GOTO 8270
  607.  
  608.           IF Y% > CHIN% THEN CHIN% = CHIN% + 1
  609.        
  610.           IF MID$(X$, Y%, 1) = "." AND A$ <> "." THEN POINTSW% = 0
  611.         
  612.           MID$(X$, Y%, 1) = A$: CCC% = CCC% + 1
  613.        
  614.           PRINT A$;
  615.        
  616.      ELSE
  617.  
  618.           IF CHIN% = MAX% THEN BEEP: GOTO 8270
  619.  
  620.           IC% = (CCC% - CC% + 1): CHIN% = CHIN% + 1
  621.  
  622.           IF IC% > CHIN% - 1 THEN INST% = 0
  623.  
  624.  
  625.           FOR Y% = MAX% TO IC% + 1 STEP -1
  626.  
  627.                MID$(X$, Y%, 1) = MID$(X$, Y% - 1, 1)
  628.  
  629.           NEXT
  630.  
  631.           MID$(X$, IC%, 1) = CHR$(IX%)
  632.  
  633.           LOCATE CL%, CC%: PRINT X$;
  634.  
  635.           CCC% = CCC% + 1
  636.  
  637.      END IF
  638.  
  639.      LOCATE CL%, CCC%
  640.  
  641. 8270 WEND
  642.  
  643.      IF WFG% = 2 THEN GOTO RESTART
  644.    
  645.      POINTSW% = 0: GOSUB 8565
  646.    
  647.      IF MISW% = 0 THEN GOTO 8345
  648.    
  649.      BC% = 6: A$ = X$: X$ = MID$(A$, 1, CHIN%)
  650.    
  651.      IF CTRL$ = "N" THEN
  652.   
  653.           Y% = INSTR(X$, ".")
  654.           IF Y% = 0 THEN GOTO 8320
  655.   
  656.           DECS% = K%(X%, 3): RIN# = VAL(X$)
  657.           CALL ROUNDOFF(DECS%, RIN#, ROUT#, ROUT$)
  658.           X$ = SPACE$(MAX%): LSET X$ = ROUT$
  659.  
  660.      END IF
  661.  
  662. 8320 IA% = CC% + MAX%: COLOR BC%
  663.      IX% = SCREEN(CL% - 2, IA%): LOCATE CL% - 1, IA%
  664.      IF IX% = 186 THEN PRINT CHR$(185); : GOTO 8323
  665.      IX% = SCREEN(CL% - 1, IA% + 1)
  666.      IF IX% = 205 OR IX% = 188 THEN PRINT CHR$(203);  ELSE PRINT CHR$(187);
  667.  
  668. 8323 LOCATE CL%, IA%: PRINT CHR$(186);
  669.      IX% = SCREEN(CL% + 2, IA%): LOCATE CL% + 1, IA%
  670.      IF IX% = 186 THEN PRINT CHR$(185); : GOTO 8330
  671.      IX% = SCREEN(CL% + 1, IA% + 1)
  672.      IF IX% = 205 OR X% = 187 THEN PRINT CHR$(202);  ELSE PRINT CHR$(188);
  673.  
  674. 8330 IA% = IA% - 1
  675.   
  676.      FOR B% = IA% TO CC% STEP -1
  677.    
  678.      IX% = SCREEN(CL% - 2, B%): IY% = SCREEN(CL% + 2, B%)
  679.      LOCATE CL% - 1, B%: COLOR BC%
  680.      IF IX% = 186 THEN PRINT CHR$(202);  ELSE PRINT CHR$(205);
  681.      IF BC% = 12 THEN COLOR MC1% ELSE COLOR MC%
  682.      LOCATE CL%, B%: PRINT MID$(X$, (B% - CC% + 1), 1);
  683.      LOCATE CL% + 1, B%: COLOR BC%
  684.      IF IY% = 186 THEN PRINT CHR$(203) ELSE PRINT CHR$(205);
  685.    
  686.      NEXT
  687.   
  688.      IA% = CC% - 1
  689.      IX% = SCREEN(CL% - 2, IA%): LOCATE CL% - 1, IA%
  690.      IF IX% = 186 THEN PRINT CHR$(204);  ELSE PRINT CHR$(201);
  691.      LOCATE CL%, IA%: PRINT CHR$(186);
  692.      IX% = SCREEN(CL% + 2, IA%): LOCATE CL% + 1, IA%
  693.      IF IX% = 186 THEN PRINT CHR$(204);  ELSE PRINT CHR$(200);
  694.    
  695.      IF BSRSW% = 1 THEN BSRSW% = 0: RETURN
  696.  
  697. 8345 POINTSW% = 0: MISW% = 0
  698.  
  699.      IF K%(X%, 1) <> 0 OR LEN(X$) = 0 THEN GOTO 8350
  700.    
  701.      DT$ = X$: CALL PARSE.DATE(K%(X%, 3), WFG%, DT$, T1$, T2$, TT1$, TT2$, DC#)
  702.    
  703.      IF WFG% > 0 THEN
  704.       
  705.         BEEP: PASS$ = X$: MISW% = 1
  706.       
  707.         GOTO RESTART
  708.    
  709.      END IF
  710.  
  711. 8350 EXIT SUB
  712.  
  713. 8500 IF Z% = 1 OR Z% = 2 THEN CR1$ = "ENTER VALUE TO BE " ELSE CR1$ = "ENTER VALUE BY WHICH TO "
  714.      CR1$ = CR1$ + T$: CR1$ = CR1$ + " OR 0 TO ABORT: "
  715.      T$ = MID$(X$, 1, CHIN%): OV# = VAL(T$)
  716.  
  717. 8510 COLOR MC%: GOSUB 8567
  718.      LOCATE 23, 8: PRINT CR1$;
  719.      MAX% = 18: CTRL$ = "N": GOSUB 8575
  720.  
  721.      A# = VAL(X$)
  722.    
  723.      IF A# THEN
  724.    
  725.           SELECT CASE Z%
  726.    
  727.           CASE 1: B# = OV# + A#
  728.           CASE 2: B# = OV# - A#
  729.           CASE 3: B# = OV# * A#
  730.           CASE 4: B# = OV# / A#
  731.  
  732.           END SELECT
  733.         
  734.      ELSE B# = OV#
  735.  
  736.      END IF
  737.    
  738.      RIN# = B#: DECS% = K%(X%, 3)
  739.      CALL ROUNDOFF(DECS%, RIN#, ROUT#, ROUT$)
  740.    
  741.      LOCATE CL%, CC%: COLOR MC1%: PRINT SPACE$(MAX%)
  742.      LOCATE CL%, CC%: PRINT ROUT$;
  743.    
  744.      IF A# <> 0 AND Z% < 3 THEN OV# = B#: GOTO 8510
  745.  
  746. 8530 GOSUB 8580: X$ = SPACE$(MAX%): LSET X$ = ROUT$
  747.      MAX% = 22: CHIN% = LEN(ROUT$): CCC% = CC% + CHIN%: LOCATE CL%, CCC%
  748.    
  749.      Z% = INSTR(ROUT$, ".")
  750.      IF Z% THEN POINTSW% = 1 ELSE POINTSW% = 0
  751.    
  752.      COLOR MC1%: RETURN
  753.  
  754. 8550 CALL WW(ATTR%, 0, 0, 6, 7, 0, 1): RETURN
  755.  
  756. 8560 CALL WW(ATTR%, 0, 0, 0, 7, 0, 1): RETURN
  757.  
  758. 8565 CALL WW(ATTR%, 0, 0, 32, 0, 0, 1): RETURN
  759.  
  760. 8567 CALL WW(ATTR%, 23, 78, 21, 1, 0, 7): RETURN
  761.  
  762. 8575 CALL INPT(MAX%, MC%, SEEDSW%, CTRL$, X$): COLOR MC%: RETURN
  763.  
  764. 8580 A$ = STR$(X%) + ". " + HDG$(X%)
  765.    
  766.      T$ = A$ + SPACE$(42 - LEN(A$))
  767.   
  768.      IF K%(X%, 1) = 0 THEN
  769.       
  770.         T$ = T$ + "DATE FIELD:   "
  771.         IF K%(X%, 3) = 1 THEN T$ = T$ + "MM/DD/YY" ELSE T$ = T$ + "DD/MM/YY"
  772.         GOTO 8590
  773.    
  774.      END IF
  775.  
  776.      IF K%(X%, 1) = 1 THEN
  777.       
  778.         T$ = T$ + "STRING: "
  779.         IF K%(X%, 3) = 1 THEN T$ = T$ + "INDEXED UNIQUE"
  780.         IF K%(X%, 3) = 2 THEN T$ = T$ + "INDEXED"
  781.         IF K%(X%, 3) = 3 THEN T$ = T$ + "CROSS-INDEXED"
  782.         GOTO 8590
  783.    
  784.      END IF
  785.  
  786.      T$ = T$ + "NUMERIC:"
  787.      IF K%(X%, 1) > 2 THEN T$ = T$ + " DOLLAR FMT": GOTO 8590
  788.      IF K%(X%, 3) = 9 THEN T$ = T$ + " FLOATING POINT": GOTO 8590
  789.      T$ = T$ + STR$(K%(X%, 3)) + " DECIMALS"
  790.  
  791. 8590 T$ = T$ + SPACE$(67 - LEN(T$)): T$ = T$ + " BYTES:"
  792.      T$ = T$ + STR$(K%(X%, 2))
  793.  
  794.      GOSUB 8567: COLOR MC%: LOCATE 22, 2: PRINT T$
  795.      COLOR 6: LOCATE , 7: PRINT "MOVEMENT KEYS:  "; CHR$(27); "   "; CHR$(26); "   Home    End.  PRESS  RETURN TO RECORD  ENTRY"
  796.      LOCATE , 7: PRINT "FUNCTION KEYS:  Esc  (BLANK)  Inst  Del  BckSp  ";
  797.    
  798.      IF K%(X%, 1) > 1 THEN PRINT "Add  Subt  Mult  Div";
  799.    
  800.      RETURN
  801.    
  802.      END SUB
  803.  
  804. SUB PARSE.DATE (REV%, WFG%, DC$, T1$, T2$, TT1$, TT2$, DC#)
  805.  
  806. 5850 WFG% = 0: IF LEN(DC$) < 8 THEN WFG% = 1: GOTO 5870
  807.      FOR M% = 1 TO 8
  808.      IF M% = 3 OR M% = 6 THEN GOTO 5855
  809.      X% = ASC(MID$(DC$, M%, 1))
  810.      IF X% < 48 OR X% > 57 THEN WFG% = 1
  811. 5855 NEXT: IF WFG% = 1 THEN GOTO 5870
  812.  
  813.      T1$ = MID$(DC$, 1, 2): T2$ = MID$(DC$, 4, 2): TT1$ = MID$(DC$, 7, LEN(DC$))
  814.   
  815.      IF REV% = 1 THEN M% = VAL(T1$) ELSE M% = VAL(T2$)
  816.      IF M% < 1 OR M% > 12 THEN WFG% = 1: GOTO 5870
  817.  
  818.      IF REV% = 2 THEN M% = VAL(T1$) ELSE M% = VAL(T2$)
  819.      IF M% < 1 OR M% > 31 THEN WFG% = 1: GOTO 5870
  820.  
  821.      M% = VAL(TT1$): IF M% < 100 THEN TT2$ = "19" + TT1$: TT1$ = TT2$
  822.  
  823.      TT2$ = TT1$: IF REV% = 1 THEN TT2$ = TT2$ + T1$ + T2$ ELSE TT2$ = TT2$ + T2$ + T1$
  824.      DC# = VAL(TT2$)
  825.  
  826. 5870 END SUB
  827.  
  828. SUB ROUNDOFF (DECS%, RIN#, ROUT#, ROUT$)
  829.  
  830.      IF RIN# < 0 THEN RT$ = STR$(RIN#) ELSE RT$ = MID$(STR$(RIN#), 2)
  831.      OS$ = RT$: RX% = INSTR(RT$, ".")
  832.  
  833.      IF RX% = 0 THEN ROUT# = RIN#: ROUT$ = RT$: EXIT SUB
  834.  
  835.      RZ% = INSTR(RT$, "D")
  836.  
  837.      IF RZ% = 0 THEN GOTO 2204
  838.  
  839.      RTT$ = MID$(RT$, RZ% + 2, 2): RN% = VAL(RTT$)
  840.      RTT$ = MID$(RT$, RZ% + 1, 1)
  841.    
  842.      IF RTT$ = "+" THEN GOTO 2200
  843.    
  844.      RTT$ = "." + STRING$(RN% - 1, "0") + MID$(RT$, 1, RX% - 1) + MID$(RT$, RX% + 1, RZ% - 1)
  845.      RT$ = RTT$: RX% = 1: GOTO 2204
  846.  
  847. 2200 RTT$ = MID$(RT$, 1, RZ% - 1): RT$ = RTT$
  848.      RZ% = LEN(RTT$) - RX%
  849.    
  850.      IF RZ% < RN% THEN RT$ = RT$ + STRING$(RN% + 1 - RZ%, "0")
  851.  
  852.      FOR RD% = RX% TO RX% + RN%
  853.      MID$(RT$, RD%, 1) = MID$(RT$, RD% + 1, 1)
  854.      NEXT
  855.  
  856.      MID$(RT$, RD% - 1, 1) = ".": RX% = RD%
  857.  
  858. 2204 IF MID$(RT$, 1, 1) = "." OR MID$(RT$, 1, 1) = "9" THEN RTT$ = "0" + RT$: RT$ = RTT$: RX% = RX% + 1
  859.  
  860.      RTT$ = MID$(RT$, RX% + 1)
  861.  
  862.      IF LEN(RTT$) <= DECS% THEN T$ = OS$: GOTO 2225
  863.  
  864. 2210 WFG% = 0: RWFG% = 0: RD% = LEN(RT$) + 1: RZ% = RX% + DECS%
  865.  
  866.      WHILE WFG% = 0 AND RD% > 1
  867.  
  868.         RD% = RD% - 1: RTT$ = MID$(RT$, RD%, 1)
  869.    
  870.         IF RTT$ = "." THEN GOTO 2220
  871.    
  872.         RY% = VAL(RTT$)
  873.    
  874.         IF RWFG% = 1 THEN RWFG% = 0: RY% = RY% + 1
  875.         IF RY% > 4 THEN RWFG% = 1
  876.         IF RY% = 10 THEN RY% = 0: XWFG% = 1 ELSE XWFG% = 0
  877.    
  878.         MID$(RT$, RD%, 1) = MID$(STR$(RY%), 2)
  879.  
  880.         IF RD% <= RZ% AND XWFG% = 0 THEN WFG% = 1
  881.  
  882. 2220 WEND
  883.  
  884.      IF MID$(RT$, 1, 1) = "0" THEN
  885.  
  886.      RTT$ = MID$(RT$, 2): RT$ = RTT$
  887.      RZ% = RZ% - 1
  888.  
  889.      END IF
  890.  
  891.      T$ = MID$(RT$, 1, RZ%)
  892.  
  893. 2225 D% = LEN(T$) + 1: WFG% = 0
  894.  
  895.      WHILE WFG% = 0 AND D% > 1
  896.  
  897.      D% = D% - 1: RTT$ = MID$(T$, D%, 1)
  898.      IF RTT$ <> "0" THEN WFG% = D%
  899.      IF RTT$ = "." THEN WFG% = D% - 1
  900.  
  901.      WEND
  902.  
  903.      IF WFG% = 0 THEN WFG% = 1
  904.  
  905.      ROUT$ = MID$(T$, 1, WFG%)
  906.      ROUT# = VAL(ROUT$)
  907.  
  908.      END SUB
  909.  
  910.