home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / basic / library / qb_pds / screen / bascreen / screen.bas next >
Encoding:
BASIC Source File  |  1988-11-03  |  6.5 KB  |  222 lines
  1. SUB SCREENI (ROWX%, COLX%, WID%, VAR%, FG%, BG%)  STATIC
  2. '-----------------------------------------------------------------------
  3. '    THIS SUB POSITIONS CURSOR AT ROWX, COLX OF SCREEN, AND READS IN
  4. '    INVERSE VIDEO THE INTEGER VARIABLE VAR, WID DIGITS.
  5. '    FG% AND BG% ARE THE NORMAL FORGROUND AND BACKGROUND COLORS, AND IN
  6. '    INVERSE VIDEO THEY WILL BE REVERSED.
  7. '    ESC ENDS PROGRAM, BACKSPACE OR CURSOR LEFT, RIGHT ALLOWS OVERWRITING
  8. '    IF Shift Tab IS PRESSED, ROWX% IS SET TO 51 AS SIGNAL TO CALLING PGM
  9. '    IF ROWX% < 0 THEN VAR% IS PUT INTO FIELD, BUT NO INPUT IS EXPECTED
  10. '    IF COLX% < 0 THEN VAR% IS PUT INTO FIELD, BUT MAY BE MODIFIED
  11. '-----------------------------------------------------------------------
  12.      ROW% = ABS(ROWX%)
  13.      COL% = ABS(COLX%)
  14.      LOCATE ROW%, COL%, 1
  15.      COLOR BG%, FG%
  16. 10 IF ROWX% < 0 THEN
  17.       PRINT USING STRING$(WID%, "#"); VAR%
  18.       COLOR FG%, BG%
  19.       EXIT SUB
  20.    END IF
  21.    IF COLX% < 0 THEN
  22.       PRINT USING STRING$(WID%, "#"); VAR%
  23.       LOCATE ROW%, COL%, 1
  24.    END IF
  25.    FOR J = 1 TO WID%
  26. 40 I$ = INKEY$: IF I$ = "" THEN 40
  27.    IF I$ = CHR$(27) THEN
  28.       COLOR FG%, BG%
  29.       CLS
  30.       END
  31.    END IF
  32.    IF I$ = CHR$(13) OR I$ = CHR$(9) THEN GOTO 100  ' CR OR TAB
  33.    IA = ASC(RIGHT$(I$, 1))
  34.    L = LEN(I$)
  35.    IF J > 1 AND ((L = 2 AND IA = 75) OR I$ = CHR$(8)) THEN ' BACKSPACE
  36.       J = J - 1
  37.       LOCATE CSRLIN, POS(0) - 1, 1
  38.       GOTO 40
  39.    END IF
  40.    IF J < WID% AND L = 2 AND IA = 77 THEN ' CURSOR RIGHT
  41.       J = J + 1
  42.       LOCATE CSRLIN, POS(0) + 1, 1
  43.       GOTO 40
  44.    END IF
  45.    IF L = 2 AND IA = 15 THEN ' SHIFT TAB
  46.       ROWX% = 51
  47.       GOTO 100
  48.    END IF
  49.    IF L = 2 AND IA = 71 THEN ' HOME
  50.       J = 1
  51.       LOCATE CSRLIN, COL%, 1
  52.       GOTO 40
  53.    END IF
  54.    IF L = 2 AND IA = 79 THEN ' END
  55.       J = WID%
  56.       LOCATE CSRLIN, COL% - 1 + WID%, 1
  57.       GOTO 40
  58.    END IF
  59.    IF I$ <> " " AND I$ <> "-" AND (I$ < "0" OR I$ > "9") THEN
  60.       BEEP
  61.       LOCATE CSRLIN, POS(0), 1
  62.       GOTO 40
  63.    END IF
  64.    PRINT I$;
  65.    NEXT J
  66. 100 I$ = ""
  67.     FOR J = COL% TO COL% - 1 + WID%
  68.         I$ = I$ + CHR$(SCREEN(ROW%, J))
  69.     NEXT
  70.     VAR% = VAL(I$)
  71.     COLOR FG%, BG%
  72. END SUB
  73.  
  74. SUB SCREENF (ROWX%, COLX%, WID%, VAR!, FG%, BG%)  STATIC
  75. '-----------------------------------------------------------------------
  76. '    THIS SUB POSITIONS CURSOR AT ROWX, COLX OF SCREEN, AND READS IN
  77. '    INVERSE VIDEO THE REAL VARIABLE VAR, WID DIGITS.
  78. '    FG% AND BG% ARE THE NORMAL FORGROUND AND BACKGROUND COLORS, AND IN
  79. '    INVERSE VIDEO THEY WILL BE REVERSED.
  80. '    ESC ENDS PROGRAM, BACKSPACE OR CURSOR LEFT, RIGHT ALLOWS OVERWRITING
  81. '    IF Shift Tab IS PRESSED, ROWX% IS SET TO 51 AS SIGNAL TO CALLING PGM
  82. '    IF ROWX% < 0 THEN VAR! IS PUT INTO FIELD, BUT NO INPUT IS EXPECTED
  83. '    IF COLX% < 0 THEN VAR! IS PUT INTO FIELD, BUT MAY BE MODIFIED
  84. '-----------------------------------------------------------------------
  85.      ROW% = ABS(ROWX%)
  86.      COL% = ABS(COLX%)
  87.      LOCATE ROW%, COL%, 1
  88.      COLOR BG%, FG%
  89.      IF ROWX% < 0 OR COLX% < 0 THEN
  90.         VAR$ = LEFT$(LTRIM$(STR$(VAR!)), WID%)
  91.      END IF
  92. F10: IF ROWX% < 0 THEN
  93.       PRINT VAR$
  94.       COLOR FG%, BG%
  95.       EXIT SUB
  96.    END IF
  97.    IF COLX% < 0 THEN
  98.       PRINT VAR$
  99.       LOCATE ROW%, COL%, 1
  100.    END IF
  101.    FOR J = 1 TO WID%
  102. F40: I$ = INKEY$: IF I$ = "" THEN GOTO F40
  103.    IF I$ = CHR$(27) THEN
  104.       COLOR FG%, BG%
  105.       CLS
  106.       END
  107.    END IF
  108.    IF I$ = CHR$(13) OR I$ = CHR$(9) THEN GOTO F100  ' CR OR TAB
  109.    IA = ASC(RIGHT$(I$, 1))
  110.    L = LEN(I$)
  111.    IF J > 1 AND ((L = 2 AND IA = 75) OR I$ = CHR$(8)) THEN ' BACKSPACE
  112.       J = J - 1
  113.       LOCATE CSRLIN, POS(0) - 1, 1
  114.       GOTO F40
  115.    END IF
  116.    IF J < WID% AND L = 2 AND IA = 77 THEN ' CURSOR RIGHT
  117.       J = J + 1
  118.       LOCATE CSRLIN, POS(0) + 1, 1
  119.       GOTO F40
  120.    END IF
  121.    IF L = 2 AND IA = 15 THEN ' SHIFT TAB
  122.       ROWX% = 51
  123.       GOTO F100
  124.    END IF
  125.    IF L = 2 AND IA = 71 THEN ' HOME
  126.       J = 1
  127.       LOCATE CSRLIN, COL%, 1
  128.       GOTO F40
  129.    END IF
  130.    IF L = 2 AND IA = 79 THEN ' END
  131.       J = WID%
  132.       LOCATE CSRLIN, COL% - 1 + WID%, 1
  133.       GOTO F40
  134.    END IF
  135.    IF I$ <> "." AND I$ <> " " AND I$ <> "-" AND (I$ < "0" OR I$ > "9") THEN
  136.       BEEP
  137.       LOCATE CSRLIN, POS(0), 1
  138.       GOTO F40
  139.    END IF
  140.    PRINT I$;
  141.    NEXT J
  142. F100: I$ = ""
  143.     FOR J = COL% TO COL% - 1 + WID%
  144.         I$ = I$ + CHR$(SCREEN(ROW%, J))
  145.     NEXT
  146.     VAR! = VAL(I$)
  147.     COLOR FG%, BG%
  148. END SUB
  149.  
  150. SUB SCREENS (ROWX%, COLX%, WID%, VAR$, FG%, BG%)  STATIC
  151. '-----------------------------------------------------------------------
  152. '    THIS SUB POSITIONS CURSOR AT ROWX, COLX OF SCREEN, AND READS IN
  153. '    INVERSE VIDEO THE STRING VARIABLE VAR$, WID POSITIONS.
  154. '    FG% AND BG% ARE THE NORMAL FORGROUND AND BACKGROUND COLORS, AND IN
  155. '    INVERSE VIDEO THEY WILL BE REVERSED.
  156. '    ESC ENDS PROGRAM, BACKSPACE, CURSOR RIGHT, LEFT ALLOWS OVERWRITING
  157. '    IF Shift Tab IS PRESSED, ROWX% IS SET TO 51 AS SIGNAL TO CALLING PGM
  158. '    IF ROWX% < 0 THEN VAR$ IS PUT INTO FIELD, BUT NO INPUT IS EXPECTED
  159. '    IF COLX% < 0 THEN VAR$ IS PUT INTO FIELD, BUT MAY BE MODIFIED
  160. '-----------------------------------------------------------------------
  161.      ROW% = ABS(ROWX%)
  162.      COL% = ABS(COLX%)
  163.      LOCATE ROW%, COL%, 1
  164.      COLOR BG%, FG%
  165. 101 IF ROWX% < 0 THEN
  166.       PRINT VAR$
  167.       COLOR FG%, BG%
  168.       EXIT SUB
  169.    END IF
  170.    IF COLX% < 0 THEN
  171.       PRINT VAR$;
  172.       LOCATE ROW%, COL%, 1
  173.    END IF
  174.    FOR J = 1 TO WID%
  175. 401 I$ = INKEY$: IF I$ = "" THEN 401
  176.    IF I$ = CHR$(27) THEN
  177.       COLOR FG%, BG%
  178.       CLS
  179.       END
  180.    END IF
  181.    IA = ASC(RIGHT$(I$, 1))
  182.    L = LEN(I$)
  183.    IF J > 1 AND ((L = 2 AND IA = 75) OR I$ = CHR$(8)) THEN ' BACKSPACE
  184.       J = J - 1
  185.       LOCATE CSRLIN, POS(0) - 1, 1
  186.       GOTO 401
  187.    END IF
  188.    IF J < WID% AND L = 2 AND IA = 77 THEN ' CURSOR RIGHT
  189.       J = J + 1
  190.       LOCATE CSRLIN, POS(0) + 1, 1
  191.       GOTO 401
  192.    END IF
  193.    IF L = 2 AND IA = 15 THEN ' SHIFT TAB
  194.       ROWX% = 51
  195.       GOTO 901
  196.    END IF
  197.    IF L = 2 AND IA = 71 THEN ' HOME
  198.       J = 1
  199.       LOCATE CSRLIN, COL%, 1
  200.       GOTO 401
  201.    END IF
  202.    IF L = 2 AND IA = 79 THEN ' END
  203.       J = WID%
  204.       LOCATE CSRLIN, COL% - 1 + WID%, 1
  205.       GOTO 401
  206.    END IF
  207.    IF I$ = CHR$(13) OR I$ = CHR$(9) THEN GOTO 901
  208.    IF L = 2 AND (IA = 75 OR IA = 77) THEN
  209.       BEEP
  210.       LOCATE CSRLIN, POS(0), 1
  211.       GOTO 401
  212.    END IF
  213.    PRINT I$;
  214.    NEXT J
  215. 901 I$ = ""
  216.     FOR J = COL% TO COL% - 1 + WID%
  217.         I$ = I$ + CHR$(SCREEN(ROW%, J))
  218.     NEXT
  219.     VAR$ = I$
  220.     COLOR FG%, BG%
  221. END SUB
  222.