home *** CD-ROM | disk | FTP | other *** search
/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / PROG / BASIC / QWEZ42.ZIP / MULTSAM1.BAS < prev    next >
Encoding:
BASIC Source File  |  1991-04-01  |  5.0 KB  |  129 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 a field in MULTINPT as a FIXED CHOICE     ****
  9. ' field.  Field two provides the choices of BASIC, PASCAL, OR ASSEMBLY. ****
  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$(3)                            ' FOR THE THREE FIELDS
  24.  
  25. '---------------------------------------------------------------------------
  26. ' SETINPT MUST BE CALLED FOR EACH MULTI-FIELD INPUT SCREEN
  27.  
  28. REDIM INPT%(19), INPT$(3)
  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. ' Alpha / numeric
  43. DATA 7,5,5,30,15,99,""
  44. ' Fixed choice - alpha / numeric
  45. DATA 30007,7,5,9,15,99,""
  46. ' Alpha / nuneric
  47. DATA 7,9,5,30,15,99,""
  48. DATA 9999
  49.  
  50. CALL SETINPT(1, 80, "1", INPT%(), INPT$(), 0)
  51. ERASE INPT%, INPT$
  52. '----------------------------------------------------------------------------
  53. ' THE MAIN PROGRAM
  54.  
  55. ' program
  56. ' program
  57.  
  58. GOSUB FIXEDEXAMPLE
  59.  
  60. ' program
  61. ' program
  62.  
  63. END
  64.  
  65. '---------------------------------------------------------------------------
  66. ' MULTI-FIELD SUB-ROUTINE
  67.  
  68. FIXEDEXAMPLE:
  69.  
  70. FLD% = 1: AUTOEXIT% = 0: EXIT$ = ""     ' START IN FIELD 1.  PRINT ALL
  71.                                         ' FIELDS.
  72. '----------------------------------------------------------------------------
  73. ' MAKE A WINDOW.  PRINT INSTRUCTIONS
  74.  
  75. CALL MAKEWIND(1, "@Fixed Choice Demonstration - Second field has three choices", 1, 1, 80, 12, 112, 102)
  76. CALL PRINTW("Any alpha/numeric input", 2, 38)
  77. CALL PRINTW("SPACE BAR changes field - cusror movement keys exit field", 4, 15)
  78. CALL PRINTW("Any alpha/numeric input", 6, 38)
  79. CALL PRINTW("Press F1 to end demonstration", 8, 100)
  80.  
  81. '----------------------------------------------------------------------------
  82. ' INITIALIZES DATA FOR FIELD 2.  PROGRAM ONLY DOES THIS ON FIRST CALL TO
  83. ' CALL THE MULTI-INPUT SCREEN AS MULTPASS% IS SET TO 1 AFTER FIRST PASS.
  84. ' IF THIS MULT-FIELD INPUT SCREEN IS CALLED AGAIN THE PROGRAM WILL
  85. ' "REMEMBER" WHAT WAS IN FIELD 2 AND WILL NOT RESET IT TO "BASIC"
  86.  
  87. IF MULTPASS% = 0 THEN
  88.   DIM CHOICE$(3)
  89.   CHOICE$(1) = "BASIC"              ' CHOICES FOR FIXED FIELD 2.
  90.   CHOICE$(2) = "PASCAL"             ' "                        "
  91.   CHOICE$(3) = "ASSEMBLY"           ' "                        "
  92.   LANGCHOICE% = 1                   ' MAKE IT "BASIC" FOR FIRST PASS
  93.   MULTPASS% = 1
  94. END IF
  95.  
  96. ' ---------------------------------------------------------------------------
  97.  
  98. PREINPT:
  99. RTRN$(2) = CHOICE$(LANGCHOICE%)    ' RESET FIELD 2
  100.  
  101. CALL MULTINPT(1, FLD%, EXIT$, AUTOEXIT%, RKEY%, RTRN$())
  102.  
  103. ' FIRST CHECK TO SEE IF THE EXIT WAS DUE TO FIELD 2 BEING EXITED,
  104. ' EITHER BY THE AUTO-EXIT FEATURE OR BY THE "F1" KEY.
  105. ' ON EXIT AUTOEXIT% POINTS TO THE FIELD THE CURSOR WAS ON WHEN MULTINPT
  106. ' WAS EXITED ( IF IT WAS AN AUTOEXIT FIELD. ).  ON EXIT FLD% POINTS TO
  107. ' THE FIELD THE CURSOR IS MOVING TO.
  108. ' NOTE: A FIXED CHOICE FIELD FIELD IS ALWAYS AN AUTOEXIT FIELD.  BY
  109. ' CHECKING TO SEE IF EXIT$ = "FIXED" IT IS DETERMINED IF THE SPACE
  110. ' BAR EXITED THE FIELD.  IF EXIT$ = "AUTO" IT WAS A CURSOR MOVEMENT KEY
  111. ' ( FROM FIELD TWO ) WHICH CAUSED THE EXIT.  IT IS NECESSARY TO CHECK
  112. ' FOR THIS OR THE PROGRAM WILL END EVERY TIME FIELD TWO IS EXITED.
  113.  
  114.  
  115.    IF AUTOEXIT% = 2 THEN           ' IS IT FIELD 2 ?
  116.      IF EXIT$ = "FIXED" THEN       ' WAS IT THE SPACE BAR ?
  117.         LANGCHOICE% = LANGCHOICE% + 1
  118.         IF LANGCHOICE% = 4 THEN LANGCHOICE% = 1
  119.         GOTO PREINPT
  120.      ELSEIF EXIT$ = "AUTO" THEN    ' WAS IT A CURSOR MOVEMENT KEY ?
  121.         GOTO PREINPT
  122.      END IF
  123.   END IF
  124.  
  125. RETURN                             ' PROGRAM WILL ALWAYS COMES HERE IF "F1"
  126.                                    ' IS PRESSED AS EXIT$ = "F1". (EVEN WHEN
  127.                                    ' AUTOEXIT% = 2).
  128.  
  129.