home *** CD-ROM | disk | FTP | other *** search
/ Stars of Shareware: Programmierung / SOURCE.mdf / programm / msdos / basic / pwez61 / multsam3.bas < prev    next >
Encoding:
BASIC Source File  |  1993-06-01  |  5.1 KB  |  109 lines
  1. '***************************************************************************
  2. ' This is an example of using a field in MULTINPT as a FIXED CHOICE     ****
  3. ' field.  Field two provides the choices of BASIC, PASCAL, OR ASSEMBLY. ****
  4. '***************************************************************************
  5. '**** THIS PROGRAM MUST BE USED WITH ONE OF THE FOLLOWING LIBRARIES:    ****
  6. '***************************************************************************
  7. '**** For QB4.5 unenhanced version use QBUNEN.QLB                       ****
  8. '**** For BASIC 7.1 unenhanced version use PDSUNEN.QLB                  ****
  9. '**** For VBDOS 1.0 unenhanced version use VBUNEN.QLB                   ****
  10. '**** For QB4.50 enhanced version use QBALL.QLB or QBNER.QLB            ****
  11. '**** For BASIC 7.1 enhanced version use PDSALL.QLB or PDSNER.QLB       ****
  12. '**** For VBDOS 1.0 enhanced version use VBALL.QLB or VBNER.QLB         ****
  13. '**** Load QB, QBX, or VBDOS with the /L option and the correct library ****
  14. '***************************************************************************
  15. DECLARE SUB PRINTINFO (I$)
  16. DECLARE SUB INFOLINE (INTR%, INLC%, INWD%, INATTR%)
  17. DECLARE SUB BOXW (TR%, LC%, WD%, NR%, BORDER%)
  18. DECLARE SUB UPDATEFIELD (SCRN%, FLD%, TEXT$)
  19. DECLARE SUB INPTINIT (DTYPE%, ISDOT%, AT1%, BLNK%, MS%)
  20. DECLARE SUB MAKEFIELD (SCRN%, FLD%, SCODE%, STR%, SLC%, SWD%, SBASEATTR%, SACTATTR%, MATTR%, RES$, EXTO$, HOTPOS%, CURPOS%, BRACKET%)
  21. DECLARE SUB MULTINPT (S%, TOFLD%, OPTION$, FF%, RKEY%, RTRN$(), SF%)
  22. DECLARE SUB SETINPT (SCRN%, DISPLAYLEN%, EXIT$, HOTCOL%)
  23. DECLARE SUB MAKEWIND (W%, LABEL$, TR%, LC%, WD%, NR%, ATTR%, BORDER%)
  24. DECLARE SUB PRINTW (TEXT$, R%, LC%)
  25. DECLARE SUB SETWIND (FST%, S%, SH%, NH%, BRKT%)
  26. DECLARE FUNCTION MOUSEON% (ISON%)
  27. '***************************************************************************
  28.  
  29. CALL SETWIND(1, 1, 7, 0, 15)            ' INITIALIZE WINDOW MEMORY
  30. CALL INPTINIT(1, 1, 1, 1, 1)            ' INITIALIZE INPUT MEMORY
  31. JUNK% = MOUSEON%(1)
  32. CALL INFOLINE(16, 2, 78, 15)
  33. COLOR 7, 0: CLS                         ' BLANK THE SCREEN
  34. DIM RTRN$(6)                            ' For the six fields/buttons
  35. '---------------------------------------------------------------------------
  36. ' SETINPT MUST BE CALLED FOR EACH MULTI-FIELD INPUT SCREEN
  37.  
  38. CALL SETINPT(1, 25, "E", 127)
  39. FOR X% = 1 TO 4
  40.   READ CODE%, TR%, LC%, WD%
  41.   CALL MAKEFIELD(1, X%, CODE%, TR%, LC%, WD%, 15, 15, 15, "", "", 0, 1, 0)
  42. NEXT
  43.  
  44. ' Auto-exit - auto advance - numeric with no decimal places
  45. DATA 11000,5,5,4                               : 'FIELD 1
  46. ' Auto-exit - auto advance - numeric with no decimal places
  47. DATA 11000,7,5,4                               : 'FIELD 2
  48. ' Protected - numeric with no decimal places
  49. DATA 100,9,5,5                                 : 'FIELD 3
  50. ' Alpha / numeric
  51. DATA 10007,11,5,15                             : 'FIELD 4
  52.  
  53. ' Make the OK and CANCEL button fields
  54. MAKEFIELD 1, 5, 30007, 14, 13, 6, 112, 15, 15, "", "", 0, 3, 1
  55. RTRN$(5) = "< OK >"
  56. MAKEFIELD 1, 6, 30007, 14, 58, 10, 112, 15, 15, "", "", 0, 3, 1
  57. RTRN$(6) = "< CANCEL >"
  58. '----------------------------------------------------------------------------
  59. ' MAKE A WINDOW.  PRINT INSTRUCTIONS
  60.  
  61. CALL MAKEWIND(1, "@Using the info-line to print instructions - All field must be AUTOEXIT.", 1, 1, 80, 17, 112, 102)
  62. CALL PRINTW("Auto-exit and auto advance with numeric input", 2, 15)
  63. CALL PRINTW("+", 3, 5)
  64. CALL PRINTW("Auto-exit and auto advance with numeric input", 4, 15)
  65. CALL PRINTW("Protected Field", 6, 15)
  66. CALL PRINTW("Alpha-numeric", 8, 24)
  67. CALL PRINTW("-------- Button fields ---------", 11, 23)
  68. CALL BOXW(10, 8, 14, 3, 2)
  69. CALL BOXW(10, 55, 14, 3, 2)
  70. '----------------------------------------------------------------------------
  71.  
  72. TOFLD% = 1: FROMFLD% = 0              ' START IN FIELD 1.  PRINT ALL
  73.                                       ' FIELDS.
  74. '----------------------------------------------------------------------------
  75. DO
  76.   SELECT CASE TOFLD%                  '  Set and print instructions
  77.     CASE 1
  78.       I$ = " Input the first number"
  79.     CASE 2
  80.       I$ = " Input the second number"
  81.     CASE 4
  82.       I$ = " Input anything!!!"
  83.     CASE 5, 6
  84.       I$ = " Press ENTER, SPACE BAR or CLICK with mouse to select."
  85.   END SELECT
  86.   CALL PRINTINFO(I$)                 ' Print instructions in info-line
  87. '----------------------------------------------------------------------------
  88.   CALL MULTINPT(1, TOFLD%, "U", FROMFLD%, RKEY%, RTRN$(), SELECTION%)
  89.  
  90.   IF FROMFLD% = 1 OR FROMFLD% = 2 THEN                ' IS IT FIELD 1 OR 2 ?
  91.     RTRN$(3) = STR$(VAL(RTRN$(1)) + VAL(RTRN$(2)))    ' ADD FIELD 1 + 2
  92.     IF RTRN$(1) + RTRN$(2) = "" THEN RTRN$(3) = ""
  93.     CALL UPDATEFIELD(1, 3, RTRN$(3))                  ' UPDATE FIELD 3 ONLY
  94.   END IF
  95.  
  96.   ' Make mouse release on OK and CANCEL same a ENTER
  97.   IF TOFLD% > 4 AND RKEY% = 100 THEN FROMFLD% = TOFLD%: RKEY% = 13
  98.  
  99.   ' Make ESC same as ENTER on CANCEL
  100.   IF RKEY% = 27 THEN FROMFLD% = 6: RKEY% = 13
  101.  
  102. ' Do until OK or CANCEL selection is made via MOUSE, SPACE BAR or ENTER
  103. LOOP UNTIL FROMFLD% > 4 AND (RKEY% = 13 OR RKEY% = 32)
  104.  
  105. ' OK or CANCEL selected
  106. LOCATE 19, 1
  107. IF FROMFLD% = 5 THEN PRINT "OK EXITED" ELSE PRINT "CANCEL/ESC EXITED"
  108.  
  109.