home *** CD-ROM | disk | FTP | other *** search
/ Simtel MSDOS - Coast to Coast / simteldosarchivecoasttocoast2.iso / qbasic / qwez42.zip / MULTSAM3.BAS < prev    next >
BASIC Source File  |  1991-04-01  |  5KB  |  126 lines
  1. DECLARE SUB SETINPT (SCRN%, WID%, EX$, INPT%(), INPT$(), BC%)
  2. DECLARE SUB SETWIND (FST%, S%, SH%, NOHI%, DEC%, SA%, DFORMAT%)
  3. DECLARE SUB MULTINPT (SCRN%, FLD%, EXIT$, AEXIT%, RKEY%, RTRN$())
  4. DECLARE SUB MAKEWIND (W%, LABEL$, TR%, LC%, WD%, NR%, ATTR%, BORDER%)
  5. DECLARE SUB PRINTW (TEXT$, R%, LC%)
  6.  
  7. '***************************************************************************
  8. ' This is an example of using auto-exit fields in MULTINPT to print an  ****
  9. ' instruction line.                                                     ****
  10. '***************************************************************************
  11. '**** THIS PROGRAM MUST BE USED WITH ONE OF THE FOLLOWING LIBRARIES:    ****
  12. '***************************************************************************
  13. '**** For QB4.+ unenhanced version use QB4UNEN.QLB                      ****
  14. '**** For BASIC 7.+ unenhanced version use PDSUNEN.QLB                  ****
  15. '**** For QB4.+ enhanced version use QB4ALL.QLB or QB4NER.QLB           ****
  16. '**** For BASIC 7.0 enhanced version use PDSALL70.QLB or PDSNER70.QLB   ****
  17. '**** For BASIC 7.1 enhanced version use PDSALL71.QLB or PDSNER71.QLB   ****
  18. '**** Load QB or QBX with the /L option using the correct library       ****
  19. '***************************************************************************
  20.  
  21. CALL SETWIND(1, 1, 7, 0, 1, 1, 1)       ' INITIALIZE WINDOW MEMORY
  22. COLOR 7, 0: CLS                         ' BLANK THE SCREEN
  23. DIM RTRN$(4)                            ' FOR THE FOUR FIELDS
  24. DIM I AS STRING * 76
  25. '---------------------------------------------------------------------------
  26. ' SETINPT MUST BE CALLED FOR EACH MULTI-FIELD INPUT SCREEN
  27.  
  28. REDIM INPT%(25), INPT$(4)
  29. FLD% = 1: B% = 1
  30. DO
  31.   READ INPT%(B%)
  32.   IF INPT%(B%) = 9999 THEN EXIT DO
  33.   B% = B% + 1
  34.   FOR X% = 1 TO 5
  35.      READ INPT%(B%)
  36.      B% = B% + 1
  37.   NEXT
  38.   READ INPT$(FLD%)
  39.   FLD% = FLD% + 1
  40. LOOP
  41.  
  42. ' Auto-exit ( always ) - auto advance - numeric with no decimal places
  43. DATA 11000,5,5,4,15,99,""
  44. ' Auto-exit ( always ) - auto advance - numeric with no decimal places
  45. DATA 11000,7,5,4,15,99,""
  46. ' Protected - numeric with no decimal places
  47. DATA 100,9,5,5,15,99,""
  48. ' Auto-exit ( always ) - Alpha / numeric
  49. DATA 10007,11,5,15,15,99,""
  50. DATA 9999
  51.  
  52. CALL SETINPT(1, 80, "E", INPT%(), INPT$(), 0)       ' SET UP MULTI-INPUT AND
  53. ERASE INPT%, INPT$                                   ' GET THE MEMORY BACK.
  54.  
  55. '----------------------------------------------------------------------------
  56. ' THE MAIN PROGRAM
  57.  
  58. ' program
  59. ' program
  60.  
  61. GOSUB AUTOEXITEXAMPLE
  62.  
  63. ' program
  64. ' program
  65.  
  66. END
  67.  
  68. '---------------------------------------------------------------------------
  69. ' MULTI-FIELD SUB-ROUTINE
  70.  
  71. AUTOEXITEXAMPLE:
  72.  
  73. FLD% = 1: AUTOEXIT% = 0: EXIT$ = ""     ' START IN FIELD 1.  PRINT ALL
  74.                                         ' FIELDS.
  75. '----------------------------------------------------------------------------
  76. ' MAKE A WINDOW.  PRINT INSTRUCTIONS
  77.  
  78. CALL MAKEWIND(1, "@Auto-exit fields used print an instruction line", 1, 1, 80, 16, 112, 102)
  79. CALL PRINTW("Auto-exit and auto advance with numeric input", 2, 15)
  80. CALL PRINTW("+", 3, 5)
  81. CALL PRINTW("Auto-exit and auto advance with numeric input", 4, 15)
  82. CALL PRINTW("Protected Field", 6, 15)
  83. CALL PRINTW("Alpha-numeric", 8, 24)
  84. CALL PRINTW("Press ESC to end demonstration", 10, 100)
  85. CALL NEWCOLOR(15)
  86. '----------------------------------------------------------------------------
  87. PREINPT:
  88.    SELECT CASE FLD%                      ' WHICH FIELD?
  89.      CASE 1
  90.         I = "Input the first number."    ' INSTRUCTIONS
  91.      CASE 2
  92.         I = "Input the second number."   '   "
  93.      CASE 4
  94.         I = "Input anything!"            '   "
  95.     END SELECT
  96.     I = "INSTRUCTION FOR FIELD" + STR$(FLD%) + ": " + I
  97. CALL PRINTW(I, 12, 2)
  98.  
  99. CALL MULTINPT(1, FLD%, EXIT$, AUTOEXIT%, RKEY%, RTRN$())
  100.  
  101. ' FIRST CHECK TO SEE IF THE EXIT WAS DUE TO FIELD 1 OR 2 BEING EXITED,
  102. ' EITHER BY THE AUTO-EXIT FEATURE OR BY THE "F1" KEY.
  103. ' ON EXIT AUTOEXIT% POINTS TO THE FIELD THE CURSOR WAS ON WHEN MULTINPT
  104. ' WAS EXITED ( IF IT WAS AN AUTOEXIT FIELD. ).  ON EXIT FLD% POINTS TO
  105. ' THE FIELD THE CURSOR IS MOVING INTO.
  106. ' THE CALL TO MULTINPT IN THE "IF - END IF" BLOCK IS USED TO UPDATE
  107. ' FIELD 3 ONLY.
  108.  
  109.    IF AUTOEXIT% = 1 OR AUTOEXIT% = 2 THEN             ' FIELD 1 OR 2. UPDATE
  110.       RTRN$(3) = STR$(VAL(RTRN$(1)) + VAL(RTRN$(2)))  ' THE PROTECTED FIELD.
  111.       IF RTRN$(1) = "" AND RTRN$(2) = "" THEN RTRN$(3) = ""
  112.       CALL MULTINPT(1, FLD%, "VIEW", 3, RKEY%, RTRN$()) ' UPDATE FIELD 3 ONLY.
  113.    END IF
  114.  
  115.   IF EXIT$ = "AUTO" GOTO PREINPT              ' WAS NOT "F1".  ONLY ONE
  116.                                               ' FIELD WILL UPDATE AS
  117.                                               ' AUTOEXIT% CAN NOT EQUAL 0.
  118.                                               ' UPON EXIT OF MULTINPT FLD%
  119.                                               ' IS SET TO NEXT FIELD NUMBER
  120.                                               ' FOR THE CURSOR.
  121.  
  122. RETURN                             ' PROGRAM WILL ALWAYS COMES HERE IF ESC
  123.                                    ' IS PRESSED AS EXIT$ = "ESC"
  124.                                    
  125.  
  126.