home *** CD-ROM | disk | FTP | other *** search
/ Stars of Shareware: Programmierung / SOURCE.mdf / programm / msdos / basic / pwez61 / multsam1.bas < prev    next >
Encoding:
BASIC Source File  |  1993-06-01  |  4.6 KB  |  94 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 INPTINIT (DTYPE%, ISDOT%, AT1%, BLNK%, MS%)
  16. DECLARE SUB MAKEFIELD (SCRN%, FLD%, SCODE%, STR%, SLC%, SWD%, SBASEATTR%, SACTATTR%, MATTR%, RES$, EXTO$, HOTPOS%, CURPOS%, BRACKET%)
  17. DECLARE SUB MULTINPT (S%, TOFLD%, OPTION$, FF%, RKEY%, RTRN$(), SF%)
  18. DECLARE SUB SETINPT (SCRN%, DISPLAYLEN%, EXIT$, HOTCOL%)
  19. DECLARE SUB MAKEWIND (W%, LABEL$, TR%, LC%, WD%, NR%, ATTR%, BORDER%)
  20. DECLARE SUB PRINTW (TEXT$, R%, LC%)
  21. DECLARE SUB SETWIND (FST%, S%, SH%, NH%, BRKT%)
  22. DECLARE FUNCTION MOUSEON% (ISON%)
  23. '***************************************************************************
  24.  
  25. CALL SETWIND(1, 1, 7, 0, 15)            ' INITIALIZE WINDOW MEMORY
  26. CALL INPTINIT(1, 1, 1, 1, 1)            ' INITIALIZE INPUT MEMORY
  27. JUNK% = MOUSEON%(1)
  28. COLOR 7, 0: CLS                         ' BLANK THE SCREEN
  29. DIM RTRN$(5)                            ' For the five fields/buttons
  30. '---------------------------------------------------------------------------
  31. ' SETINPT MUST BE CALLED FOR EACH MULTI-FIELD INPUT SCREEN
  32. ' Define each field
  33.  
  34. CALL SETINPT(1, 25, "12", 15)
  35. FOR X% = 1 TO 3                      ' define the fields
  36.   READ CODE%, TR%, LC%, WD%
  37.   CALL MAKEFIELD(1, X%, CODE%, TR%, LC%, WD%, 15, 15, 15, "", "", 0, 1, 0)
  38. NEXT
  39.  
  40. DATA 7,5,5,30                      : ' Alpha / numeric
  41. DATA 30007,7,5,9                   : ' Fixed choice - alpha / numeric
  42. DATA 7,9,5,30                      : ' Alpha / nuneric
  43.  
  44. MAKEFIELD 1, 4, 30107, 11, 13, 9, 112, 112, 15, "", "", 0, 0, 0
  45. RTRN$(4) = "< F1=OK >"
  46. MAKEFIELD 1, 5, 30107, 11, 56, 14, 112, 112, 15, "", "", 0, 0, 0
  47. RTRN$(5) = "< F2= CANCEL >"
  48. '----------------------------------------------------------------------------
  49.  
  50. TOFLD% = 1: FROMFLD% = 0              ' START IN FIELD 1.  PRINT ALL
  51.                                       ' FIELDS.
  52. '----------------------------------------------------------------------------
  53. ' MAKE A WINDOW.  PRINT INSTRUCTIONS
  54.  
  55. CALL MAKEWIND(1, "@Fixed Choice Demonstration - Second field has three choices", 1, 1, 80, 12, 112, 102)
  56. CALL PRINTW("Any alpha/numeric input", 2, 38)
  57. CALL PRINTW("SPACE BAR / MOUSE changes field", 4, 15)
  58. CALL PRINTW("Any alpha/numeric input", 6, 38)
  59. CALL PRINTW("-- Mouse selectable fields --", 8, 23)
  60.                                                      
  61. '----------------------------------------------------------------------------
  62. ' Iinitialize data for field 2.
  63.  
  64.   DIM CHOICE$(3)
  65.   CHOICE$(1) = "BASIC"              ' CHOICES FOR FIXED FIELD 2.
  66.   CHOICE$(2) = "PASCAL"             ' "                        "
  67.   CHOICE$(3) = "ASSEMBLY"           ' "                        "
  68.   LANGCHOICE% = 1                   ' MAKE IT DEFAULT TO "BASIC"
  69.  
  70. ' ---------------------------------------------------------------------------
  71.  
  72.   DO                                               ' NOT F1 OR F2
  73.     RTRN$(2) = CHOICE$(LANGCHOICE%)                ' RESET FIELD 2
  74.  
  75.     CALL MULTINPT(1, TOFLD%, "", FROMFLD%, RKEY%, RTRN$(), SELECTION%)
  76.  
  77.     'Make mouse selection on field 4 or 5 emulate the F1 or F2 keys.
  78.     IF SELECTION% <> 0 THEN RKEY% = SELECTION% - 3
  79.  
  80.  
  81.     IF FROMFLD% = 2 AND TOFLD% = 2 THEN    ' was cursor in field 2 ?
  82.       IF RKEY% = 32 OR RKEY% = 100 THEN    ' was it the SPACE BAR or MOUSE ?
  83.         LANGCHOICE% = LANGCHOICE% + 1      ' "increment" the choice.
  84.         IF LANGCHOICE% = 4 THEN LANGCHOICE% = 1
  85.       END IF
  86.     END IF
  87.  
  88.   LOOP WHILE RKEY% > 2      ' Do until OK or CANCEL selection is made.
  89.  
  90.   ' Must be F1 or F2 or Mouse selectiing OK or CANCEL
  91.   LOCATE 15, 1
  92.   IF RKEY% = 1 THEN PRINT "OK EXITED" ELSE PRINT "CANCEL EXITED"
  93.  
  94.