home *** CD-ROM | disk | FTP | other *** search
/ CD Actual 15 / CDACTUAL15.iso / cdactual / program / basic / QBSCR20.ZIP / QDEMO_E.BAS < prev    next >
Encoding:
BASIC Source File  |  1992-07-08  |  22.7 KB  |  601 lines

  1. ' ──────────────────────────────────────────────────────────────────────────
  2. '
  3. '                           Q D E M O _ E . 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. CONST NEEDMOUSE = -3
  19. CONST ORDERFORMMISSING = -12
  20. CONST NEEDVGA = -16
  21. CONST NOFONTS = -17
  22.  
  23. DECLARE SUB InfoBox (messageNum%)
  24. DECLARE SUB DrawMouse (x%, y%)
  25. DECLARE SUB PrintForm ()
  26.  
  27. SUB DrawMouse (x%, y%)
  28.  
  29.     ' ────────────────────────────────────────────────────────────────────────
  30.     '  This function draws a 3D text representation of a mouse on the screen.
  31.     '  It is used by the Mouse Movement demo, and maybe a routine or two
  32.     '  elsewise.  Drawn with upper-left corner at passed-in x and y.
  33.     ' ────────────────────────────────────────────────────────────────────────
  34.  
  35.     ' ────────────────────────────────────────────────────────────────────────
  36.     '  Set color dependent data.
  37.     ' ────────────────────────────────────────────────────────────────────────
  38.     IF kolor% THEN
  39.         ft1% = 6
  40.         ft2% = 7
  41.         bs% = STYLE3D
  42.     ELSE
  43.         ft1% = 0
  44.         ft2% = 0
  45.         bs% = STYLE2D
  46.     END IF
  47.  
  48.     ' ────────────────────────────────────────────────────────────────────────
  49.     '  Use the MakeWindow routine to draw the mouse and two mouse buttons.
  50.     ' ────────────────────────────────────────────────────────────────────────
  51.     MakeWindow CSNG(y%), CSNG(x%), CSNG(y% + 8), CSNG(x% + 14), 0, 7, 0, ft1%, -1, 0, ""' Mouse body
  52.     MakeWindow CSNG(y% + 1), CSNG(x% + 2), CSNG(y% + 3), CSNG(x% + 6), 0, 7, 0, ft1%, -1, 0, ""' Mouse left button
  53.     MakeWindow CSNG(y% + 1), CSNG(x% + 8), CSNG(y% + 3), CSNG(x% + 12), 0, 7, 0, ft1%, -1, 0, ""' Mouse right button
  54.  
  55.     ' ────────────────────────────────────────────────────────────────────────
  56.     '  Add some more mouse detail - a horizontal dividing line and a brand
  57.     '  name.
  58.     ' ────────────────────────────────────────────────────────────────────────
  59.     IF kolor% THEN
  60.         COLOR 15, 7
  61.     ELSE
  62.         COLOR 0, 7
  63.     END IF
  64.     LOCATE y% + 4, x% + 1, 0: PRINT STRING$(13, 196);         ' Dividing line
  65.     COLOR 0, 7
  66.     LOCATE y% + 7, x% + 4, 0: PRINT "BAD Mouse";              ' Mouse brand name
  67.  
  68. END SUB
  69.  
  70. SUB FontsDemo
  71.  
  72.     CONST MAXFONTS = 8
  73.     DIM fi AS FileInfoType
  74.     DIM usedLetters(MAXFONTS + 1) AS STRING * 1
  75.  
  76.     ' ────────────────────────────────────────────────────────────────────────
  77.     '  This demo will illustrate the use of the VGA text mode screen fonts.
  78.     '  If user does not have a VGA card, this routine displays a message and
  79.     '  exits.  If so, they can choose a VGA font to change everything to.
  80.     ' ────────────────────────────────────────────────────────────────────────
  81.  
  82.     ' ────────────────────────────────────────────────────────────────────────
  83.     '  Is a VGA card here?  If not, display an error message and leave.
  84.     ' ────────────────────────────────────────────────────────────────────────
  85.     IF VgaPresent% THEN
  86.         scanLines% = 16
  87.     ELSE
  88.         IF EgaPresent% THEN
  89.             scanLines% = 14
  90.         ELSE
  91.             InfoBox NEEDVGA
  92.             EXIT SUB
  93.         END IF
  94.     END IF
  95.  
  96.     ' ────────────────────────────────────────────────────────────────────────
  97.     '  Find all VGA fonts on disk. There won't be more than, say, 8 of them,
  98.     '  so simply DIM an array of 8 strings.  If there are more than 8,
  99.     '  then just ignore the extras.  And, as long as we're here, build the
  100.     '  fonts menu.  First, inform the user that we're looking for fonts.
  101.     ' ────────────────────────────────────────────────────────────────────────
  102.     IF kolor% THEN
  103.         ft1% = 6
  104.         ft2% = 7
  105.         bs% = STYLE3D
  106.     ELSE
  107.         ft1% = 0
  108.         ft2% = 0
  109.         bs% = STYLE2D
  110.     END IF
  111.  
  112.     IF mouseExists% THEN
  113.         MouseHide
  114.     END IF
  115.  
  116.     MakeWindow 9, 21, 13, 60, 0, 7, 0, ft1%, -1, 0, "" ' ─┐
  117.     COLOR 0, 7                                         '  ├ Tell user we're looking
  118.     Center "Looking for font files...", 11             ' ─┘
  119.  
  120.     DIM fontfiles$(MAXFONTS)
  121.     DIM menu$(MAXFONTS + 1)
  122.  
  123.     IF scanLines% = 14 THEN
  124.         fileSpec$ = "*.EGF"
  125.     ELSE
  126.         fileSpec$ = "*.VGF"
  127.     END IF
  128.     numFonts% = 0
  129.     found% = FALSE
  130.     found% = FirstFile%(fileSpec$, NormalAttr, dta$)
  131.  
  132.     WHILE (found%) AND (numFonts% < MAXFONTS)
  133.         numFonts% = numFonts% + 1
  134.         FileInfo fi, dta$
  135.         fontfiles$(numFonts%) = fi.fname
  136.         IF INSTR(fontfiles$(numFonts%), CHR$(0)) THEN
  137.             fontfiles$(numFonts%) = LEFT$(fontfiles$(numFonts%), INSTR(fontfiles$(numFonts%), CHR$(0)) - 1)
  138.         END IF
  139.         menu$(numFonts%) = LEFT$(fontfiles$(numFonts%), INSTR(fontfiles$(numFonts%), ".") - 1)
  140.         found% = NextFile%(dta$)
  141.     WEND
  142.  
  143.     ' ────────────────────────────────────────────────────────────────────────
  144.     '  If there were no font files then display a message and exit.
  145.     ' ────────────────────────────────────────────────────────────────────────
  146.     IF numFonts% = 0 THEN
  147.         InfoBox NOFONTS
  148.         EXIT SUB
  149.     END IF
  150.  
  151.     ' ────────────────────────────────────────────────────────────────────────
  152.     '  Add the "Default" menu option to the bottom of the menu list.
  153.     ' ────────────────────────────────────────────────────────────────────────
  154.     numFonts% = numFonts% + 1
  155.     menu$(numFonts%) = "DEFAULT"
  156.  
  157.     ' ────────────────────────────────────────────────────────────────────────
  158.     '  Select a unique quick access letter for each menu choice.
  159.     ' ────────────────────────────────────────────────────────────────────────
  160.     FOR i% = 1 TO numFonts%
  161.      
  162.         found% = FALSE
  163.         WHILE found% = FALSE
  164.          
  165.             FOR j% = 1 TO LEN(menu$(i%))
  166.              
  167.                 ' Check every used letter against the current character in the menu
  168.                 ' choice string.
  169.                 letterOK% = TRUE
  170.                 currentLtr$ = MID$(menu$(i%), j%, 1)
  171.                 FOR k% = 1 TO i%
  172.                     IF currentLtr$ = usedLetters(k%) THEN
  173.                         letterOK% = FALSE
  174.                     END IF
  175.                 NEXT k%
  176.              
  177.                 ' If the current letter was used, letterOK% will be false. If not, it
  178.                 ' will be true and we can use it.
  179.                 IF letterOK% THEN
  180.                     usedLetters(i%) = currentLtr$
  181.                     menu$(i%) = LEFT$(menu$(i%), INSTR(menu$(i%), usedLetters(i%)) - 1) + "^" + RIGHT$(menu$(i%), LEN(menu$(i%)) - INSTR(menu$(i%), usedLetters(i%)) + 1)
  182.                     found% = TRUE
  183.                     EXIT FOR
  184.                 END IF
  185.             NEXT j%
  186.  
  187.         WEND
  188.  
  189.     NEXT i%
  190.  
  191.     ' ────────────────────────────────────────────────────────────────────────
  192.     '  Now that we' have all we need, let's get started.  Display a window
  193.     '  and some buttons.  The Done button will get us outta here and the
  194.     '  Font button will display a menu of fonts to choose from.
  195.     ' ────────────────────────────────────────────────────────────────────────
  196.     MakeWindow 5, 8, 23, 73, 0, 7, 0, ft1%, -1, 0, ""
  197.     DrawButton SINGLEBORDER, 11, 20, 20, 22, 0, 7, "Font", bs%
  198.     DrawButton SINGLEBORDER, 22, 20, 31, 22, 0, 7, "Done", bs%
  199.  
  200.     ' ────────────────────────────────────────────────────────────────────────
  201.     '  Add text to the window explaining about fonts and the font demo.
  202.     ' ────────────────────────────────────────────────────────────────────────
  203.     Center "··· Text Mode Screen Fonts ···", 7
  204.     Center "This routine will let you change the screen font on an EGA/", 9
  205.     Center "VGA monitor-equipped machine. QBSCR comes supplied with 10,", 10
  206.     Center "or so fonts and a program called Font Builder that lets you", 11
  207.     Center "create your own fonts.", 12
  208.     Center "If you click the Font button below (or hit F), you will see", 14
  209.     Center "a menu of available fonts.  Simply select the one you want", 15
  210.     Center "and it will remain in effect until you change it or end the", 16
  211.     Center "demo.  If you want out of here, click the Done button or hit", 17
  212.     Center "the D or ESC keys.  You will return to the main menu.", 18
  213.  
  214.     ' ────────────────────────────────────────────────────────────────────────
  215.     '  Wait on user events.  Act based on event.
  216.     ' ────────────────────────────────────────────────────────────────────────
  217.     IF mouseExists% THEN
  218.         MouseShow
  219.     END IF
  220.     done% = FALSE
  221.     WHILE done% = FALSE
  222.  
  223.         result% = getEvent%(mouseExists%, kc%, mx%, my%)
  224.  
  225.         SELECT CASE result%
  226.             CASE EMpressedLeft      ' Left mouse button pressed
  227.                 IF (mx% >= 11) AND (mx% <= 20) AND (my% >= 20) AND (my% <= 22) THEN
  228.                     PressButton SINGLEBORDER, 11, 20, 20, 22, 0, 7, "Font", bs%
  229.                     MakeWindow 8, 35, 8 + numFonts% + 1, 46, 0, 7, 0, ft1%, -1, 0, ""
  230.                     menuResult% = MakeMenu%(menu$(), numFonts%, "L", 37, 48, 9, "^", "|", 0, 7, 15, 0, 15, 7, mouseExists%)
  231.                     IF (menuResult% > 0) AND (menuResult% < numFonts%) THEN
  232.                         IF scanLines% = 16 THEN
  233.                             LoadVgaTextFont fontfiles$(menuResult%)
  234.                         ELSE
  235.                             LoadEgaTextFont fontfiles$(menuResult%)
  236.                         END IF
  237.                     END IF
  238.                     IF menuResult% = numFonts% THEN
  239.                         IF scanLines% = 16 THEN
  240.                             LoadVgaTextFont ""
  241.                         ELSE
  242.                             LoadEgaTextFont ""
  243.                         END IF
  244.                     END IF
  245.                     done% = TRUE
  246.                 END IF
  247.                 IF (mx% >= 22) AND (mx% <= 31) AND (my% >= 20) AND (my% <= 22) THEN
  248.                     PressButton SINGLEBORDER, 22, 20, 31, 22, 0, 7, "Done", bs%
  249.                     done% = TRUE
  250.                 END IF
  251.             CASE EMpressedRight     ' Right mouse button pressed
  252.                 done% = TRUE
  253.             CASE EKpressed          ' Keyboard key pressed.
  254.                 IF (kc% = ASC("F")) OR (kc% = ASC("f")) THEN
  255.                     MakeWindow 8, 35, 8 + numFonts% + 1, 46, 0, 7, 0, ft1%, -1, 0, ""
  256.                     menuResult% = MakeMenu%(menu$(), numFonts%, "L", 37, 48, 9, "^", "|", 0, 7, 15, 0, 15, 7, mouseExists%)
  257.                     IF (menuResult% > 0) AND (menuResult% < numFonts%) THEN
  258.                         IF scanLines% = 16 THEN
  259.                             LoadVgaTextFont fontfiles$(menuResult%)
  260.                         ELSE
  261.                             LoadEgaTextFont fontfiles$(menuResult%)
  262.                         END IF
  263.                     END IF
  264.                     IF menuResult% = numFonts% THEN
  265.                         IF scanLines% = 16 THEN
  266.                             LoadVgaTextFont ""
  267.                         ELSE
  268.                             LoadEgaTextFont ""
  269.                         END IF
  270.                     END IF
  271.                     done% = TRUE
  272.                 END IF
  273.                 IF (kc% = ASC("D")) OR (kc% = ASC("d")) OR (kc% = 27) THEN
  274.                     done% = TRUE
  275.                 END IF
  276.             CASE ELSE
  277.         END SELECT
  278.  
  279.     WEND
  280.  
  281. END SUB
  282.  
  283. SUB MouseMovement
  284.  
  285.     ' ────────────────────────────────────────────────────────────────────────
  286.     '  This routine demonstrates the ability of the QBSCR Screen Routines
  287.     '  to track mouse movement.  In this case, we are using the MousePosition
  288.     '  routine to track the mouse's whereabouts.  If the position changes,
  289.     '  then the mouse location on the screen is changed.
  290.     ' ────────────────────────────────────────────────────────────────────────
  291.     DIM mScr%(BlockSize(1, 15, 1, 9))
  292.  
  293.     ' ────────────────────────────────────────────────────────────────────────
  294.     '  Make sure there is a mouse around before anything else happens.
  295.     ' ────────────────────────────────────────────────────────────────────────
  296.     IF mouseExists% = FALSE THEN
  297.         InfoBox NEEDMOUSE
  298.         EXIT SUB
  299.     END IF
  300.  
  301.     ' ────────────────────────────────────────────────────────────────────────
  302.     '  Hide the mouse before we display anything.  Note that we don't have to
  303.     '  check for the mouse's existence any longer in this routine.  We would
  304.     '  not be here if it didn't exist.
  305.     ' ────────────────────────────────────────────────────────────────────────
  306.     MouseHide
  307.  
  308.     ' ────────────────────────────────────────────────────────────────────────
  309.     '  Determine color and 3D information before we proceed.
  310.     ' ────────────────────────────────────────────────────────────────────────
  311.     IF kolor% THEN
  312.         ft1% = 6
  313.         ft2% = 7
  314.         bs% = STYLE3D
  315.     ELSE
  316.         ft1% = 0
  317.         ft2% = 0
  318.         bs% = STYLE2D
  319.     END IF
  320.  
  321.     ' ────────────────────────────────────────────────────────────────────────
  322.     '  Draw a window with some info and a mouse.  Save what's underneath the
  323.     '  Mouse before we draw.
  324.     ' ────────────────────────────────────────────────────────────────────────
  325.     MakeWindow 5, 8, 23, 73, 0, 7, 0, ft1%, -1, 0, ""
  326.     COLOR 0, 7
  327.     LOCATE 7, 11, 0: PRINT "This demo illustarates how your own programs can detect the";
  328.     LOCATE 8, 11, 0: PRINT "movement of the mouse.";
  329.     LOCATE 10, 11, 0: PRINT "To see how mouse movement can be utilized, move your mouse";
  330.     LOCATE 11, 11, 0: PRINT "around the screen.  In response to those movements, we will";
  331.     LOCATE 12, 11, 0: PRINT "move the simulated mouse in the lower-right corner of this";
  332.     LOCATE 13, 11, 0: PRINT "window.";
  333.     LOCATE 15, 11, 0: PRINT "See the source code for this demo for more";
  334.     LOCATE 16, 11, 0: PRINT "information on how this all works.";
  335.     LOCATE 18, 11, 0: PRINT "When you are finished, click either mouse";
  336.     LOCATE 19, 11, 0: PRINT "button, or hit the ESC key.  You will be";
  337.     LOCATE 20, 11, 0: PRINT "You will be returned to the menu.";
  338.     mx% = 56
  339.     my% = 14
  340.     MakeWindow my% + 1, mx% + 2, my% + 6, mx% + 11, 0, 7, 0, ft2%, -1, 0, ""
  341.     LOCATE my% + 2, mx% + 4, 0: PRINT "Pretty";
  342.     LOCATE my% + 3, mx% + 4, 0: PRINT "Nifty";
  343.     LOCATE my% + 4, mx% + 4, 0: PRINT "Mouse";
  344.     LOCATE my% + 5, mx% + 4, 0: PRINT "Stuff!";
  345.     BlockSave mx%, mx% + 14, my%, my% + 8, mScr%(), GetVideoSegment!
  346.     DrawMouse mx%, my%
  347.  
  348.     ' ────────────────────────────────────────────────────────────────────────
  349.     '  Set the mouse position to the upper-left corner of the screen "mouse."
  350.     '  First we must turn the mouse cursor on, since the SetPosition command
  351.     '  doesn't do anything if the cursor is not visible.
  352.     ' ────────────────────────────────────────────────────────────────────────
  353.     MouseShow
  354.     MouseSetPosition mx% * 8, my% * 8
  355.  
  356.     ' ────────────────────────────────────────────────────────────────────────
  357.     '  Set the maximum X and Y values so that the user cannot run our screen
  358.     '  "mouse" off the screen.
  359.     ' ────────────────────────────────────────────────────────────────────────
  360.     MouseSetMinMaxX 0, 65 * 8
  361.     MouseSetMinMaxY 0, 16 * 8
  362.  
  363.     ' ────────────────────────────────────────────────────────────────────────
  364.     '  Initialize a few variables before we go into the event loop.  The
  365.     '  oldmx% and oldmy% variables keep track of the previous location of
  366.     '  the mouse, so that we know where to restore the screen when our
  367.     '  screen "mouse" is moved.  Hide the mouse before we go into the loop
  368.     '  since our screen "mouse" acts as our cursor.
  369.     ' ────────────────────────────────────────────────────────────────────────
  370.     oldmx% = mx%
  371.     oldmy% = my%
  372.     MouseHide
  373.     done% = FALSE
  374.  
  375.     ' ────────────────────────────────────────────────────────────────────────
  376.     '  Sit in a loop waiting on events.  If the user moves the mouse, then
  377.     '  update the position of our screen "mouse."  If the user clicks one
  378.     '  of the mouse buttons, then exit this demo (also if they hit ESC).
  379.     ' ────────────────────────────────────────────────────────────────────────
  380.     WHILE done% = FALSE
  381.  
  382.         ' ──────────────────────────────────────────────────────────────────────
  383.         '  Get event from user.
  384.         ' ──────────────────────────────────────────────────────────────────────
  385.         result% = getEvent%(mouseExists%, kc%, mx%, my%)
  386.  
  387.         ' ──────────────────────────────────────────────────────────────────────
  388.         '  Decide what to do based on user event.
  389.         ' ──────────────────────────────────────────────────────────────────────
  390.         SELECT CASE result%
  391.             CASE EMmoved    ' Mouse was moved.
  392.                 IF (mx% <> oldmx%) OR (my% <> oldmy%) THEN
  393.                     BlockRestore oldmx%, oldmx% + 14, oldmy%, oldmy% + 8, mScr%(), GetVideoSegment!
  394.                     BlockSave mx%, mx% + 14, my%, my% + 8, mScr%(), GetVideoSegment!
  395.                     DrawMouse mx%, my%
  396.                     oldmx% = mx%
  397.                     oldmy% = my%
  398.                 END IF
  399.             CASE EMpressedRight, EMpressedLeft    ' Mouse button was pressed.
  400.                 done% = TRUE
  401.             CASE EKpressed    ' Keyboard key was pressed.
  402.                 IF (kc% = 27) THEN
  403.                     done% = TRUE
  404.                 END IF
  405.             CASE ELSE
  406.         END SELECT
  407.  
  408.     WEND
  409.  
  410.     ' ────────────────────────────────────────────────────────────────────────
  411.     '  Make sure we reset the mouse mouse maximum X and Y to the full screen
  412.     '  before we leave.
  413.     ' ────────────────────────────────────────────────────────────────────────
  414.     MouseSetMinMaxX 0, 80 * 8
  415.     MouseSetMinMaxY 0, 25 * 8
  416.  
  417. END SUB
  418.  
  419. SUB OrderingInfo
  420.  
  421.     ' ────────────────────────────────────────────────────────────────────────
  422.     '  This routine displays a screen's worth of data and two buttons in the
  423.     '  window.  The first button is Print Form, and the second is Cancel. If
  424.     '  the user hits Print Form, then a form is printed on LPT1.  If the
  425.     '  Cancel button is pressed, we exit from here.
  426.     ' ────────────────────────────────────────────────────────────────────────
  427.  
  428.     ' ────────────────────────────────────────────────────────────────────────
  429.     '  Display a window.
  430.     ' ────────────────────────────────────────────────────────────────────────
  431.     IF kolor% THEN
  432.         ft% = 6
  433.         ft2% = 7
  434.         bs% = STYLE3D
  435.     ELSE
  436.         ft% = 0
  437.         ft2% = 0
  438.         bs% = STYLE2D
  439.     END IF
  440.  
  441.     ' ────────────────────────────────────────────────────────────────────────
  442.     '  If we are using the mouse, make sure that it is off while we are
  443.     '  writing to the screen.
  444.     ' ────────────────────────────────────────────────────────────────────────
  445.     IF mouseExists% THEN
  446.         MouseHide
  447.     END IF
  448.  
  449.     MakeWindow 2, 11, 24, 70, 0, 7, 0, ft%, -1, 0, ""
  450.  
  451.     ' ────────────────────────────────────────────────────────────────────────
  452.     '  Add the screen buttons.
  453.     ' ────────────────────────────────────────────────────────────────────────
  454.     DrawButton SINGLEBORDER, 13, 21, 26, 23, 0, 7, "Print Form", bs%
  455.     DrawButton SINGLEBORDER, 28, 21, 41, 23, 0, 7, "Cancel", bs%
  456.  
  457.     ' ────────────────────────────────────────────────────────────────────────
  458.     '  Add the text.
  459.     ' ────────────────────────────────────────────────────────────────────────
  460.     MakeWindow 3, 21, 5, 60, 0, 7, 0, ft2%, -1, 0, ""
  461.     Center "∙∙∙ Ordering Information ∙∙∙", 4
  462.     Center "If you haven't registered the QBSCR Screen Routines,", 7
  463.     Center "the cost is $20.00, sent to the address below.  Make", 8
  464.     Center "all checks payable to Tony Martin.  For all overseas", 9
  465.     Center "customers, add $5.00 for trans-Atlantic postage, and", 10
  466.     Center "make sure your check is for U.S. funds, AND drawn on", 11
  467.     Center "a U.S. bank.  Otherwise, it cannot be cashed. If you", 12
  468.     Center "would like to print an order on a printer attached", 13
  469.     Center "to your LPT1: port, Click the Print Form button or", 14
  470.     Center "hit P.  To exit, click the Cancel buttor hit ESC.", 15
  471.     Center "Tony Martin", 17
  472.     Center "1611 Harvest Green Ct.", 18
  473.     Center "Reston, VA 22094", 19
  474.  
  475.     ' ────────────────────────────────────────────────────────────────────────
  476.     '  Turn the mouse back on if it is around here.
  477.     ' ────────────────────────────────────────────────────────────────────────
  478.     IF mouseExists% THEN
  479.         MouseShow
  480.     END IF
  481.  
  482.     ' ────────────────────────────────────────────────────────────────────────
  483.     '  Now we must wait on the user for a response of some kind.  To do this,
  484.     '  we use the QBSCR routine GetEvent%.  It will return a keypress or a
  485.     '  mouse event, whichever occurs first.  If the C, c, Esc, or right
  486.     '  mouse buttons are pressed, or if the left button is pressed while the
  487.     '  mouse cursor is on the Cancel button, we get out. If the P, p, or left
  488.     '  mouse button is pressed while one the Print Form button, then we
  489.     '  print a form and THEN get out.
  490.     ' ────────────────────────────────────────────────────────────────────────
  491.     done% = FALSE
  492.     WHILE done% = FALSE
  493.  
  494.         ' ──────────────────────────────────────────────────────────────────────
  495.         '  Get an event of some kind.
  496.         ' ──────────────────────────────────────────────────────────────────────
  497.         result% = getEvent%(mouseExists%, kc%, mx%, my%)
  498.  
  499.         ' ──────────────────────────────────────────────────────────────────────
  500.         '  Decide what to do based on the event that occurred.
  501.         ' ──────────────────────────────────────────────────────────────────────
  502.         SELECT CASE result%
  503.             CASE EMpressedLeft      ' Mouse left button pressed.
  504.              
  505.                 ' ──────────────────────────────────────────────────────────────────
  506.                 '  See if the mouse was on the PrintForm button.
  507.                 ' ──────────────────────────────────────────────────────────────────
  508.                 IF (mx% >= 13) AND (mx% <= 26) AND (my% >= 21) AND (my% <= 23) THEN
  509.                     PressButton SINGLEBORDER, 13, 21, 26, 23, 0, 7, "Print Form", bs%
  510.                     PrintForm
  511.                     done% = TRUE
  512.                 END IF
  513.  
  514.                 ' ──────────────────────────────────────────────────────────────────
  515.                 '  See if the mouse was on the Cancel button.
  516.                 ' ──────────────────────────────────────────────────────────────────
  517.                 IF (mx% >= 28) AND (mx% <= 41) AND (my% >= 21) AND (my% <= 23) THEN
  518.                     PressButton SINGLEBORDER, 28, 21, 41, 23, 0, 7, "Cancel", bs%
  519.                     done% = TRUE
  520.                 END IF
  521.  
  522.             CASE EMpressedRight     ' Right mouse button pressed.
  523.                 done% = TRUE
  524.  
  525.             CASE EKpressed          ' Keyboard pressed.
  526.                 IF (kc% = 27) OR (kc% = ASC("C")) OR (kc% = ASC("c")) THEN
  527.                     done% = TRUE
  528.                 END IF
  529.  
  530.                 IF (kc% = ASC("P")) OR (kc% = ASC("p")) THEN
  531.                     PrintForm
  532.                     done% = TRUE
  533.                 END IF
  534.             CASE ELSE
  535.         END SELECT
  536.  
  537.     WEND
  538.  
  539. END SUB
  540.  
  541. SUB PrintForm
  542.  
  543.     ' ────────────────────────────────────────────────────────────────────────
  544.     '  This routine asks the user to ensure that everything is OK, and then
  545.     '  hit the OK or Cancel buttons to print or abort, respectively.  It
  546.     '  uses the QBSCR OkCancelMessageBox routine to do this.  If the user
  547.     '  responded affirmatively, then a form is printed; otherwise the routine
  548.     '  simply ends.
  549.     ' ────────────────────────────────────────────────────────────────────────
  550.  
  551.     ' ────────────────────────────────────────────────────────────────────────
  552.     '  If the order form file ORDER.FRM is missing, then display an error and
  553.     '  get out of this function now.
  554.     ' ────────────────────────────────────────────────────────────────────────
  555.     IF FirstFile%("ORDER.FRM", NormalAttr, dta$) = FALSE THEN
  556.         InfoBox ORDERFORMMISSING
  557.         EXIT SUB
  558.     END IF
  559.  
  560.     ' ────────────────────────────────────────────────────────────────────────
  561.     '  Get ready for and display an OkCancelMessageBox.
  562.     ' ────────────────────────────────────────────────────────────────────────
  563.     IF kolor% THEN
  564.         ft% = 6
  565.         bs% = STYLE3D
  566.     ELSE
  567.         ft% = 0
  568.         bs% = STYLE2D
  569.     END IF
  570.     DIM txt$(6)
  571.     txt$(1) = "Make sure your printer is attached"
  572.     txt$(2) = "to the LPT1: port of your computer"
  573.     txt$(3) = "and is ON LINE. If this is all set,"
  574.     txt$(4) = "click the OK button or hit O or the"
  575.     txt$(5) = "ENTER key.  If not, then hit C or"
  576.     txt$(6) = "the ESC key."
  577.     result% = OkCancelMessageBox%(21, 7, 60, 19, txt$(), 6, 0, 0, 7, ft%, -1, 0, "", mouseExists%, SINGLEBORDER, bs%)
  578.  
  579.     ' ────────────────────────────────────────────────────────────────────────
  580.     '  If result% is TRUE (non-zero) then the user hit OK.  If not, the user
  581.     '  hit Cancel.  If OK, then print the form.
  582.     ' ────────────────────────────────────────────────────────────────────────
  583.     IF result% THEN
  584.         IF mouseExists% THEN
  585.             MouseHide
  586.         END IF
  587.         MakeWindow 12, 16, 14, 65, 0, 7, 0, ft%, -1, 0, ""
  588.         Center "Printing form...", 13
  589.         OPEN "ORDER.FRM" FOR INPUT AS #1
  590.         WHILE (NOT (EOF(1)))
  591.             LINE INPUT #1, aLine$
  592.             aLine$ = RTRIM$(aLine$)
  593.             LPRINT aLine$
  594.         WEND
  595.         LPRINT CHR$(12)
  596.         CLOSE #1
  597.     END IF
  598.  
  599. END SUB
  600.  
  601.