home *** CD-ROM | disk | FTP | other *** search
/ CD Actual 15 / CDACTUAL15.iso / cdactual / program / basic / QBSCR20.ZIP / QDEMO_D.BAS < prev    next >
Encoding:
BASIC Source File  |  1992-07-08  |  28.2 KB  |  704 lines
  1. ' ──────────────────────────────────────────────────────────────────────────
  2. '
  3. '                           Q D E M O _ D . B A S
  4. '
  5. '  This file is a subcomponent of the QBSCR Screen Routines Demonstration
  6. '  program QDEMO. It is not meant to run as a standalone program. Use only
  7. '  in conjunction with the QDEMO.BAS program.  See QBSCR documentation or
  8. '  QDEMO.BAS for more information.
  9. '
  10. ' ──────────────────────────────────────────────────────────────────────────
  11.  
  12. '$INCLUDE: 'qbscr.inc'
  13. '$INCLUDE: 'mouse.bi'
  14.  
  15. CONST NEEDMOUSE4GETEVENT = -4
  16. CONST VIEWLISTMISSING = -11
  17. CONST SELECTMISSING = -13
  18.  
  19. COMMON SHARED kolor%
  20. COMMON SHARED mouseExists%
  21.  
  22. DECLARE SUB SelectListDemo ()
  23. DECLARE SUB ViewListDemo ()
  24. DECLARE SUB InfoBox (messageNum%)
  25.  
  26. SUB EditDemo
  27.  
  28.     ' ────────────────────────────────────────────────────────────────────────
  29.     '  This demo will utilize the EditString function to accept a user's name.
  30.     '  It will then use the name to fill in the red-shirt in an excerpt from
  31.     '  a Start Trek episode.
  32.     ' ────────────────────────────────────────────────────────────────────────
  33.  
  34.     ' ────────────────────────────────────────────────────────────────────────
  35.     '  Establish a frameType and buttonStyle based on kolor%.
  36.     ' ────────────────────────────────────────────────────────────────────────
  37.     IF kolor% THEN
  38.         ft1% = 6
  39.         ft2% = 7
  40.         bs% = STYLE3D
  41.     ELSE
  42.         ft1% = 0
  43.         ft2% = 0
  44.         bs% = STYLE2D
  45.     END IF
  46.  
  47.     ' ────────────────────────────────────────────────────────────────────────
  48.     '  If the mouse is around, turn it off whilst we display.
  49.     ' ────────────────────────────────────────────────────────────────────────
  50.     IF mouseExists% THEN
  51.         MouseHide
  52.     END IF
  53.  
  54.     ' ────────────────────────────────────────────────────────────────────────
  55.     '  Add windows and buttons to the display.
  56.     ' ────────────────────────────────────────────────────────────────────────
  57.     MakeWindow 6, 6, 23, 75, 0, 7, 0, ft1%, -1, 0, ""
  58.     MakeWindow 20, 30, 22, 51, 0, 7, 0, ft2%, -1, 0, ""
  59.  
  60.     ' ────────────────────────────────────────────────────────────────────────
  61.     ' Add text to the window.
  62.     ' ────────────────────────────────────────────────────────────────────────
  63.     Center "This demo will illustrate the editing capabilities of the", 8
  64.     Center "QBSCR EditString routine.  Enter your LAST NAME in the field", 9
  65.     Center "below, using the following editing capabilities (ESC quits):", 10
  66.     Center "Edit Function...              ...Use this key(s)", 12
  67.     Center "────────────────────────────────────────────────", 13
  68.     Center "Cursor Left, Cursor Right . . . . . . . . .  " + CHR$(27) + " " + CHR$(26), 14
  69.     Center "Delete character left of cursor . . .  Backspace", 15
  70.     Center "Delete character at cursor  . . . . . . . .  Del", 16
  71.     Center "Clear line  . . . . . . . . . . . . . . Ctrl + Y", 17
  72.     Center "Finished editing  . . . . . . . . . . . .  Enter", 18
  73.  
  74.     ' ────────────────────────────────────────────────────────────────────────
  75.     '  Get a name from the user by using the EditString function.
  76.     ' ────────────────────────────────────────────────────────────────────────
  77.     userName$ = SPACE$(18)
  78.     EditString userName$, 32, 21, 0, 7
  79.  
  80.     ' ────────────────────────────────────────────────────────────────────────
  81.     '  If the user hit the ESC key, then get out now.
  82.     ' ────────────────────────────────────────────────────────────────────────
  83.     IF LTRIM$(RTRIM$(userName$)) = "" THEN
  84.         EXIT SUB
  85.     END IF
  86.  
  87.     ' ────────────────────────────────────────────────────────────────────────
  88.     '  Since the user did not hit the ESC key, we will assume that they en-
  89.     '  tered a valid name of some sort.  Build a sample Star Trek excerpt
  90.     '  using the name entered.
  91.     ' ────────────────────────────────────────────────────────────────────────
  92.     RANDOMIZE TIMER
  93.     rnum% = INT(RND(1) * 6) + 1
  94.     SELECT CASE rnum%
  95.         CASE 1
  96.             absurdOccupation$ = "rocket scientist"
  97.         CASE 2
  98.             absurdOccupation$ = "programmer"
  99.         CASE 3
  100.             absurdOccupation$ = "TV evangelist"
  101.         CASE 4
  102.             absurdOccupation$ = "Vulcan"
  103.         CASE 5
  104.             absurdOccupation$ = "Klingon Gartha Lizard"
  105.         CASE 6
  106.             absurdOccupation$ = "used car salesman"
  107.     END SELECT
  108.  
  109.     MakeWindow 3, 6, 23, 75, 0, 7, 0, ft1%, -1, 0, ""
  110.     MakeWindow 4, 21, 6, 60, 0, 7, 0, ft2%, -1, 0, ""
  111.     DrawButton SINGLEBORDER, 8, 20, 17, 22, 0, 7, "OK", bs%
  112.     Center "Your Own Star Trek Episode", 5
  113.     LOCATE 8, 9, 0: PRINT "    As Ensign "; RTRIM$(userName$); " stepped on the loose rock, it";
  114.     LOCATE 9, 9, 0: PRINT "exploded, sending the red-shirt flying throught the air, land-";
  115.     LOCATE 10, 9, 0: PRINT "ing with a thud at Kirk's feet.";
  116.     LOCATE 11, 9, 0: PRINT "    McCoy leaned down and scanned the Ensign briefly."
  117.     LOCATE 12, 9, 0: PRINT "    "; CHR$(34); "He's dead, Jim."; CHR$(34);
  118.     LOCATE 13, 9, 0: PRINT "    "; CHR$(34); "He was the third son of my eighth girlfriend.  Can't you"
  119.     LOCATE 14, 9, 0: PRINT "do anything for him Bones?"; CHR$(34);
  120.     LOCATE 15, 9, 0: PRINT "    "; CHR$(34); "I'm a doctor, not a "; absurdOccupation$; ", Jim!";
  121.     LOCATE 16, 9, 0: PRINT "I can't bring them back from the dead."; CHR$(34);
  122.     LOCATE 17, 9, 0: PRINT "    "; CHR$(34); "My God, Bones,"; CHR$(34); " said Kirk, his jaw set firmly.  "; CHR$(34); "What is";
  123.     LOCATE 18, 9, 0: PRINT "space travel coming to?"; CHR$(34);
  124.  
  125.     ' ────────────────────────────────────────────────────────────────────────
  126.     '  Sit in a loop waiting for the user to say "I'm done."
  127.     ' ────────────────────────────────────────────────────────────────────────
  128.     done% = FALSE
  129.     WHILE done% = FALSE
  130.  
  131.         ' ──────────────────────────────────────────────────────────────────────
  132.         '  If mouse is around, turn him on.
  133.         ' ──────────────────────────────────────────────────────────────────────
  134.         IF mouseExists% THEN
  135.             MouseShow
  136.         END IF
  137.  
  138.         ' ──────────────────────────────────────────────────────────────────────
  139.         '  Use the QBSCR GetEvent% function to get mouse events and keyboard
  140.         '  keypresses.
  141.         ' ──────────────────────────────────────────────────────────────────────
  142.         result% = getEvent(mouseExists%, kc%, mx%, my%)
  143.  
  144.         ' ──────────────────────────────────────────────────────────────────────
  145.         '  Decide what to do, if anything, based on the event returned by the
  146.         '  getEvent routine.
  147.         ' ──────────────────────────────────────────────────────────────────────
  148.         SELECT CASE result%
  149.             CASE EMpressedLeft    ' Mouse left button pressed.
  150.                 IF (mx% >= 8) AND (mx% <= 17) AND (my% >= 20) AND (my% <= 22) THEN
  151.                     IF kolor% THEN
  152.                         PressButton SINGLEBORDER, 8, 20, 17, 22, 0, 7, "OK", bs%
  153.                     END IF
  154.                     done% = TRUE
  155.                 END IF
  156.             CASE EKpressed        ' Keyboard key pressed.
  157.                 IF kc% = ASC("O") OR kc% = ASC("o") OR kc% = 27 OR kc% = 13 THEN
  158.                     done% = TRUE
  159.                 END IF
  160.             CASE ELSE
  161.         END SELECT
  162.     WEND
  163.  
  164. END SUB
  165.  
  166. SUB EventsDemo
  167.  
  168.     ' ────────────────────────────────────────────────────────────────────────
  169.     '  This demo will illustrate the use of the GetEvent% function and the
  170.     '  kinds of things you can do with it.  After displaying some text and
  171.     '  two buttons, if the user chooses to proceed, a mock control panel will
  172.     '  be displayed depiciting nonsense controls and buttons. Moving the mouse
  173.     '  around will cause different things to happen.  If the user does not
  174.     '  have a mouse, then this demo will display a message and exit.
  175.     ' ────────────────────────────────────────────────────────────────────────
  176.  
  177.     ' ────────────────────────────────────────────────────────────────────────
  178.     '  If there is no mouse here, then display a simple message and exit.
  179.     ' ────────────────────────────────────────────────────────────────────────
  180.     IF mouseExists% = FALSE THEN
  181.         InfoBox NEEDMOUSE4GETEVENT
  182.         EXIT SUB
  183.     END IF
  184.  
  185.     ' ────────────────────────────────────────────────────────────────────────
  186.     '  Set color-dependent data.
  187.     ' ────────────────────────────────────────────────────────────────────────
  188.     IF kolor% THEN
  189.         ft1% = 6
  190.         ft2% = 7
  191.         bs% = STYLE3D
  192.     ELSE
  193.         ft1% = 0
  194.         ft2% = 0
  195.         bs% = STYLE2D
  196.     END IF
  197.  
  198.     ' ────────────────────────────────────────────────────────────────────────
  199.     '  Hide the mouse while we draw on the screen.
  200.     ' ────────────────────────────────────────────────────────────────────────
  201.     MouseHide
  202.  
  203.     ' ────────────────────────────────────────────────────────────────────────
  204.     '  Display the initial window, text and buttons.
  205.     ' ────────────────────────────────────────────────────────────────────────
  206.     MakeWindow 3, 7, 23, 74, 0, 7, 0, ft1%, -1, 0, ""
  207.     MakeWindow 4, 21, 6, 60, 0, 7, 0, ft2%, -1, 0, ""
  208.     DrawButton SINGLEBORDER, 9, 20, 18, 22, 0, 7, "Events", bs%
  209.     DrawButton SINGLEBORDER, 20, 20, 29, 22, 0, 7, "Cancel", bs%
  210.     COLOR 0, 7
  211.     Center "QBSCR GetEvent Demo", 5
  212.  
  213.     LOCATE 8, 10, 0: PRINT "The QBSCR Screen Routines needed a new capability when mouse";
  214.     LOCATE 9, 10, 0: PRINT "support was added.  QuickBASIC provided a way to obtain key-";
  215.     LOCATE 10, 10, 0: PRINT "board events via the INPUT$() and INKEY$ functions, but there";
  216.     LOCATE 11, 10, 0: PRINT "way to conventiently collect mouse as well as keyboard events.";
  217.  
  218.     LOCATE 13, 10, 0: PRINT "Enter the GetEvent% function. With one call, you will get the";
  219.     LOCATE 14, 10, 0: PRINT "first keyborad OR mouse event that occurs, including mouse";
  220.     LOCATE 15, 10, 0: PRINT "button presses, releases, mouse movement and position, and";
  221.     LOCATE 16, 10, 0: PRINT "all keyboard keys, including extended function and arrow keys.";
  222.  
  223.     LOCATE 18, 10, 0: PRINT "Select Events to play, or Cancel to retutn to the menu.";
  224.  
  225.     ' ────────────────────────────────────────────────────────────────────────
  226.     '  If the mouse is around, turn him (it) back on.
  227.     ' ────────────────────────────────────────────────────────────────────────
  228.     MouseShow
  229.     done% = FALSE
  230.     doEvents% = FALSE
  231.  
  232.     ' ────────────────────────────────────────────────────────────────────────
  233.     '  Sit in a loop until the user does something right.  When they do, then
  234.     '  we move on.
  235.     ' ────────────────────────────────────────────────────────────────────────
  236.     WHILE done% = FALSE
  237.  
  238.         result% = getEvent%(mouseExists%, kc%, mx%, my%)
  239.  
  240.         SELECT CASE result%
  241.             CASE EMpressedLeft
  242.                 IF (mx% >= 9) AND (mx% <= 18) AND (my% >= 20) AND (my% <= 22) THEN
  243.                     PressButton SINGLEBORDER, 9, 20, 18, 22, 0, 7, "Events", bs%
  244.                     done% = TRUE
  245.                     doEvents% = TRUE
  246.                 END IF
  247.                 IF (mx% >= 20) AND (mx% <= 29) AND (my% >= 20) AND (my% <= 22) THEN
  248.                     PressButton SINGLEBORDER, 20, 20, 29, 22, 0, 7, "Cancel", bs%
  249.                     done% = TRUE
  250.                 END IF
  251.             CASE EMpressedRight
  252.                 done% = TRUE
  253.             CASE EKpressed
  254.                 IF (kc% = ASC("E")) OR (kc% = ASC("e")) THEN
  255.                     done% = TRUE
  256.                     doEvents% = TRUE
  257.                 END IF
  258.                 IF (kc% = ASC("C")) OR (kc% = ASC("c")) OR (kc% = 27) THEN
  259.                     done% = TRUE
  260.                 END IF
  261.             CASE ELSE
  262.         END SELECT
  263.  
  264.     WEND
  265.  
  266.     ' ────────────────────────────────────────────────────────────────────────
  267.     '  If the user hit cancel, then get outta here.
  268.     ' ────────────────────────────────────────────────────────────────────────
  269.     IF doEvents% = FALSE THEN
  270.         EXIT SUB
  271.     END IF
  272.  
  273.     ' ────────────────────────────────────────────────────────────────────────
  274.     '  Now we do the fun stuff, the demo part.  First draw the interface.
  275.     ' ────────────────────────────────────────────────────────────────────────
  276.     MouseHide
  277.     MakeWindow 3, 7, 23, 74, 0, 7, 0, ft1%, -1, 0, ""
  278.     MakeWindow 4, 21, 6, 60, 0, 7, 0, ft2%, -1, 0, ""
  279.     MakeWindow 9, 10, 11, 71, 0, 7, 0, ft2%, -1, 0, ""
  280.     MakeWindow 14, 10, 19, 71, 0, 7, 0, ft2%, -1, 0, ""
  281.     Center "Demonstrating the usage of GetEvent", 5
  282.     LOCATE 8, 11, 0: PRINT "Last Event";
  283.     LOCATE 13, 11, 0: PRINT "Comments";
  284.     LOCATE 10, 12, 0: PRINT "Waiting for first event";
  285.     DrawButton SINGLEBORDER, 10, 20, 19, 22, 0, 7, "Done", bs%
  286.  
  287.     ' ────────────────────────────────────────────────────────────────────────
  288.     '  Now sit in a loop waiting for events.  As they occur, display event
  289.     '  information and humorous or informative commentary.  Since we're doing
  290.     '  alot here, things may look a little complicated.  They're not, really,
  291.     '  just long-winded.
  292.     ' ────────────────────────────────────────────────────────────────────────
  293.     MouseShow
  294.     done% = FALSE
  295.     WHILE done% = FALSE
  296.  
  297.         result% = getEvent%(mouseExists%, kc%, mx%, my%)
  298.  
  299.         SELECT CASE result%
  300.             CASE EMpressedLeft      ' Left mouse button pressed.
  301.                 LOCATE 10, 12, 0: PRINT SPACE$(59);
  302.                 LOCATE 10, 12, 0: PRINT "Left button pressed.";
  303.                 ' ─── Mouse was clicked on the Done button ──────────────────────────
  304.                 IF (mx% >= 10) AND (mx% <= 19) AND (my% >= 20) AND (my% <= 22) THEN
  305.                     MouseHide
  306.                     Wipe 14, 19, 10, 71, 7
  307.                     LOCATE 15, 12, 0: PRINT "Oh well, Goodbye!";
  308.                     PressButton SINGLEBORDER, 10, 20, 19, 22, 0, 7, "Done", bs%
  309.                     done% = TRUE
  310.                     MouseShow
  311.                 ELSE        ' Mouse was clicked, but NOT on the done button.
  312.                     MouseHide
  313.                     Wipe 14, 19, 10, 71, 7
  314.                     ' ─── Mouse clicked in Events Box ─────────────────────────────────
  315.                     IF (mx% >= 10) AND (mx% <= 71) AND (my% >= 9) AND (my% <= 11) THEN
  316.                         LOCATE 15, 12, 0: PRINT "The mouse was clicked in the Events Box, even though no";
  317.                         LOCATE 16, 12, 0: PRINT "cheese is present there.";
  318.                     ELSEIF (mx% >= 10) AND (mx% <= 71) AND (my% >= 14) AND (my% <= 19) THEN
  319.                         ' ─── Mouse clicked in comments box ─────────────────────────────
  320.                         LOCATE 15, 12, 0: PRINT "The mouse was clicked in the Comments Box.  Imagine, in";
  321.                         LOCATE 16, 12, 0: PRINT "MY box!  Of all the temerity!";
  322.                     ELSE
  323.                         ' ─── Mouse clicked anywhere else ───────────────────────────────
  324.                         LOCATE 15, 12, 0: PRINT "The mouse was clicked in some out-of-the-way locale, not";
  325.                         LOCATE 16, 12, 0: PRINT "of any interest whatsoever.";
  326.                     END IF
  327.                     MouseShow
  328.                 END IF
  329.             CASE EMpressedRight     ' Right mouse button pressed.
  330.                 MouseHide
  331.                 LOCATE 10, 12, 0: PRINT SPACE$(59);
  332.                 LOCATE 10, 12, 0: PRINT "Right button pressed.";
  333.                 Wipe 14, 19, 10, 71, 7
  334.                 LOCATE 15, 12, 0: PRINT "Hah! You thought pressing the right mouse button would get";
  335.                 LOCATE 16, 12, 0: PRINT "get you out of this ridiculous demo, didn't you?  Well for";
  336.                 LOCATE 17, 12, 0: PRINT "once, smarty-pants, the computer out-witted the user!";
  337.                 LOCATE 18, 12, 0: PRINT "Hahahahahaha!";
  338.                 MouseShow
  339.             CASE EMreleasedLeft     ' Left mouse button released.
  340.                 MouseHide
  341.                 LOCATE 10, 12, 0: PRINT SPACE$(59);
  342.                 LOCATE 10, 12, 0: PRINT "Left button released.";
  343.                 Wipe 14, 19, 10, 71, 7
  344.                 LOCATE 15, 12, 0: PRINT "You let go of the left mouse button.  Slippery fingers?";
  345.                 MouseShow
  346.             CASE EMreleasedRight    ' Right mouse button released.
  347.                 MouseHide
  348.                 LOCATE 10, 12, 0: PRINT SPACE$(59);
  349.                 LOCATE 10, 12, 0: PRINT "Right button released.";
  350.                 Wipe 14, 19, 10, 71, 7
  351.                 LOCATE 15, 12, 0: PRINT "You let go of the right mouse button.  Think twice next";
  352.                 LOCATE 16, 12, 0: PRINT "time before you try to run out on ME.";
  353.                 MouseShow
  354.             CASE EMmoved            ' Mouse was moved.
  355.                 MouseHide
  356.                 LOCATE 10, 12, 0: PRINT SPACE$(59);
  357.                 LOCATE 10, 12, 0: PRINT "Mouse moved to coordinates X:"; mx%; "  Y:"; my%
  358.                 Wipe 14, 19, 10, 71, 7
  359.                 IF (mx% >= 10) AND (mx% <= 71) AND (my% >= 9) AND (my% <= 11) THEN
  360.                     ' ─── Mouse moved into Events Box ─────────────────────────────────
  361.                     LOCATE 15, 12, 0: PRINT "The mouse is vacationing in the sunny land of the Last";
  362.                     LOCATE 16, 12, 0: PRINT "Event box.  That sneaky little squeaker...";
  363.                 ELSEIF (mx% >= 10) AND (mx% <= 71) AND (my% >= 14) AND (my% <= 19) THEN
  364.                     ' ─── Mouse moved into Comments box ───────────────────────────────
  365.                     LOCATE 15, 12, 0: PRINT "Hey!  Get your furry little track ball outta MY box!  I";
  366.                     LOCATE 16, 12, 0: PRINT "don't recall inviting you!";
  367.                 ELSEIF (mx% >= 10) AND (mx% <= 19) AND (my% >= 20) AND (my% <= 22) THEN
  368.                     ' ─── Mouse moved into Done button ────────────────────────────────
  369.                     LOCATE 15, 12, 0: PRINT "Wait!  You weren't thinking of leaving were you?  Move";
  370.                     LOCATE 16, 12, 0: PRINT "that mouse off of the Done button; I promise I'll be a";
  371.                     LOCATE 17, 12, 0: PRINT "bit nicer, really!  Please...?";
  372.                 ELSE
  373.                     LOCATE 15, 12, 0: PRINT "The mouse was moved, alright, but not to anywhere I'd";
  374.                     LOCATE 16, 12, 0: PRINT "admit to in public.";
  375.                 END IF
  376.                 MouseShow
  377.             CASE EKpressed          ' Key was pressed on the keyboard.
  378.                 MouseHide
  379.                 LOCATE 10, 12, 0: PRINT SPACE$(59);
  380.                 IF (kc% <= 255 AND kc% >= 0) THEN     ' Normal key (letters, numbers)
  381.                     LOCATE 10, 12, 0: PRINT "Normal key pressed: "; CHR$(kc%);
  382.                     Wipe 14, 19, 10, 71, 7
  383.                     LOCATE 15, 12, 0: PRINT "Average, evryday, normal, boring key was pressed.";
  384.                 ELSE      ' Extended key (arrow, PgUp, End, etc.)
  385.                     Wipe 14, 19, 10, 71, 7
  386.                     LOCATE 15, 12, 0: PRINT "Now THAT'S a more intersting key to press!";
  387.                     LOCATE 10, 12, 0: PRINT "Extended key pressed:";
  388.                     ' ─── Display the extended key that was pressed ───────────────────
  389.                     SELECT CASE kc%
  390.                     CASE F1: PRINT " F1";
  391.                     CASE F2: PRINT " F2";
  392.                     CASE F3: PRINT " F3";
  393.                     CASE F4: PRINT " F4";
  394.                     CASE F5: PRINT " F5";
  395.                     CASE F6: PRINT " F6";
  396.                     CASE F7: PRINT " F7";
  397.                     CASE F8: PRINT " F8";
  398.                     CASE F9: PRINT " F9";
  399.                     CASE F10: PRINT " F10";
  400.                     CASE UPARROW: PRINT " Up Arrow";
  401.                     CASE DOWNARROW: PRINT " Down Arrow";
  402.                     CASE LEFTARROW: PRINT " Left Arrow";
  403.                     CASE RIGHTARROW: PRINT " Right Arrow";
  404.                     CASE HOMEKEY: PRINT " Home";
  405.                     CASE ENDKEY: PRINT " End";
  406.                     CASE PGUP: PRINT " PgUp";
  407.                     CASE PGDN: PRINT " PgDn";
  408.                     CASE INSERT: PRINT " Ins";
  409.                     CASE DELETE: PRINT " Del";
  410.                     CASE ELSE: PRINT " Unknown Key";
  411.                     END SELECT
  412.                 END IF
  413.                 ' ─── If key was D, d, or Esc, then exit. ───────────────────────────
  414.                 IF (kc% = ASC("D")) OR (kc% = ASC("d")) OR (kc% = 27) THEN
  415.                     done% = TRUE
  416.                 END IF
  417.                 MouseShow
  418.             CASE ELSE
  419.         END SELECT
  420.  
  421.     WEND
  422.  
  423. END SUB
  424.  
  425. SUB ListDemo
  426.  
  427.     ' ────────────────────────────────────────────────────────────────────────
  428.     '  This demo will illustrate the two types of lists available, the View-
  429.     '  List and the selectList.  This routine will display a submenu with
  430.     '  these two choices, and will kick off the appropriate demo.
  431.     ' ────────────────────────────────────────────────────────────────────────
  432.  
  433.     ' ────────────────────────────────────────────────────────────────────────
  434.     '  Define frameType based on kolor%.
  435.     ' ────────────────────────────────────────────────────────────────────────
  436.     IF kolor% THEN
  437.         ft% = 6
  438.     ELSE
  439.         ft% = 0
  440.     END IF
  441.  
  442.     ' ────────────────────────────────────────────────────────────────────────
  443.     '  If the mouse is about, turn it off.
  444.     ' ────────────────────────────────────────────────────────────────────────
  445.     IF mouseExists% THEN
  446.         MouseHide
  447.     END IF
  448.  
  449.     ' ────────────────────────────────────────────────────────────────────────
  450.     '  Prepare the submenu.  This involves drawing a window in which it will
  451.     '  reside and defining the menu choices.
  452.     ' ────────────────────────────────────────────────────────────────────────
  453.     MakeWindow 8, 50, 11, 68, 0, 7, 0, ft%, -1, 0, ""
  454.  
  455.     DIM m$(2)
  456.     m$(1) = "^Selectable List"
  457.     m$(2) = "^Viewing List"
  458.  
  459.     ' ────────────────────────────────────────────────────────────────────────
  460.     '  Call the submenu to get a response from the user.
  461.     ' ────────────────────────────────────────────────────────────────────────
  462.     result% = MakeMenu%(m$(), 2, "L", 52, 69, 9, "^", "|", 0, 7, 15, 0, 15, 7, mouseExists%)
  463.  
  464.     ' ────────────────────────────────────────────────────────────────────────
  465.     '  Decide what to do from here based on the user's menu selection.
  466.     ' ────────────────────────────────────────────────────────────────────────
  467.     SELECT CASE result%
  468.         CASE 1     ' Selectable List
  469.             SelectListDemo
  470.         CASE 2     ' Viewing List
  471.             ViewListDemo
  472.         CASE ELSE
  473.     END SELECT
  474.  
  475. END SUB
  476.  
  477. SUB SelectListDemo
  478.  
  479.     ' ────────────────────────────────────────────────────────────────────────
  480.     '  Right off the bat, check to see if the file that contains the list of
  481.     '  items from which a selection will be made is on disk.  If so, then
  482.     '  proceed.  If not, then exit now.
  483.     ' ────────────────────────────────────────────────────────────────────────
  484.     IF FirstFile%("SELECT.TXT", NormalAttr, dta$) = FALSE THEN
  485.         InfoBox SELECTMISSING
  486.         EXIT SUB
  487.     END IF
  488.  
  489.     ' ────────────────────────────────────────────────────────────────────────
  490.     '  This demo will illustrate the SelectList routine.
  491.     ' ────────────────────────────────────────────────────────────────────────
  492.     DIM list$(50)
  493.     DIM scr%(BlockSize%(1, 80, 10, 17))
  494.  
  495.     ' ────────────────────────────────────────────────────────────────────────
  496.     '  Turn the mouse off if it's around.
  497.     ' ────────────────────────────────────────────────────────────────────────
  498.     IF mouseExists% THEN
  499.         MouseHide
  500.     END IF
  501.  
  502.     ' ────────────────────────────────────────────────────────────────────────
  503.     '  Define color-based data.
  504.     ' ────────────────────────────────────────────────────────────────────────
  505.     IF kolor% THEN
  506.         ft1% = 6
  507.         ft2% = 7
  508.         bs% = STYLE3D
  509.     ELSE
  510.         ft1% = 0
  511.         ft2% = 0
  512.         bs% = STYLE2D
  513.     END IF
  514.  
  515.     ' ────────────────────────────────────────────────────────────────────────
  516.     '  Make a window in which the demo will reside, as well as a title box.
  517.     ' ────────────────────────────────────────────────────────────────────────
  518.     MakeWindow 2, 6, 23, 75, 0, 7, 0, ft1%, -1, 0, ""
  519.     MakeWindow 3, 21, 5, 60, 0, 7, 0, ft2%, -1, 0, ""
  520.     MakeWindow 20, 30, 22, 73, 0, 7, 0, ft2%, -1, 0, ""
  521.     Center "SelectList Demo", 4
  522.  
  523.     ' ────────────────────────────────────────────────────────────────────────
  524.     '  Add buttons to window.
  525.     ' ────────────────────────────────────────────────────────────────────────
  526.     DrawButton SINGLEBORDER, 8, 20, 17, 22, 0, 7, "Done", bs%
  527.     DrawButton SINGLEBORDER, 19, 20, 28, 22, 0, 7, "List", bs%
  528.  
  529.     ' ────────────────────────────────────────────────────────────────────────
  530.     '  Display some text explaining the SelectList function.
  531.     ' ────────────────────────────────────────────────────────────────────────
  532.     COLOR 0, 7
  533.     LOCATE 7, 9, 0: PRINT "The QBSCR routine SelectList displays a scrolling list of items";
  534.     LOCATE 8, 9, 0: PRINT "from which the user may select one item.  Selection is made via";
  535.     LOCATE 9, 9, 0: PRINT "a highlight bar that moves up and down.  Once the item desired";
  536.     LOCATE 10, 9, 0: PRINT "is highlighted, the ENTER key selects it.  the bar may also be";
  537.     LOCATE 11, 9, 0: PRINT "moved by hitting the first letter of the item to be chosen.";
  538.     LOCATE 13, 9, 0: PRINT "Mouse support is also provided.  A scroll bar on the right side";
  539.     LOCATE 14, 9, 0: PRINT "of the window allows mouse scrolling, and the user simply left-";
  540.     LOCATE 15, 9, 0: PRINT "clicks the item desired.";
  541.     LOCATE 17, 9, 0: PRINT "Click on the List button or hit 'L' to try it out (you will";
  542.     LOCATE 18, 9, 0: PRINT "select a hobby from a list) or click Done (or hit D) to exit.";
  543.  
  544.     ' ────────────────────────────────────────────────────────────────────────
  545.     '  Set up the selectable list.
  546.     ' ────────────────────────────────────────────────────────────────────────
  547.     OPEN "SELECT.TXT" FOR INPUT AS #1
  548.     numHobbies% = 0
  549.     WHILE (NOT (EOF(1)))
  550.         numHobbies% = numHobbies% + 1
  551.         LINE INPUT #1, list$(numHobbies%)
  552.         list$(numHobbies%) = RTRIM$(list$(numHobbies%))
  553.     WEND
  554.     CLOSE #1
  555.  
  556.     ' ────────────────────────────────────────────────────────────────────────
  557.     '  Sit in a loop waiting for input.  If the List button is activated,
  558.     '  then display the selectable list.  When we return from it, display a
  559.     '  message based on what hobby they selected.  If the Done button is
  560.     '  activated, then get outta here.
  561.     ' ────────────────────────────────────────────────────────────────────────
  562.     IF mouseExists% THEN
  563.         MouseShow
  564.     END IF
  565.     done% = FALSE
  566.     WHILE done% = FALSE
  567.  
  568.         result% = getEvent%(mouseExists%, kc%, mx%, my%)
  569.  
  570.         SELECT CASE result%
  571.             CASE EMpressedLeft     ' Left mouse button pressed
  572.                 IF (mx% >= 19) AND (mx% < 28) AND (my% >= 20) AND (my% <= 22) THEN
  573.                     PressButton SINGLEBORDER, 19, 20, 28, 22, 0, 7, "List", bs%
  574.                     IF mouseExists% THEN
  575.                         MouseHide
  576.                     END IF
  577.                     BlockSave 1, 80, 10, 17, scr%(), GetVideoSegment!
  578.                     sResult$ = SelectList$(list$(), numHobbies%, 11, 16, 22, 25, 0, 7, 15, 0, ft1%, 0, -1, "", mouseExists%)
  579.                     IF mouseExists% THEN
  580.                         MouseHide
  581.                     END IF
  582.                     BlockRestore 1, 80, 10, 17, scr%(), GetVideoSegment!
  583.                     COLOR 0, 7
  584.                     LOCATE 21, 32, 0: PRINT SPACE$(40);
  585.                     IF UCASE$(RTRIM$(sResult$)) = "NONE" THEN
  586.                         LOCATE 21, 32, 0: PRINT "None?? Get a life!";
  587.                     ELSEIF UCASE$(LEFT$(sResult$, 9)) = "COMPUTING" THEN
  588.                         LOCATE 21, 32, 0: PRINT "Don't you ever get tired of this box?";
  589.                     ELSE
  590.                         IF LTRIM$(RTRIM$(sResult$)) = "" THEN
  591.                             LOCATE 21, 32, 0: PRINT RTRIM$(sResult$); "Surely you're interested in something!";
  592.                         ELSE
  593.                             LOCATE 21, 32, 0: PRINT RTRIM$(sResult$); ", eh? Nifty!";
  594.                         END IF
  595.                     END IF
  596.                     IF mouseExists% THEN
  597.                         MouseShow
  598.                     END IF
  599.                 END IF
  600.                 IF (mx% >= 8) AND (mx% < 17) AND (my% >= 20) AND (my% <= 22) THEN
  601.                     PressButton SINGLEBORDER, 8, 20, 17, 22, 0, 7, "Done", bs%
  602.                     done% = TRUE
  603.                 END IF
  604.             CASE EMpressedRight    ' Right mouse button pressed.
  605.                 done% = TRUE
  606.             CASE EKpressed         ' A key was pressed on the keyboard.
  607.                 IF (kc% = ASC("L")) OR (kc% = ASC("l")) THEN
  608.                     IF mouseExists% THEN
  609.                         MouseHide
  610.                     END IF
  611.                     BlockSave 1, 80, 10, 17, scr%(), GetVideoSegment!
  612.                     sResult$ = SelectList$(list$(), numHobbies%, 11, 16, 22, 25, 0, 7, 15, 0, ft1%, 0, -1, "", mouseExists%)
  613.                     IF mouseExists% THEN
  614.                         MouseHide
  615.                     END IF
  616.                     BlockRestore 1, 80, 10, 17, scr%(), GetVideoSegment!
  617.                     COLOR 0, 7
  618.                     LOCATE 21, 32, 0: PRINT SPACE$(40);
  619.                     IF UCASE$(RTRIM$(sResult$)) = "NONE" THEN
  620.                         LOCATE 21, 32, 0: PRINT "None?? Get a life!";
  621.                     ELSEIF UCASE$(LEFT$(sResult$, 9)) = "COMPUTING" THEN
  622.                         LOCATE 21, 32, 0: PRINT "Don't you ever get tired of this box?";
  623.                     ELSE
  624.                         IF LTRIM$(RTRIM$(sResult$)) = "" THEN
  625.                             LOCATE 21, 32, 0: PRINT RTRIM$(sResult$); "Surely you're interested in something!";
  626.                         ELSE
  627.                             LOCATE 21, 32, 0: PRINT RTRIM$(sResult$); ", eh? Nifty!";
  628.                         END IF
  629.                     END IF
  630.                     IF mouseExists% THEN
  631.                         MouseShow
  632.                     END IF
  633.                 END IF
  634.                 IF (kc% = ASC("D")) OR (kc% = ASC("d")) OR (kc% = 27) THEN
  635.                     done% = TRUE
  636.                 END IF
  637.             CASE ELSE
  638.         END SELECT
  639.  
  640.     WEND
  641.  
  642. END SUB
  643.  
  644. SUB ViewListDemo
  645.  
  646.     ' ────────────────────────────────────────────────────────────────────────
  647.     '  This demo will illustrate the ViewList routine.  It reads a text file
  648.     '  from disk that explains how ViewList works, and then uses ViewList to
  649.     '  display it.
  650.     ' ────────────────────────────────────────────────────────────────────────
  651.  
  652.     ' ────────────────────────────────────────────────────────────────────────
  653.     '  Turn the mouse off if it's around.
  654.     ' ────────────────────────────────────────────────────────────────────────
  655.     IF mouseExists% THEN
  656.         MouseHide
  657.     END IF
  658.  
  659.     ' ────────────────────────────────────────────────────────────────────────
  660.     '  Define color-based data.
  661.     ' ────────────────────────────────────────────────────────────────────────
  662.     IF kolor% THEN
  663.         ft1% = 6
  664.     ELSE
  665.         ft1% = 0
  666.     END IF
  667.  
  668.     ' ────────────────────────────────────────────────────────────────────────
  669.     '  Display a "Wait" window.
  670.     ' ────────────────────────────────────────────────────────────────────────
  671.     MakeWindow 9, 21, 13, 60, 0, 7, 0, ft1%, -1, 0, ""
  672.     COLOR 0, 7
  673.     Center "Loading text...Please wait.", 11
  674.  
  675.     ' ────────────────────────────────────────────────────────────────────────
  676.     '  Check to see if the file VIEWLIST.TXT exists.  If so, proceed.  If not,
  677.     '  then display an error and exit this function.
  678.     ' ────────────────────────────────────────────────────────────────────────
  679.     IF FirstFile%("VIEWLIST.TXT", NormalAttr, dta$) = FALSE THEN
  680.         InfoBox VIEWLISTMISSING
  681.         EXIT SUB
  682.     END IF
  683.  
  684.     ' ────────────────────────────────────────────────────────────────────────
  685.     '  Load text from file.
  686.     ' ────────────────────────────────────────────────────────────────────────
  687.     DIM txt$(100)
  688.     OPEN "VIEWLIST.TXT" FOR INPUT AS #1
  689.     numLines% = 0
  690.     WHILE (NOT (EOF(1)))
  691.         numLines% = numLines% + 1
  692.         LINE INPUT #1, txt$(numLines%)
  693.         txt$(numLines%) = RTRIM$(txt$(numLines%))
  694.     WEND
  695.     CLOSE #1
  696.  
  697.     ' ────────────────────────────────────────────────────────────────────────
  698.     '  Call ViewList to run the demo.
  699.     ' ────────────────────────────────────────────────────────────────────────
  700.     ViewList txt$(), numLines%, 64, 9, 23, 8, 0, 7, ft1%, 0, -1, "", mouseExists%
  701.  
  702. END SUB
  703.  
  704.