home *** CD-ROM | disk | FTP | other *** search
/ CD Actual 15 / CDACTUAL15.iso / cdactual / program / basic / QBSCR20.ZIP / QDEMO_B.BAS < prev    next >
Encoding:
BASIC Source File  |  1992-07-08  |  30.5 KB  |  806 lines
  1. ' ──────────────────────────────────────────────────────────────────────────
  2. '
  3. '                           Q D E M O _ B . 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. COMMON SHARED kolor%
  16. COMMON SHARED mouseExists%
  17.  
  18. DECLARE SUB InfoBox (messageNum%)
  19. DECLARE SUB DrawBoxPointer (x%, y%)
  20. DECLARE SUB SetChaosPalette (pal%())
  21. DECLARE SUB ShowPaletteInfo (pal%())
  22. DECLARE SUB SetPalette (pal%())
  23.  
  24. CONST CANTDOBRIGHTBACKS = -1
  25. CONST CANTDOEGAVGACOLORS = -5
  26. CONST NEEDCOLOR = -6
  27. CONST QDEMO1CLRMISSING = -8
  28. CONST QDEMO1MONMISSING = -9
  29.  
  30. SUB BrightBacks
  31.  
  32.     ' ────────────────────────────────────────────────────────────────────────
  33.     '  This routine displays a screen's worth of data and two buttons in the
  34.     '  window.  The first button is either Bright Backs or Normal Backs, de-
  35.     '  pending on the current state of the system.  The other button is a
  36.     '  Done button.
  37.     ' ────────────────────────────────────────────────────────────────────────
  38.  
  39.     ' ────────────────────────────────────────────────────────────────────────
  40.     '  Display a window.
  41.     ' ────────────────────────────────────────────────────────────────────────
  42.     IF kolor% THEN
  43.         ft% = 6
  44.         ft2% = 7
  45.         bs% = STYLE3D
  46.     ELSE
  47.         InfoBox CANTDOBRIGHTBACKS
  48.         EXIT SUB
  49.     END IF
  50.  
  51.     ' ────────────────────────────────────────────────────────────────────────
  52.     '  If we are using the mouse, make sure that it is off while we are
  53.     '  writing to the screen.
  54.     ' ────────────────────────────────────────────────────────────────────────
  55.     IF mouseExists% THEN
  56.         MouseHide
  57.     END IF
  58.  
  59.     MakeWindow 6, 6, 23, 75, 0, 7, 0, ft%, -1, 0, ""
  60.  
  61.     ' ────────────────────────────────────────────────────────────────────────
  62.     '  Add the screen buttons.
  63.     ' ────────────────────────────────────────────────────────────────────────
  64.     DrawButton SINGLEBORDER, 8, 20, 23, 22, 0, 7, "Bright Backs", bs%
  65.     DrawButton SINGLEBORDER, 25, 20, 40, 22, 0, 7, "Done", bs%
  66.  
  67.     ' ────────────────────────────────────────────────────────────────────────
  68.     '  Draw the text in colors that will not show when Bright Backs are off.
  69.     ' ────────────────────────────────────────────────────────────────────────
  70.     MakeWindow 18, 42, 22, 73, 23, 7, 0, 0, -1, 0, ""
  71.     LOCATE 20, 47, 0: PRINT "Bright Backgrounds ON!";
  72.  
  73.     ' ────────────────────────────────────────────────────────────────────────
  74.     '  Add explanatory text to the window.
  75.     ' ────────────────────────────────────────────────────────────────────────
  76.     COLOR 0, 7
  77.     Center "The QBSCR Screen Routines give you access to 16 background", 8
  78.     Center "colors via the BlinkOff and BlinkOn routines.  They trade", 9
  79.     Center "blinking attributes for bright backgrounds.  Below and to", 10
  80.     Center "the right, a window has been drawn.  It is in colors that", 11
  81.     Center "cannot be seen unless bright backgrounds are enabled.  To", 12
  82.     Center "see the window, click on the Bright Backgrounds button or", 13
  83.     Center "hit the B key.  To quit, click the Done button or hit the", 14
  84.     Center "D or ESC keys.  See the QBSCR documentaiton for more info", 15
  85.     Center "regarding the BlinkOff and BlinkOn routines.", 16
  86.  
  87.  
  88.     ' ────────────────────────────────────────────────────────────────────────
  89.     '  Turn the mouse back on if it is around here.
  90.     ' ────────────────────────────────────────────────────────────────────────
  91.     IF mouseExists% THEN
  92.         MouseShow
  93.     END IF
  94.  
  95.     ' ────────────────────────────────────────────────────────────────────────
  96.     '  Now we must wait on the user for a response of some kind.  To do this,
  97.     '  we use the QBSCR routine GetEvent%.  It will return a keypress or a
  98.     '  mouse event, whichever occurs first.  If the C, c, Esc, or right
  99.     '  mouse buttons are pressed, or if the left button is pressed while the
  100.     '  mouse cursor is on the Cancel button, we get out. If the P, p, or left
  101.     '  mouse button is pressed while one the Print Form button, then we
  102.     '  print a form and THEN get out.
  103.     ' ────────────────────────────────────────────────────────────────────────
  104.     done% = FALSE
  105.     brightState% = 0
  106.     WHILE done% = FALSE
  107.  
  108.         ' ──────────────────────────────────────────────────────────────────────
  109.         '  Get an event of some kind.
  110.         ' ──────────────────────────────────────────────────────────────────────
  111.         IF mouseExists% THEN
  112.             MouseShow
  113.         END IF
  114.         result% = getEvent%(mouseExists%, kc%, mx%, my%)
  115.  
  116.         ' ──────────────────────────────────────────────────────────────────────
  117.         '  Decide what to do based on the event that occurred.
  118.         ' ──────────────────────────────────────────────────────────────────────
  119.         SELECT CASE result%
  120.             CASE EMpressedLeft      ' Mouse left button pressed.
  121.             
  122.                 ' ──────────────────────────────────────────────────────────────────
  123.                 '  See if the mouse was on the PrintForm button.
  124.                 ' ──────────────────────────────────────────────────────────────────
  125.                 IF (mx% >= 8) AND (mx% <= 23) AND (my% >= 20) AND (my% <= 22) THEN
  126.                     IF brightState% = 0 THEN
  127.                         PressButton SINGLEBORDER, 8, 20, 23, 22, 0, 7, "Bright Backs", bs%
  128.                         DrawButton SINGLEBORDER, 8, 20, 23, 22, 0, 7, "Normal Backs", bs%
  129.                         BlinkOff
  130.                         brightState% = 1
  131.                     ELSE
  132.                         PressButton SINGLEBORDER, 8, 20, 23, 22, 0, 7, "Normal Backs", bs%
  133.                         DrawButton SINGLEBORDER, 8, 20, 23, 22, 0, 7, "Bright Backs", bs%
  134.                         BlinkOn
  135.                         brightState% = 0
  136.                     END IF
  137.                 END IF
  138.  
  139.                 ' ──────────────────────────────────────────────────────────────────
  140.                 '  See if the mouse was on the Done button.
  141.                 ' ──────────────────────────────────────────────────────────────────
  142.                 IF (mx% >= 25) AND (mx% <= 40) AND (my% >= 20) AND (my% <= 22) THEN
  143.                     PressButton SINGLEBORDER, 25, 20, 40, 22, 0, 7, "Done", bs%
  144.                     done% = TRUE
  145.                 END IF
  146.  
  147.             CASE EMpressedRight     ' Right mouse button pressed.
  148.                 done% = TRUE
  149.  
  150.             CASE EKpressed          ' Keyboard pressed.
  151.                 IF (kc% = 27) OR (kc% = ASC("D")) OR (kc% = ASC("d")) THEN
  152.                     done% = TRUE
  153.                 END IF
  154.  
  155.                 IF (kc% = ASC("B")) OR (kc% = ASC("b")) OR (kc% = ASC("N")) OR (kc% = ASC("n")) THEN
  156.                     IF brightState% = 0 THEN
  157.                         DrawButton SINGLEBORDER, 8, 20, 23, 22, 0, 7, "Normal Backs", bs%
  158.                         BlinkOff
  159.                         brightState% = 1
  160.                     ELSE
  161.                         DrawButton SINGLEBORDER, 8, 20, 23, 22, 0, 7, "Bright Backs", bs%
  162.                         BlinkOn
  163.                         brightState% = 0
  164.                     END IF
  165.                 END IF
  166.             CASE ELSE
  167.         END SELECT
  168.  
  169.     WEND
  170.  
  171.     ' ────────────────────────────────────────────────────────────────────────
  172.     '  Ensure that bright backgrounds are OFF when we leave this place, or
  173.     '  the Get Fore/Back demo may be screwed up!
  174.     ' ────────────────────────────────────────────────────────────────────────
  175.     BlinkOn
  176.  
  177. END SUB
  178.  
  179. SUB DrawBoxPointer (x%, y%)
  180.  
  181.     ' ────────────────────────────────────────────────────────────────────────
  182.     '  This routine is used by the GetForeBack routine, and simply draws a
  183.     '  box-shaped pointer on the screen at the passed-in coordinates.
  184.     ' ────────────────────────────────────────────────────────────────────────
  185.  
  186.     COLOR 15, 0
  187.     LOCATE y%, x%, 0
  188.     PRINT "┌─┐";
  189.     LOCATE y% + 1, x%, 0
  190.     PRINT "│";
  191.     LOCATE y% + 1, x% + 2, 0
  192.     PRINT "│";
  193.     LOCATE y% + 2, x%, 0
  194.     PRINT "└─┘";
  195.  
  196. END SUB
  197.  
  198. SUB EgaVgaColors
  199.  
  200.     ' ────────────────────────────────────────────────────────────────────────
  201.     '  This demo-nstrates the rgbRGB function and the use of 64 possible
  202.     '  colors in text mode with an EGA/VGA card.  Uses the QBSCR EgaPresent
  203.     '  function to determine if an EGA/VGA is present.
  204.     ' ────────────────────────────────────────────────────────────────────────
  205.  
  206.     ' ────────────────────────────────────────────────────────────────────────
  207.     '  If an EGA/VGA is not present, then display an error and get outta here.
  208.     ' ────────────────────────────────────────────────────────────────────────
  209.     IF (EgaPresent% = FALSE) THEN
  210.         InfoBox CANTDOEGAVGACOLORS
  211.         EXIT SUB
  212.     END IF
  213.  
  214.     ' ────────────────────────────────────────────────────────────────────────
  215.     '  Need to make sure color is available, since it is possible to have a
  216.     '  monochrome VGA system.  If not, error and exit.
  217.     ' ────────────────────────────────────────────────────────────────────────
  218.     IF kolor% = FALSE THEN
  219.         InfoBox NEEDCOLOR
  220.         EXIT SUB
  221.     END IF
  222.  
  223.     ' ────────────────────────────────────────────────────────────────────────
  224.     '  If mouse is around, hide it.
  225.     ' ────────────────────────────────────────────────────────────────────────
  226.     IF mouseExists% THEN
  227.         MouseHide
  228.     END IF
  229.  
  230.     ' ────────────────────────────────────────────────────────────────────────
  231.     '  Define and initialize palette arrays.  The values in the arrays were
  232.     '  predetermined to be the correct colors.  You can experiment with the
  233.     '  rgbRGB function on your own to see all 64 possible colors.  These
  234.     '  color calues will be used by the rgbRGB% function later.
  235.     ' ────────────────────────────────────────────────────────────────────────
  236.     DIM redPal%(9, 3)
  237.     DIM greenPal%(9, 3)
  238.     DIM bluePal%(9, 3)
  239.     DIM chaosPal%(9, 3)
  240.  
  241.     ' Reds
  242.     redPal%(1, 1) = 1: redPal%(1, 2) = 0: redPal%(1, 3) = 0
  243.     redPal%(2, 1) = 2: redPal%(2, 2) = 0: redPal%(2, 3) = 0
  244.     redPal%(3, 1) = 2: redPal%(3, 2) = 1: redPal%(3, 3) = 0
  245.     redPal%(4, 1) = 3: redPal%(4, 2) = 1: redPal%(4, 3) = 0
  246.     redPal%(5, 1) = 3: redPal%(5, 2) = 0: redPal%(5, 3) = 0
  247.     redPal%(6, 1) = 3: redPal%(6, 2) = 0: redPal%(6, 3) = 1
  248.     redPal%(7, 1) = 3: redPal%(7, 2) = 1: redPal%(7, 3) = 1
  249.     redPal%(8, 1) = 3: redPal%(8, 2) = 1: redPal%(8, 3) = 2
  250.     redPal%(9, 1) = 3: redPal%(9, 2) = 2: redPal%(9, 3) = 2
  251.  
  252.     ' Greens
  253.     greenPal%(1, 1) = 0: greenPal%(1, 2) = 1: greenPal%(1, 3) = 0
  254.     greenPal%(2, 1) = 0: greenPal%(2, 2) = 2: greenPal%(2, 3) = 1
  255.     greenPal%(3, 1) = 0: greenPal%(3, 2) = 2: greenPal%(3, 3) = 0
  256.     greenPal%(4, 1) = 0: greenPal%(4, 2) = 3: greenPal%(4, 3) = 0
  257.     greenPal%(5, 1) = 1: greenPal%(5, 2) = 3: greenPal%(5, 3) = 1
  258.     greenPal%(6, 1) = 0: greenPal%(6, 2) = 3: greenPal%(6, 3) = 1
  259.     greenPal%(7, 1) = 2: greenPal%(7, 2) = 3: greenPal%(7, 3) = 0
  260.     greenPal%(8, 1) = 2: greenPal%(8, 2) = 3: greenPal%(8, 3) = 1
  261.     greenPal%(9, 1) = 2: greenPal%(9, 2) = 3: greenPal%(9, 3) = 2
  262.  
  263.     ' Blues
  264.     bluePal%(1, 1) = 0: bluePal%(1, 2) = 0: bluePal%(1, 3) = 1
  265.     bluePal%(2, 1) = 0: bluePal%(2, 2) = 0: bluePal%(2, 3) = 2
  266.     bluePal%(3, 1) = 0: bluePal%(3, 2) = 1: bluePal%(3, 3) = 2
  267.     bluePal%(4, 1) = 0: bluePal%(4, 2) = 0: bluePal%(4, 3) = 3
  268.     bluePal%(5, 1) = 0: bluePal%(5, 2) = 1: bluePal%(5, 3) = 3
  269.     bluePal%(6, 1) = 1: bluePal%(6, 2) = 0: bluePal%(6, 3) = 3
  270.     bluePal%(7, 1) = 1: bluePal%(7, 2) = 1: bluePal%(7, 3) = 3
  271.     bluePal%(8, 1) = 0: bluePal%(8, 2) = 2: bluePal%(8, 3) = 3
  272.     bluePal%(9, 1) = 1: bluePal%(9, 2) = 2: bluePal%(9, 3) = 3
  273.  
  274.     ' ────────────────────────────────────────────────────────────────────────
  275.     '  Draw a simple window on the screen with Proceed and Cancel buttons
  276.     '  that explains what's about to happen.
  277.     ' ────────────────────────────────────────────────────────────────────────
  278.     IF kolor% THEN
  279.         ft1% = 6
  280.         ft2% = 7
  281.         bs% = STYLE3D
  282.     ELSE
  283.         ft1% = 6
  284.         ft2% = 7
  285.         bs% = STYLE3D
  286.     END IF
  287.     MakeWindow 5, 8, 23, 73, 0, 7, 0, ft1%, -1, 0, ""
  288.     MakeWindow 6, 10, 22, 71, 0, 7, 0, ft2%, -1, 0, ""
  289.     MakeWindow 7, 21, 9, 60, 0, 7, 0, ft1%, -1, 0, ""
  290.     Center "EGA/VGA Extended Text Colors", 8
  291.     DrawButton SINGLEBORDER, 12, 19, 25, 21, 0, 7, "See Colors", bs%
  292.     DrawButton SINGLEBORDER, 27, 19, 40, 21, 0, 7, "Cancel", bs%
  293.     LOCATE 11, 13, 0: PRINT "A new capability in version 1.7 of the QBSCR Screen";
  294.     LOCATE 12, 13, 0: PRINT "Routines is the use of up to 16 of 64 total colors when";
  295.     LOCATE 13, 13, 0: PRINT "using an EGA or VGA video card.  Since you have one, you";
  296.     LOCATE 14, 13, 0: PRINT "will be able to see what we're talking about by clicking";
  297.     LOCATE 15, 13, 0: PRINT "the See Colors button below (or hitting the S key).  If";
  298.     LOCATE 16, 13, 0: PRINT "you really don't care or don't want to see, then click";
  299.     LOCATE 17, 13, 0: PRINT "the Cancel button (or hit C or ESC).";
  300.  
  301.     done% = FALSE
  302.     seeColors% = FALSE
  303.     IF mouseExists% THEN
  304.         MouseShow
  305.     END IF
  306.     WHILE done% = FALSE
  307.  
  308.         result% = getEvent%(mouseExists%, kc%, mx%, my%)
  309.  
  310.         SELECT CASE result%
  311.             CASE EMpressedLeft
  312.                 IF (mx% >= 12) AND (mx% <= 25) AND (my% >= 19) AND (my% <= 21) THEN
  313.                     PressButton SINGLEBORDER, 12, 19, 25, 21, 0, 7, "See Colors", bs%
  314.                     done% = TRUE
  315.                     seeColors% = TRUE
  316.                 END IF
  317.                 IF (mx% >= 27) AND (mx% <= 40) AND (my% >= 19) AND (my% <= 21) THEN
  318.                     PressButton SINGLEBORDER, 27, 19, 40, 21, 0, 7, "Cancel", bs%
  319.                     done% = TRUE
  320.                 END IF
  321.             CASE EMpressedRight
  322.                 done% = TRUE
  323.             CASE EKpressed
  324.                 IF (kc% = ASC("S")) OR (kc% = ASC("s")) OR (kc% = 13) THEN
  325.                     done% = TRUE
  326.                     seeColors% = TRUE
  327.                 END IF
  328.                 IF (kc% = ASC("C")) OR (kc% = ASC("c")) OR (kc% = 27) THEN
  329.                     done% = TRUE
  330.                 END IF
  331.             CASE ELSE
  332.         END SELECT
  333.  
  334.     WEND
  335.  
  336.     ' ────────────────────────────────────────────────────────────────────────
  337.     '  If user aborted the operation, then get out.  Otherwise, continue on.
  338.     ' ────────────────────────────────────────────────────────────────────────
  339.     IF seeColors% = FALSE THEN
  340.         EXIT SUB
  341.     END IF
  342.  
  343.     ' ────────────────────────────────────────────────────────────────────────
  344.     '  Make the interface for the color viewing stuff (dang this is fun!)
  345.     ' ────────────────────────────────────────────────────────────────────────
  346.     IF mouseExists% THEN
  347.         MouseHide
  348.     END IF
  349.     MakeWindow 3, 7, 23, 73, 0, 7, 0, ft1%, -1, 0, ""
  350.     MakeWindow 17, 9, 22, 58, 0, 7, 0, ft2%, -1, 0, ""
  351.     MakeWindow 4, 9, 16, 58, 0, 0, 0, 0, -1, 0, ""
  352.     DrawButton SINGLEBORDER, 61, 4, 70, 6, 0, 7, "Reds", bs%
  353.     DrawButton SINGLEBORDER, 61, 7, 70, 9, 0, 7, "Greens", bs%
  354.     DrawButton SINGLEBORDER, 61, 10, 70, 12, 0, 7, "Blues", bs%
  355.     DrawButton SINGLEBORDER, 61, 13, 70, 15, 0, 7, "Chaos", bs%
  356.     DrawButton DOUBLEBORDER, 61, 19, 70, 21, 0, 7, "Done", bs%
  357.     LOCATE 18, 11, 0: PRINT "Note that this demo shows only some of the 64";
  358.     LOCATE 19, 11, 0: PRINT "possible colors.  Chaos shows random colors.";
  359.     LOCATE 20, 11, 0: PRINT "Click buttons or hit the first letter to see";
  360.     LOCATE 21, 11, 0: PRINT "the color sets named. Done exits to the menu.";
  361.  
  362.     ' ────────────────────────────────────────────────────────────────────────
  363.     '  Since we will be using colors above value 7, we need to set the Bright
  364.     '  Background capability ON, by calling the QBSCR routine BlinkOff.
  365.     ' ────────────────────────────────────────────────────────────────────────
  366.     BlinkOff
  367.  
  368.     ' ────────────────────────────────────────────────────────────────────────
  369.     ' Set the palette initially to the red set.
  370.     ' ────────────────────────────────────────────────────────────────────────
  371.     SetPalette redPal%()
  372.  
  373.     ' ────────────────────────────────────────────────────────────────────────
  374.     '  Add in the text that will be viewed in the new nifty colors.
  375.     ' ────────────────────────────────────────────────────────────────────────
  376.     LOCATE 5, 11, 0: COLOR 15, 0: PRINT "Color Display                   Color Values";
  377.     LOCATE 6, 11, 0: PRINT STRING$(45, 196);
  378.     LOCATE 7, 11, 0: COLOR 0, 1: PRINT " As Background ";
  379.     COLOR 1, 0: PRINT " As Foreground";
  380.     LOCATE 8, 11, 0: COLOR 0, 2: PRINT " As Background ";
  381.     COLOR 2, 0: PRINT " As Foreground";
  382.     LOCATE 9, 11, 0: COLOR 0, 3: PRINT " As Background ";
  383.     COLOR 3, 0: PRINT " As Foreground";
  384.     LOCATE 10, 11, 0: COLOR 0, 4: PRINT " As Background ";
  385.     COLOR 4, 0: PRINT " As Foreground";
  386.     LOCATE 11, 11, 0: COLOR 0, 5: PRINT " As Background ";
  387.     COLOR 5, 0: PRINT " As Foreground";
  388.     LOCATE 12, 11, 0: COLOR 0, 6: PRINT " As Background ";
  389.     COLOR 6, 0: PRINT " As Foreground";
  390.     LOCATE 13, 11, 0: COLOR 16, 0: PRINT " As Background ";
  391.     COLOR 8, 0: PRINT " As Foreground";
  392.     LOCATE 14, 11, 0: COLOR 16, 1: PRINT " As Background ";
  393.     COLOR 9, 0: PRINT " As Foreground";
  394.     LOCATE 15, 11, 0: COLOR 16, 2: PRINT " As Background ";
  395.     COLOR 10, 0: PRINT " As Foreground";
  396.  
  397.     ' ────────────────────────────────────────────────────────────────────────
  398.     '  Now add in the informational stuff.
  399.     ' ────────────────────────────────────────────────────────────────────────
  400.     ShowPaletteInfo redPal%()
  401.  
  402.     IF mouseExists% THEN
  403.         MouseShow
  404.     END IF
  405.     done% = FALSE
  406.     WHILE done% = FALSE
  407.  
  408.         result% = getEvent%(mouseExists%, kc%, mx%, my%)
  409.  
  410.         SELECT CASE result%
  411.             CASE EMpressedLeft
  412.              
  413.                 ' Reds
  414.                 IF (mx% >= 61) AND (mx% <= 70) AND (my% >= 4) AND (my% <= 6) THEN
  415.                     PressButton SINGLEBORDER, 61, 4, 70, 6, 0, 7, "Reds", bs%
  416.                     MouseHide
  417.                     SetPalette redPal%()
  418.                     ShowPaletteInfo redPal%()
  419.                     MouseShow
  420.                 END IF
  421.                 ' Greens button
  422.                 IF (mx% >= 61) AND (mx% <= 70) AND (my% >= 7) AND (my% <= 9) THEN
  423.                     PressButton SINGLEBORDER, 61, 7, 70, 9, 0, 7, "Greens", bs%
  424.                     MouseHide
  425.                     SetPalette greenPal%()
  426.                     ShowPaletteInfo greenPal%()
  427.                     MouseShow
  428.                 END IF
  429.                 ' Blues button
  430.                 IF (mx% >= 61) AND (mx% <= 70) AND (my% >= 10) AND (my% <= 12) THEN
  431.                     PressButton SINGLEBORDER, 61, 10, 70, 12, 0, 7, "Blues", bs%
  432.                     MouseHide
  433.                     SetPalette bluePal%()
  434.                     ShowPaletteInfo bluePal%()
  435.                     MouseShow
  436.                 END IF
  437.                 ' Chaos button
  438.                 IF (mx% >= 61) AND (mx% <= 70) AND (my% >= 13) AND (my% <= 15) THEN
  439.                     PressButton SINGLEBORDER, 61, 13, 70, 15, 0, 7, "Chaos", bs%
  440.                     MouseHide
  441.                     SetChaosPalette chaosPal%()
  442.                     ShowPaletteInfo chaosPal%()
  443.                     MouseShow
  444.                 END IF
  445.                 ' Done button
  446.                 IF (mx% >= 61) AND (mx% <= 70) AND (my% >= 19) AND (my% <= 21) THEN
  447.                     PressButton DOUBLEBORDER, 61, 19, 70, 21, 0, 7, "Done", bs%
  448.                     done% = TRUE
  449.                 END IF
  450.             CASE EMpressedRight
  451.                 done% = TRUE
  452.             CASE EKpressed
  453.                 IF (kc% = ASC("R")) OR (kc% = ASC("r")) THEN     ' Reds
  454.                     IF mouseExists% THEN MouseHide
  455.                     SetPalette redPal%()
  456.                     ShowPaletteInfo redPal%()
  457.                     IF mouseExists% THEN MouseShow
  458.                 END IF
  459.                 IF (kc% = ASC("G")) OR (kc% = ASC("g")) THEN     ' Greens
  460.                     IF mouseExists% THEN MouseHide
  461.                     SetPalette greenPal%()
  462.                     ShowPaletteInfo greenPal%()
  463.                     IF mouseExists% THEN MouseShow
  464.                 END IF
  465.                 IF (kc% = ASC("B")) OR (kc% = ASC("b")) THEN     ' Blues
  466.                     IF mouseExists% THEN MouseHide
  467.                     SetPalette bluePal%()
  468.                     ShowPaletteInfo bluePal%()
  469.                     IF mouseExists% THEN MouseShow
  470.                 END IF
  471.                 IF (kc% = ASC("C")) OR (kc% = ASC("c")) THEN     ' Blues
  472.                     IF mouseExists% THEN MouseHide
  473.                     SetChaosPalette chaosPal%()
  474.                     ShowPaletteInfo chaosPal%()
  475.                     IF mouseExists% THEN MouseShow
  476.                 END IF
  477.                 IF (kc% = ASC("D")) OR (kc% = ASC("d")) OR (kc% = 27) THEN  ' Done
  478.                     done% = TRUE
  479.                 END IF
  480.             CASE ELSE
  481.         END SELECT
  482.  
  483.     WEND
  484.  
  485.     ' ────────────────────────────────────────────────────────────────────────
  486.     '  Last but not least, we clean up.  Hide the mouse first of all.  The
  487.     '  Clear out the window with the colors in it.  If we don't do this, then
  488.     '  the text tere will revert to normal colors when we reset the palette.
  489.     '  This isn't bad, but doesn't look "clean."  Then reset the palette to
  490.     '  normal defaults by calling the PALETTE statement with no parameters.
  491.     '  Last, call BlinkOn to restore blinking attributes.
  492.     ' ────────────────────────────────────────────────────────────────────────
  493.     IF mouseExists% THEN
  494.         MouseHide
  495.     END IF
  496.     Wipe 4, 16, 9, 58, 0
  497.     PALETTE
  498.     BlinkOn
  499.  
  500. END SUB
  501.  
  502. SUB GetForeBack
  503.  
  504.     ' ────────────────────────────────────────────────────────────────────────
  505.     '  This routine will demonstrate the GetForeground and GetBackground
  506.     '  routines from the QBSCR Screen Routines.  It uses PutScreen as well
  507.     '  to display a premade picture.
  508.     ' ────────────────────────────────────────────────────────────────────────
  509.  
  510.     ' ────────────────────────────────────────────────────────────────────────
  511.     '  Load and display the correct image, but only if the file exists.  If
  512.     '  the image file is missing, then display an error message and get out.
  513.     ' ────────────────────────────────────────────────────────────────────────
  514.     IF mouseExists% THEN
  515.         MouseHide
  516.     END IF
  517.     IF kolor% THEN
  518.         ft% = 6: ft2% = 7
  519.         bs% = STYLE3D
  520.         IF FirstFile%("QDEMO_1.CLR", NormalAttr, dta$) THEN
  521.             PutScreen "QDEMO_1.CLR"
  522.         ELSE
  523.             InfoBox QDEMO1CLRMISSING
  524.             EXIT SUB
  525.         END IF
  526.     ELSE
  527.         ft% = 0: ft2% = 0
  528.         bs% = STYLE2D
  529.         IF FirstFile%("QDEMO_1.MON", NormalAttr, dta$) THEN
  530.             PutScreen "QDEMO_1.MON"
  531.         ELSE
  532.             InfoBox QDEMO1MONMISSING
  533.             EXIT SUB
  534.         END IF
  535.     END IF
  536.  
  537.     ' ────────────────────────────────────────────────────────────────────────
  538.     '  Add a window to the bottom part of the screen and add all interface
  539.     '  bits to it.
  540.     ' ────────────────────────────────────────────────────────────────────────
  541.     COLOR 0, 7
  542.     FOR i% = 16 TO 25
  543.         LOCATE i%, 1, 0: PRINT SPACE$(80);
  544.     NEXT i%
  545.     MakeWindow 16, 2, 25, 79, 0, 7, 0, ft2%, -1, 0, ""
  546.     MakeWindow 17, 16, 19, 65, 0, 7, 0, ft%, -1, 0, ""
  547.     DrawButton SINGLEBORDER, 4, 22, 13, 24, 0, 7, "Done", bs%
  548.  
  549.     LOCATE 21, 17, 0: PRINT "Use the arrow keys or the mouse to move the small box above";
  550.     LOCATE 22, 17, 0: PRINT "around the screen.  The foreground and background colors of";
  551.     LOCATE 23, 17, 0: PRINT "of the character in the box will be displayed.";
  552.  
  553.     ' ────────────────────────────────────────────────────────────────────────
  554.     '  Now initialize a few variables we will be using to keep track of
  555.     '  things for us.  Get the current mouse position and set out starting
  556.     '  point there.
  557.     ' ────────────────────────────────────────────────────────────────────────
  558.     DIM sc%(18)
  559.     IF mouseExists% THEN
  560.         MousePosition curX%, curY%
  561.         curX% = (curX% \ 8) + 1
  562.         curY% = (curY% \ 8) + 1
  563.     ELSE
  564.         curX% = 39: curY% = 9
  565.     END IF
  566.     oldX% = curX%: oldY% = curY%
  567.  
  568.     ' ────────────────────────────────────────────────────────────────────────
  569.     '  Find out the forground and background colors in the initial box
  570.     '  position, and display them in the interface box below the picture.
  571.     ' ────────────────────────────────────────────────────────────────────────
  572.     curFG% = GetForeground%(curY% + 1, curX% + 1)
  573.     curBG% = GetBackground%(curY% + 1, curX% + 1)
  574.     txt$ = "Foreground:" + STR$(curFG%) + "  Background:" + STR$(curBG%)
  575.     COLOR 0, 7
  576.     Center txt$, 18
  577.  
  578.     ' ────────────────────────────────────────────────────────────────────────
  579.     '  Since the mouse represents the upper-left corner of the pointer box,
  580.     '  we must ensure that it is not moved passed column 78, or part of the
  581.     '  box will disappear off the right edge of the screen.  Rather than check
  582.     '  the mouse position every time the mouse is moved, we'll let the QBSCR
  583.     '  mouse routine called MouseSetMinMaxX do it for us.  It prevents the
  584.     '  mouse from being moved farther than we want it to.
  585.     ' ────────────────────────────────────────────────────────────────────────
  586.     IF mouseExists% THEN
  587.         MouseSetMinMaxX 1, 77 * 8
  588.     END IF
  589.  
  590.     ' ────────────────────────────────────────────────────────────────────────
  591.     '  Save the screen underneath the small box that will be drawn at the
  592.     '  curX%, curY% location.  Then draw the box.
  593.     ' ────────────────────────────────────────────────────────────────────────
  594.     okToRestore% = FALSE
  595.     IF (curY% < 14) THEN
  596.         BlockSave curX%, curX% + 2, curY%, curY% + 2, sc%(), GetVideoSegment!
  597.         DrawBoxPointer curX%, curY%
  598.         okToRestore% = TRUE
  599.     ELSE
  600.         MouseShow
  601.     END IF
  602.  
  603.     ' ────────────────────────────────────────────────────────────────────────
  604.     '  Now that everything is set up, we sit in a loop waiting on events.
  605.     '  If the mouse is moved or the arrow keys are pressed, we must move the
  606.     '  box around.  There is an added complication, though.  If the mouse is
  607.     '  moved below the picture into the interface box, the mouse cursor must
  608.     '  be redisplayed and we are in regular mouse mode.  If moved back into
  609.     '  the picture, we are then moving the box around again.  You'll see...
  610.     ' ────────────────────────────────────────────────────────────────────────
  611.     done% = FALSE
  612.     WHILE done% = FALSE
  613.  
  614.         result% = getEvent%(mouseExists%, kc%, mx%, my%)
  615.             
  616.         SELECT CASE result%
  617.             CASE EMmoved
  618.              
  619.                 ' ──────────────────────────────────────────────────────────────────
  620.                 '  If mouse WAS in picture, and NOW is in interface box, turn mouse
  621.                 '  back on.
  622.                 ' ──────────────────────────────────────────────────────────────────
  623.                 IF (my% > 14) THEN
  624.                     IF okToRestore% THEN
  625.                         BlockRestore oldX%, oldX% + 2, oldY%, oldY% + 2, sc%(), GetVideoSegment!
  626.                     END IF
  627.                     MouseShow
  628.                 END IF
  629.  
  630.                 ' ──────────────────────────────────────────────────────────────────
  631.                 '  If mouse is in picture, and was last time, simply update the box
  632.                 '  and its associated information.
  633.                 ' ──────────────────────────────────────────────────────────────────
  634.                 IF (my% <= 14) THEN
  635.                     curX% = mx%
  636.                     curY% = my%
  637.                     'okToRestore% = TRUE
  638.                     update% = TRUE
  639.                 END IF
  640.  
  641.             CASE EMpressedLeft
  642.  
  643.                 ' ──────────────────────────────────────────────────────────────────
  644.                 '  If the left mouse button was pressed, then see if it was on the
  645.                 '  Done button.  If so, then press the button and exit.
  646.                 ' ──────────────────────────────────────────────────────────────────
  647.                 IF (mx% >= 4) AND (mx% <= 13) AND (my% >= 22) AND (my% <= 24) THEN
  648.                     PressButton SINGLEBORDER, 4, 22, 13, 24, 0, 7, "Done", bs%
  649.                     done% = TRUE
  650.                 END IF
  651.  
  652.             CASE EMpressedRight
  653.                 done% = TRUE
  654.  
  655.             CASE EKpressed
  656.  
  657.                 IF curY% > 14 THEN
  658.                     curY% = 14
  659.                 END IF
  660.  
  661.                 SELECT CASE kc%
  662.                     CASE LEFTARROW
  663.                         IF curX% > 1 THEN
  664.                             curX% = curX% - 1
  665.                         ELSE
  666.                             curX% = 78
  667.                         END IF
  668.                         update% = TRUE
  669.                     CASE RIGHTARROW
  670.                         IF curX% < 78 THEN
  671.                             curX% = curX% + 1
  672.                         ELSE
  673.                             curX% = 1
  674.                         END IF
  675.                         update% = TRUE
  676.                     CASE UPARROW
  677.                         IF curY% > 1 AND curY% < 15 THEN
  678.                             curY% = curY% - 1
  679.                         ELSE
  680.                             curY% = 14
  681.                         END IF
  682.                         update% = TRUE
  683.                     CASE DOWNARROW
  684.                         IF curY% < 14 THEN
  685.                             curY% = curY% + 1
  686.                         ELSE
  687.                             curY% = 1
  688.                         END IF
  689.                         update% = TRUE
  690.                     CASE 27, ASC("D"), ASC("d")
  691.                         done% = TRUE
  692.                     CASE ELSE
  693.                 END SELECT
  694.             CASE ELSE
  695.  
  696.         END SELECT
  697.  
  698.         IF update% THEN
  699.             MouseHide
  700.             update% = FALSE
  701.             IF okToRestore% THEN
  702.                 BlockRestore oldX%, oldX% + 2, oldY%, oldY% + 2, sc%(), GetVideoSegment!
  703.             END IF
  704.             okToRestore% = TRUE
  705.             BlockSave curX%, curX% + 2, curY%, curY% + 2, sc%(), GetVideoSegment!
  706.             DrawBoxPointer curX%, curY%
  707.             oldX% = curX%
  708.             oldY% = curY%
  709.             curFG% = GetForeground%(curY% + 1, curX% + 1)
  710.             curBG% = GetBackground%(curY% + 1, curX% + 1)
  711.             txt$ = "Foreground:" + STR$(curFG%) + "  Background:" + STR$(curBG%)
  712.             COLOR 0, 7
  713.             Center SPACE$(40), 18
  714.             Center txt$, 18
  715.         END IF
  716.  
  717.     WEND
  718.  
  719.     ' ────────────────────────────────────────────────────────────────────────
  720.     '  Lastly, since we restricted the mouse's movement earlier, we must un-
  721.     '  restrict it before we leave.
  722.     ' ────────────────────────────────────────────────────────────────────────
  723.     IF mouseExists% THEN
  724.         MouseSetMinMaxX 1, 79 * 8
  725.     END IF
  726.  
  727. END SUB
  728.  
  729. SUB SetChaosPalette (pal%())
  730.  
  731.     ' ────────────────────────────────────────────────────────────────────────
  732.     '  This routine sets a random palette of 9 colors.  Used only by the
  733.     '  EgaVgaColors demo routine.
  734.     ' ────────────────────────────────────────────────────────────────────────
  735.  
  736.     ' ────────────────────────────────────────────────────────────────────────
  737.     '  Set nine random colors.
  738.     ' ────────────────────────────────────────────────────────────────────────
  739.     RANDOMIZE TIMER
  740.  
  741.     pal%(1, 1) = (INT(RND(1) * 4)): pal%(1, 2) = (INT(RND(1) * 4)): pal%(1, 3) = (INT(RND(1) * 4))
  742.     pal%(2, 1) = (INT(RND(1) * 4)): pal%(2, 2) = (INT(RND(1) * 4)): pal%(2, 3) = (INT(RND(1) * 4))
  743.     pal%(3, 1) = (INT(RND(1) * 4)): pal%(3, 2) = (INT(RND(1) * 4)): pal%(3, 3) = (INT(RND(1) * 4))
  744.     pal%(4, 1) = (INT(RND(1) * 4)): pal%(4, 2) = (INT(RND(1) * 4)): pal%(4, 3) = (INT(RND(1) * 4))
  745.     pal%(5, 1) = (INT(RND(1) * 4)): pal%(5, 2) = (INT(RND(1) * 4)): pal%(5, 3) = (INT(RND(1) * 4))
  746.     pal%(6, 1) = (INT(RND(1) * 4)): pal%(6, 2) = (INT(RND(1) * 4)): pal%(6, 3) = (INT(RND(1) * 4))
  747.     pal%(7, 1) = (INT(RND(1) * 4)): pal%(7, 2) = (INT(RND(1) * 4)): pal%(7, 3) = (INT(RND(1) * 4))
  748.     pal%(8, 1) = (INT(RND(1) * 4)): pal%(8, 2) = (INT(RND(1) * 4)): pal%(8, 3) = (INT(RND(1) * 4))
  749.     pal%(9, 1) = (INT(RND(1) * 4)): pal%(9, 2) = (INT(RND(1) * 4)): pal%(9, 3) = (INT(RND(1) * 4))
  750.  
  751.     PALETTE 1, rgbRGB%(pal%(1, 1), pal%(1, 2), pal%(1, 3))
  752.     PALETTE 2, rgbRGB%(pal%(2, 1), pal%(2, 2), pal%(2, 3))
  753.     PALETTE 3, rgbRGB%(pal%(3, 1), pal%(3, 2), pal%(3, 3))
  754.     PALETTE 4, rgbRGB%(pal%(4, 1), pal%(4, 2), pal%(4, 3))
  755.     PALETTE 5, rgbRGB%(pal%(5, 1), pal%(5, 2), pal%(5, 3))
  756.     PALETTE 6, rgbRGB%(pal%(6, 1), pal%(6, 2), pal%(6, 3))
  757.     PALETTE 8, rgbRGB%(pal%(7, 1), pal%(7, 2), pal%(7, 3))
  758.     PALETTE 9, rgbRGB%(pal%(8, 1), pal%(8, 2), pal%(8, 3))
  759.     PALETTE 10, rgbRGB%(pal%(9, 1), pal%(9, 2), pal%(9, 3))
  760.  
  761. END SUB
  762.  
  763. SUB SetPalette (pal%())
  764.  
  765.     ' ────────────────────────────────────────────────────────────────────────
  766.     '  This routine is used by the EgaVgaColors demo routine.  It sets some
  767.     '  of the palette to the attributes passed in the pal%() array.  Note
  768.     '  that the array is assumed to be a 2D 9x3 array, like DIM pal%(9, 3).
  769.     ' ────────────────────────────────────────────────────────────────────────
  770.  
  771.     ' ────────────────────────────────────────────────────────────────────────
  772.     '  Set palette attributes.  Note that attribute 7 is skipped, since we
  773.     '  use that color (light grey) extensively in the interface.
  774.     ' ────────────────────────────────────────────────────────────────────────
  775.     PALETTE 1, rgbRGB%(pal%(1, 1), pal%(1, 2), pal%(1, 3))
  776.     PALETTE 2, rgbRGB%(pal%(2, 1), pal%(2, 2), pal%(2, 3))
  777.     PALETTE 3, rgbRGB%(pal%(3, 1), pal%(3, 2), pal%(3, 3))
  778.     PALETTE 4, rgbRGB%(pal%(4, 1), pal%(4, 2), pal%(4, 3))
  779.     PALETTE 5, rgbRGB%(pal%(5, 1), pal%(5, 2), pal%(5, 3))
  780.     PALETTE 6, rgbRGB%(pal%(6, 1), pal%(6, 2), pal%(6, 3))
  781.     PALETTE 8, rgbRGB%(pal%(7, 1), pal%(7, 2), pal%(7, 3))
  782.     PALETTE 9, rgbRGB%(pal%(8, 1), pal%(8, 2), pal%(8, 3))
  783.     PALETTE 10, rgbRGB%(pal%(9, 1), pal%(9, 2), pal%(9, 3))
  784.  
  785. END SUB
  786.  
  787. SUB ShowPaletteInfo (pal%())
  788.  
  789.     ' ────────────────────────────────────────────────────────────────────────
  790.     '  This routine displays data in the array passed-in, assumed to by a 2D
  791.     '  9x3 array, as in DIM pal%(9, 3).  Used only by the EgaVgaColors demo.
  792.     ' ────────────────────────────────────────────────────────────────────────
  793.  
  794.     ' ────────────────────────────────────────────────────────────────────────
  795.     '  Show palette data in color 7 at a fixed display location.
  796.     ' ────────────────────────────────────────────────────────────────────────
  797.     COLOR 7, 0
  798.     FOR i% = 1 TO 9
  799.         LOCATE i% + 6, 43, 0: PRINT "R="; LTRIM$(STR$(pal%(i%, 1)));
  800.         PRINT "  G="; LTRIM$(STR$(pal%(i%, 2)));
  801.         PRINT "  B="; LTRIM$(STR$(pal%(i%, 3)));
  802.     NEXT i%
  803.  
  804. END SUB
  805.  
  806.