CD Actual 15

home *** CD-ROM | disk | FTP | other *** search

/ CD Actual 15 / CDACTUAL15.iso / cdactual / program / basic / QBSCR20.ZIP / QBSCR.BAS < prev next >

Wrap

BASIC Source File | 1992-07-08 | 211.7 KB | 5,399 lines

'┌────────────────────────────────────────────────────────────────────────┐ '│ │ '│ Q B S C R . B A S │ '│ │ '│ The QBSCR Screen Routines for QuickBASIC 4.0+ Programmers │ '│ Version 2.0 │ '│ │ '│ (C) Copyright 1992 by Tony Martin │ '│ │ '├────────────────────────────────────────────────────────────────────────┤ '│ │ '│ This source code is copyright 1992 by Tony Martin. You may change │ '│ it to suit your programming needs, but you may not distribute any │ '│ modified copies of the library itself. I retain all rights to the │ '│ source code and all library modules included with the QBSCR package, │ '│ as well as to the example programs. You may not remove this notice │ '│ from any copies of the library itself you distribute. │ '│ │ '│ You are granted the right to use this source code for your own pro- │ '│ grams, without royalty payments or credits to me (though, if you │ '│ feel so inclined to give me credit, feel free to do so). You MUST │ '│ register this software if you release a shareware or commercial │ '│ program that uses it. You may use these routines in any type of │ '│ software you create, as long as it is not a programming toolbox or │ '│ package of routines OF ANY KIND. │ '│ │ '│ This package is shareware. If you find it useful or use it in any │ '│ software you release, you are requested to send a registration fee of │ '│ $25.00 (U.S. funds only) to: │ '│ │ '│ Tony Martin │ '│ 1611 Harvest Green Ct. │ '│ Reston, VA 22094 │ '│ │ '│ All registered users receive an 'official' disk set containing the │ '│ latest verison of the QBSCR routines. For more information, see │ '│ the QBSCR documentation. │ '│ │ '├────────────────────────────────────────────────────────────────────────┤ '│ │ '│ For information on using these routines and incorporating them into │ '│ your own programs, see the accompanying documentation. │ '│ │ '└────────────────────────────────────────────────────────────────────────┘ '────────────────────────────────────────────────────────────────────────── ' Include the mouse support routines. '────────────────────────────────────────────────────────────────────────── REM $INCLUDE: 'MOUSE.BI' '────────────────────────────────────────────────────────────────────────── ' Use the QBSCR include file to get our function declare statements. '────────────────────────────────────────────────────────────────────────── REM $INCLUDE: 'QBSCR.INC' '────────────────────────────────────────────────────────────────────────── ' CONSTants required by the Screen Routines '────────────────────────────────────────────────────────────────────────── CONST LEFTARROWCODE = -99 CONST RIGHTARROWCODE = -98 CONST LEFTMOUSEEXIT = -97 CONST RIGHTMOUSEEXIT = -96 COMMON SHARED mouseExists%, mouseState% SUB Banner (st$, row%) STATIC '┌────────────────────────────────────────────────────────────────────────┐ '│ This subroutine displays a scrolling banner on any line of the │ '│ display screen. The scrolling effect is achieved through successive │ '│ calls to this subfunction. Each call shifts the string by 1 char- │ '│ acter and redisplays it. │ '│ │ '│ Parameters are as follows: │ '│ │ '│ st$ - The string containing the text to be scrolled. Must be │ '│ 80 characters or less. │ '│ row% - The row of the screen on which to scroll the text. Valid │ '│ range is 1 through 23. │ '└────────────────────────────────────────────────────────────────────────┘ '────────────────────────────────────────────────────────────────────────── ' Check to see if this is the first time Banner has been called '────────────────────────────────────────────────────────────────────────── temp$ = "" IF NOT (bannerFlag) THEN bannerFlag = -1 text$ = st$ END IF '────────────────────────────────────────────────────────────────────────── ' Move each character in the banner string one space to the left '────────────────────────────────────────────────────────────────────────── FOR n = 1 TO LEN(text$) - 1 temp$ = temp$ + MID$(text$, n + 1, 1) NEXT n '────────────────────────────────────────────────────────────────────────── ' Set the last character in Temp$ to the first character of the string '────────────────────────────────────────────────────────────────────────── temp$ = temp$ + LEFT$(text$, 1) '────────────────────────────────────────────────────────────────────────── ' Determine the column to display the new string on, centered '────────────────────────────────────────────────────────────────────────── text$ = temp$ x% = INT((80 - (LEN(text$))) / 2) + 1 '────────────────────────────────────────────────────────────────────────── ' Print the newly adjusted string '────────────────────────────────────────────────────────────────────────── LOCATE row%, x%, 0 PRINT text$; END SUB SUB BlockRestore (l%, r%, t%, b%, scrArray%(), segment!) '┌──────────────────────────────────────────────────────────────────┐ '│ This subprogram will restore a rectanglar portion of the screen │ '│ that was saved using the QBSCR routine 'BlockSave.' The first │ '│ four parameters are the left, right, top, and bottom sides of │ '│ the rectangular area to restore. They should be the same as │ '│ the ones used when the area was saved. The scrArray% is an │ '│ integer array passed to this routine, that was originally used │ '│ to save the screen area. The segment parameter is the segment │ '│ of the screen memory to restore the saved info to. For this │ '│ parameter, simply use the QBSCR GetVideoSegment function. │ '└──────────────────────────────────────────────────────────────────┘ '──────────────────────────────────────────────────────────────────── ' Determine where to start restoring in screen memory '──────────────────────────────────────────────────────────────────── wdth% = 2 * (r% - l%) + 1 offset% = 160 * (t% - 1) + 2 * (l% - 1) z% = 0 '──────────────────────────────────────────────────────────────────── ' Set the memory segment to the screen memory address '──────────────────────────────────────────────────────────────────── DEF SEG = segment '──────────────────────────────────────────────────────────────────── ' Restore the rectangular area of the screen by POKEing the stored ' screen display info into the display memory '──────────────────────────────────────────────────────────────────── FOR x% = t% TO b% FOR y% = 0 TO wdth% POKE offset% + y%, scrArray%(z%) z% = z% + 1 NEXT y% offset% = offset% + 160 NEXT x% '──────────────────────────────────────────────────────────────────── ' Restore BASIC's default data segment '──────────────────────────────────────────────────────────────────── DEF SEG END SUB SUB BlockSave (l%, r%, t%, b%, scrArray%(), segment!) '┌──────────────────────────────────────────────────────────────────┐ '│ This subprogram will save a rectanglar portion of the screen │ '│ in an integer array. The first four parameters are the left, │ '│ right, top, and bottom sides of the rectangular area to │ '│ restore. The scrArray% is an integer array passed to this │ '│ routine in which to save the screen area. The segment parameter │ '│ is the segment of the screen memory to save from. For this │ '│ parameter, simply use the QBSCR GetVideoSegment function. │ '└──────────────────────────────────────────────────────────────────┘ '──────────────────────────────────────────────────────────────────── ' Determine where to start saving in screen memory '──────────────────────────────────────────────────────────────────── wdth% = 2 * (r% - l%) + 1 offset% = 160 * (t% - 1) + 2 * (l% - 1) z% = 0 '──────────────────────────────────────────────────────────────────── ' Set the memory segment to the screen memory address '──────────────────────────────────────────────────────────────────── DEF SEG = segment '──────────────────────────────────────────────────────────────────── ' Save the rectangular area of the screen by PEEKing into the ' screen display memory at the right place '──────────────────────────────────────────────────────────────────── FOR x% = t% TO b% FOR y% = 0 TO wdth% scrArray%(z%) = PEEK(offset% + y%) z% = z% + 1 NEXT y% offset% = offset% + 160 NEXT x% '──────────────────────────────────────────────────────────────────── ' Restore BASIC's default data segment '──────────────────────────────────────────────────────────────────── DEF SEG END SUB FUNCTION BlockSize% (l%, r%, t%, b%) '┌──────────────────────────────────────────────────────────────────┐ '│ This function will calculate the number of elements required │ '│ for an array used to save a rectangular area of the screen. │ '│ The four parameters are the left, right, top, and bottom values │ '│ of the rectangular area of the screen. Use the function right │ '│ inside the DIM statement, like this: │ '│ DIM scrArray%(BlockSize%(1, 1, 10, 20)) │ '└──────────────────────────────────────────────────────────────────┘ BlockSize% = ((r% - l% + 1) * (b% - t% + 1)) * 2 END FUNCTION SUB BuildScreen (file$, mode%) '┌────────────────────────────────────────────────────────────────────────┐ '│ This routine allows you to place on the screen a predefined display │ '│ that was created with Screen Builder. It will place the display on │ '│ the screen in any of sixteen different ways. Note that the methods │ '│ of displaying the screen are identical to the methods used in the │ '│ ClrScr routine. Some code differences will be apparent for obvious │ '│ reasons. │ '│ │ '│ Parameters are as follows: │ '│ │ '│ file$ - The name of the screen file that was saved using the │ '│ Screen Builder program. │ '│ mode% - The method to use when placing the screen on the display. │ '└────────────────────────────────────────────────────────────────────────┘ '────────────────────────────────────────────────────────────────────────── ' The delay local variable is used here for dummy loops that create a ' very brief pauses of execution at points in the routine that need it, ' particularly in the vertical motion. Change this value to suit the ' speed of your machine, or make it 0 to get rid of it. '────────────────────────────────────────────────────────────────────────── delay = 10 COLOR f%, b% '────────────────────────────────────────────────────────────────────────── ' Load the screen file into an array for later access '────────────────────────────────────────────────────────────────────────── DIM scrArray(4000) AS STRING * 1 DIM sArray%(4000) DEF SEG = VARSEG(scrArray(0)) BLOAD file$, VARPTR(scrArray(0)) DEF SEG '────────────────────────────────────────────────────────────────────────── ' Convert the array to one that runs much faster '────────────────────────────────────────────────────────────────────────── FOR x% = 0 TO 3999 sArray%(x%) = ASC(scrArray(x%)) NEXT x% '────────────────────────────────────────────────────────────────────────── ' Determine the memory segment of the video display for all direct screen ' writes and save it in vidSeg '────────────────────────────────────────────────────────────────────────── vidseg = GetVideoSegment SELECT CASE mode% CASE 0 ' ─ Horizontal build, middle out ──────────────────────────────── y% = 12 FOR x% = 13 TO 1 STEP -1 FOR d = 1 TO delay NEXT d y% = y% + 1 xOffSet% = (x% - 1) * 160 yOffSet% = (y% - 1) * 160 DEF SEG = vidseg FOR a% = 0 TO 159 POKE xOffSet% + a%, sArray%(xOffSet% + a%) POKE yOffSet% + a%, sArray%(yOffSet% + a%) NEXT a% DEF SEG NEXT x% CASE 1 ' ─ Horizontal build, ends in ─────────────────────────────────── y% = 26 FOR x% = 1 TO 13 FOR d = 1 TO delay ' Delay loop - change delay above to NEXT d ' regulate speed y% = y% - 1 xOffSet% = (x% - 1) * 160 yOffSet% = (y% - 1) * 160 DEF SEG = vidseg FOR a% = 0 TO 159 POKE xOffSet% + a%, sArray%(xOffSet% + a%) POKE yOffSet% + a%, sArray%(yOffSet% + a%) NEXT a% DEF SEG NEXT x% CASE 2 ' ─ Vertical build, middle out ─────────────────────────────────── y% = 39 FOR x% = 39 TO 0 STEP -1 y% = y% + 1 DEF SEG = vidseg FOR i% = 1 TO 25 xOffSet% = ((i% - 1) * 160) + (x% * 2) yOffSet% = ((i% - 1) * 160) + (y% * 2) POKE xOffSet%, sArray%(xOffSet%): POKE xOffSet% + 1, sArray%(xOffSet% + 1) POKE yOffSet%, sArray%(yOffSet%): POKE yOffSet% + 1, sArray%(yOffSet% + 1) NEXT i% DEF SEG FOR d = 1 TO delay NEXT d NEXT x% CASE 3 ' ─ Vertical build, ends in ────────────────────────────────────── y% = 80 FOR x% = 0 TO 40 y% = y% - 1 DEF SEG = vidseg FOR i% = 1 TO 25 xOffSet% = ((i% - 1) * 160) + (x% * 2) yOffSet% = ((i% - 1) * 160) + (y% * 2) POKE xOffSet%, sArray%(xOffSet%): POKE xOffSet% + 1, sArray%(xOffSet% + 1) POKE yOffSet%, sArray%(yOffSet%): POKE yOffSet% + 1, sArray%(yOffSet% + 1) NEXT i% DEF SEG FOR d = 1 TO delay NEXT d NEXT x% CASE 4 ' ─ Left to right screen build ─────────────────────────────────── FOR x% = 0 TO 79 DEF SEG = vidseg FOR i% = 1 TO 25 xOffSet% = ((i% - 1) * 160) + (x% * 2) POKE xOffSet%, sArray%(xOffSet%): POKE xOffSet% + 1, sArray%(xOffSet% + 1) NEXT i% DEF SEG FOR d = 1 TO delay NEXT d NEXT x% CASE 5 ' ─ Right to left screen build ─────────────────────────────────── FOR x% = 79 TO 0 STEP -1 DEF SEG = vidseg FOR i% = 1 TO 25 xOffSet% = ((i% - 1) * 160) + (x% * 2) POKE xOffSet%, sArray%(xOffSet%): POKE xOffSet% + 1, sArray%(xOffSet% + 1) NEXT i% DEF SEG FOR d = 1 TO delay NEXT d NEXT x% CASE 6 ' ─ All sides in to center ─────────────────────────────────────── y% = 25 FOR x% = 0 TO 13 y% = y% - 1 topOffSet% = x% * 160 botOffSet% = y% * 160 DEF SEG = vidseg ' Top-most row FOR j% = (x% * 3) TO (y% * 3) + 7 POKE topOffSet% + (j% * 2), sArray%(topOffSet% + (j% * 2)) POKE topOffSet% + (j% * 2) + 1, sArray%(topOffSet% + (j% * 2) + 1) NEXT j% ' Left and right sides FOR j% = x% TO y% FOR i% = 0 TO 5 POKE (j% * 160) + (x% * 6) + i%, sArray%((j% * 160) + (x% * 6) + i%) POKE (j% * 160) + (y% * 6) + 10 + i%, sArray%((j% * 160) + (y% * 6) + 10 + i%) NEXT i% NEXT j% ' Bottom-most row FOR j% = (x% * 3) TO (y% * 3) + 7 POKE botOffSet% + (j% * 2), sArray%(botOffSet% + (j% * 2)) POKE botOffSet% + (j% * 2) + 1, sArray%(botOffSet% + (j% * 2) + 1) NEXT j% DEF SEG NEXT x% CASE 7 ' ─ All sides out from center ──────────────────────────────────── y% = 11 FOR x% = 12 TO 0 STEP -1 y% = y% + 1 topOffSet% = x% * 160 botOffSet% = y% * 160 DEF SEG = vidseg ' Top-most row FOR j% = (x% * 3) TO (y% * 3) + 7 POKE topOffSet% + (j% * 2), sArray%(topOffSet% + (j% * 2)) POKE topOffSet% + (j% * 2) + 1, sArray%(topOffSet% + (j% * 2) + 1) NEXT j% ' Left and right sides FOR j% = x% TO y% FOR i% = 0 TO 5 POKE (j% * 160) + (x% * 6) + i%, sArray%((j% * 160) + (x% * 6) + i%) POKE (j% * 160) + (y% * 6) + 10 + i%, sArray%((j% * 160) + (y% * 6) + 10 + i%) NEXT i% NEXT j% ' Bottom-most row FOR j% = (x% * 3) TO (y% * 3) + 7 POKE botOffSet% + (j% * 2), sArray%(botOffSet% + (j% * 2)) POKE botOffSet% + (j% * 2) + 1, sArray%(botOffSet% + (j% * 2) + 1) NEXT j% DEF SEG NEXT x% CASE 8 ' ─ Vertical split - left down, right up ───────────────────────── y% = 26 FOR x% = 1 TO 25 FOR d = 1 TO delay NEXT d y% = y% - 1 DEF SEG = vidseg offset% = (x% - 1) * 160 FOR i% = 0 TO 79 POKE offset% + i%, sArray%(offset% + i%) NEXT i% offset% = (y% - 1) * 160 FOR i% = 80 TO 159 POKE offset% + i%, sArray%(offset% + i%) NEXT i% DEF SEG NEXT x% CASE 9 ' ─ Horizontal split - top right to left, bottom left to right ─── y% = 80 FOR x% = 0 TO 79 y% = y% - 1 DEF SEG = vidseg FOR i% = 1 TO 12 offset% = ((i% - 1) * 160) + (x% * 2) POKE offset%, sArray%(offset%): POKE offset% + 1, sArray%(offset% + 1) NEXT i% FOR i% = 13 TO 25 offset% = ((i% - 1) * 160) + (y% * 2) POKE offset%, sArray%(offset%): POKE offset% + 1, sArray%(offset% + 1) NEXT i% DEF SEG NEXT x% CASE 10 ' ─ Spiral inward ──────────────────────────────────────────────── FOR x% = 1 TO 25 offset% = (x% - 1) * 160 DEF SEG = vidseg FOR y% = 0 TO 31 POKE offset% + y%, sArray%(offset% + y%) NEXT y% DEF SEG NEXT x% offset% = 19 * 160 FOR x% = 16 TO 79 DEF SEG = vidseg FOR y% = 0 TO 5 POKE 3040 + (x% * 2) + (y% * 160), sArray%(3040 + (x% * 2) + (y% * 160)) POKE 3041 + (x% * 2) + (y% * 160), sArray%(3041 + (x% * 2) + (y% * 160)) NEXT y% DEF SEG NEXT x% FOR x% = 19 TO 1 STEP -1 offset% = (x% - 1) * 160 + 127 DEF SEG = vidseg FOR y% = 0 TO 32 POKE offset% + y%, sArray%(offset% + y%) NEXT y% DEF SEG NEXT x% FOR x% = 63 TO 16 STEP -1 DEF SEG = vidseg FOR y% = 0 TO 5 POKE 1 + (x% * 2) + (y% * 160), sArray%(1 + (x% * 2) + (y% * 160)) POKE (x% * 2) + (y% * 160), sArray%((x% * 2) + (y% * 160)) NEXT y% DEF SEG NEXT x% FOR x% = 7 TO 19 offset% = (x% - 1) * 160 + 32 DEF SEG = vidseg FOR y% = 0 TO 31 POKE offset% + y%, sArray%(offset% + y%) NEXT y% DEF SEG NEXT x% offset% = 19 * 160 FOR x% = 32 TO 63 DEF SEG = vidseg FOR y% = 0 TO 5 POKE 2240 + (x% * 2) + (y% * 160), sArray%(2240 + (x% * 2) + (y% * 160)) POKE 2241 + (x% * 2) + (y% * 160), sArray%(2241 + (x% * 2) + (y% * 160)) NEXT y% DEF SEG NEXT x% FOR x% = 14 TO 6 STEP -1 offset% = (x% - 1) * 160 + 95 DEF SEG = vidseg FOR y% = 1 TO 31 POKE offset% + y%, sArray%(offset% + y%) NEXT y% DEF SEG NEXT x% offset% = 6 * 160 FOR x% = 47 TO 32 STEP -1 DEF SEG = vidseg FOR y% = 0 TO 5 POKE offset% + 1 + (x% * 2) + (y% * 160), sArray%(offset% + 1 + (x% * 2) + (y% * 160)) POKE offset% + (x% * 2) + (y% * 160), sArray%(offset% + (x% * 2) + (y% * 160)) NEXT y% DEF SEG NEXT x% FOR x% = 13 TO 14 offset% = (x% - 1) * 160 + 64 DEF SEG = vidseg FOR y% = 0 TO 31 POKE offset% + y%, sArray%(offset% + y%) NEXT y% DEF SEG NEXT x% CASE 11 ' ─ Top to bottom ──────────────────────────────────────────────── FOR x% = 1 TO 25 FOR d = 1 TO delay NEXT d DEF SEG = vidseg offset% = (x% - 1) * 160 FOR i% = 0 TO 159 POKE offset% + i%, sArray%(offset% + i%) NEXT i% DEF SEG NEXT x% CASE 12 ' ─ Bottom to top ──────────────────────────────────────────────── FOR x% = 25 TO 1 STEP -1 FOR d = 1 TO delay NEXT d DEF SEG = vidseg offset% = (x% - 1) * 160 FOR i% = 0 TO 159 POKE offset% + i%, sArray%(offset% + i%) NEXT i% DEF SEG NEXT x% CASE 13 ' ─ Upper-left corner to lower-right ──────────────────────────── FOR x% = 1 TO 25 ' The horizontal portion... offset% = (x% - 1) * 160 DEF SEG = vidseg FOR i% = offset% TO offset% + (x% * 6) POKE i%, sArray%(i%) NEXT i% ' ...and the vertical portion. FOR y% = 1 TO x% offset% = ((y% - 1) * 160) + (x% * 6) DEF SEG = vidseg FOR j% = 0 TO 5 POKE offset% + j%, sArray%(offset% + j%) NEXT j% DEF SEG NEXT y% NEXT x% ' Take care of the remaining two columns FOR y% = 1 TO 25 offset% = ((y% - 1) * 160) + 155 DEF SEG = vidseg FOR j% = 0 TO 4 POKE offset% + j%, sArray%(offset% + j%) NEXT j% DEF SEG NEXT y% CASE 14 ' ─ Lower-right corner to upper-left ──────────────────────────── ' Take care of the last two columns FOR y% = 1 TO 25 offset% = ((y% - 1) * 160) + 155 DEF SEG = vidseg FOR j% = 0 TO 4 POKE offset% + j%, sArray%(offset% + j%) NEXT j% DEF SEG NEXT y% FOR x% = 25 TO 1 STEP -1 ' The hori(zontal portion... offset% = (x% - 1) * 160 DEF SEG = vidseg FOR i% = offset% TO offset% + (x% * 6) POKE i%, sArray%(i%) NEXT i% ' ...and the vertical portion. FOR y% = 1 TO x% offset% = ((y% - 1) * 160) + (x% * 6) DEF SEG = vidseg FOR j% = 0 TO 5 POKE offset% + j%, sArray%(offset% + j%) NEXT j% DEF SEG NEXT y% NEXT x% CASE 15 ' ─ Random blocks ─────────────────────────────────────────────── RANDOMIZE TIMER DIM screenGrid%(1 TO 5, 1 TO 10) FOR x% = 1 TO 50 ' Find a block of the screen that hasn't been displayed yet validBlock% = FALSE DO row% = INT(RND(1) * 5) + 1 col% = INT(RND(1) * 10) + 1 IF screenGrid%(row%, col%) = FALSE THEN validBlock% = TRUE screenGrid%(row%, col%) = TRUE END IF LOOP UNTIL validBlock% ' Display the block FOR i% = ((row% - 1) * 5) TO ((row% - 1) * 5) + 4 offset% = (i% * 160) + ((col% - 1) * 16) DEF SEG = vidseg FOR j% = offset% TO offset% + 15 POKE j%, sArray%(j%) NEXT j% DEF SEG NEXT i% NEXT x% CASE 16 ' ─ Interlacing ───────────────────────────────────────────────── DEF SEG = vidseg FOR x% = 0 TO 219 FOR y% = 0 TO 3959 STEP 180 POKE x% + y%, sArray%(x% + y%) POKE x% + y% + 1, sArray%(x% + y% + 1) NEXT y% NEXT x% DEF SEG CASE 17 ' ─ Vertical Blinds - Left to Right ───────────────────────────── DEF SEG = vidseg FOR j% = 0 TO 9 FOR x% = 0 TO 79 STEP 10 FOR i% = 1 TO 25 xOffSet% = ((i% - 1) * 160) + ((x% + j%) * 2) POKE xOffSet%, sArray%(xOffSet%): POKE xOffSet% + 1, sArray%(xOffSet% + 1) NEXT i% NEXT x% NEXT j% DEF SEG CASE 18 ' ─ Vertical Blinds - Right to Left ───────────────────────────── DEF SEG = vidseg FOR j% = 9 TO 0 STEP -1 FOR x% = 0 TO 79 STEP 10 FOR i% = 1 TO 25 xOffSet% = ((i% - 1) * 160) + ((x% + j%) * 2) POKE xOffSet%, sArray%(xOffSet%): POKE xOffSet% + 1, sArray%(xOffSet% + 1) NEXT i% NEXT x% NEXT j% DEF SEG CASE ELSE ' Programmer passed an invalid Mode% - do nothing END SELECT END SUB FUNCTION CalcScrollPos% (listSize%, numDivisions%, currentPos%) '┌────────────────────────────────────────────────────────────────────────┐ '│ This function is used internally by the routines that utilize a │ '│ scroll bar, such as SelectList and ViewList. It calculates the next │ '│ position of a scroll bar elevator. │ '│ │ '│ Parameters are as follows: │ '│ │ '│ listSize% - The number of items being scrolled through, total. │ '│ numDivisions% - The number of elevator floors in the scroll bar │ '│ (i.e., number of possible scroll bar positions). │ '│ Numbered starting with 1. │ '│ currentPos% - The current position through the list (not the │ '│ position of the scroll bar elevator). │ '└────────────────────────────────────────────────────────────────────────┘ '────────────────────────────────────────────────────────────────────────── ' Find the percentage through the list. '────────────────────────────────────────────────────────────────────────── percent! = currentPos% / listSize% '────────────────────────────────────────────────────────────────────────── ' Determine the final answer. If division results in less that 1, return ' 1 anyway. If more than numDivisions%, return numDivisions%. '────────────────────────────────────────────────────────────────────────── answer% = percent! * numDivisions% IF answer% < 1 THEN answer% = 1 END IF IF answer% > numDivisions% THEN answer% = numDivisions% END IF '────────────────────────────────────────────────────────────────────────── ' Return the final answer. '────────────────────────────────────────────────────────────────────────── CalcScrollPos% = answer% END FUNCTION SUB Center (st$, row%) '┌────────────────────────────────────────────────────────────────────────┐ '│ This subroutine will display a string passed to it centered on the │ '│ row passed to it. Parameters are as follows: │ '│ │ '│ st$ - The string to center on the screen. String must be 80 │ '│ characters or less. │ '│ row% - The row of the screen on which to center the string. │ '│ Must be in the range 1 through 25. │ '└────────────────────────────────────────────────────────────────────────┘ '────────────────────────────────────────────────────────────────────────── ' Calculate X-Coordinate (column) on which to locate the string '────────────────────────────────────────────────────────────────────────── x% = INT((80 - (LEN(st$))) / 2) + 1 '────────────────────────────────────────────────────────────────────────── ' Display the text string '────────────────────────────────────────────────────────────────────────── LOCATE row%, x%, 0: PRINT st$; END SUB SUB ClrScr (mode%, fillChar$) '┌────────────────────────────────────────────────────────────────────────┐ '│ This routine clears the screen in any of 10 different ways. The │ '│ parameters are as follows: │ '│ │ '│ mode% - A number indicating which way you want the screen cleared. │ '│ The number must be in the range of 0 through 14. See the │ '│ QBSCR documentation or the REF program for more info. │ '│ fillChar$ - This is a single character string containing the │ '│ character you want to clear the screen with. Under │ '│ most circumstances, this will simply be a space. │ '└────────────────────────────────────────────────────────────────────────┘ '────────────────────────────────────────────────────────────────────────── ' The Delay local variable is used here for dummy loops that create a ' very brief pauses of execution at points in the routine that need it, ' particularly in the vertical motion. Change this value to suit the ' speed of your machine. '────────────────────────────────────────────────────────────────────────── delay = 5 '────────────────────────────────────────────────────────────────────────── ' Clear the screen. Method used is based on the passed Mode parameter '────────────────────────────────────────────────────────────────────────── SELECT CASE mode% CASE 0 ' ─ Horizontal clear, middle out ──────────────────────────── y = 12 FOR x = 13 TO 1 STEP -1 FOR a = 1 TO delay NEXT a y = y + 1 LOCATE x, 1, 0: PRINT STRING$(80, fillChar$); LOCATE y, 1, 0: PRINT STRING$(80, fillChar$); NEXT x CASE 1 ' ─ Horizontal clear, ends in ─────────────────────────────── y = 26 FOR x = 1 TO 13 FOR a = 1 TO delay NEXT a y = y - 1 LOCATE x, 1, 0: PRINT STRING$(80, fillChar$); LOCATE y, 1, 0: PRINT STRING$(80, fillChar$); NEXT x CASE 2 ' ─ Vertical clear, middle out ─────────────────────────────── y% = 39 FOR x% = 39 TO 1 STEP -2 y% = y% + 2 FOR a% = 1 TO 25 LOCATE a%, x%, 0: PRINT fillChar$ + fillChar$; LOCATE a%, y%, 0: PRINT fillChar$ + fillChar$; NEXT a% NEXT x% CASE 3 ' ─ Vertical clear, ends in ────────────────────────────────── y% = 81 FOR x% = 1 TO 40 STEP 2 y% = y% - 2 FOR a% = 1 TO 25 LOCATE a%, x%, 0: PRINT fillChar$ + fillChar$; LOCATE a%, y%, 0: PRINT fillChar$ + fillChar$; NEXT a% NEXT x% CASE 4 ' ─ Left to right screen wipe ──────────────────────────────── FOR x% = 1 TO 79 STEP 2 FOR a% = 1 TO 25 LOCATE a%, x%, 0: PRINT fillChar$ + fillChar$; NEXT a% NEXT x% CASE 5 ' ─ Right to left screen wipe ──────────────────────────────── FOR x% = 79 TO 1 STEP -2 FOR a% = 1 TO 25 LOCATE a%, x%, 0: PRINT fillChar$ + fillChar$; NEXT a% NEXT x% CASE 6 ' ─ All sides in to center ─────────────────────────────────── y% = 26 FOR x% = 1 TO 13 y% = y% - 1 LOCATE x%, 1, 0: PRINT STRING$(80, fillChar$); LOCATE y%, 1, 0: PRINT STRING$(80, fillChar$); FOR a1% = 1 TO 25 LOCATE a1%, x% * 3 - 2, 0: PRINT fillChar$ + fillChar$ + fillChar$; LOCATE a1%, y% * 3 + 3, 0: PRINT fillChar$ + fillChar$ + fillChar$; NEXT a1% NEXT x% CASE 7 ' ─ All sides out from center ──────────────────────────────── y% = 12 FOR x% = 13 TO 1 STEP -1 y% = y% + 1 LOCATE x%, x% * 3 + 1, 0: PRINT STRING$((y% * 3 - x% * 3) + 2, fillChar$); LOCATE y%, x% * 3 + 1, 0: PRINT STRING$((y% * 3 - x% * 3) + 2, fillChar$); FOR a1% = x% TO y% LOCATE a1%, x% * 3 - 2, 0: PRINT fillChar$ + fillChar$ + fillChar$; LOCATE a1%, y% * 3 + 3, 0: PRINT fillChar$ + fillChar$ + fillChar$; NEXT a1% NEXT x% CASE 8 ' ─ Vertical split - left down, right up ───────────────────── y = 26 FOR x = 1 TO 25 FOR a = 1 TO delay NEXT a y = y - 1 LOCATE x, 1, 0: PRINT STRING$(40, fillChar$); LOCATE y, 41, 0: PRINT STRING$(40, fillChar$); NEXT x CASE 9 ' ─ Horizontal split - top right to left, bottom left to right y% = 81 FOR x% = 1 TO 80 STEP 2 y% = y% - 2 FOR a% = 1 TO 12 LOCATE a%, x%, 0: PRINT fillChar$ + fillChar$; NEXT a% FOR a% = 13 TO 25 LOCATE a%, y%, 0: PRINT fillChar$ + fillChar$; NEXT a% NEXT x% CASE 10 ' ─ Spiral inward ──────────────────────────────────────────── FOR x = 1 TO 25 FOR y = 1 TO delay NEXT y LOCATE x, 1, 0: PRINT STRING$(16, fillChar$); NEXT x FOR x% = 16 TO 78 STEP 3 FOR y% = 20 TO 25 LOCATE y%, x%, 0: PRINT STRING$(5, fillChar$); NEXT y% NEXT x% FOR x = 19 TO 1 STEP -1 FOR y = 1 TO delay NEXT y LOCATE x, 65, 0: PRINT STRING$(16, fillChar$); NEXT x FOR x% = 65 TO 16 STEP -3 FOR y% = 1 TO 6 LOCATE y%, x%, 0: PRINT STRING$(5, fillChar$); NEXT y% NEXT x% FOR x = 7 TO 19 FOR y = 1 TO delay NEXT y LOCATE x, 17, 0: PRINT STRING$(16, fillChar$); NEXT x FOR x% = 32 TO 64 STEP 3 FOR y% = 15 TO 19 LOCATE y%, x%, 0: PRINT STRING$(5, fillChar$); NEXT y% NEXT x% FOR x = 14 TO 6 STEP -1 FOR y = 1 TO delay NEXT y LOCATE x, 49, 0: PRINT STRING$(16, fillChar$); NEXT x FOR x% = 48 TO 33 STEP -3 FOR y% = 7 TO 10 LOCATE y%, x%, 0: PRINT STRING$(5, fillChar$); NEXT y% NEXT x% FOR x = 11 TO 14 FOR y = 1 TO delay NEXT y LOCATE x, 33, 0: PRINT STRING$(16, fillChar$); NEXT x CASE 11 ' ─ Top to bottom ──────────────────────────────────────────── FOR x = 1 TO 25 FOR a = 1 TO delay NEXT a LOCATE x, 1, 0: PRINT STRING$(80, fillChar$); NEXT x CASE 12 ' ─ Bottom to top ──────────────────────────────────────────── FOR x = 25 TO 1 STEP -1 FOR a = 1 TO delay NEXT a LOCATE x, 1, 0: PRINT STRING$(80, fillChar$); NEXT x CASE 13 ' ─ Upper-left corner to lower-right ───────────────────────── fill$ = "" FOR x% = 1 TO 25 fill$ = fill$ + STRING$(3, fillChar$) LOCATE x%, 1, 0 PRINT fill$; FOR y% = 1 TO x% LOCATE y%, x% * 3, 0 PRINT STRING$(3, fillChar$); NEXT y% NEXT x% FOR y% = 1 TO 25 LOCATE y%, 78, 0 PRINT STRING$(3, fillChar$); NEXT y% CASE 14 ' ─ Lower-right corner to upper-left ───────────────────────── FOR y% = 1 TO 25 LOCATE y%, 78, 0 PRINT STRING$(3, fillChar$); NEXT y% fill$ = STRING$(80, fillChar$) FOR x% = 25 TO 1 STEP -1 fill$ = LEFT$(fill$, LEN(fill$) - 3) LOCATE x%, 1, 0 PRINT fill$; FOR y% = 1 TO x% LOCATE y%, x% * 3, 0 PRINT STRING$(3, fillChar$); NEXT y% NEXT x% CASE 15 ' ─ Random blocks ──────────────────────────────────────────── RANDOMIZE TIMER DIM screenGrid%(1 TO 5, 1 TO 10) ' Initialize grid tracking array to all false FOR row% = 1 TO 5 FOR col% = 1 TO 10 screenGrid%(row%, col%) = FALSE NEXT col% NEXT row% FOR x% = 1 TO 50 ' Find a block of the scren that hasn't been blanked yet validBlock% = FALSE DO row% = INT(RND(1) * 5) + 1 col% = INT(RND(1) * 10) + 1 IF screenGrid%(row%, col%) = FALSE THEN validBlock% = TRUE screenGrid%(row%, col%) = TRUE END IF LOOP UNTIL validBlock% ' Blank out the block FOR i% = ((row% * 5 + 1) - 5) TO ((row% * 5 + 1) - 5) + 4 LOCATE i%, (col% * 8 + 1) - 8, 0 PRINT STRING$(8, fillChar$); NEXT i% NEXT x% CASE 16 ' ─ Interlacing ───────────────────────────────────────────────── FOR y% = 0 TO 79 FOR x% = 1 TO 25 LOCATE x%, ((x% - 1) * 10 + y%) MOD 80 + 1, 0 PRINT fillChar$; NEXT x% NEXT y% CASE 17 ' ─ Vertical Blinds - Left to Right ───────────────────────────── FOR x% = 0 TO 9 FOR y% = 1 TO 80 STEP 10 offset% = x% + y% FOR z% = 1 TO 25 LOCATE z%, offset%, 0 PRINT fillChar$; NEXT z% NEXT y% NEXT x% CASE 18 ' ─ Vertical Blinds - Right to Left ───────────────────────────── FOR x% = 9 TO 0 STEP -1 FOR y% = 1 TO 80 STEP 10 offset% = x% + y% FOR z% = 1 TO 25 LOCATE z%, offset%, 0 PRINT fillChar$; NEXT z% NEXT y% NEXT x% CASE ELSE ' Programmer passed an invalid Mode% - do nothing END SELECT LOCATE 1, 1, 0 END SUB FUNCTION ColorChk '┌────────────────────────────────────────────────────────────────────────┐ '│ This function when called checks the value stored at the machine │ '│ memory location that contains the video display type. If the value │ '│ is hex B4 then the display is mono. Otherwise, it is color. The │ '│ function returns a value of False (Zero) if mono, True (Non-Zero) if │ '│ color. │ '└────────────────────────────────────────────────────────────────────────┘ '────────────────────────────────────────────────────────────────────────── ' Set default segment to 0 '────────────────────────────────────────────────────────────────────────── DEF SEG = 0 '────────────────────────────────────────────────────────────────────────── ' PEEK at value stored at video adapter address '────────────────────────────────────────────────────────────────────────── adapter = PEEK(&H463) '────────────────────────────────────────────────────────────────────────── ' Set ColorChk to True or False based on value at hex &H463 '────────────────────────────────────────────────────────────────────────── IF adapter = &HB4 THEN ColorChk = 0 ' Mono (False/Zero) ELSE ColorChk = 1 ' Color (True/Non-Zero) END IF END FUNCTION SUB DisplayEntry (entry$, qfg%, qbg%, hfg%, hBG%, fg%, bg%, marker$, divider$, wid%, actionCode%) '┌─────────────────────────────────────────────────────────────────────────┐ '│ This routine is used only by the MakeMenu% Function. It is not meant │ '│ for use on its own. The routine displays the passed menu entry on the │ '│ screen, and highlights the character that proceeds the marker │ '│ character. Also interprets and displays menu dividers. │ '│ │ '│ Parameters are as follows: │ '│ │ '│ entry$ - the actual text entry to display on the screen │ '│ qfg% - Foreground color for 'Quick Access' key character │ '│ qbg% - Background color for 'Quick Access' key character │ '│ hfg% - Foreground color for entry at highlight bar │ '│ hbg% - Background color for entry at highlight bar │ '│ fg% - Foreground color for normal entry │ '│ bg% - Background color for normal entry │ '│ marker$ - the character used in menu entry strings that indicates │ '│ the next character is a 'Quick Access' key. │ '│ divider$ - The string or character that denotes a menu divider. │ '│ wid% - The full width of the menu window. │ '│ actionCode% - Has value of 1 or 2. 1 indicates that the entry │ '│ being displayed is a normal, unhighlighted entry, │ '│ thus the 'Quick Access' character in the entry will │ '│ be highlighted. If 2, 'Quick Access' key is not │ '│ highlighted, since entry is in highlight bar. │ '└─────────────────────────────────────────────────────────────────────────┘ '────────────────────────────────────────────────────────────────────────── ' Assumes cursor is already at the right spot to display entry on. ' Display each character until the marker char is found. Print highlighted ' 'Quick Access' char if ActionCode% is 1, otherwise print normal 'Quick ' Access' char. Then print rest of entry and return to MakeMenu%. '────────────────────────────────────────────────────────────────────────── '────────────────────────────────────────────────────────────────────────── ' Set colors. '────────────────────────────────────────────────────────────────────────── SELECT CASE actionCode% CASE 1 COLOR fg%, bg% CASE 2 COLOR hfg%, hBG% CASE ELSE END SELECT '────────────────────────────────────────────────────────────────────────── ' If the entry is a menu divider, draw it. Otherwise, display text. '────────────────────────────────────────────────────────────────────────── IF entry$ = divider$ THEN LOCATE CSRLIN, POS(0) - 1, 0 PRINT STRING$(wid% + 2, 196); ELSE FOR x% = 1 TO LEN(entry$) IF MID$(entry$, x%, 1) = marker$ THEN x% = x% + 1 SELECT CASE actionCode% CASE 1 COLOR qfg%, qbg% CASE 2 COLOR hfg%, hBG% CASE ELSE END SELECT END IF PRINT MID$(entry$, x%, 1); IF actionCode% = 2 THEN COLOR hfg%, hBG% ELSE COLOR fg%, bg% END IF NEXT x% END IF END SUB SUB EditString (st$, leftCol%, row%, foreColor%, backColor%) '┌────────────────────────────────────────────────────────────────────────┐ '│ This function returns a user-entered string. You can limit the │ '│ length of the string they enter as they type, a capability not │ '│ possible with the INPUT statement. With minor modification of the │ '│ SELECT CASE statements, you can also allow only certain characters │ '│ to be entered. Parameters are as follows: │ '│ │ '│ st$ - This is the string to edit. If there is no starting │ '│ value, then it should be all spaces. Make sure the │ '│ string is as lon as its maximum length. │ '│ leftCol% - This is the column of the screen to allow the user to │ '│ start typing on. Valid range is 1 through 79. │ '│ row% - This is the row of the screen on which the user will type │ '│ Allowable range is 1 through 25. │ '│ foreColor% - The foreground color to display the user's entry │ '│ in. Alowable range is 0 through 15. │ '│ backColor% - The background color to display the user's entry │ '│ in. Allowable range is 0 through 7. │ '└────────────────────────────────────────────────────────────────────────┘ '───────────────────────────────────────────────────────────────────────── ' Save the string passed in just in case ESC is hit '───────────────────────────────────────────────────────────────────────── oldSt$ = st$ '───────────────────────────────────────────────────────────────────────── ' Define variables to contain keycodes '───────────────────────────────────────────────────────────────────────── enter$ = CHR$(13) esc$ = CHR$(27) backspace$ = CHR$(8) ins$ = CHR$(0) + CHR$(82) LeftArrowKey$ = CHR$(0) + CHR$(75) RightArrowKey$ = CHR$(0) + CHR$(77) HomeKee$ = CHR$(0) + CHR$(71) EndKee$ = CHR$(0) + CHR$(79) del$ = CHR$(0) + CHR$(83) ctrlLeftArrow$ = CHR$(0) + CHR$(115) ctrlRightArrow$ = CHR$(0) + CHR$(116) ctrlY$ = CHR$(25) ctrlT$ = CHR$(20) '───────────────────────────────────────────────────────────────────────── ' Define initial values for insert mode and cursor size '───────────────────────────────────────────────────────────────────────── IF ColorChk THEN topScan% = 1 botScan% = 7 ELSE topScan% = 1 botScan% = 12 END IF insON% = FALSE '───────────────────────────────────────────────────────────────────────── ' Define errortone string to use with PLAY '───────────────────────────────────────────────────────────────────────── errorTone$ = "L60 N1 N0 N1" '───────────────────────────────────────────────────────────────────────── ' Clear variable that holds keystroke '───────────────────────────────────────────────────────────────────────── key$ = "" '───────────────────────────────────────────────────────────────────────── ' Set cursor position to first char in string '───────────────────────────────────────────────────────────────────────── charPos% = 1 '───────────────────────────────────────────────────────────────────────── ' Set colors and locate the cursor '───────────────────────────────────────────────────────────────────────── COLOR foreColor%, backColor% LOCATE row%, leftCol%, 1 '───────────────────────────────────────────────────────────────────────── ' Display the passed in string and relocate the cursor to beginning '───────────────────────────────────────────────────────────────────────── PRINT st$; LOCATE row%, leftCol%, 1, topScan%, botScan% '───────────────────────────────────────────────────────────────────────── ' Read keystrokes until ENTER or ESC is pressed '───────────────────────────────────────────────────────────────────────── done% = FALSE DO key$ = "" WHILE key$ = "" key$ = INKEY$ WEND '───────────────────────────────────────────────────────────────────── '== Decide what to do with the returned key '───────────────────────────────────────────────────────────────────── SELECT CASE key$ '───────────────────────────────────────────────────────────────── ' The CASE statement below is what checks for allowable characters. ' If you wish to change the set of allowable characters, change the ' conditions of the CASE statement. '───────────────────────────────────────────────────────────────── CASE " " TO "■" ' ASCII 32 to 254 - allowable characters '───────────────────────────────────────────────────────────── ' Place new character in the string. If in INS mode, then ' move all chars to right 1 first. '───────────────────────────────────────────────────────────── IF charPos% <= LEN(st$) THEN IF insON% THEN FOR x% = LEN(st$) - 1 TO charPos% STEP -1 MID$(st$, x% + 1, 1) = MID$(st$, x%, 1) NEXT x% END IF MID$(st$, charPos%, 1) = key$ END IF '───────────────────────────────────────────────────────────── ' Move character position right 1 if not at max pos already '───────────────────────────────────────────────────────────── charPos% = charPos% + 1 IF charPos% > LEN(st$) + 1 THEN charPos% = charPos% - 1 END IF CASE EndKee$ ' Move to last non-space char, plus one '───────────────────────────────────────────────────────────── ' Move cursor to last NON-SPACE character of string '───────────────────────────────────────────────────────────── charPos% = LEN(st$) WHILE MID$(st$, charPos%, 1) = " " AND charPos% > 1 charPos% = charPos% - 1 WEND IF charPos% > 1 THEN charPos% = charPos% + 1 END IF CASE HomeKee$ ' Move to first char position '───────────────────────────────────────────────────────────── ' Move cursor to first char position '───────────────────────────────────────────────────────────── charPos% = 1 CASE LeftArrowKey$ ' Cursor left one position '───────────────────────────────────────────────────────────── ' If charPos not already at first pos, move it left 1 '───────────────────────────────────────────────────────────── IF charPos% > 1 THEN charPos% = charPos% - 1 END IF CASE RightArrowKey$ ' Cursor right one position '───────────────────────────────────────────────────────────── ' If not already at end of string, move charPos right 1 '───────────────────────────────────────────────────────────── IF charPos% < LEN(st$) THEN charPos% = charPos% + 1 END IF CASE del$ ' Delete char at cursor '───────────────────────────────────────────────────────────── ' Move all characters to left of cursor left 1 '───────────────────────────────────────────────────────────── FOR i% = charPos% TO LEN(st$) - 1 MID$(st$, i%, 1) = MID$(st$, i% + 1, 1) NEXT i% MID$(st$, LEN(st$), 1) = " " CASE ins$ ' Change from insert mode to overtype and back '───────────────────────────────────────────────────────────── ' Toggle ins mode '───────────────────────────────────────────────────────────── IF insON% THEN insON% = FALSE ELSE insON% = TRUE END IF '───────────────────────────────────────────────────────────── ' Change cursor scan lines so it's BIG for overtype mode, ' small for insert mode '───────────────────────────────────────────────────────────── IF insON% THEN ' Make cursor small - insert mode IF ColorChk THEN topScan% = 6 botScan% = 7 ELSE topScan% = 11 botScan% = 12 END IF ELSE ' Make cursor BIG - overtype mode IF ColorChk THEN topScan% = 1 botScan% = 7 ELSE topScan% = 1 botScan% = 12 END IF END IF CASE backspace$ ' Delete char left of cursor and move left one '───────────────────────────────────────────────────────────── ' Move cursor left 1 if not already at beginning of string, ' and then shift all chars right of cursor left 1. '───────────────────────────────────────────────────────────── IF charPos% > 1 THEN charPos% = charPos% - 1 FOR i% = charPos% TO LEN(st$) - 1 MID$(st$, i%, 1) = MID$(st$, i% + 1, 1) NEXT i% MID$(st$, LEN(st$), 1) = " " END IF CASE ctrlY$ ' Erase entire entry field '───────────────────────────────────────────────────────────── ' Delete the entire line - reset string to spaces and move cursor ' to beginning of field '───────────────────────────────────────────────────────────── st$ = SPACE$(LEN(st$)) charPos% = 1 CASE ctrlT$ ' Erase the word to the right of the cursor '───────────────────────────────────────────────────────────── ' Remove characters from right of string until a space is ' found, or we have removed the whole line from the cursor. '───────────────────────────────────────────────────────────── charsLeft% = LEN(st$) - charPos% count% = charPos% WHILE MID$(st$, charPos%, 1) <> " " AND count% < charsLeft% FOR x% = charPos% TO LEN(st$) - 1 MID$(st$, x%, 1) = MID$(st$, x% + 1) NEXT x% MID$(st$, LEN(st$), 1) = " " count% = count% + 1 WEND '───────────────────────────────────────────────────────────── ' Remove any spaces until a char is found. DO NOT delete the ' char! '───────────────────────────────────────────────────────────── WHILE MID$(st$, charPos%, 1) = " " AND count% < charsLeft% FOR x% = charPos% TO LEN(st$) - 1 MID$(st$, x%, 1) = MID$(st$, x% + 1) NEXT x% MID$(st$, LEN(st$), 1) = " " count% = count% + 1 WEND CASE ctrlLeftArrow$ ' Find next word left '───────────────────────────────────────────────────────────── ' Move to either the next non-space or position 1, whichever ' is first '───────────────────────────────────────────────────────────── IF charPos% > 1 THEN DO charPos% = charPos% - 1 LOOP UNTIL (MID$(st$, charPos%, 1) <> " ") OR charPos% = 1 END IF '───────────────────────────────────────────────────────────── ' Move left until space or pos 1 is found, whichever is first '───────────────────────────────────────────────────────────── IF charPos% > 1 THEN DO charPos% = charPos% - 1 LOOP UNTIL (MID$(st$, charPos%, 1) = " ") OR charPos% = 1 END IF '───────────────────────────────────────────────────────────── ' Move forward one if at a space '───────────────────────────────────────────────────────────── IF MID$(st$, charPos%, 1) = " " THEN charPos% = charPos% + 1 END IF CASE ctrlRightArrow$ ' Find next word right '───────────────────────────────────────────────────────────── ' Move right until space or last pos is found, whichever is ' first '───────────────────────────────────────────────────────────── IF charPos% <= LEN(st$) THEN DO charPos% = charPos% + 1 LOOP UNTIL (MID$(st$, charPos%, 1) = " ") OR charPos% = LEN(st$) + 1 END IF '───────────────────────────────────────────────────────────── ' Move to either the next non-space or last position, which- ' ever is first '───────────────────────────────────────────────────────────── IF charPos% <= LEN(st$) THEN DO charPos% = charPos% + 1 LOOP UNTIL (MID$(st$, charPos%, 1) <> " ") OR charPos% = LEN(st$) + 1 END IF CASE esc$ ' Exit the operation '───────────────────────────────────────────────────────────── ' Restore original value of string and exit '───────────────────────────────────────────────────────────── st$ = oldSt$ done% = TRUE CASE enter$ ' Accept entry and exit operation '───────────────────────────────────────────────────────────── ' Edit finished - exit subroutine '───────────────────────────────────────────────────────────── done% = TRUE CASE ELSE ' Invalid keypresses fall here '───────────────────────────────────────────────────────────── ' Unacceptable key was hit '───────────────────────────────────────────────────────────── PLAY errorTone$ END SELECT ' CASE Key$ '───────────────────────────────────────────────────────────────────── ' Redisplay string after edits '───────────────────────────────────────────────────────────────────── LOCATE row%, leftCol%, 0 PRINT st$; '───────────────────────────────────────────────────────────────────── ' Make sure cursor is at the right spot '───────────────────────────────────────────────────────────────────── LOCATE row%, leftCol% + charPos% - 1, 1, topScan%, botScan% LOOP UNTIL done% END SUB FUNCTION GetBackground% (row%, col%) '┌──────────────────────────────────────────────────────────────────┐ '│ This function will return the background color of the character │ '│ cell at the specified row and column of the screen. │ '└──────────────────────────────────────────────────────────────────┘ '──────────────────────────────────────────────────────────────────── ' Set the memory segment to the address of screen memory '──────────────────────────────────────────────────────────────────── DEF SEG = GetVideoSegment '──────────────────────────────────────────────────────────────────── ' Determine the background color of the cell at row%, col% '──────────────────────────────────────────────────────────────────── ' Get color attribute byte attr% = PEEK(((row% - 1) * 160) + ((col% - 1) * 2) + 1) ' Calculate background step1% = (attr% AND &HFF) \ 16 IF step1% > 7 THEN ' Foreground is blinking GetBackground% = step1% - 8 ELSE ' Foreground is NOT blinking GetBackground% = step1% END IF '──────────────────────────────────────────────────────────────────── ' Restore BASIC's default data segment '──────────────────────────────────────────────────────────────────── DEF SEG END FUNCTION FUNCTION GetForeground% (row%, col%) '┌──────────────────────────────────────────────────────────────────┐ '│ This function will return the foreground color of the character │ '│ cell at the specified row and column of the screen. │ '└──────────────────────────────────────────────────────────────────┘ '──────────────────────────────────────────────────────────────────── ' Set the memory segment to the address of screen memory '──────────────────────────────────────────────────────────────────── DEF SEG = GetVideoSegment '──────────────────────────────────────────────────────────────────── ' Determine the foreground color of the cell at row%, col% '──────────────────────────────────────────────────────────────────── ' Calculate color attribute byte attr% = PEEK(((row% - 1) * 160) + ((col% - 1) * 2) + 1) ' Calculate foreground color step1% = attr% AND &HFF IF step1% > 127 THEN ' Color is blinking GetForeground% = ((step1% - 128) MOD 16) + 16 ELSE ' Color is NOT blinking GetForeground% = step1% MOD 16 END IF '──────────────────────────────────────────────────────────────────── ' Restore BASIC's default data segment '──────────────────────────────────────────────────────────────────── DEF SEG END FUNCTION SUB GetScreen (file$) '┌──────────────────────────────────────────────────────────────────┐ '│ This subprogram will copy the contents of the display to a disk │ '│ file specified by the file$ parameter. The save is very fast. │ '└──────────────────────────────────────────────────────────────────┘ '──────────────────────────────────────────────────────────────────── ' Set the memory segment to the address of screen memory '──────────────────────────────────────────────────────────────────── DEF SEG = GetVideoSegment '──────────────────────────────────────────────────────────────────── ' Use the BASIC BSAVE statement to save the 4000 bytes of video RAM '──────────────────────────────────────────────────────────────────── BSAVE file$, 0, 4000 '──────────────────────────────────────────────────────────────────── ' Restore BASIC's default data segment '──────────────────────────────────────────────────────────────────── DEF SEG END SUB FUNCTION GetVideoSegment '┌──────────────────────────────────────────────────────────────────────────┐ '│ This function returns as a value the memory address where the video │ '│ display memory begins. There are only two possible return values, one │ '│ for monochrome and one for color. This routine is used to obtain the │ '│ video segment for use with the QBSCR routines ScrnSave and ScrnRestore. │ '│ Call this routine, obtain the segment, and then pass it to the two │ '│ above listed routines. │ '└──────────────────────────────────────────────────────────────────────────┘ '────────────────────────────────────────────────────────────────────────── ' Set default segment to 0. '────────────────────────────────────────────────────────────────────────── DEF SEG = 0 '────────────────────────────────────────────────────────────────────────── ' PEEK at value stored at video adapter address. '────────────────────────────────────────────────────────────────────────── adapter = PEEK(&H463) '────────────────────────────────────────────────────────────────────────── ' Set function equal to proper segment value. '────────────────────────────────────────────────────────────────────────── IF adapter = &HB4 THEN GetVideoSegment = &HB000 ' Mono ELSE GetVideoSegment = &HB800 ' Color END IF END FUNCTION FUNCTION MakeMenu% (choice$(), numOfChoices%, justify$, leftColumn, rightColumn, row%, marker$, divider$, fg%, bg%, hfg%, hBG%, qfg%, qbg%, useMouse%) '┌────────────────────────────────────────────────────────────────────────┐ '│ The MakeMenu function displays a menu list on the screen and allows │ '│ the user to move a scrolling selection bar to highlight the entry of │ '│ their choice. Selection is made by hitting the ENTER key. Other │ '│ allowable keys include Home or PgUp to move to the first menu entry, │ '│ and End or PgDn to move to the last entry. Scroll bar wraps from top │ '│ to bottom and bottom to top. The function returns as a value the │ '│ position of the entry in the list of the user's selection. For ex- │ '│ ample, if the user selected the third item in a list of eight, the │ '│ function would return a value of three. Parameters for this function │ '│ are: │ '│ │ '│ choice$() - An array of strings that contains the actual menu │ '│ entries. Example: Choice$(1) = 'Menu selcection 1'. │ '│ Strings must be 78 characters or less in length. │ '│ numOfChoices% - The number of menu choices available. The same as │ '│ the number of elements in Choices$(). Allowable │ '│ range is 1 through 25. │ '│ justify$ - This string will contain a single letter, either an L, C, │ '│ or a R. L means left-justify the menu entries. C means │ '│ center them with respect to the left and right sides of │ '│ the menu (see LeftColumn and RightColumn parameters below) │ '│ and an R means right-justify the menu entries. │ '│ leftColumn - A numerical value containing the left-most column on │ '│ which menu entries will be displayed. Allowable range │ '│ is 1 though 76. │ '│ rightColumn - A numerical value containing the right-most column on │ '│ which menu entries will be displayed. Allowable range │ '│ is 5 through 80. │ '│ row% - A numerical value containing the first row on which to display │ '│ menu entries. Allowable range is 1 through 24. │ '│ marker$ - The character used in the menu entry strings that indicates │ '│ the next character is a 'Quick Access' key. │ '│ divider$ - The character used as a menu entry if a dividing line is │ '│ desired. '│ fg% - The foreground color of normal menu entries. Allowable range │ '│ is 0 to 15. │ '│ bg% - The background color of normal menu entries. Allowable range │ '│ is 0 to 7. │ '│ hfg% - The foreground color of the highlighted menu entry. Allowable │ '│ range is 0 to 15. │ '│ hbg% - The background color of the highlighted menu entry. Allowable │ '│ range is 0 to 7. │ '│ qfg% - The foreground color of the Quick Access keys. Allowable │ '│ range is 0 to 15. │ '│ qbg% - The background color of the Quick Access keys. Allowable │ '│ range is 0 to 7. │ '│ useMouse% - 1 = use mouse support, 0 = don't. '└────────────────────────────────────────────────────────────────────────┘ '───────────────────────────────────────────────────────────────────────── ' Set local variables - extended scan codes for keypad keys '───────────────────────────────────────────────────────────────────────── up$ = CHR$(0) + CHR$(72) down$ = CHR$(0) + CHR$(80) enter$ = CHR$(13) home$ = CHR$(0) + CHR$(71) EndKee$ = CHR$(0) + CHR$(79) PgUpKey$ = CHR$(0) + CHR$(73) PgDnKey$ = CHR$(0) + CHR$(81) esc$ = CHR$(27) '───────────────────────────────────────────────────────────────────────── ' Define other local variables. '───────────────────────────────────────────────────────────────────────── mx% = 0 my% = 0 lmCnt% = 0 rmCnt% = 0 returnIt% = FALSE updateMenu% = FALSE '───────────────────────────────────────────────────────────────────────── ' Define the error tone string to use with PLAY '───────────────────────────────────────────────────────────────────────── errorTone$ = "MB T120 L50 O3 AF" '───────────────────────────────────────────────────────────────────────── ' Set type of justification to uppercase '───────────────────────────────────────────────────────────────────────── justify$ = UCASE$(justify$) wdth% = (rightColumn - leftColumn - 1) '───────────────────────────────────────────────────────────────────────── ' Check for out-of-bounds parameters. If any are out of range, ' quit the function '───────────────────────────────────────────────────────────────────────── IF numOfChoices% < 1 OR numOfChoices% > 25 THEN EXIT FUNCTION IF justify$ <> "C" AND justify$ <> "L" AND justify$ <> "R" THEN EXIT FUNCTION IF leftColumn < 1 OR rightColumn > 80 THEN EXIT FUNCTION IF row% < 1 OR row% > 24 THEN EXIT FUNCTION '───────────────────────────────────────────────────────────────────────── ' Calculate the array of character identifiers '───────────────────────────────────────────────────────────────────────── REDIM charID(numOfChoices%) AS STRING * 1 FOR x% = 1 TO numOfChoices% FOR y% = 1 TO LEN(choice$(x%)) IF MID$(choice$(x%), y%, 1) = marker$ THEN charID(x%) = UCASE$(MID$(choice$(x%), y% + 1, 1)) EXIT FOR END IF NEXT y% NEXT x% '───────────────────────────────────────────────────────────────────────── ' Calculate length of longest menu choice and store value in ChoiceLen% '───────────────────────────────────────────────────────────────────────── choiceLen% = 0 FOR x% = 1 TO numOfChoices% IF LEN(choice$(x%)) > choiceLen% THEN IF INSTR(choice$(x%), marker$) THEN choiceLen% = LEN(choice$(x%)) ELSE choiceLen% = LEN(choice$(x%)) + 1 END IF END IF NEXT x% choiceLen% = choiceLen% - 1 '───────────────────────────────────────────────────────────────────────── ' Determine left-most column to display highlight bar on '───────────────────────────────────────────────────────────────────────── col = (((rightColumn - leftColumn - 1) - choiceLen%) / 2) + leftColumn '───────────────────────────────────────────────────────────────────────── ' At this point, we must turn off the mouse cursor if it's available. We ' don't want to write overtop of it, leaving a hole when it's moved later. '───────────────────────────────────────────────────────────────────────── IF useMouse% THEN MouseHide END IF '───────────────────────────────────────────────────────────────────────── ' Print menu choices to screen based on the type of Justification ' selected (Center, Left, Right). '───────────────────────────────────────────────────────────────────────── COLOR fg%, bg% SELECT CASE justify$ CASE "C" FOR x% = 1 TO numOfChoices% xCol% = ((wdth% - (LEN(choice$(x%))) - 1) \ 2 + leftColumn) + 1 LOCATE (row% - 1) + x%, leftColumn - 1, 0 PRINT SPACE$(choiceLen% + 2); LOCATE (row% - 1) + x%, xCol%, 0 DisplayEntry choice$(x%), qfg%, qbg%, hfg%, hBG%, fg%, bg%, marker$, divider$, wdth%, 1 NEXT x% CASE "R" FOR x% = 1 TO numOfChoices% LOCATE (row% - 1) + x%, leftColumn - 1, 0 PRINT SPACE$(choiceLen% + 2); LOCATE (row% - 1) + x%, (rightColumn - LEN(choice$(x%))) DisplayEntry choice$(x%), qfg%, qbg%, hfg%, hBG%, fg%, bg%, marker$, divider$, wdth%, 1 NEXT x% CASE "L" FOR x% = 1 TO numOfChoices% LOCATE (row% - 1) + x%, leftColumn - 1, 0 PRINT SPACE$(choiceLen% + 2); LOCATE (row% - 1) + x%, leftColumn, 0 DisplayEntry choice$(x%), qfg%, qbg%, hfg%, hBG%, fg%, bg%, marker$, divider$, wdth%, 1 NEXT x% END SELECT '───────────────────────────────────────────────────────────────────────── ' Highlight the first entry in the list. Must take into account the ' justification type. '───────────────────────────────────────────────────────────────────────── currentLocation% = 1 oldLocation% = 1 COLOR hfg%, hBG% LOCATE row%, leftColumn - 1: PRINT SPACE$(choiceLen% + 2); SELECT CASE justify$ CASE "C" xCol% = ((wdth% - (LEN(choice$(currentLocation%))) - 1) \ 2 + leftColumn) + 1 LOCATE (row% - 1 + currentLocation%), xCol%, 0 DisplayEntry choice$(currentLocation%), qfg%, qbg%, hfg%, hBG%, fg%, bg%, marker$, divider$, wdth%, 2 CASE "R" LOCATE (row% - 1) + currentLocation%, (rightColumn - LEN(choice$(currentLocation%))) DisplayEntry choice$(currentLocation%), qfg%, qbg%, hfg%, hBG%, fg%, bg%, marker$, divider$, wdth%, 2 CASE "L" LOCATE (row% - 1) + currentLocation%, leftColumn DisplayEntry choice$(currentLocation%), qfg%, qbg%, hfg%, hBG%, fg%, bg%, marker$, divider$, wdth%, 2 END SELECT '───────────────────────────────────────────────────────────────────────── ' Read keystrokes and change the highlighted entry appropriately. Also ' drain out any pending mouse button presses if the mouse is available. '───────────────────────────────────────────────────────────────────────── exitCode% = FALSE IF useMouse% THEN MouseButtonPressInfo LEFTBUTTON, lmCnt%, mx%, my% MouseButtonPressInfo RIGHTBUTTON, rmCnt%, mx%, my% lmCnt% = 0 rmCnt% = 0 END IF WHILE exitCode% = FALSE '───────────────────────────────────────────────────────────────────── ' If we're using the mouse, turn it on. '───────────────────────────────────────────────────────────────────── IF useMouse% THEN MouseShow END IF '───────────────────────────────────────────────────────────────────── ' Read keystrokes and/or mouse presses. '───────────────────────────────────────────────────────────────────── key$ = "" lmCnt% = 0 rmCnt% = 0 IF useMouse% THEN MouseButtonPressInfo RIGHTBUTTON, rmCnt%, mx%, my% MouseButtonPressInfo LEFTBUTTON, lmCnt%, mx%, my% '─────────────────────────────────────────────────────────────────── ' Did we have any left mouse button presses? If not, check the ' keyboard for input. '─────────────────────────────────────────────────────────────────── IF lmCnt% = 0 THEN key$ = UCASE$(INKEY$) END IF ELSE '─────────────────────────────────────────────────────────────────── ' No mouse available, so wait for keyboard input. '─────────────────────────────────────────────────────────────────── WHILE key$ = "" key$ = UCASE$(INKEY$) WEND END IF '───────────────────────────────────────────────────────────────────── ' If the left mouse button was pressed, check to see if a menu item ' was selected by it. '───────────────────────────────────────────────────────────────────── IF (useMouse%) AND (lmCnt% > 0) THEN '─────────────────────────────────────────────────────────────────── ' Convert virtual screen mouse coordinates to real 80x25 coords. '─────────────────────────────────────────────────────────────────── mx% = (mx% \ 8) + 1 my% = (my% \ 8) + 1 '─────────────────────────────────────────────────────────────────── ' If mouse was inside menu window then return the item pointed to. '─────────────────────────────────────────────────────────────────── IF (mx% >= leftColumn) AND (mx% <= rightColumn) AND (my% >= row%) AND (my% <= row% + numOfChoices% - 1) THEN IF (choice$(my% - row% + 1) <> divider$) THEN exitCode% = TRUE updateMenu% = TRUE currentLocation% = my% - row% + 1 key$ = charID(currentLocation%) returnIt% = TRUE END IF END IF END IF '───────────────────────────────────────────────────────────────────── ' If right mouse button was pressed, then exit as if ESC were pressed. '───────────────────────────────────────────────────────────────────── IF (useMouse%) AND (rmCnt% > 0) THEN MakeMenu% = 0 EXIT FUNCTION END IF '─────────────────────────────────────────────────────────────────── ' Update currentLocation based on what user did, key-wise. '─────────────────────────────────────────────────────────────────── SELECT CASE key$ CASE up$ IF currentLocation% > 1 THEN currentLocation% = currentLocation% - 1 IF (choice$(currentLocation%) = divider$) AND (currentLocation% > 0) THEN currentLocation% = currentLocation% - 1 END IF ELSE currentLocation% = numOfChoices% END IF updateMenu% = TRUE CASE down$ IF currentLocation% < numOfChoices% THEN currentLocation% = currentLocation% + 1 IF (choice$(currentLocation%) = divider$) AND (currentLocation% < numOfChoices%) THEN currentLocation% = currentLocation% + 1 END IF ELSE currentLocation% = 1 END IF updateMenu% = TRUE CASE home$, PgUpKey$ IF currentLocation% <> 1 THEN currentLocation% = 1 updateMenu% = TRUE END IF CASE EndKee$, PgDnKey$ IF currentLocation% <> numOfChoices% THEN currentLocation% = numOfChoices% updateMenu% = TRUE END IF CASE enter$ MakeMenu% = currentLocation% exitCode% = TRUE CASE esc$ MakeMenu% = 0 exitCode% = TRUE CASE ELSE '─────────────────────────────────────────────────────────────────── ' Check quick access keys. '─────────────────────────────────────────────────────────────────── FOR i% = 1 TO numOfChoices% IF charID(i%) = key$ THEN currentLocation% = i% updateMenu% = TRUE MakeMenu% = i% exitCode% = TRUE END IF NEXT i% END SELECT '─────────────────────────────────────────────────────────────────── ' If required, update the display. '─────────────────────────────────────────────────────────────────── IF updateMenu% THEN '─────────────────────────────────────────────────────────────────── ' If mouse is around, turn it off, since we'll be displaying. '─────────────────────────────────────────────────────────────────── IF useMouse% THEN MouseHide END IF '───────────────────────────────────────────────────────────────── ' Restore the old highlighted item to normal colors. '───────────────────────────────────────────────────────────────── COLOR fg%, bg% LOCATE row% + oldLocation% - 1, leftColumn - 1: PRINT SPACE$(choiceLen% + 2); SELECT CASE justify$ CASE "C" xCol% = ((wdth% - (LEN(choice$(oldLocation%))) - 1) \ 2 + leftColumn) + 1 LOCATE (row% - 1 + oldLocation%), xCol%, 0 DisplayEntry choice$(oldLocation%), qfg%, qbg%, hfg%, hBG%, fg%, bg%, marker$, divider$, wdth%, 1 CASE "R" LOCATE (row% - 1) + oldLocation%, (rightColumn - LEN(choice$(oldLocation%))) DisplayEntry choice$(oldLocation%), qfg%, qbg%, hfg%, hBG%, fg%, bg%, marker$, divider$, wdth%, 1 CASE "L" LOCATE (row% - 1) + oldLocation%, leftColumn DisplayEntry choice$(oldLocation%), qfg%, qbg%, hfg%, hBG%, fg%, bg%, marker$, divider$, wdth%, 1 END SELECT '───────────────────────────────────────────────────────────────── ' Display newly highlighted item in highlight colors. '───────────────────────────────────────────────────────────────── COLOR hfg%, hBG% LOCATE row% + currentLocation% - 1, leftColumn - 1: PRINT SPACE$(choiceLen% + 2); SELECT CASE justify$ CASE "C" xCol% = ((wdth% - (LEN(choice$(currentLocation%))) - 1) \ 2 + leftColumn) + 1 LOCATE (row% - 1 + currentLocation%), xCol%, 0 DisplayEntry choice$(currentLocation%), qfg%, qbg%, hfg%, hBG%, fg%, bg%, marker$, divider$, wdth%, 2 CASE "R" LOCATE (row% - 1) + currentLocation%, (rightColumn - LEN(choice$(currentLocation%))) DisplayEntry choice$(currentLocation%), qfg%, qbg%, hfg%, hBG%, fg%, bg%, marker$, divider$, wdth%, 2 CASE "L" LOCATE (row% - 1) + currentLocation%, leftColumn DisplayEntry choice$(currentLocation%), qfg%, qbg%, hfg%, hBG%, fg%, bg%, marker$, divider$, wdth%, 2 END SELECT '───────────────────────────────────────────────────────────────── ' Reset old location to current. '───────────────────────────────────────────────────────────────── oldLocation% = currentLocation% updateMenu% = FALSE END IF '─────────────────────────────────────────────────────────────────── ' If the mouse was used to click on a menu choice, then return it ' and exit now. '─────────────────────────────────────────────────────────────────── IF returnIt% THEN MakeMenu% = currentLocation% EXIT FUNCTION END IF WEND END FUNCTION SUB MakeWindow (topRow!, leftCol!, botRow!, rightCol!, foreColor%, backColor%, windowType%, frameType%, shadowColor%, explodeType%, label$) '┌────────────────────────────────────────────────────────────────────────┐ '│ The MakeWindow subroutine draws windows on the screen for you. The │ '│ kinds of windows you can make is quite varied. There are 10 │ '│ window types, six different frame types, windows can have shadows │ '│ or not, you can 'explode' them onto the screen, and even place labels │ '│ on them. The parameters for MakeWindow are as follows: │ '│ │ '│ topRow! - This is a numerical value containing the top-most row of │ '│ the window. Allowable range is 1 through 22. │ '│ leftCol! - This is a numerical value containing the left-most side │ '│ of the window. Allowable range is 1 to 79. │ '│ botRow! - This is a numerical value containing the bottom-most row │ '│ of the window. Allowable range is 2 through 23. │ '│ rightCol! - This is a numerical value containing the right-most row │ '│ of the window. Allowable range is 2 through 80. │ '│ foreColor% - This is the foreground color of the window. Allowable │ '│ range is 0 through 15. │ '│ backColor% - This is the background color of the window. Allowable │ '│ range is 0 through 7. │ '│ windowType% - This is a numerical value containing the type of window │ '│ desired. Allowable range is 0 through 9. See the │ '│ QBSCR documentation for more info. │ '│ frameType% - This is a numerical value containing the type of frame │ '│ you want your window to have. Allowable range is 0 │ '│ through 5. See the QBSCR documentation for more info. │ '│ shadowColor% - This is a numerical value containing the color of the │ '│ shadow for your window. If you desire no shadow at │ '│ all, use a value of -1. Allowable range is -1 through │ '│ 15. See the QBSCR documentation for more detail. │ '│ explodeType% - This is a numerical value that indicates how you want │ '│ your window to be placed on the screen. A value of 0 │ '│ display it normally, top to bottom. A value of 1 │ '│ means explode it onto the screen using auto mode. A │ '│ value of 2 means explode it onto the screen using the │ '│ horizontal bias mode, and a value of 3 means explode │ '│ it onto the screen using the vertical bias mode. See │ '│ the QBSCR documentation for more details. │ '│ label$ - This is a string used to label your window. It is placed │ '│ along the top line of your window, framed by brackets. │ '│ A string of zero length ("") means don't display any label. │ '│ Allowable string length is equal to (RightCol - LeftCol) - 4 │ '└────────────────────────────────────────────────────────────────────────┘ '───────────────────────────────────────────────────────────────────────── ' Setup line$ as a dynamic array that can REDimensioned. Line$() ' will contain the actual character strings that make up our window. '───────────────────────────────────────────────────────────────────────── '$DYNAMIC DIM line$(24) '───────────────────────────────────────────────────────────────────────── ' Initialize local variables '───────────────────────────────────────────────────────────────────────── part1 = 0: part2 = 0: numLines = 0 '───────────────────────────────────────────────────────────────────────── ' Check all passed values for validity and set defaults '───────────────────────────────────────────────────────────────────────── numLines = 0 IF topRow < 1 THEN topRow = 1: IF topRow > 24 THEN topRow = 24 IF botRow < 2 THEN botRow = 2: IF botRow > 25 THEN botRow = 25 IF rightCol < 2 THEN rightCol = 2: IF rightCol > 80 THEN rightCol = 80 IF leftCol < 1 THEN leftCol = 1: IF leftCol > 80 THEN leftCol = 80 IF foreColor% < 0 OR foreColor% > 31 THEN foreColor% = 7 IF backColor% < 0 OR backColor% > 7 THEN backColor% = 0 IF windowType% < 0 OR windowType% > 9 THEN windowType% = 0 IF frameType% < 0 OR frameType% > 9 THEN frameType% = 0 IF shadowColor% > 17 THEN shadowColor% = -1 IF explodeType% < 0 OR explodeType% > 3 THEN explodeType% = 0 IF LEN(label$) > ((rightCol - leftCol) - 4) THEN label$ = "" '───────────────────────────────────────────────────────────────────────── ' Setup graphics characters to use based on FrameType% '───────────────────────────────────────────────────────────────────────── SELECT CASE frameType% CASE 0, 6, 7 ' All lines SINGLE urc$ = CHR$(191): ulc$ = CHR$(218): llc$ = CHR$(192): lrc$ = CHR$(217) ver$ = CHR$(179): hor$ = CHR$(196) vtl$ = CHR$(195): vtr$ = CHR$(180) htt$ = CHR$(194): htb$ = CHR$(193) crs$ = CHR$(197): blk$ = CHR$(219) lbl$ = CHR$(180): lbr$ = CHR$(195) CASE 1, 8, 9 ' All lines DOUBLE urc$ = CHR$(187): ulc$ = CHR$(201): llc$ = CHR$(200): lrc$ = CHR$(188) ver$ = CHR$(186): hor$ = CHR$(205) vtl$ = CHR$(204): vtr$ = CHR$(185) htt$ = CHR$(203): htb$ = CHR$(202) crs$ = CHR$(206): blk$ = CHR$(219) lbl$ = CHR$(181): lbr$ = CHR$(198) CASE 2 ' Horizontals SINGLE / Verticals DOUBLE urc$ = CHR$(183): ulc$ = CHR$(214): llc$ = CHR$(211): lrc$ = CHR$(189) ver$ = CHR$(186): hor$ = CHR$(196) vtl$ = CHR$(199): vtr$ = CHR$(182) htt$ = CHR$(210): htb$ = CHR$(208) crs$ = CHR$(215): blk$ = CHR$(219) lbl$ = CHR$(180): lbr$ = CHR$(195) CASE 3 ' Horizontals DOUBLE / Verticals SINGLE urc$ = CHR$(184): ulc$ = CHR$(213): llc$ = CHR$(212): lrc$ = CHR$(190) ver$ = CHR$(179): hor$ = CHR$(205) vtl$ = CHR$(198): vtr$ = CHR$(181) htt$ = CHR$(209): htb$ = CHR$(207) crs$ = CHR$(216): blk$ = CHR$(219) lbl$ = CHR$(181): lbr$ = CHR$(198) CASE 4 ' Outside lines DOUBLE / Inside lines SINGLE urc$ = CHR$(187): ulc$ = CHR$(201): llc$ = CHR$(200): lrc$ = CHR$(188) ver$ = CHR$(186): ver1$ = CHR$(179): hor$ = CHR$(205): hor1$ = CHR$(196) vtl$ = CHR$(199): vtr$ = CHR$(182) htt$ = CHR$(209): htt1$ = CHR$(194): htb$ = CHR$(207): htb1$ = CHR$(193) crs$ = CHR$(197): blk$ = CHR$(219) lbl$ = CHR$(181): lbr$ = CHR$(198) CASE 5 ' Outside lines SINGLE / Inside Lines DOUBLE urc$ = CHR$(191): ulc$ = CHR$(218): llc$ = CHR$(192): lrc$ = CHR$(217) ver$ = CHR$(179): ver1$ = CHR$(186): hor$ = CHR$(196): hor1$ = CHR$(205) vtl$ = CHR$(198): vtr$ = CHR$(181) htt$ = CHR$(210): htt1$ = CHR$(203): htb$ = CHR$(208): htb1$ = CHR$(202) crs$ = CHR$(206): blk$ = CHR$(219) lbl$ = CHR$(180): lbr$ = CHR$(195) CASE ELSE ' Shouldn't be an 'else' ! END SELECT '───────────────────────────────────────────────────────────────────────── ' Calculate the number of lines to be printed and redimension Lines$() '───────────────────────────────────────────────────────────────────────── numLines = (botRow - topRow) + 1 REDIM line$(numLines) '───────────────────────────────────────────────────────────────────────── ' Determine ExplodeStep% for explode loop based on ExplodeType% '───────────────────────────────────────────────────────────────────────── SELECT CASE explodeType% CASE 0 ' Exploding Windows OFF explodeStep% = 0 CASE 1 ' Explode automatic - determine explode ratio explodeStep% = INT((rightCol - leftCol) / (botRow - topRow)) CASE 2 ' Explode ratio biased toward HORIZONTAL explodeStep% = 3 CASE 3 ' Explode ratio biased toward VERTICAL explodeStep% = 1 END SELECT '───────────────────────────────────────────────────────────────────────── ' Construct the window strings based on WindowType% '───────────────────────────────────────────────────────────────────────── SELECT CASE windowType% CASE 0 ' Regular box, no extra lines line$(1) = ulc$ + STRING$((rightCol - leftCol) - 1, hor$) + urc$ FOR x% = 2 TO numLines - 1 line$(x%) = ver$ + SPACE$((rightCol - leftCol) - 1) + ver$ NEXT x% line$(numLines) = llc$ + STRING$((rightCol - leftCol) - 1, hor$) + lrc$ CASE 1 ' Box with extra internal line at top and bottom line$(1) = ulc$ + STRING$((rightCol - leftCol) - 1, hor$) + urc$ line$(2) = ver$ + SPACE$((rightCol - leftCol) - 1) + ver$ IF frameType% = 4 OR frameType% = 5 THEN tempHOR$ = hor$ hor$ = hor1$ END IF line$(3) = vtl$ + STRING$((rightCol - leftCol) - 1, hor$) + vtr$ FOR x% = 4 TO numLines - 3 line$(x%) = ver$ + SPACE$((rightCol - leftCol) - 1) + ver$ NEXT x% line$(numLines - 2) = vtl$ + STRING$((rightCol - leftCol) - 1, hor$) + vtr$ line$(numLines - 1) = ver$ + SPACE$((rightCol - leftCol) - 1) + ver$ IF frameType% = 4 OR frameType% = 5 THEN hor$ = tempHOR$ END IF line$(numLines) = llc$ + STRING$((rightCol - leftCol) - 1, hor$) + lrc$ CASE 2 ' Box with extra internal line at top line$(1) = ulc$ + STRING$((rightCol - leftCol) - 1, hor$) + urc$ line$(2) = ver$ + SPACE$((rightCol - leftCol) - 1) + ver$ IF frameType% = 4 OR frameType% = 5 THEN tempHOR$ = hor$ hor$ = hor1$ END IF line$(3) = vtl$ + STRING$((rightCol - leftCol) - 1, hor$) + vtr$ FOR x% = 4 TO numLines - 1 line$(x%) = ver$ + SPACE$((rightCol - leftCol) - 1) + ver$ NEXT x% IF frameType% = 4 OR frameType% = 5 THEN hor$ = tempHOR$ END IF line$(numLines) = llc$ + STRING$((rightCol - leftCol) - 1, hor$) + lrc$ CASE 3 ' Box with extra internal line at bottom line$(1) = ulc$ + STRING$((rightCol - leftCol) - 1, hor$) + urc$ FOR x% = 2 TO numLines - 3 line$(x%) = ver$ + SPACE$((rightCol - leftCol) - 1) + ver$ NEXT x% IF frameType% = 4 OR frameType% = 5 THEN tempHOR$ = hor$ hor$ = hor1$ END IF line$(numLines - 2) = vtl$ + STRING$((rightCol - leftCol) - 1, hor$) + vtr$ line$(numLines - 1) = ver$ + SPACE$((rightCol - leftCol) - 1) + ver$ IF frameType% = 4 OR frameType% = 5 THEN hor$ = tempHOR$ END IF line$(numLines) = llc$ + STRING$((rightCol - leftCol) - 1, hor$) + lrc$ CASE 4 ' Box with vertical line down the center part1 = ((rightCol - leftCol) - 1) / 2 IF INT(part1) = part1 THEN part2 = part1 - 1 ELSE part1 = INT(part1) part2 = part1 END IF line$(1) = ulc$ + STRING$(part1, hor$) + htt$ + STRING$(part2, hor$) + urc$ IF frameType% <> 4 AND frameType% <> 5 THEN ver1$ = ver$ END IF FOR x% = 2 TO numLines - 1 line$(x%) = ver$ + SPACE$(part1) + ver1$ + SPACE$(part2) + ver$ NEXT x% line$(numLines) = llc$ + STRING$(part1, hor$) + htb$ + STRING$(part2, hor$) + lrc$ CASE 5 ' Box with horizontal line down the center TopHalf = INT(numLines / 2) line$(1) = ulc$ + STRING$((rightCol - leftCol) - 1, hor$) + urc$ FOR x% = 2 TO TopHalf line$(x%) = ver$ + SPACE$((rightCol - leftCol) - 1) + ver$ NEXT x% IF frameType% = 4 OR frameType% = 5 THEN tempHOR$ = hor$ hor$ = hor1$ END IF line$(TopHalf + 1) = vtl$ + STRING$((rightCol - leftCol) - 1, hor$) + vtr$ IF frameType% = 4 OR frameType% = 5 THEN hor$ = tempHOR$ END IF FOR x% = TopHalf + 2 TO numLines - 1 line$(x%) = ver$ + SPACE$((rightCol - leftCol) - 1) + ver$ NEXT x% line$(numLines) = llc$ + STRING$((rightCol - leftCol) - 1, hor$) + lrc$ CASE 6 ' Box cross-divided into four sections TopHalf = INT(numLines / 2): part1 = ((rightCol - leftCol) - 1) / 2 IF INT(part1) = part1 THEN part2 = part1 - 1 ELSE part1 = INT(part1): part2 = part1 END IF line$(1) = ulc$ + STRING$(part1, hor$) + htt$ + STRING$(part2, hor$) + urc$ IF frameType% <> 4 AND frameType% <> 5 THEN ver1$ = ver$ FOR x% = 2 TO TopHalf line$(x%) = ver$ + SPACE$(part1) + ver1$ + SPACE$(part2) + ver$ NEXT x% IF frameType% = 4 OR frameType% = 5 THEN tempHOR$ = hor$: hor$ = hor1$ END IF line$(TopHalf + 1) = vtl$ + STRING$(part1, hor$) + crs$ + STRING$(part2, hor$) + vtr$ IF frameType% = 4 OR frameType% = 5 THEN hor$ = tempHOR$ FOR x% = TopHalf + 2 TO numLines - 1 line$(x%) = ver$ + SPACE$(part1) + ver1$ + SPACE$(part2) + ver$ NEXT x% line$(numLines) = llc$ + STRING$(part1, hor$) + htb$ + STRING$(part2, hor$) + lrc$ CASE 7 ' Box with extra internal line at top and vertical ' dividing line for rest of window part1 = ((rightCol - leftCol) - 1) / 2 IF INT(part1) = part1 THEN part2 = part1 - 1 ELSE part1 = INT(part1) part2 = part1 END IF line$(1) = ulc$ + STRING$((rightCol - leftCol) - 1, hor$) + urc$ line$(2) = ver$ + SPACE$((rightCol - leftCol) - 1) + ver$ IF frameType% <> 4 AND frameType% <> 5 THEN htt1$ = htt$ ver1$ = ver$ hor1$ = hor$ END IF line$(3) = vtl$ + STRING$(part1, hor1$) + htt1$ + STRING$(part2, hor1$) + vtr$ FOR x% = 4 TO numLines - 1 line$(x%) = ver$ + SPACE$(part1) + ver1$ + SPACE$(part2) + ver$ NEXT x% line$(numLines) = llc$ + STRING$(part1, hor$) + htb$ + STRING$(part2, hor$) + lrc$ CASE 8 ' Box with extra internalline at bottom and vertical ' dividing line for rest of window part1 = ((rightCol - leftCol) - 1) / 2 IF INT(part1) = part1 THEN part2 = part1 - 1 ELSE part1 = INT(part1) part2 = part1 END IF line$(1) = ulc$ + STRING$(part1, hor$) + htt$ + STRING$(part2, hor$) + urc$ IF frameType% <> 4 AND frameType% <> 5 THEN htb1$ = htb$ ver1$ = ver$ hor1$ = hor$ END IF FOR x% = 2 TO numLines - 3 line$(x%) = ver$ + SPACE$(part1) + ver1$ + SPACE$(part2) + ver$ NEXT x% line$(numLines - 2) = vtl$ + STRING$(part1, hor1$) + htb1$ + STRING$(part2, hor1$) + vtr$ line$(numLines - 1) = ver$ + SPACE$((rightCol - leftCol) - 1) + ver$ line$(numLines) = llc$ + STRING$((rightCol - leftCol) - 1, hor$) + lrc$ CASE 9 ' Box with extra internal lines at top and bottom, ' with dividing line for rest of window part1 = ((rightCol - leftCol) - 1) / 2 IF INT(part1) = part1 THEN part2 = part1 - 1 ELSE part1 = INT(part1) part2 = part1 END IF line$(1) = ulc$ + STRING$((rightCol - leftCol) - 1, hor$) + urc$ line$(2) = ver$ + SPACE$((rightCol - leftCol) - 1) + ver$ IF frameType% <> 4 AND frameType% <> 5 THEN htt1$ = htt$ htb1$ = htb$ ver1$ = ver$ hor1$ = hor$ END IF line$(3) = vtl$ + STRING$(part1, hor1$) + htt1$ + STRING$(part2, hor1$) + vtr$ FOR x% = 4 TO numLines - 3 line$(x%) = ver$ + SPACE$(part1) + ver1$ + SPACE$(part2) + ver$ NEXT x% line$(numLines - 2) = vtl$ + STRING$(part1, hor1$) + htb1$ + STRING$(part2, hor1$) + vtr$ line$(numLines - 1) = ver$ + SPACE$((rightCol - leftCol) - 1) + ver$ line$(numLines) = llc$ + STRING$((rightCol - leftCol) - 1, hor$) + lrc$ CASE ELSE '───────────────────────────────────────────────────────────────────── ' Shouldn't be an 'else' ! '───────────────────────────────────────────────────────────────────── END SELECT '───────────────────────────────────────────────────────────────────────── ' Print the Window, Please! Set colors to those passed to MakeWindow '───────────────────────────────────────────────────────────────────────── COLOR foreColor%, backColor% '───────────────────────────────────────────────────────────────────────── ' Print the window on the screen, using method based on ExplodeType% '───────────────────────────────────────────────────────────────────────── SELECT CASE explodeType% CASE 0 ' No explosion - just a straight print. See how easy? IF (frameType% < 6) THEN FOR x% = 1 TO numLines LOCATE (x% + (topRow - 1)), leftCol: PRINT line$(x%); NEXT x% ELSE IF (frameType% = 6 OR frameType% = 8) THEN ' *** RAISED *** tempFG1% = 15 tempFG2% = 0 ELSE ' *** DEPRESSED *** tempFG1% = 0 tempFG2% = 15 END IF LOCATE topRow, leftCol, 0 COLOR tempFG1%, backColor% PRINT LEFT$(line$(1), LEN(line$(1)) - 1); COLOR tempFG2%, backColor% PRINT RIGHT$(line$(1), 1); FOR x% = 2 TO numLines - 1 COLOR tempFG1%, backColor% LOCATE (x% + (topRow - 1)), leftCol: PRINT LEFT$(line$(x%), LEN(line$(x%)) - 1); COLOR tempFG2%, backColor% PRINT RIGHT$(line$(x%), 1); NEXT x% LOCATE botRow, leftCol, 0 COLOR tempFG1%, backColor% PRINT LEFT$(line$(numLines), 1); COLOR tempFG2%, backColor% PRINT RIGHT$(line$(numLines), LEN(line$(numLines)) - 1); END IF CASE 1, 2, 3 ' Explode that window! expX1% = INT(((rightCol - leftCol) / 2) + leftCol): expX2% = expX1% expY1% = INT(((botRow - topRow) / 2) + topRow): expY2% = expY1% WHILE (expX1% > leftCol + 1) OR (expY1% > topRow + 1) IF expX1% > leftCol THEN expX1% = expX1% - explodeStep% IF expX2% < rightCol THEN expX2% = expX2% + explodeStep% IF expY1% > topRow THEN expY1% = expY1% - 1 IF expY2% < botRow THEN expY2% = expY2% + 1 IF expX1% < leftCol THEN expX1% = leftCol: expX2% = rightCol IF expY1% < topRow THEN expY1% = topRow: expY2% = botRow LOCATE expY1%, expX1%: PRINT ulc$ + STRING$((expX2% - expX1%) - 1, hor$) + urc$; FOR x% = expY1% + 1 TO expY2% - 1 LOCATE x%, expX1%: PRINT ver$ + SPACE$((expX2% - expX1%) - 1) + ver$; NEXT x% LOCATE expY2%, expX1%: PRINT llc$ + STRING$((expX2% - expX1%) - 1, hor$) + lrc$; WEND '───────────────────────────────────────────────────────────────── ' Print a straight window now, after the explosion effect '───────────────────────────────────────────────────────────────── IF (frameType% < 6) THEN FOR x% = 1 TO numLines LOCATE (x% + (topRow - 1)), leftCol: PRINT line$(x%); NEXT x% ELSE IF (frameType% = 6) THEN ' *** RAISED *** tempFG1% = 15 tempFG2% = 0 ELSE ' *** DEPRESSED *** tempFG1% = 0 tempFG2% = 15 END IF LOCATE topRow, leftCol, 0 COLOR tempFG1%, backColor% PRINT LEFT$(line$(1), LEN(line$(1)) - 1); COLOR tempFG2%, backColor% PRINT RIGHT$(line$(1), 1); FOR x% = 2 TO numLines - 1 COLOR 15, backColor% LOCATE (x% + (topRow - 1)), leftCol: PRINT LEFT$(line$(x%), LEN(line$(x%)) - 1); COLOR 0, backColor% PRINT RIGHT$(line$(x%), 1); NEXT x% LOCATE botRow, leftCol, 0 COLOR tempFG1%, backColor% PRINT LEFT$(line$(1), 1); COLOR tempFG2%, backColor% PRINT RIGHT$(line$(1), LEN(line$(1)) - 1); END IF CASE ELSE '───────────────────────────────────────────────────────────────────── ' Shouldn't be an 'else' ! '───────────────────────────────────────────────────────────────────── END SELECT '───────────────────────────────────────────────────────────────────────── ' Add a shadow if required '───────────────────────────────────────────────────────────────────────── SELECT CASE shadowColor% CASE 0 TO 15 '───────────────────────────────────────────────────────────────────── ' Change colors to ShadowColor% '───────────────────────────────────────────────────────────────────── COLOR shadowColor%, 0 '───────────────────────────────────────────────────────────────────── ' Define the characters to display for the side/bottom shadow '───────────────────────────────────────────────────────────────────── sideShadow$ = STRING$(2, 219) botShadow$ = STRING$((rightCol - leftCol), 219) '───────────────────────────────────────────────────────────────────── ' Print the side shadow '───────────────────────────────────────────────────────────────────── FOR x% = topRow + 1 TO botRow + 1 LOCATE x%, rightCol + 1: PRINT sideShadow$; NEXT x% '───────────────────────────────────────────────────────────────────── ' Print the bottom shadow '───────────────────────────────────────────────────────────────────── LOCATE botRow + 1, leftCol + 2: PRINT botShadow$; CASE 16 '───────────────────────────────────────────────────────────────────── ' If shadow color is 16 use monochrome see-thru shadow '───────────────────────────────────────────────────────────────────── 'Side shadow segment = GetVideoSegment! FOR x% = topRow TO botRow offset% = (160 * x%) + (rightCol * 2) + 1 DEF SEG = segment POKE offset%, 7 POKE offset% + 2, 7 DEF SEG NEXT x% 'Bottom shadow offset% = (botRow * 160) FOR x% = ((leftCol + 1) * 2) TO ((rightCol + 1) * 2) STEP 2 DEF SEG = segment POKE offset% + x% + 1, 7 DEF SEG NEXT x% CASE 17 '───────────────────────────────────────────────────────────────────── ' Shadow type 17 - color see-thru shadow '───────────────────────────────────────────────────────────────────── 'Side shadow segment = GetVideoSegment FOR x% = topRow TO botRow - 1 offset% = (160 * x%) + (rightCol * 2) + 1 sf% = GetForeground%(x% + 1, INT(rightCol + 1)) IF sf% > 15 THEN blink% = 128 ELSE blink% = 0 END IF IF sf% > 7 THEN sf% = (sf% MOD 8) + blink% ELSE END IF DEF SEG = segment POKE offset%, sf% DEF SEG sf% = GetForeground%(x% + 1, INT(rightCol + 2)) IF sf% > 15 THEN blink% = 128 ELSE blink% = 0 END IF IF sf% > 7 THEN sf% = (sf% MOD 8) + blink% END IF DEF SEG = segment POKE offset% + 2, sf% DEF SEG NEXT x% 'Bottom shadow offset% = (botRow * 160) col% = INT(leftCol + 2) FOR x% = ((leftCol + 1) * 2) TO ((rightCol + 1) * 2) STEP 2 sf% = GetForeground%(INT(botRow) + 1, col%) col% = col% + 1 IF sf% > 15 THEN blink% = 128 ELSE blink% = 0 END IF IF sf% > 7 THEN sf% = (sf% MOD 8) + blink% END IF DEF SEG = segment POKE offset% + x% + 1, sf% DEF SEG NEXT x% CASE ELSE END SELECT ' shadowColor% '───────────────────────────────────────────────────────────────────────── ' Add the Window Label, if possible. Set the colors to those passed ' to MakeWindow routine. '───────────────────────────────────────────────────────────────────────── IF (frameType% = 6) OR (frameType% = 8) THEN COLOR 15, backColor% ELSEIF (frameType% = 7) OR (frameType% = 9) THEN COLOR 0, backColor% ELSE COLOR foreColor%, backColor% END IF '───────────────────────────────────────────────────────────────────────── ' Add label to window if one was specified '───────────────────────────────────────────────────────────────────────── IF label$ <> "" THEN label$ = lbl$ + label$ + lbr$ LOCATE topRow, leftCol + 1 PRINT label$; END IF END SUB REM $STATIC SUB MouseAdjustBox (minSens%, x%, y%, fg%, bg%, bpfg%, bpbg%, frType%, shadow%, explode%) '┌────────────────────────────────────────────────────────────────────────┐ '│ This routine displays a window that contains some info about the │ '│ mouse and allows the user to adjust the sensitivity of the mouse. │ '│ OK and Cancel buttons are provided so that changes may be saved │ '│ or aborted. This routine saves and restores the screen automatic- │ '│ ally for you, so don't bother with that. │ '│ │ '│ minSens% - The lowest value that the user may set the sensitivity │ '│ of the mouse to. Suggested value is 10. This prevents │ '│ the user from accidentally creating an unmoveable mouse. │ '│ x% - Column of upper left corner of window. │ '│ y% - Row of upper-left corner of window. │ '│ fg% - Foreground color of the window. │ '│ bg% = Background color of the window. │ '│ bpfg% - Foreground color of the pressed button. │ '│ bfbg% - Background color of the pressed button. │ '│ frType% - The frame type of the surrounding window. │ '│ shadow% - The shadow type to use for the surrounding window. │ '│ explode% - The explode type to use for the window. │ '│ │ '│ *NOTE: This routine will RESET the mouse in accordance with the │ '│ rules in the MouseInit% routine (called by this routine). │ '│ The following settings will result: │ '│ │ '│ Cursor Position: Center of screen │ '│ Cursor State: OFF │ '│ Graphics Cursor Shape: Arrow │ '│ Text Cursor: Reverse Video │ '│ Double-speed threshold: 64 │ '└────────────────────────────────────────────────────────────────────────┘ '────────────────────────────────────────────────────────────────────────── ' Define the special keys used in the routine. '────────────────────────────────────────────────────────────────────────── bothUp$ = CHR$(0) + CHR$(77) ' Right arrow bothDown$ = CHR$(0) + CHR$(75) ' Left arrow vertUp$ = CHR$(0) + CHR$(116) ' Ctrl+Right arrow vertDown$ = CHR$(0) + CHR$(115) ' Ctrl+Left arrow horzUp$ = CHR$(54) ' Shift+Right arrow horzDown$ = CHR$(52) ' Shift+Left arrow fastBothUp$ = CHR$(0) + CHR$(73) ' PgUp fastBothDown$ = CHR$(0) + CHR$(81) ' PgDn fastHorzUp$ = CHR$(57) ' Shift+PgUp fastHorzDown$ = CHR$(51) ' Shift+Down arrow fastVertUp$ = CHR$(0) + CHR$(132) ' Ctrl+PgUp fastVertDown$ = CHR$(0) + CHR$(118) ' Ctrl+PgDn esc$ = CHR$(27) enter$ = CHR$(13) '────────────────────────────────────────────────────────────────────────── ' First step is to make sure the mouse exists. This will reset the mouse ' as a side effect. We can't set the mouse sensitivity if it's not there. '────────────────────────────────────────────────────────────────────────── numButtons% = MouseInit% IF numButtons% = 0 THEN EXIT SUB END IF '────────────────────────────────────────────────────────────────────────── ' Get info about the mouse now that we know it's there. '────────────────────────────────────────────────────────────────────────── MouseInfo ver$, mType%, IRQ% '────────────────────────────────────────────────────────────────────────── ' Now get the current mouse sensitivity for x and y directions. '────────────────────────────────────────────────────────────────────────── MouseGetSensitivity currentXsens%, currentYsens%, dst% oldXsens% = currentXsens% oldYsens% = currentYsens% '────────────────────────────────────────────────────────────────────────── ' Now that we've collected all our information, its time to move on with ' the real functionality of the routine. First, turn the mouse off whilst ' we display the dialog box. '────────────────────────────────────────────────────────────────────────── MouseHide '────────────────────────────────────────────────────────────────────────── ' Now save what's on the screen before we overwrite it. '────────────────────────────────────────────────────────────────────────── DIM scr%(BlockSize%(x%, x% + 42, y%, y% + 20)) BlockSave x%, x% + 42, y%, y% + 20, scr%(), GetVideoSegment! '────────────────────────────────────────────────────────────────────────── ' Display a window in which all elements of the dialog box will reside. '────────────────────────────────────────────────────────────────────────── MakeWindow CSNG(y%), CSNG(x%), CSNG(y%) + 20, CSNG(x%) + 42, fg%, bg%, 0, frType%, shadow%, explode%, " Mouse Adjustments " '────────────────────────────────────────────────────────────────────────── ' Now display each part of the dialog box. '────────────────────────────────────────────────────────────────────────── ' Mouse information. COLOR fg%, bg% LOCATE y% + 2, x% + 3, 0 PRINT "Mouse Version: "; ver$ LOCATE y% + 3, x% + 3, 0 PRINT "Mouse Type : "; SELECT CASE mType% CASE BUSMOUSE PRINT "BUS"; CASE SERIALMOUSE PRINT "SERIAL"; CASE INPORTMOUSE PRINT "IN-PORT"; CASE PS2MOUSE PRINT "PS/2"; CASE HEWLETTPACKARDMOUSE PRINT "HP"; CASE ELSE END SELECT LOCATE y% + 4, x% + 3, 0 PRINT "IRQ Number :"; IRQ%; LOCATE y% + 5, x% + 3, 0 PRINT "Num buttons :"; numButtons%; ' Buttons LOCATE y% + 1, x% + 30, 0: PRINT "┌────────╖"; LOCATE y% + 2, x% + 30, 0: PRINT "│ OK ║"; LOCATE y% + 3, x% + 30, 0: PRINT "╘════════╝"; LOCATE y% + 4, x% + 30, 0: PRINT "┌────────╖"; LOCATE y% + 5, x% + 30, 0: PRINT "│ Cancel ║"; LOCATE y% + 6, x% + 30, 0: PRINT "╘════════╝"; ' Horizontal sensitivity gadgets. LOCATE y% + 8, x% + 3, 0 PRINT "Horizontal Sensitivity"; MakeWindow y% + 9, x% + 3, y% + 11, x% + 7, fg%, bg%, 0, 0, -1, 0, "" LOCATE y% + 10, x% + 4, 0: PRINT ""; MakeWindow y% + 9, x% + 8, y% + 11, x% + 12, fg%, bg%, 0, 0, -1, 0, "" LOCATE y% + 10, x% + 10, 0: PRINT ""; MakeWindow y% + 9, x% + 13, y% + 11, x% + 24, fg%, bg%, 0, 0, -1, 0, "" MakeWindow y% + 9, x% + 25, y% + 11, x% + 29, fg%, bg%, 0, 0, -1, 0, "" LOCATE y% + 10, x% + 27, 0: PRINT ""; MakeWindow y% + 9, x% + 30, y% + 11, x% + 34, fg%, bg%, 0, 0, -1, 0, "" LOCATE y% + 10, x% + 31, 0: PRINT ""; MakeWindow y% + 9, x% + 35, y% + 11, x% + 39, fg%, bg%, 0, 0, -1, 0, "" LOCATE y% + 10, x% + 36, 0: PRINT LTRIM$(RTRIM$(STR$(currentXsens%))); ' Vertical sensitivity gadgets. LOCATE y% + 18, x% + 3, 0 PRINT "Vertical Sensitivity"; MakeWindow y% + 15, x% + 3, y% + 17, x% + 7, fg%, bg%, 0, 0, -1, 0, "" LOCATE y% + 16, x% + 4, 0: PRINT ""; MakeWindow y% + 15, x% + 8, y% + 17, x% + 12, fg%, bg%, 0, 0, -1, 0, "" LOCATE y% + 16, x% + 10, 0: PRINT ""; MakeWindow y% + 15, x% + 13, y% + 17, x% + 24, fg%, bg%, 0, 0, -1, 0, "" MakeWindow y% + 15, x% + 25, y% + 17, x% + 29, fg%, bg%, 0, 0, -1, 0, "" LOCATE y% + 16, x% + 27, 0: PRINT ""; MakeWindow y% + 15, x% + 30, y% + 17, x% + 34, fg%, bg%, 0, 0, -1, 0, "" LOCATE y% + 16, x% + 31, 0: PRINT ""; MakeWindow y% + 15, x% + 35, y% + 17, x% + 39, fg%, bg%, 0, 0, -1, 0, "" LOCATE y% + 16, x% + 36, 0: PRINT LTRIM$(RTRIM$(STR$(currentYsens%))); ' Gadgets for both. MakeWindow y% + 12, x% + 3, y% + 14, x% + 7, fg%, bg%, 0, 0, -1, 0, "" LOCATE y% + 13, x% + 4, 0: PRINT ""; MakeWindow y% + 12, x% + 8, y% + 14, x% + 12, fg%, bg%, 0, 0, -1, 0, "" LOCATE y% + 13, x% + 10, 0: PRINT ""; MakeWindow y% + 12, x% + 25, y% + 14, x% + 29, fg%, bg%, 0, 0, -1, 0, "" LOCATE y% + 13, x% + 27, 0: PRINT ""; MakeWindow y% + 12, x% + 30, y% + 14, x% + 34, fg%, bg%, 0, 0, -1, 0, "" LOCATE y% + 13, x% + 31, 0: PRINT ""; LOCATE y% + 13, x% + 17, 0: PRINT "BOTH"; '────────────────────────────────────────────────────────────────────────── ' Set the initial sensitivity bar indicators. '────────────────────────────────────────────────────────────────────────── XsiBar$ = STRING$(currentXsens% \ 10, 219) IF ((currentXsens% MOD 10) >= 5) THEN XsiBar$ = XsiBar$ + CHR$(221) END IF XsiBar$ = LEFT$(XsiBar$ + SPACE$(10), 10) LOCATE y% + 10, x% + 14, 0 PRINT XsiBar$; YsiBar$ = STRING$(currentYsens% \ 10, 219) IF ((currentYsens% MOD 10) >= 5) THEN YsiBar$ = YsiBar$ + CHR$(221) END IF YsiBar$ = LEFT$(YsiBar$ + SPACE$(10), 10) LOCATE y% + 16, x% + 14, 0 PRINT YsiBar$; '────────────────────────────────────────────────────────────────────────── ' Now that the whole thing is displayed, we're ready for our event loop. ' We'll be capturing mouse and keyboard events and then acting on them. ' First, though, we'll drain out the mouse and keyboard buffers. '────────────────────────────────────────────────────────────────────────── MouseButtonPressInfo LEFTBUTTON, lmCnt%, mx%, my% MouseButtonPressInfo RIGHTBUTTON, rmCnt%, mx%, my% done% = FALSE DO '──────────────────────────────────────────────────────────────────────── ' Get mouse press information. '──────────────────────────────────────────────────────────────────────── MouseShow ' Don't know why, but had to call MouseShow twice. MouseShow k$ = "" lmCnt% = 0 rmCnt% = 0 MouseButtonPressInfo RIGHTBUTTON, rmCnt%, mx%, my% MouseButtonPressInfo LEFTBUTTON, lmCnt%, mx%, my% '──────────────────────────────────────────────────────────────────────── ' Did we have any left mouse button presses? If not, check the ' keyboard for input. '──────────────────────────────────────────────────────────────────────── IF lmCnt% = 0 THEN k$ = UCASE$(INKEY$) END IF '──────────────────────────────────────────────────────────────────────── ' Check for left mouse button presses on the many hot spots in our ' dialog box. For operations that have keyboard equivalents, simply ' force the setting of k$, our keypress holder, and let the select ' statement handle it later. '──────────────────────────────────────────────────────────────────────── IF (lmCnt%) THEN ' Convert mouse virtual screen coordinates to real 80x25 coordinates. mx% = (mx% / 8) + 1 my% = (my% / 8) + 1 ' OK Button IF (mx% >= x% + 30) AND (mx% <= x% + 39) AND (my% >= y% + 1) AND (my% <= y% + 3) THEN done% = TRUE MouseHide COLOR bpfg%, bpbg% LOCATE y% + 1, x% + 30, 0: PRINT "┌────────╖"; LOCATE y% + 2, x% + 30, 0: PRINT "│ OK ║"; LOCATE y% + 3, x% + 30, 0: PRINT "╘════════╝"; END IF ' Cancel Button IF (mx% >= x% + 30) AND (mx% <= x% + 39) AND (my% >= y% + 4) AND (my% <= y% + 6) THEN done% = TRUE MouseHide COLOR bpfg%, bpbg% LOCATE y% + 4, x% + 30, 0: PRINT "┌────────╖"; LOCATE y% + 5, x% + 30, 0: PRINT "│ Cancel ║"; LOCATE y% + 6, x% + 30, 0: PRINT "╘════════╝"; MouseSetSensitivity oldXsens%, oldYsens%, dst% END IF ' Fast Horizontal down IF (mx% >= x% + 3) AND (mx% <= x% + 7) AND (my% >= y% + 9) AND (my% <= y% + 11) THEN k$ = fastHorzDown$ END IF ' Horizontal down IF (mx% >= x% + 8) AND (mx% <= x% + 12) AND (my% >= y% + 9) AND (my% <= y% + 11) THEN k$ = horzDown$ END IF ' Horizontal Up IF (mx% >= x% + 25) AND (mx% <= x% + 29) AND (my% >= y% + 9) AND (my% <= y% + 11) THEN k$ = horzUp$ END IF ' Fast Horizontal Up IF (mx% >= x% + 30) AND (mx% <= x% + 34) AND (my% >= y% + 9) AND (my% <= y% + 11) THEN k$ = fastHorzUp$ END IF ' Fast Vertical down IF (mx% >= x% + 3) AND (mx% <= x% + 7) AND (my% >= y% + 15) AND (my% <= y% + 17) THEN k$ = fastVertDown$ END IF ' Vertical down IF (mx% >= x% + 8) AND (mx% <= x% + 12) AND (my% >= y% + 15) AND (my% <= y% + 17) THEN k$ = vertDown$ END IF ' Vertical Up IF (mx% >= x% + 25) AND (mx% <= x% + 29) AND (my% >= y% + 15) AND (my% <= y% + 17) THEN k$ = vertUp$ END IF ' Fast Vertical Up IF (mx% >= x% + 30) AND (mx% <= x% + 34) AND (my% >= y% + 15) AND (my% <= y% + 17) THEN k$ = fastVertUp$ END IF ' Fast Both down IF (mx% >= x% + 3) AND (mx% <= x% + 7) AND (my% >= y% + 12) AND (my% <= y% + 14) THEN k$ = fastBothDown$ END IF ' Both down IF (mx% >= x% + 8) AND (mx% <= x% + 12) AND (my% >= y% + 12) AND (my% <= y% + 14) THEN k$ = bothDown$ END IF ' Both Up IF (mx% >= x% + 25) AND (mx% <= x% + 29) AND (my% >= y% + 12) AND (my% <= y% + 14) THEN k$ = bothUp$ END IF ' Fast Both Up IF (mx% >= x% + 30) AND (mx% <= x% + 34) AND (my% >= y% + 12) AND (my% <= y% + 14) THEN k$ = fastBothUp$ END IF END IF ' lmCnt% '──────────────────────────────────────────────────────────────────────── ' Check for right mouse button presses. Any press means abort this ' operation. '──────────────────────────────────────────────────────────────────────── IF (rmCnt%) THEN done% = TRUE MouseHide COLOR bpfg%, bpbg% LOCATE y% + 4, x% + 30, 0: PRINT "┌────────╖"; LOCATE y% + 5, x% + 30, 0: PRINT "│ Cancel ║"; LOCATE y% + 6, x% + 30, 0: PRINT "╘════════╝"; MouseSetSensitivity oldXsens%, oldYsens%, dst% END IF ' rmCnt% '──────────────────────────────────────────────────────────────────────── ' Now act based on any keys that were pressed. This includes all mouse ' operations that have a keyboard equivalent. '──────────────────────────────────────────────────────────────────────── SELECT CASE k$ CASE esc$ MouseSetSensitivity oldXsens%, oldYsens%, dst% done% = TRUE CASE enter$ done% = TRUE CASE fastHorzDown$ IF (currentXsens% > minSens% + 10) THEN currentXsens% = currentXsens% - 10 ELSE currentXsens% = minSens% END IF updateBox% = TRUE CASE horzDown$ IF (currentXsens% > minSens%) THEN currentXsens% = currentXsens% - 1 updateBox% = TRUE END IF CASE horzUp$ IF (currentXsens% < 100) THEN currentXsens% = currentXsens% + 1 updateBox% = TRUE END IF CASE fastHorzUp$ IF (currentXsens% < 90) THEN currentXsens% = currentXsens% + 10 ELSE currentXsens% = 100 END IF updateBox% = TRUE CASE fastVertDown$ IF (currentYsens% > minSens% + 10) THEN currentYsens% = currentYsens% - 10 ELSE currentYsens% = minSens% END IF updateBox% = TRUE CASE vertDown$ IF (currentYsens% > minSens%) THEN currentYsens% = currentYsens% - 1 updateBox% = TRUE END IF CASE vertUp$ IF (currentYsens% < 100) THEN currentYsens% = currentYsens% + 1 updateBox% = TRUE END IF CASE fastVertUp$ IF (currentYsens% < 90) THEN currentYsens% = currentYsens% + 10 ELSE currentYsens% = 100 END IF updateBox% = TRUE CASE fastBothDown$ IF (currentYsens% > minSens% + 10) THEN currentYsens% = currentYsens% - 10 ELSE currentYsens% = minSens% END IF IF (currentXsens% > minSens% + 10) THEN currentXsens% = currentXsens% - 10 ELSE currentXsens% = minSens% END IF updateBox% = TRUE CASE bothDown$ IF (currentYsens% > minSens%) THEN currentYsens% = currentYsens% - 1 updateBox% = TRUE END IF IF (currentXsens% > minSens%) THEN currentXsens% = currentXsens% - 1 updateBox% = TRUE END IF CASE bothUp$ IF (currentYsens% < 100) THEN currentYsens% = currentYsens% + 1 updateBox% = TRUE END IF IF (currentXsens% < 100) THEN currentXsens% = currentXsens% + 1 updateBox% = TRUE END IF CASE fastBothUp$ IF (currentXsens% < 90) THEN currentXsens% = currentXsens% + 10 ELSE currentXsens% = 100 END IF IF (currentYsens% < 90) THEN currentYsens% = currentYsens% + 10 ELSE currentYsens% = 100 END IF updateBox% = TRUE CASE ELSE END SELECT '──────────────────────────────────────────────────────────────────────── ' If something was changed, update everything. This includes: ' ' 1) Sensitivity indicator bars ' 2) Sensitivity indicator values ' 3) Reset mouse sensitivity ' '──────────────────────────────────────────────────────────────────────── IF (updateBox%) THEN '────────────────────────────────────────────────────────────────────── ' Hide mouse whilst we display. '────────────────────────────────────────────────────────────────────── MouseHide '────────────────────────────────────────────────────────────────────── ' Reset update flag. '────────────────────────────────────────────────────────────────────── updateBox% = FALSE '────────────────────────────────────────────────────────────────────── ' Set mouse sensitivity to current levels. '────────────────────────────────────────────────────────────────────── MouseSetSensitivity currentXsens%, currentYsens%, dst% ' (3) '────────────────────────────────────────────────────────────────────── ' Calculate and display new sensitivity indicator bars. '────────────────────────────────────────────────────────────────────── XsiBar$ = STRING$(currentXsens% \ 10, 219) ' (1) IF ((currentXsens% MOD 10) >= 5) THEN XsiBar$ = XsiBar$ + CHR$(221) END IF XsiBar$ = LEFT$(XsiBar$ + SPACE$(10), 10) LOCATE y% + 10, x% + 14, 0 PRINT XsiBar$; YsiBar$ = STRING$(currentYsens% \ 10, 219) IF ((currentYsens% MOD 10) >= 5) THEN YsiBar$ = YsiBar$ + CHR$(221) END IF YsiBar$ = LEFT$(YsiBar$ + SPACE$(10), 10) LOCATE y% + 16, x% + 14, 0 PRINT YsiBar$; '────────────────────────────────────────────────────────────────────── ' Display new values for sensitivities. '────────────────────────────────────────────────────────────────────── LOCATE y% + 10, x% + 36, 0: PRINT LEFT$(LTRIM$(RTRIM$(STR$(currentXsens%))) + SPACE$(3), 3); LOCATE y% + 16, x% + 36, 0: PRINT LEFT$(LTRIM$(RTRIM$(STR$(currentYsens%))) + SPACE$(3), 3); END IF ' updateBox% LOOP UNTIL done% '────────────────────────────────────────────────────────────────────────── ' Now restore what was on the screen before we got here. '────────────────────────────────────────────────────────────────────────── BlockRestore x%, x% + 42, y%, y% + 20, scr%(), GetVideoSegment! END SUB SUB MultiMenu (menusArray$(), numEntries%(), menuTitles$(), x1%, y1%, x2%, justify$, marker$, divider$, frameType%, shadowCode%, fg%, bg%, hfg%, hBG%, qfg%, qbg%, menuSelected%, menuEntrySelected%, useMouse%) '┌──────────────────────────────────────────────────────────────────┐ '│ This routine allows you to create a pull down menu system for │ '│ any program. The parameters are as follows: │ '│ │ '│ menusArray$() - A 2-dimensional array that stores all the │ '│ entries for each menu. The FIRST index │ '│ indicates the particular MENU, while the │ '│ SECOND index indicates the particular entry │ '│ for the menu indicated by the FIRST index. │ '│ numEntries%() - A 1-dimensional array that contains the │ '│ number of actual entries for each menu. │ '│ The index for this array indicates which │ '│ menu you're talking about. │ '│ menuTitles$() - A 1-dimensional array that stores the │ '│ title of each menu. │ '│ x1% - Starting column of menu bar. │ '│ y1% - Starting row of menu bar. │ '│ x2% - Ending column of menu bar. │ '│ justify$ - A single text character indicating the type │ '│ of justification to use when displaying the │ '│ menu will use when displaying the entries │ '│ of each sub-menu. The valid values are: │ '│ "C" - Centered │ '│ "L" - Left justified │ '│ "R" - Right justified │ '│ marker$ - A single character used to identify the │ '│ 'Quick Access' key for each menu entry. │ '│ divider$ - Character or string used as a menu divider. │ '│ shadowCode% - A value indicating the type of shadowing │ '│ to use for the menu windows. Valid values: │ '│ -1 - No shadow at all │ '│ 0-15 - Shadow of this color │ '│ 16 - Special character shadow │ '│ fg%, bg% - The foreground and background colors of the │ '│ normal, unhighlighted menu entries │ '│ hfg%, hbg% - The foreground and background colors of the │ '│ highlighted menu entries │ '│ qfg%, qbg% - The foreground and background colors of the │ '│ 'Quick Access' letters │ '│ menuSelected% - This variable is an 'out' parameter. It │ '│ has no value when you call the routine. │ '│ When the MultiMenu returns to the calling │ '│ routine, this variable will contain the │ '│ number of the menu the user made his/her │ '│ selection from. │ '│ menuEntrySelected% - This variable is an 'out' parameter. │ '│ It has no value when you call the routine. │ '│ When the MultiMenu returns to the calling │ '│ routine, this variable will contain the │ '│ number of the entry the user selected on │ '│ the menu indicated by menuSelected%. │ '│ useMouse% - 1 = use mouse support, 0 = don't. │ '│ │ '│ See the QBSCR Screen Routines documentation for more details. │ '└──────────────────────────────────────────────────────────────────┘ '──────────────────────────────────────────────────────────────────── ' Define special keys '──────────────────────────────────────────────────────────────────── LeftArrowKey$ = CHR$(0) + CHR$(75) RightArrowKey$ = CHR$(0) + CHR$(77) DownArrowKey$ = CHR$(0) + CHR$(80) HomeKee$ = CHR$(0) + CHR$(71) EndKee$ = CHR$(0) + CHR$(79) enter$ = CHR$(13) esc$ = CHR$(27) '──────────────────────────────────────────────────────────────────── ' Determine number of menus '──────────────────────────────────────────────────────────────────── numMenus% = UBOUND(menusArray$, 1) '──────────────────────────────────────────────────────────────────── ' Define an array that will store the column locations or each menu ' title string. '──────────────────────────────────────────────────────────────────── DIM menuXs%(numMenus%) '──────────────────────────────────────────────────────────────────── ' Determine all QuickAccess keys for the menu titles, as well as the ' starting screen column that each menu item will be displayed on. ' Also, as long as we're here, determine the x-coordinate for each ' menu title. '──────────────────────────────────────────────────────────────────── DIM charID(1 TO numMenus%) AS STRING * 1 FOR x% = 1 TO numMenus% '────────────────────────────────────────────────────────────────── ' Get starting columns for each menu title. '────────────────────────────────────────────────────────────────── IF (x% > 1) THEN menuXs%(x%) = menuXs%(x% - 1) + LEN(menuTitles$(x% - 1)) + 1 ELSE menuXs%(x%) = x1% + 1 END IF '────────────────────────────────────────────────────────────────── ' Determine quick access key for menu item. '────────────────────────────────────────────────────────────────── FOR y% = 1 TO LEN(menuTitles$(x%)) IF MID$(menuTitles$(x%), y%, 1) = marker$ THEN charID(x%) = UCASE$(MID$(menuTitles$(x%), y% + 1, 1)) EXIT FOR END IF NEXT y% NEXT x% '───────────────────────────────────────────────────────────────────── ' At this point, we must turn off the mouse cursor if it's available. ' We don't want to write overtop of it, leaving a hole when it's moved ' later. '───────────────────────────────────────────────────────────────────── IF useMouse% THEN MouseHide END IF '──────────────────────────────────────────────────────────────────── ' Display pull-down menus line '──────────────────────────────────────────────────────────────────── COLOR fg%, bg% LOCATE y1%, x1%, 0: PRINT SPACE$(x2% - x1% + 1); colCount% = 0 FOR x% = 1 TO numMenus% LOCATE y1%, x1% + colCount% + 1, 0: DisplayEntry menuTitles$(x%), qfg%, qbg%, hfg%, hBG%, fg%, bg%, marker$, divider$, wid%, 1 colCount% = colCount% + LEN(menuTitles$(x%)) + 1 NEXT x% '──────────────────────────────────────────────────────────────────── ' Display highlight for first entry '──────────────────────────────────────────────────────────────────── COLOR hfg%, hBG% LOCATE y1%, x1% + 1, 0: DisplayEntry menuTitles$(1), qfg%, qbg%, hfg%, hBG%, fg%, bg%, marker$, divider$, wid%, 2 '──────────────────────────────────────────────────────────────────── ' Wait for keystrokes '──────────────────────────────────────────────────────────────────── currentMenu% = 1 oldMenu% = 1 done% = FALSE updateMenu% = FALSE DO '────────────────────────────────────────────────────────────────── ' If we're using the mouse, turn it on. '────────────────────────────────────────────────────────────────── IF useMouse% THEN MouseShow END IF '────────────────────────────────────────────────────────────────── ' Read keystrokes and/or mouse strokes. '────────────────────────────────────────────────────────────────── k$ = "" lmCnt% = 0 rmCnt% = 0 IF useMouse% THEN MouseButtonPressInfo RIGHTBUTTON, rmCnt%, mx%, my% MouseButtonPressInfo LEFTBUTTON, lmCnt%, mx%, my% '──────────────────────────────────────────────────────────────── ' Did we have any left mouse button presses? If not, check the ' keyboard for input. '──────────────────────────────────────────────────────────────── IF lmCnt% = 0 THEN k$ = UCASE$(INKEY$) END IF ELSE '──────────────────────────────────────────────────────────────── ' No mouse available, so wait for keyboard input. '──────────────────────────────────────────────────────────────── WHILE k$ = "" k$ = UCASE$(INKEY$) WEND END IF '───────────────────────────────────────────────────────────────────── ' If the left mouse button was pressed, check to see if a menu item ' was selected by it. '───────────────────────────────────────────────────────────────────── IF (useMouse%) AND (lmCnt% > 0) THEN '─────────────────────────────────────────────────────────────────── ' Convert virtual screen mouse coordinates to real 80x25 coords. '─────────────────────────────────────────────────────────────────── mx% = (mx% \ 8) + 1 my% = (my% \ 8) + 1 '─────────────────────────────────────────────────────────────────── ' If mouse was inside menu bar then update currentMenu% '─────────────────────────────────────────────────────────────────── IF (my% = y1%) THEN FOR i% = 1 TO numMenus% IF (mx% >= menuXs%(i%)) AND (mx% <= menuXs%(i%) + LEN(menuTitles$(i%))) THEN currentMenu% = i% updateMenu% = TRUE done% = TRUE EXIT FOR END IF NEXT i% END IF END IF '───────────────────────────────────────────────────────────────────── ' If right mouse button was pressed, then exit as if ESC were pressed. '───────────────────────────────────────────────────────────────────── IF (useMouse%) AND (rmCnt% > 0) THEN menuSelected% = 0 menuEntrySelected% = 0 EXIT SUB END IF '───────────────────────────────────────────────────────────────────── ' If keys were pressed, act on them. '───────────────────────────────────────────────────────────────────── SELECT CASE k$ CASE LeftArrowKey$ ' Move highlight to the left IF currentMenu% > 1 THEN currentMenu% = currentMenu% - 1 ELSE currentMenu% = numMenus% END IF updateMenu% = TRUE CASE RightArrowKey$ ' Move highlight to the right IF currentMenu% < numMenus% THEN currentMenu% = currentMenu% + 1 ELSE currentMenu% = 1 END IF updateMenu% = TRUE CASE HomeKee$ currentMenu% = 1 updateMenu% = TRUE CASE EndKee$ currentMenu% = numMenus% updateMenu% = TRUE CASE enter$, DownArrowKey$ ' Use the current menu and exit DO done% = TRUE CASE esc$ ' Abort MultiMenu call menuSelected% = 0 menuEntrySelected% = 0 EXIT SUB CASE ELSE '──────────────────────────────────────────────────────────── ' Check for special quick access keys '──────────────────────────────────────────────────────────── FOR x% = 1 TO numMenus% IF k$ = charID(x%) THEN currentMenu% = x% done% = TRUE updateMenu% = TRUE EXIT FOR END IF NEXT x% END SELECT '──────────────────────────────────────────────────────────────── ' Update highlight, if required. '──────────────────────────────────────────────────────────────── IF updateMenu% THEN IF useMouse% THEN MouseHide END IF LOCATE y1%, menuXs%(oldMenu%), 0: DisplayEntry menuTitles$(oldMenu%), qfg%, qbg%, hfg%, hBG%, fg%, bg%, marker$, divider$, wid%, 1 oldMenu% = currentMenu% LOCATE y1%, menuXs%(currentMenu%), 0: DisplayEntry menuTitles$(currentMenu%), qfg%, qbg%, hfg%, hBG%, fg%, bg%, marker$, divider$, wid%, 2 updateMenu% = FALSE END IF colCount% = 0 LOOP UNTIL done% '───────────────────────────────────────────────────────────────────── ' At this point, we must turn off the mouse cursor if it's available. ' We don't want to write overtop of it, leaving a hole when it's moved ' later. '───────────────────────────────────────────────────────────────────── IF useMouse% THEN MouseHide END IF '──────────────────────────────────────────────────────────────────── ' Now we know the first menu to display. Loop while the user hits ' the left or right arrow keys '──────────────────────────────────────────────────────────────────── done% = FALSE DO '──────────────────────────────────────────────────────────────── ' Calculate the longest menu entry in the list '──────────────────────────────────────────────────────────────── longestEntry% = 0 FOR x% = 1 TO numEntries%(currentMenu%) IF longestEntry% < LEN(menusArray$(currentMenu%, x%)) THEN longestEntry% = LEN(menusArray$(currentMenu%, x%)) END IF NEXT x% '──────────────────────────────────────────────────────────────── ' Calculate box dimensions '──────────────────────────────────────────────────────────────── lft% = menuXs%(currentMenu%) - 1 IF lft% < x1% THEN lft% = x1% END IF rght% = lft% + longestEntry% + 2 IF rght% > x2% THEN lft% = lft% - (rght% - x2%) rght% = x2% END IF top% = y1% + 1 bot% = top% + numEntries%(currentMenu%) + 1 '──────────────────────────────────────────────────────────────── ' Ony draw a box if we have menu entries to put in it. '──────────────────────────────────────────────────────────────── IF numEntries%(currentMenu%) > 0 THEN '──────────────────────────────────────────────────────────────── ' Save area of the screen that the window overwrites. '──────────────────────────────────────────────────────────────── REDIM blockArray%(BlockSize%(lft%, rght% + 2, top%, bot% + 1)) BlockSave lft%, rght% + 2, top%, bot% + 1, blockArray%(), GetVideoSegment '──────────────────────────────────────────────────────────────── ' Make the window to hold the entries. '──────────────────────────────────────────────────────────────── MakeWindow CSNG(top%), CSNG(lft%), CSNG(bot%), CSNG(rght%), fg%, bg%, 0, frameType%, shadowCode%, 0, "" '──────────────────────────────────────────────────────────────── ' Make the menu for the current menu '──────────────────────────────────────────────────────────────── choice% = SubMenu%(menusArray$(), currentMenu%, numEntries%(currentMenu%), justify$, lft% + 2, CSNG(rght%), top% + 1, marker$, divider$, fg%, bg%, hfg%, hBG%, qfg%, qbg%, useMouse%, mx%, my%) ELSE '──────────────────────────────────────────────────────────────── ' This section of code handles the case where there are no menu ' entries in the submenu, or in other words, no submenu at all. '──────────────────────────────────────────────────────────────── menuSelected% = currentMenu% menuEntrySelected% = 0 IF (k$ = LeftArrowKey$) OR (k$ = RightArrowKey$) OR (choice% = LEFTARROWCODE) OR (choice% = RIGHTARROWCODE) THEN choice% = 0 WHILE choice% = 0 kee$ = "" WHILE kee$ = "" kee$ = UCASE$(INKEY$) WEND SELECT CASE kee$ CASE LeftArrowKey$: choice% = LEFTARROWCODE CASE RightArrowKey$: choice% = RIGHTARROWCODE CASE enter$: EXIT SUB CASE ELSE END SELECT WEND ELSE EXIT SUB END IF END IF '──────────────────────────────────────────────────────────────── ' Decide what to do based on the returned value of the call to ' the SubMenu function, which handles the individual menus '──────────────────────────────────────────────────────────────── SELECT CASE choice% CASE LEFTARROWCODE ' Move to the next menu to the left IF currentMenu% > 1 THEN currentMenu% = currentMenu% - 1 ELSE currentMenu% = numMenus% END IF CASE RIGHTARROWCODE ' Move to the next menu to the right IF currentMenu% < numMenus% THEN currentMenu% = currentMenu% + 1 ELSE currentMenu% = 1 END IF CASE LEFTMOUSEEXIT ' Find out if mouse was on a menu title. FOR i% = 1 TO numMenus% IF (mx% >= menuXs%(i%)) AND (mx% <= menuXs%(i%) + LEN(menuTitles$(i%))) THEN currentMenu% = i% EXIT FOR END IF NEXT i% CASE RIGHTMOUSEEXIT menuSelected% = 0 menuEntrySelected% = 0 EXIT SUB CASE 1 TO numEntries%(currentMenu%) ' See if an entry from the menu menuEntrySelected% = choice% ' was selected menuSelected% = currentMenu% EXIT SUB CASE 27 ' Escape ∙ Abort the menu menuEntrySelected% = 0 menuSelected% = 0 done% = TRUE CASE ELSE END SELECT '──────────────────────────────────────────────────────────────── ' Update highlight '──────────────────────────────────────────────────────────────── IF useMouse% THEN MouseHide END IF LOCATE y1%, menuXs%(oldMenu%), 0: DisplayEntry menuTitles$(oldMenu%), qfg%, qbg%, hfg%, hBG%, fg%, bg%, marker$, divider$, wid%, 1 oldMenu% = currentMenu% LOCATE y1%, menuXs%(currentMenu%), 0: DisplayEntry menuTitles$(currentMenu%), qfg%, qbg%, hfg%, hBG%, fg%, bg%, marker$, divider$, wid%, 2 '──────────────────────────────────────────────────────────────── ' Restore screen block '──────────────────────────────────────────────────────────────── BlockRestore lft%, rght% + 2, top%, bot% + 1, blockArray%(), GetVideoSegment LOOP UNTIL done% END SUB SUB OffCenter (st$, row%, leftCol%, rightCol%) '┌────────────────────────────────────────────────────────────────────────┐ '│ This routine will center the text passed to it on the screen between │ '│ two specified columns. Excellent for centering text in a window │ '│ that itself is not centered in the screen. Parameters are: │ '│ │ '│ st$ - the string to center. Maximum length of string is 80 │ '│ characters. │ '│ row% - The row on which the string will be centered. Allowable │ '│ range is 1 through 25. │ '│ leftCol! - The left-most column to center the text between. │ '│ Allowable range is 1 through 79. │ '│ rightCol! - The right-most column to center the text between. │ '│ Allowable range is 2 through 80. │ '└────────────────────────────────────────────────────────────────────────┘ '───────────────────────────────────────────────────────────────────────── ' Calculate width available for string '───────────────────────────────────────────────────────────────────────── wdth% = (rightCol% - leftCol%) '───────────────────────────────────────────────────────────────────────── ' If ST$ fits in available width, determine X% for Locate. Otherwise, ' quit the routine. '───────────────────────────────────────────────────────────────────────── IF LEN(st$) > wdth% THEN EXIT SUB ELSE x% = INT(((wdth% - (LEN(st$))) \ 2) + leftCol%) + 1 END IF '───────────────────────────────────────────────────────────────────────── ' Print the string '───────────────────────────────────────────────────────────────────────── LOCATE row%, x%: PRINT st$; END SUB FUNCTION OkCancelMessageBox% (x1%, y1%, x2%, y2%, st$(), numLines%, justify%, fg%, bg%, frType%, shadow%, explode%, label$, useMouse%, buttonBorder%, buttonStyle%) '┌────────────────────────────────────────────────────────────────────────┐ '│ This routine will display a window that contains a message that is │ '│ passed in by the caller. If a mouse is available (indicated by the │ '│ useMouse% parameter), an OK button will be available to click on to │ '│ indicate user acceptance, and a Cancel button to indicate user │ '│ rejection. A return value of TRUE is OK, FALSE is Cancel. │ '│ │ '│ x1% - Upper-left corner column of box │ '│ y1% - Upper-left corner row of box │ '│ x2% - Lower-right corner column of box │ '│ y2% - Lower-right corner column of box │ '│ st$() - An array of strings to display as the message │ '│ numLines% - The number of lines in the array st$() │ '│ justify% - 0 = Flush Left, 1 = Flush Right, 2 = Centered. Also │ '│ there are constants defined in QBSCR.INC you may use in │ '│ place of these numbers: FLUSHLEFT, FLUSHRIGHT, and CENTERED. │ '│ fg% - The foreground color to use for display of the window and │ '│ text contained in it. │ '│ bg% - The background color to use for display of the window and │ '│ text contained in it. │ '│ bpfg% - The foreground color for a pressed button. │ '│ bpbg% - The background color for a pressed button. │ '│ frType% - The type of frame to use for the window. │ '│ shadow% - Shadow type to use for window. │ '│ explode% - Explode mode to use for window. │ '│ label$ - The window label string. │ '│ useMouse% - 1 = use mouse support, 0 = don't. │ '│ │ '└────────────────────────────────────────────────────────────────────────┘ '───────────────────────────────────────────────────────────────────────── ' Define a couple of special keys. '───────────────────────────────────────────────────────────────────────── enter$ = CHR$(13) esc$ = CHR$(27) '───────────────────────────────────────────────────────────────────────── ' First step is to turn off the mouse if we plan to use it. This is to ' prevent us from screwing up the display by drawing over top of it. '───────────────────────────────────────────────────────────────────────── IF useMouse% THEN MouseHide END IF '───────────────────────────────────────────────────────────────────────── ' Now display the window that will contain the message. '───────────────────────────────────────────────────────────────────────── MakeWindow CSNG(y1%), CSNG(x1%), CSNG(y2%), CSNG(x2%), fg%, bg%, 0, frType%, shadow%, explode%, label$ '───────────────────────────────────────────────────────────────────────── ' Now display the text passed in as a message. The constants used here, ' FLUSHLEFT, FLUSHRIGHT, and CENTERED, are found in the QBSCR.INC file. '───────────────────────────────────────────────────────────────────────── COLOR fg%, bg% SELECT CASE justify% CASE FLUSHLEFT FOR i% = 1 TO numLines% LOCATE y1% + 1 + i%, x1% + 3, 0 PRINT st$(i%); NEXT i% CASE FLUSHRIGHT FOR i% = 1 TO numLines% st$(i%) = RIGHT$(SPACE$(LEN(st$(i%))) + st$(i%), x2% - x1% - 5) LOCATE y1% + 1 + i%, x1% + 3, 0 PRINT st$(i%); NEXT i% CASE CENTERED FOR i% = 1 TO numLines% OffCenter st$(i%), y1% + i% + 1, x1%, x2% NEXT i% CASE ELSE END SELECT '───────────────────────────────────────────────────────────────────────── ' If we are to use the mouse, display a bitton to click on. If not, then ' Display a text message on the bottom line of the window. '───────────────────────────────────────────────────────────────────────── IF useMouse% THEN DrawButton buttonBorder%, x1% + 2, y2% - 3, x1% + 11, y2% - 1, fg%, bg%, "OK", buttonStyle% DrawButton buttonBorder%, x1% + 13, y2% - 3, x1% + 22, y2% - 1, fg%, bg%, "Cancel", buttonStyle% ELSE IF (x2% - x1% >= 26) THEN OffCenter " Enter = OK, Esc = Cancel ", y2% - 1, x1%, x2% ELSEIF (x2% - x1% >= 14) THEN OffCenter " Enter = OK ", y2% - 2, x1%, x2% OffCenter " Esc = CANCEL ", y2% - 1, x1%, x2% END IF END IF '───────────────────────────────────────────────────────────────────────── ' Now we wait. If the mouse was clicked inside the button, then we're ' done. If ESC or ENTER was hit, we're done. If O (for OK) was hit, then ' we're done. If the right mouse button is clicked, we're done. If C ' (for Cancel) was hit, we're done. If the left button was clicked in the ' Cancel button, we're done. '───────────────────────────────────────────────────────────────────────── MouseButtonPressInfo LEFTBUTTON, lmCnt%, mx%, my% MouseButtonPressInfo RIGHTBUTTON, rmCnt%, mx%, my% lmcCnt% = 0 rmCnt% = 0 done% = FALSE DO '─────────────────────────────────────────────────────────────────────── ' Get some input, mouse or keyboard. '─────────────────────────────────────────────────────────────────────── k$ = "" lmCnt% = 0 rmCnt% = 0 IF useMouse% THEN '───────────────────────────────────────────────────────────────────── ' Turn the mouse cursor on. '───────────────────────────────────────────────────────────────────── MouseShow '───────────────────────────────────────────────────────────────────── ' Did we have any left mouse button presses? If not, check the ' keyboard for input. '───────────────────────────────────────────────────────────────────── MouseButtonPressInfo RIGHTBUTTON, rmCnt%, mx%, my% MouseButtonPressInfo LEFTBUTTON, lmCnt%, mx%, my% mx% = (mx% / 8) + 1 my% = (my% / 8) + 1 IF (lmCnt% = 0) AND (rmCnt% = 0) THEN k$ = UCASE$(INKEY$) END IF ELSE '───────────────────────────────────────────────────────────────────── ' No mouse available, so wait for keyboard input. '───────────────────────────────────────────────────────────────────── WHILE k$ = "" k$ = UCASE$(INKEY$) WEND END IF '─────────────────────────────────────────────────────────────────────── ' Act based on user's input, if there was any. First check the left ' mouse button for activity. '─────────────────────────────────────────────────────────────────────── IF (lmCnt%) THEN ' OK Button. DrawButton buttonBorder%, x1% + 2, y2% - 3, x1% + 11, y2% - 1, fg%, bg%, "OK", buttonStyle% IF (mx% >= x1% + 2) AND (mx% <= x1% + 11) AND (my% >= y2% - 3) AND (my% <= y2% - 1) THEN done% = TRUE result% = TRUE IF mouseExists% THEN MouseHide END IF PressButton buttonBorder%, x1% + 2, y2% - 3, x1% + 11, y2% - 1, fg%, bg%, "OK", buttonStyle% END IF ' Cancel Button. IF (mx% >= x1% + 13) AND (mx% <= x1% + 22) AND (my% >= y2% - 3) AND (my% <= y2% - 1) THEN done% = TRUE result% = FALSE IF mouseExists% THEN MouseHide END IF PressButton buttonBorder%, x1% + 13, y2% - 3, x1% + 22, y2% - 1, fg%, bg%, "Cancel", buttonStyle% 'COLOR bpfg%, bpbg% 'LOCATE y2% - 3, x1% + 13, 0: PRINT "┌────────╖"; 'LOCATE y2% - 2, x1% + 13, 0: PRINT "│ Cancel ║"; 'LOCATE y2% - 1, x1% + 13, 0: PRINT "╘════════╝"; END IF END IF '─────────────────────────────────────────────────────────────────────── ' Now see if the right mouse button was pressed. '─────────────────────────────────────────────────────────────────────── IF (rmCnt%) THEN done% = TRUE result% = FALSE END IF '─────────────────────────────────────────────────────────────────────── ' Were any of the exit keys pressed on the keyboard? '─────────────────────────────────────────────────────────────────────── SELECT CASE k$ CASE enter$, "O" done% = TRUE result% = TRUE CASE esc$, "C" done% = TRUE result% = FALSE CASE ELSE END SELECT LOOP UNTIL done% '───────────────────────────────────────────────────────────────────────── ' Return the result of the user's action. '───────────────────────────────────────────────────────────────────────── OkCancelMessageBox% = result% END FUNCTION SUB OkMessageBox (x1%, y1%, x2%, y2%, st$(), numLines%, justify%, fg%, bg%, frType%, shadow%, explode%, label$, useMouse%, buttonBorder%, buttonStyle%) '┌────────────────────────────────────────────────────────────────────────┐ '│ This routine will display a window tha contains a message that is │ '│ passed in by the caller. If a mouse is available (indicated by the │ '│ useMouse% parameter), an OK button will be available to click on to │ '│ indicate user completion. There is no return value. │ '│ │ '│ x1% - Upper-left corner column of box │ '│ y1% - Upper-left corner row of box │ '│ x2% - Lower-right corner column of box │ '│ y2% - Lower-right corner column of box │ '│ st$() - An array of strings to display as the message │ '│ numLines% - The number of lines in the array st$() │ '│ justify% - 0 = Flush Left, 1 = Flush Right, 2 = Centered. Also │ '│ there are constants defined in QBSCR.INC you may use in │ '│ place of these numbers: FLUSHLEFT, FLUSHRIGHT, and CENTERED. │ '│ fg% - The foreground color to use for display of the window and │ '│ text contained in it. │ '│ bg% - The background color to use for display of the window and │ '│ text contained in it. │ '│ bpfg% - The foreground color for a pressed button. │ '│ bpbg% - The background color for a pressed button. │ '│ frType% - The type of frame to use for the window. │ '│ shadow% - Shadow type to use for window. │ '│ explode% - Explode mode to use for window. │ '│ label$ - The window label string. │ '│ useMouse% - 1 = use mouse support, 0 = don't. │ '│ │ '└────────────────────────────────────────────────────────────────────────┘ enter$ = CHR$(13) esc$ = CHR$(27) '───────────────────────────────────────────────────────────────────────── ' First step is to turn off the mouse if we plan to use it. This is to ' prevent us from screwing up the display by drawing over top of it. '───────────────────────────────────────────────────────────────────────── IF useMouse% THEN MouseHide END IF '───────────────────────────────────────────────────────────────────────── ' Now display the window that will contain the message. '───────────────────────────────────────────────────────────────────────── MakeWindow CSNG(y1%), CSNG(x1%), CSNG(y2%), CSNG(x2%), fg%, bg%, 0, frType%, shadow%, explode%, label$ '───────────────────────────────────────────────────────────────────────── ' Now display the text passed in as a message. These constants are ' defined in QBSCR.INC. '───────────────────────────────────────────────────────────────────────── COLOR fg%, bg% SELECT CASE justify% CASE FLUSHLEFT FOR i% = 1 TO numLines% LOCATE y1% + 1 + i%, x1% + 3, 0 PRINT st$(i%); NEXT i% CASE FLUSHRIGHT FOR i% = 1 TO numLines% st$(i%) = RIGHT$(SPACE$(LEN(st$(i%))) + st$(i%), x2% - x1% - 5) LOCATE y1% + 1 + i%, x1% + 3, 0 PRINT st$(i%); NEXT i% CASE CENTERED FOR i% = 1 TO numLines% OffCenter st$(i%), y1% + i% + 1, x1%, x2% NEXT i% CASE ELSE END SELECT '───────────────────────────────────────────────────────────────────────── ' If we are to use the mouse, display a bitton to click on. If not, then ' Display a text message on the bottom line of the window. '───────────────────────────────────────────────────────────────────────── IF useMouse% THEN DrawButton buttonBorder%, x1% + 2, y2% - 3, x1% + 11, y2% - 1, fg%, bg%, "OK", buttonStyle% ELSE OffCenter " Hit any key ", y2% - 1, x1%, x2% END IF '───────────────────────────────────────────────────────────────────────── ' Now we wait. If the mouse was clicked inside the button, then we're ' done. If ESC or ENTER was hit, we're done. If O (for OK) was hit, then ' we're done. If the right mouse button is clicked, we're done. '───────────────────────────────────────────────────────────────────────── MouseButtonPressInfo LEFTBUTTON, lmCnt%, mx%, my% MouseButtonPressInfo RIGHTBUTTON, rmCnt%, mx%, my% lmcCnt% = 0 rmCnt% = 0 done% = FALSE DO '─────────────────────────────────────────────────────────────────────── ' Get some input, mouse or keyboard. '─────────────────────────────────────────────────────────────────────── k$ = "" lmCnt% = 0 rmCnt% = 0 IF useMouse% THEN MouseShow '───────────────────────────────────────────────────────────────────── ' Did we have any left mouse button presses? If not, check the ' keyboard for input. '───────────────────────────────────────────────────────────────────── MouseButtonPressInfo RIGHTBUTTON, rmCnt%, mx%, my% MouseButtonPressInfo LEFTBUTTON, lmCnt%, mx%, my% mx% = (mx% / 8) + 1 my% = (my% / 8) + 1 IF (lmCnt% = 0) AND (rmCnt% = 0) THEN k$ = UCASE$(INKEY$) END IF ELSE '───────────────────────────────────────────────────────────────────── ' No mouse available, so wait for keyboard input. '───────────────────────────────────────────────────────────────────── WHILE k$ = "" k$ = UCASE$(INKEY$) WEND END IF '─────────────────────────────────────────────────────────────────────── ' Act based on user's input, if there was any. First check the left ' mouse button for activity. '─────────────────────────────────────────────────────────────────────── IF (lmCnt%) THEN IF (mx% >= x1% + 2) AND (mx% <= x1% + 11) AND (my% >= y2% - 3) AND (my% <= y2% - 1) THEN done% = TRUE IF mouseExists% THEN MouseHide END IF PressButton buttonBorder%, x1% + 2, y2% - 3, x1% + 11, y2% - 1, fg%, bg%, "OK", buttonStyle% ' COLOR bpfg%, bpbg% ' LOCATE y2% - 3, x1% + 2, 0: PRINT "┌────────╖"; ' LOCATE y2% - 2, x1% + 2, 0: PRINT "│ OK ║"; ' LOCATE y2% - 1, x1% + 2, 0: PRINT "╘════════╝"; END IF END IF '─────────────────────────────────────────────────────────────────────── ' Now see if the right mouse button was pressed. '─────────────────────────────────────────────────────────────────────── IF (rmCnt%) THEN done% = TRUE END IF '─────────────────────────────────────────────────────────────────────── ' Were any of the exit keys pressed on the keyboard? '─────────────────────────────────────────────────────────────────────── SELECT CASE k$ CASE esc$, enter$, "O" done% = TRUE CASE ELSE END SELECT LOOP UNTIL done% END SUB SUB PutScreen (file$) '┌──────────────────────────────────────────────────────────────────┐ '│ This subprogram will copy the contents of a file that was saved │ '│ using the QBSCR GetScreen subprogram (or Screen Builder)into │ '│ video RAM. The result is a very fast retrieval and display of │ '│ a video screen. │ '└──────────────────────────────────────────────────────────────────┘ '──────────────────────────────────────────────────────────────────── ' Set the memory segment to the address of screen memory '──────────────────────────────────────────────────────────────────── DEF SEG = GetVideoSegment! '──────────────────────────────────────────────────────────────────── ' Use the BASIC BLOAD statement to load the saved screen to video RAM '──────────────────────────────────────────────────────────────────── LOCATE 1, 1, 0 BLOAD file$, 0 '──────────────────────────────────────────────────────────────────── ' Restore BASIC's default data segment '──────────────────────────────────────────────────────────────────── DEF SEG END SUB SUB QBPrint (st$, row%, col%, fore%, back%) '────────────────────────────────────────────────────────────────────── ' Calculate video memory offset, where display will begin '────────────────────────────────────────────────────────────────────── offset% = 160 * (row% - 1) + 2 * (col% - 1) '────────────────────────────────────────────────────────────────────── ' Calculate color byte for string '────────────────────────────────────────────────────────────────────── IF fore% > 15 THEN blinkingFore% = TRUE fore% = fore% - 16 ELSE blinkingFore% = FALSE END IF attribute% = (back% * 16) + fore% IF blinkingFore% THEN attribute% = attribute% + 128 END IF '────────────────────────────────────────────────────────────────────── ' Set default data segment to screen memory '────────────────────────────────────────────────────────────────────── DEF SEG = GetVideoSegment '────────────────────────────────────────────────────────────────────── ' Place the string into video memory, along with the color '────────────────────────────────────────────────────────────────────── stPos% = 1 FOR x% = 0 TO ((LEN(st$) - 1) * 2) STEP 2 POKE x% + offset%, ASC(MID$(st$, stPos%, 1)) POKE x% + offset% + 1, attribute% stPos% = stPos% + 1 NEXT x% '────────────────────────────────────────────────────────────────────── ' Restore BASIC's default data segment '────────────────────────────────────────────────────────────────────── DEF SEG END SUB FUNCTION ScreenBlank$ (delay!, useMouse%) '┌────────────────────────────────────────────────────────────────────────┐ '│ This routine blanks out the screen and displays a message informing │ '│ the user of this. To prevent this message from burning into the │ '│ screen, it changes place periodically. The Delay parameter is a │ '│ numerical variable used in a dummy wait loop. Change this value │ '│ based on the speed of your machine. This routine returns the key │ '│ the user pressed to restore the screen, in case you want to use it. │ '│ │ '│ Parameters are as follows: │ '│ │ '│ delay - Numerical delay value. │ '│ useMouse% - 1 = use mouse support, 0 = don't. │ '└────────────────────────────────────────────────────────────────────────┘ '───────────────────────────────────────────────────────────────────────── ' Drain keys and mouse presses from buffers. '───────────────────────────────────────────────────────────────────────── WHILE INKEY$ <> "" WEND MouseButtonPressInfo LEFTBUTTON, lmCnt%, mx%, my% MouseButtonPressInfo RIGHTBUTTON, rmCnt%, mx%, my% MouseButtonPressInfo CENTERBUTTON, cmCnt%, mx%, my% MousePosition oldMouseX%, oldMouseY% lmCnt% = 0 rmCnt% = 0 cmCnt% = 0 MouseHide '───────────────────────────────────────────────────────────────────────── ' Seed the random number generator with the TIMER function '───────────────────────────────────────────────────────────────────────── RANDOMIZE TIMER '───────────────────────────────────────────────────────────────────────── ' Initialize local variables, set colors and clear the screen '───────────────────────────────────────────────────────────────────────── blankCount! = 0: key$ = "": COLOR 7, 0: CLS '───────────────────────────────────────────────────────────────────────── ' Display the informational message '───────────────────────────────────────────────────────────────────────── GOSUB BounceMessage '───────────────────────────────────────────────────────────────────────── ' While the user has not hit a key, increment our delay counter '───────────────────────────────────────────────────────────────────────── WHILE key$ = "" AND lmCnt% = 0 AND rmCnt% = 0 AND cmCnt% = 0 AND mx% = oldMouseX% AND my% = oldMouseY% MouseButtonPressInfo LEFTBUTTON, lmCnt%, mx%, my% MouseButtonPressInfo RIGHTBUTTON, rmCnt%, mx%, my% MouseButtonPressInfo CENTERBUTTON, cmCnt%, mx%, my% MousePosition mx%, my% key$ = INKEY$ blankCount! = blankCount! + 1 '───────────────────────────────────────────────────────────────────── ' If our counter reaches our delay, then move the screen message '───────────────────────────────────────────────────────────────────── IF blankCount! > delay! THEN blankCount! = 0: CLS GOSUB BounceMessage END IF WEND '───────────────────────────────────────────────────────────────────────── ' Assign the key hit to the function and exit '───────────────────────────────────────────────────────────────────────── ScreenBlank$ = key$ EXIT FUNCTION '───────────────────────────────────────────────────────────────────────── ' This little subroutine moves the informational message to a new ' location on the screen '───────────────────────────────────────────────────────────────────────── BounceMessage: '───────────────────────────────────────────────────────────────────────── ' Clear the screen '───────────────────────────────────────────────────────────────────────── CLS '───────────────────────────────────────────────────────────────────────── ' Calculate new X and Y coordinates for the message randomly '───────────────────────────────────────────────────────────────────────── xCoord% = INT(RND(1) * 38) + 1 yCoord% = INT(RND(1) * 24) + 1 '───────────────────────────────────────────────────────────────────────── ' Display the message at the new X and Y coordinates '───────────────────────────────────────────────────────────────────────── LOCATE yCoord%, xCoord%, 0: PRINT "Screen has been blanked to prevent burn-in."; IF useMouse% THEN LOCATE yCoord% + 1, xCoord%, 0: PRINT " Hit any key or mouse button to return..."; ELSE LOCATE yCoord% + 1, xCoord%, 0: PRINT " Hit any key to return..."; END IF '───────────────────────────────────────────────────────────────────────── ' Return to the wait loop '───────────────────────────────────────────────────────────────────────── RETURN END FUNCTION SUB ScrnRestore (firstLine%, lastLine%, scrArray%(), segment) '┌────────────────────────────────────────────────────────────────────────┐ '│ This routine will restore all or a portion of the screen display from │ '│ an integer array. For more implementation details, see the QBSCR │ '│ reference manual. │ '│ │ '│ Parameters are as follows: │ '│ │ '│ firstLine% - The first line of the display where restore should │ '│ begin. Top line is 1, bottom is 25. │ '│ lastLine% - The last line of the display where restore should │ '│ end, LastLine% being included. │ '│ scrArray%() - The array in which the display contents will be │ '│ restored. Must be integer, and must be dimensioned │ '│ to 3999 (or 4000) elements. │ '└────────────────────────────────────────────────────────────────────────┘ '────────────────────────────────────────────────────────────────────────── ' Determine the starting address in the video memory (start%). Must use ' 160 for the length of a line, since an attribute byte is stored for each ' character on the screen (80 characters + 80 attributes = 160) '────────────────────────────────────────────────────────────────────────── start% = (firstLine% - 1) * 160 '────────────────────────────────────────────────────────────────────────── ' Calculate the length of the block of addresses we must restore (length%). ' 1 is subtracted since the array starts with element 0. '────────────────────────────────────────────────────────────────────────── length% = (((lastLine% - firstLine%) + 1) * 160) - 1 '────────────────────────────────────────────────────────────────────────── ' Set the default segment to the video memory segment. '────────────────────────────────────────────────────────────────────────── DEF SEG = segment '────────────────────────────────────────────────────────────────────────── ' Restore information (characters and attributes) to video memory. '────────────────────────────────────────────────────────────────────────── FOR i% = 0 TO length% POKE start% + i%, scrArray%(start% + i%) NEXT i% '────────────────────────────────────────────────────────────────────────── ' Restore default segment to BASIC's segment. '────────────────────────────────────────────────────────────────────────── DEF SEG END SUB SUB ScrnSave (firstLine%, lastLine%, scrArray%(), segment) '┌────────────────────────────────────────────────────────────────────────┐ '│ This routine will save all or a portion of the screen display to an │ '│ integer array. For more implementation details, see the QBSCR │ '│ reference manual. │ '│ │ '│ Parameters are as follows: │ '│ │ '│ firstLine% - The first line of the display where saving should │ '│ begin. Top line is 1, bottom is 25. │ '│ lastLine% - The last line of the display where saving should │ '│ end, LastLine% being included. │ '│ scrArray%() - The array in which the display contents will be │ '│ stored. Must be integer, and must be dimensioned │ '│ to 3999 (or 4000) elements. │ '└────────────────────────────────────────────────────────────────────────┘ '────────────────────────────────────────────────────────────────────────── ' Determine the starting address in the video memory (start%). Must use ' 160 for the length of a line, since an attribute byte is stored for each ' character on the screen (80 characters + 80 attributes = 160) '────────────────────────────────────────────────────────────────────────── start% = (firstLine% - 1) * 160 '────────────────────────────────────────────────────────────────────────── ' Calculate the length of the block of addresses we must retrieve and ' store (length%). 1 is subtracted since the array starts with element 0. '────────────────────────────────────────────────────────────────────────── length% = (((lastLine% - firstLine%) + 1) * 160) - 1 '────────────────────────────────────────────────────────────────────────── ' Set the default segment to the video memory segment. '────────────────────────────────────────────────────────────────────────── DEF SEG = segment '────────────────────────────────────────────────────────────────────────── ' Get information (characters and attributes) from video memory. '────────────────────────────────────────────────────────────────────────── FOR i% = 0 TO length% scrArray%(start% + i%) = PEEK(start% + i%) NEXT i% '────────────────────────────────────────────────────────────────────────── ' Restore default segment to BASIC's segment. '────────────────────────────────────────────────────────────────────────── DEF SEG END SUB FUNCTION SelectList$ (items$(), numItems%, topRow%, botRow%, leftCol%, maxWidth%, normFG%, normBG%, hiFG%, hiBG%, frameType%, explode%, shadow%, label$, useMouse%) '┌────────────────────────────────────────────────────────────────────────┐ '│ This function accepts a list of string items and from it creates a │ '│ scrolling list with a selection bar. The function will return the │ '│ item selected by a user. │ '│ │ '│ Parameters are as follows: │ '│ │ '│ items$() - an array containing the items from which a selection │ '│ will be made │ '│ numItems% - the number of items in the list (items$()) │ '│ topRow% - the top-most screen row of the list │ '│ botRow% - the bottom-most screen row of the list │ '│ leftCol% - the left-most screen column of the list │ '│ maxWidth% - the width of the widest entry in the list │ '│ normFG% - Foreground color of unhighlighted entries in the list │ '│ normBG% - Background color of unhighlighted entries in the list │ '│ hiFG% - Foreground color of highlighted entry in the list │ '│ hiBG% - Background color of highlighted entry in the list │ '│ useMouse% - 1 = use mouse support, 0 = don't │ '└────────────────────────────────────────────────────────────────────────┘ '────────────────────────────────────────────────────────────────────────── ' Define keys that will be used in this function '────────────────────────────────────────────────────────────────────────── enter$ = CHR$(13) esc$ = CHR$(27) UpArrowKey$ = CHR$(0) + CHR$(72) DownArrowKey$ = CHR$(0) + CHR$(80) PgUpKey$ = CHR$(0) + CHR$(73) PgDnKey$ = CHR$(0) + CHR$(81) HomeKee$ = CHR$(0) + CHR$(71) EndKee$ = CHR$(0) + CHR$(79) '────────────────────────────────────────────────────────────────────────── ' Define errortone string to use with PLAY '────────────────────────────────────────────────────────────────────────── errorTone$ = "L60 N1 N0 N1" '────────────────────────────────────────────────────────────────────────── ' Set up our top, bottom, and highlight pointers for the list. ' ' - topPtr% will maintain the top of the screen position in the overall ' list. Values will range from 1 to numItems%-numPerScreen%. ' - botPtr% will maintain the bottom of the screen position in the overall ' list. Values will range from numPerScreen% to numItems%. ' - hiPtr% will maintain the position of the highlight in the overall ' list. Values range from 1 to numItems%. '────────────────────────────────────────────────────────────────────────── numPerScreen% = botRow% - topRow% + 1 topPtr% = 1 botPtr% = numPerScreen% hiPtr% = 1 elevatorPos% = 1 '────────────────────────────────────────────────────────────────────────── ' Determine widest entry in list. '────────────────────────────────────────────────────────────────────────── longest% = 0 FOR i% = 1 TO numItems% IF LEN(items$(i%)) > longest% THEN longest% = LEN(items$(i%)) END IF NEXT i% '────────────────────────────────────────────────────────────────────────── ' If using the mouse, turn it off before we display. '────────────────────────────────────────────────────────────────────────── IF useMouse% THEN MouseHide END IF '────────────────────────────────────────────────────────────────────────── ' Calculate and display a box AROUND the list. '────────────────────────────────────────────────────────────────────────── MakeWindow topRow% - 1, leftCol% - 1, botRow% + 1, leftCol% + longest% + 2, normFG%, normBG%, 0, frameType%, shadow%, explode%, label$ '────────────────────────────────────────────────────────────────────────── ' If we are using a mouse, and the number of rows is 2 or more, then we ' will build a scroll bar for the window. '────────────────────────────────────────────────────────────────────────── COLOR normFG%, normBG% IF (numPerScreen% >= 2) AND (useMouse%) THEN scrollBarFlag% = TRUE FOR i% = topRow% + 1 TO botRow% - 1 LOCATE i%, leftCol% + longest% + 2, 0 PRINT CHR$(177); NEXT i% elevatorFloors% = (botRow% - 1) - (topRow% + 1) + 1 QBPrint CHR$(30), topRow%, leftCol% + longest% + 2, normFG%, normBG% QBPrint CHR$(31), botRow%, leftCol% + longest% + 2, normFG%, normBG% QBPrint CHR$(219), topRow% + 1, leftCol% + longest% + 2, normFG%, normBG% END IF '────────────────────────────────────────────────────────────────────────── ' Display first screen's worth of entries '────────────────────────────────────────────────────────────────────────── COLOR normFG%, normBG% FOR i% = 1 TO numPerScreen% LOCATE topRow% + i% - 1, leftCol% + 1, 0 PRINT items$(i%); NEXT i% '────────────────────────────────────────────────────────────────────────── ' Locate the highlight bar to top position '────────────────────────────────────────────────────────────────────────── COLOR hiFG%, hiBG% LOCATE topRow% + topPtr% - 1, leftCol%, 0 PRINT SPACE$(maxWidth% + 2); LOCATE topRow% + topPtr% - 1, leftCol% + 1, 0 PRINT items$(hiPtr%); '────────────────────────────────────────────────────────────────────────── ' Sit in a loop whle the user hits keys. If the ESC key is hit, then set ' function to NUL string and exit. If ENTER is hit, set function to the ' entry pointed to by highlight (hiPtr%) and exit. '────────────────────────────────────────────────────────────────────────── updateList% = FALSE done% = FALSE MouseButtonPressInfo RIGHTBUTTON, rmCnt%, mx%, my% MouseButtonPressInfo LEFTBUTTON, lmCnt%, mx%, my% DO '──────────────────────────────────────────────────────────────────────── ' If mouse is around, show it. '──────────────────────────────────────────────────────────────────────── IF useMouse% THEN MouseShow END IF '──────────────────────────────────────────────────────────────────────── ' Get a key from the user '──────────────────────────────────────────────────────────────────────── k$ = "" lmCnt% = 0 rmCnt% = 0 IF useMouse% THEN MouseButtonStatus lmCnt%, rmCnt%, bc% IF lmCnt% OR rmCnt% THEN MousePosition mx%, my% END IF '────────────────────────────────────────────────────────────────────── ' Did we have any left mouse button presses? If not, check the ' keyboard for input. '────────────────────────────────────────────────────────────────────── IF lmCnt% = 0 THEN k$ = UCASE$(INKEY$) END IF ELSE '────────────────────────────────────────────────────────────────────── ' No mouse available, so wait for keyboard input. '────────────────────────────────────────────────────────────────────── WHILE k$ = "" k$ = UCASE$(INKEY$) WEND END IF '──────────────────────────────────────────────────────────────────────── ' If left mouse was clicked, then see if it was clicked on certain ' "hot spots" we understand. '──────────────────────────────────────────────────────────────────────── IF (lmCnt%) THEN mx% = (mx% / 8) + 1 my% = (my% / 8) + 1 '──────────────────────────────────────────────────────────────────────── ' First, check to see if a list item was selected. '──────────────────────────────────────────────────────────────────────── IF (mx% > leftCol%) AND (mx% < leftCol% + longest% + 2) AND (my% >= topRow%) AND (my% <= botRow%) THEN hiPtr% = topPtr% + (my% - topRow%) done% = TRUE updateList% = TRUE END IF '──────────────────────────────────────────────────────────────────────── ' Now check to see if the left button was clicked on the up arrow part ' of the scroll bar. Is so, decrement the pointers. '──────────────────────────────────────────────────────────────────────── IF (my% = topRow%) AND (mx% = leftCol% + longest% + 2) THEN k$ = UpArrowKey$ END IF '──────────────────────────────────────────────────────────────────────── ' Now check to see if the left button was clicked on the down arrow part ' of the scroll bar. Is so, increment the pointers. '──────────────────────────────────────────────────────────────────────── IF (my% = botRow%) AND (mx% = leftCol% + longest% + 2) THEN k$ = DownArrowKey$ END IF '──────────────────────────────────────────────────────────────────────── ' If the left mouse button was clicked on the scroll bar itself, then ' execute a PgUp or PgDn, based on where the elevator is. '──────────────────────────────────────────────────────────────────────── IF (mx% = leftCol% + longest% + 2) AND (my% < elevatorPos% + (topRow% - 1)) AND (my% >= topRow% + 1) THEN k$ = PgUpKey$ END IF IF (mx% = leftCol% + longest% + 2) AND (my% > elevatorPos% + (topRow% - 1)) AND (my% <= botRow% - 1) THEN k$ = PgDnKey$ END IF END IF '──────────────────────────────────────────────────────────────────────── ' If right mouse button was pressed, then exit. '──────────────────────────────────────────────────────────────────────── IF rmCnt% THEN k$ = esc$ END IF '──────────────────────────────────────────────────────────────────────── ' Decide what to do based on the user's keystroke '──────────────────────────────────────────────────────────────────────── SELECT CASE k$ CASE "A" TO "Z", "a" TO "z", "0" TO "9" ' First character search k$ = UCASE$(k$) ' Look for the user-entered character in the first pos of all list items foundPos% = 0 ' First check from current position plus one to end of screen FOR i% = hiPtr% + 1 TO botPtr% IF LEFT$(items$(i%), 1) = k$ THEN foundPos% = i% EXIT FOR END IF NEXT i% ' If not found, check from current position plus one to end of screen IF foundPos% = 0 THEN FOR i% = hiPtr% + 1 TO numItems% IF LEFT$(items$(i%), 1) = k$ THEN foundPos% = i% EXIT FOR END IF NEXT i% END IF ' If item was not found, then check from top of list to current pos IF foundPos% = 0 THEN FOR i% = 1 TO hiPtr% IF LEFT$(items$(i%), 1) = k$ THEN foundPos% = i% EXIT FOR END IF NEXT i% END IF ' If letter was found, update pointers for new list display IF foundPos% THEN ' Is foundPos% something other than 0? ' --- Yes ' If the letter was found on the existing screen list, then ' don't move the list - only the hilight pointer. Otherwise, ' move the list and the pointer. IF foundPos% <= botPtr% AND foundPos% >= topPtr% THEN hiPtr% = foundPos% ELSE ' Make sure the list will fill the whole screen IF foundPos% > numItems% - numPerScreen% + 1 THEN topPtr% = numItems% - numPerScreen% + 1 botPtr% = numItems% hiPtr% = foundPos% ELSE topPtr% = foundPos% botPtr% = topPtr% + numPerScreen% - 1 hiPtr% = foundPos% END IF END IF ' Tell routine to update list updateList% = TRUE END IF CASE UpArrowKey$ ' Move list and/or highlight up one IF hiPtr% > topPtr% THEN ' Is highlight at top of screen list? hiPtr% = hiPtr% - 1 ' --- No ELSE ' --- Yes IF hiPtr% > 1 THEN ' Is highlight at top of overall list? topPtr% = topPtr% - 1 ' --- No botPtr% = botPtr% - 1 hiPtr% = hiPtr% - 1 ELSE ' --- Yes topPtr% = numItems% - numPerScreen% + 1 botPtr% = numItems% hiPtr% = numItems% END IF END IF updateList% = TRUE CASE DownArrowKey$ ' Move list and/or highlight down one IF hiPtr% < botPtr% THEN ' Is highlight at bottom of screen list? hiPtr% = hiPtr% + 1 ' --- No ELSE ' --- Yes IF hiPtr% < numItems% THEN ' Is highlight at bottom of overall list? topPtr% = topPtr% + 1 ' --- No botPtr% = botPtr% + 1 hiPtr% = hiPtr% + 1 ELSE ' --- Yes topPtr% = 1 botPtr% = numPerScreen% hiPtr% = 1 END IF END IF updateList% = TRUE CASE PgUpKey$ ' Move up one screen's worth IF topPtr% > numPerScreen% THEN ' Got a whole screen's worth? topPtr% = topPtr% - numPerScreen% ' --- Yes botPtr% = botPtr% - numPerScreen% hiPtr% = hiPtr% - numPerScreen% ELSE ' --- No IF topPtr% > 1 THEN ' Need to move list on screen? hiPtr% = hiPtr% - topPtr% + 1 topPtr% = 1 botPtr% = numPerScreen% ELSE ' --- No hiPtr% = 1 ' Move highlight to top of list END IF END IF updateList% = TRUE CASE PgDnKey$ ' Move down one screen's worth IF botPtr% <= numItems% - numPerScreen% THEN ' Got a whole screen's worth? topPtr% = topPtr% + numPerScreen% ' --- Yes botPtr% = botPtr% + numPerScreen% hiPtr% = hiPtr% + numPerScreen% ELSE ' --- No IF botPtr% < numItems% THEN ' Need to move the list on screen? hiPtr% = hiPtr% + (numItems% - numPerScreen% + 1 - topPtr%) topPtr% = numItems% - numPerScreen% + 1 botPtr% = numItems% ELSE ' --- No hiPtr% = numItems% ' Move highlight to end of list END IF END IF updateList% = TRUE CASE HomeKee$ ' Move to top of overall list topPtr% = 1 botPtr% = numPerScreen% hiPtr% = 1 updateList% = TRUE CASE EndKee$ ' Move to bottom of overall list topPtr% = numItems% - numPerScreen% + 1 botPtr% = numItems% hiPtr% = numItems% updateList% = TRUE CASE esc$ ' User wants out SelectList$ = "" done% = TRUE CASE enter$ ' User is done and has made selection SelectList$ = items$(hiPtr%) done% = TRUE CASE ELSE ' Invalid key was hit IF k$ <> "" THEN PLAY errorTone$ END IF END SELECT '──────────────────────────────────────────────────────────────────────── ' If required, update the scroll bar display. '──────────────────────────────────────────────────────────────────────── COLOR normFG%, normBG% IF (scrollBarFlag%) AND (updateList%) THEN IF useMouse% THEN MouseHide END IF FOR i% = topRow% + 1 TO botRow% - 1 LOCATE i%, leftCol% + longest% + 2, 0 PRINT CHR$(177); NEXT i% elevatorPos% = CalcScrollPos%(numItems%, elevatorFloors%, hiPtr%) QBPrint CHR$(219), topRow% + elevatorPos%, leftCol% + longest% + 2, normFG%, normBG% END IF '──────────────────────────────────────────────────────────────────────── ' If required, update the display list and hilight position '──────────────────────────────────────────────────────────────────────── IF updateList% THEN IF useMouse% THEN MouseHide END IF ' Update the list COLOR normFG%, normBG% FOR i% = topPtr% TO botPtr% LOCATE topRow% + i% - topPtr%, leftCol%, 0 PRINT LEFT$(" " + items$(i%) + SPACE$(maxWidth%), maxWidth% + 1) + " "; NEXT i% ' Update the highlight COLOR hiFG%, hiBG% LOCATE hiPtr% - topPtr% + topRow%, leftCol%, 0 PRINT SPACE$(maxWidth% + 2); LOCATE hiPtr% - topPtr% + topRow%, leftCol% + 1, 0 PRINT items$(hiPtr%); updateList% = FALSE END IF LOOP UNTIL done% IF lmCnt% THEN SelectList$ = items$(hiPtr%) END IF '────────────────────────────────────────────────────────────────────────── ' Wait here until the mouse buttons are no longer down. This is useful ' in case this function is called successively. '────────────────────────────────────────────────────────────────────────── MouseButtonStatus l%, r%, c% WHILE (l% OR r%) MouseButtonStatus l%, r%, c% WEND END FUNCTION FUNCTION SubMenu% (choice$(), currentMenu%, numOfChoices%, justify$, leftColumn, rightColumn, row%, marker$, divider$, fg%, bg%, hfg%, hBG%, qfg%, qbg%, useMouse%, mx%, my%) '┌───────────────────────────────────────────────────────────────────────┐ '│ This function is a special version of MakeMenu% and is used only by │ '│ the MultiMenu routine. It is not intended to be called by itself. │ '│ See the MakeMenu% function if you need a single menu, or want to │ '│ know more about the parameters of this function. │ '└───────────────────────────────────────────────────────────────────────┘ '───────────────────────────────────────────────────────────────────────── ' Set local variables - extended scan codes for keypad keys '───────────────────────────────────────────────────────────────────────── up$ = CHR$(0) + CHR$(72) down$ = CHR$(0) + CHR$(80) enter$ = CHR$(13) home$ = CHR$(0) + CHR$(71) EndKee$ = CHR$(0) + CHR$(79) PgUpKey$ = CHR$(0) + CHR$(73) PgDnKey$ = CHR$(0) + CHR$(81) LeftArrowKey$ = CHR$(0) + CHR$(75) RightArrowKey$ = CHR$(0) + CHR$(77) esc$ = CHR$(27) '───────────────────────────────────────────────────────────────────────── ' Define other local variables. '───────────────────────────────────────────────────────────────────────── mx% = 0 my% = 0 lmCnt% = 0 rmCnt% = 0 returnIt% = FALSE updateMenu% = FALSE '───────────────────────────────────────────────────────────────────────── ' Define the error tone string to use with PLAY '───────────────────────────────────────────────────────────────────────── errorTone$ = "MB T120 L50 O3 AF" '───────────────────────────────────────────────────────────────────────── ' Set type of justification to uppercase '───────────────────────────────────────────────────────────────────────── justify$ = UCASE$(justify$) wdth% = (rightColumn - leftColumn - 1) '───────────────────────────────────────────────────────────────────────── ' Check for out-of-bounds parameters. If any are out of range, ' quit the function '───────────────────────────────────────────────────────────────────────── IF numOfChoices% < 1 OR numOfChoices% > 25 THEN EXIT FUNCTION IF justify$ <> "C" AND justify$ <> "L" AND justify$ <> "R" THEN EXIT FUNCTION IF leftColumn < 1 OR rightColumn > 80 THEN EXIT FUNCTION IF row% < 1 OR row% > 24 THEN EXIT FUNCTION '───────────────────────────────────────────────────────────────────────── ' Calculate the array of character identifiers '───────────────────────────────────────────────────────────────────────── REDIM charID(numOfChoices%) AS STRING * 1 FOR x% = 1 TO numOfChoices% FOR y% = 1 TO LEN(choice$(currentMenu%, x%)) IF MID$(choice$(currentMenu%, x%), y%, 1) = marker$ THEN charID(x%) = UCASE$(MID$(choice$(currentMenu%, x%), y% + 1, 1)) EXIT FOR END IF NEXT y% NEXT x% '───────────────────────────────────────────────────────────────────────── ' Calculate length of longest menu choice and store value in ChoiceLen% '───────────────────────────────────────────────────────────────────────── choiceLen% = 0 FOR x% = 1 TO numOfChoices% IF LEN(choice$(currentMenu%, x%)) > choiceLen% THEN IF INSTR(choice$(currentMenu%, x%), marker$) THEN choiceLen% = LEN(choice$(currentMenu%, x%)) ELSE choiceLen% = LEN(choice$(currentMenu%, x%)) + 1 END IF END IF NEXT x% choiceLen% = choiceLen% - 1 '───────────────────────────────────────────────────────────────────────── ' Determine left-most column to display highlight bar on '───────────────────────────────────────────────────────────────────────── col = (((rightColumn - leftColumn - 1) - choiceLen%) / 2) + leftColumn '───────────────────────────────────────────────────────────────────────── ' At this point, we must turn off the mouse cursor if it's available. We ' don't want to write overtop of it, leaving a hole when it's moved later. '───────────────────────────────────────────────────────────────────────── IF useMouse% THEN MouseHide END IF '───────────────────────────────────────────────────────────────────────── ' Print menu choices to screen based on the type of Justification ' selected (Center, Left, Right). '───────────────────────────────────────────────────────────────────────── COLOR fg%, bg% SELECT CASE justify$ CASE "C" FOR x% = 1 TO numOfChoices% xCol% = ((wdth% - (LEN(choice$(currentMenu%, x%))) - 1) \ 2 + leftColumn) + 1 LOCATE (row% - 1) + x%, leftColumn - 1, 0 PRINT SPACE$(choiceLen% + 2); LOCATE (row% - 1) + x%, xCol%, 0 DisplayEntry choice$(currentMenu%, x%), qfg%, qbg%, hfg%, hBG%, fg%, bg%, marker$, divider$, wdth%, 1 NEXT x% CASE "R" FOR x% = 1 TO numOfChoices% LOCATE (row% - 1) + x%, leftColumn - 1, 0 PRINT SPACE$(choiceLen% + 2); LOCATE (row% - 1) + x%, (rightColumn - LEN(choice$(currentMenu%, x%))) DisplayEntry choice$(currentMenu%, x%), qfg%, qbg%, hfg%, hBG%, fg%, bg%, marker$, divider$, wdth%, 1 NEXT x% CASE "L" FOR x% = 1 TO numOfChoices% LOCATE (row% - 1) + x%, leftColumn - 1, 0 PRINT SPACE$(choiceLen% + 2); LOCATE (row% - 1) + x%, leftColumn, 0 DisplayEntry choice$(currentMenu%, x%), qfg%, qbg%, hfg%, hBG%, fg%, bg%, marker$, divider$, wdth%, 1 NEXT x% END SELECT '───────────────────────────────────────────────────────────────────────── ' Highlight the first entry in the list. Must take into account the ' justification type. '───────────────────────────────────────────────────────────────────────── currentLocation% = 1 oldLocation% = 1 COLOR hfg%, hBG% LOCATE row%, leftColumn - 1: PRINT SPACE$(choiceLen% + 2); SELECT CASE justify$ CASE "C" xCol% = ((wdth% - (LEN(choice$(currentMenu%, currentLocation%))) - 1) \ 2 + leftColumn) + 1 LOCATE (row% - 1 + currentLocation%), xCol%, 0 DisplayEntry choice$(currentMenu%, currentLocation%), qfg%, qbg%, hfg%, hBG%, fg%, bg%, marker$, divider$, wdth%, 2 CASE "R" LOCATE (row% - 1) + currentLocation%, (rightColumn - LEN(choice$(currentMenu%, currentLocation%))) DisplayEntry choice$(currentMenu%, currentLocation%), qfg%, qbg%, hfg%, hBG%, fg%, bg%, marker$, divider$, wdth%, 2 CASE "L" LOCATE (row% - 1) + currentLocation%, leftColumn DisplayEntry choice$(currentMenu%, currentLocation%), qfg%, qbg%, hfg%, hBG%, fg%, bg%, marker$, divider$, wdth%, 2 END SELECT '───────────────────────────────────────────────────────────────────────── ' Read keystrokes and change the highlighted entry appropriately. Also ' drain out any pending mouse button presses if the mouse is available. '───────────────────────────────────────────────────────────────────────── exitCode% = FALSE IF useMouse% THEN MouseButtonPressInfo LEFTBUTTON, lmCnt%, mx%, my% MouseButtonPressInfo RIGHTBUTTON, rmCnt%, mx%, my% lmCnt% = 0 rmCnt% = 0 END IF WHILE exitCode% = FALSE '───────────────────────────────────────────────────────────────────── ' If we're using the mouse, turn it on. '───────────────────────────────────────────────────────────────────── IF useMouse% THEN MouseShow END IF '───────────────────────────────────────────────────────────────────── ' Read keystrokes and/or mouse strokes. '───────────────────────────────────────────────────────────────────── key$ = "" lmCnt% = 0 rmCnt% = 0 IF useMouse% THEN MouseButtonPressInfo RIGHTBUTTON, rmCnt%, mx%, my% MouseButtonPressInfo LEFTBUTTON, lmCnt%, mx%, my% '─────────────────────────────────────────────────────────────────── ' Did we have any left mouse button presses? If not, check the ' keyboard for input. '─────────────────────────────────────────────────────────────────── IF lmCnt% = 0 THEN key$ = UCASE$(INKEY$) END IF ELSE '─────────────────────────────────────────────────────────────────── ' No mouse available, so wait for keyboard input. '─────────────────────────────────────────────────────────────────── WHILE key$ = "" key$ = UCASE$(INKEY$) WEND END IF '───────────────────────────────────────────────────────────────────── ' If the left mouse button was pressed, check to see if a menu item ' was selected by it. '───────────────────────────────────────────────────────────────────── IF (useMouse%) AND (lmCnt% > 0) THEN '─────────────────────────────────────────────────────────────────── ' Convert virtual screen mouse coordinates to real 80x25 coords. '─────────────────────────────────────────────────────────────────── mx% = (mx% \ 8) + 1 my% = (my% \ 8) + 1 '─────────────────────────────────────────────────────────────────── ' If mouse was inside menu window then return the item pointed to. '─────────────────────────────────────────────────────────────────── IF (mx% >= leftColumn) AND (mx% <= rightColumn) AND (my% >= row%) AND (my% <= row% + numOfChoices% - 1) THEN IF (choice$(currentMenu%, my% - row% + 1) <> divider$) THEN exitCode% = TRUE updateMenu% = TRUE currentLocation% = my% - row% + 1 key$ = charID(currentLocation%) returnIt% = TRUE END IF ELSE '───────────────────────────────────────────────────────────────── ' See if the mouse was clicked on the row two above the top row. ' If so, it was clicked on the menu bar - return mx. '───────────────────────────────────────────────────────────────── IF (my% = row% - 2) THEN SubMenu% = LEFTMOUSEEXIT EXIT FUNCTION END IF END IF END IF '───────────────────────────────────────────────────────────────────── ' If right mouse button was pressed, then exit as if ESC were pressed. '───────────────────────────────────────────────────────────────────── IF (useMouse%) AND (rmCnt% > 0) THEN SubMenu% = RIGHTMOUSEEXIT EXIT FUNCTION END IF '─────────────────────────────────────────────────────────────────── ' Update currentLocation based on what user did, key-wise. '─────────────────────────────────────────────────────────────────── SELECT CASE key$ CASE up$ IF currentLocation% > 1 THEN currentLocation% = currentLocation% - 1 IF (choice$(currentMenu%, currentLocation%) = divider$) AND (currentLocation% > 0) THEN currentLocation% = currentLocation% - 1 END IF ELSE currentLocation% = numOfChoices% END IF updateMenu% = TRUE CASE down$ IF currentLocation% < numOfChoices% THEN currentLocation% = currentLocation% + 1 IF (choice$(currentMenu%, currentLocation%) = divider$) AND (currentLocation% < numOfChoices%) THEN currentLocation% = currentLocation% + 1 END IF ELSE currentLocation% = 1 END IF updateMenu% = TRUE CASE home$, PgUpKey$ IF currentLocation% <> 1 THEN currentLocation% = 1 updateMenu% = TRUE END IF CASE LeftArrowKey$ SubMenu% = LEFTARROWCODE EXIT FUNCTION CASE RightArrowKey$ SubMenu% = RIGHTARROWCODE EXIT FUNCTION CASE EndKee$, PgDnKey$ IF currentLocation% <> numOfChoices% THEN currentLocation% = numOfChoices% updateMenu% = TRUE END IF CASE enter$ SubMenu% = currentLocation% exitCode% = TRUE CASE esc$ SubMenu% = 27 exitCode% = TRUE CASE ELSE '─────────────────────────────────────────────────────────────────── ' Check hot quick access keys. '─────────────────────────────────────────────────────────────────── FOR i% = 1 TO numOfChoices% IF charID(i%) = key$ THEN currentLocation% = i% updateMenu% = TRUE SubMenu% = i% exitCode% = TRUE END IF NEXT i% END SELECT '─────────────────────────────────────────────────────────────────── ' If required, update the display. '─────────────────────────────────────────────────────────────────── IF updateMenu% THEN '─────────────────────────────────────────────────────────────────── ' If mouse is around, turn it off, since we'll be displaying. '─────────────────────────────────────────────────────────────────── IF useMouse% THEN MouseHide END IF '───────────────────────────────────────────────────────────────── ' Restore the old highlighted item to normal colors. '───────────────────────────────────────────────────────────────── COLOR fg%, bg% LOCATE row% + oldLocation% - 1, leftColumn - 1: PRINT SPACE$(choiceLen% + 2); SELECT CASE justify$ CASE "C" xCol% = ((wdth% - (LEN(choice$(currentMenu%, oldLocation%))) - 1) \ 2 + leftColumn) + 1 LOCATE (row% - 1 + oldLocation%), xCol%, 0 DisplayEntry choice$(currentMenu%, oldLocation%), qfg%, qbg%, hfg%, hBG%, fg%, bg%, marker$, divider$, wdth%, 1 CASE "R" LOCATE (row% - 1) + oldLocation%, (rightColumn - LEN(choice$(currentMenu%, oldLocation%))) DisplayEntry choice$(currentMenu%, oldLocation%), qfg%, qbg%, hfg%, hBG%, fg%, bg%, marker$, divider$, wdth%, 1 CASE "L" LOCATE (row% - 1) + oldLocation%, leftColumn DisplayEntry choice$(currentMenu%, oldLocation%), qfg%, qbg%, hfg%, hBG%, fg%, bg%, marker$, divider$, wdth%, 1 END SELECT '───────────────────────────────────────────────────────────────── ' Display newly highlighted item in highlight colors. '───────────────────────────────────────────────────────────────── COLOR hfg%, hBG% LOCATE row% + currentLocation% - 1, leftColumn - 1: PRINT SPACE$(choiceLen% + 2); SELECT CASE justify$ CASE "C" xCol% = ((wdth% - (LEN(choice$(currentMenu%, currentLocation%))) - 1) \ 2 + leftColumn) + 1 LOCATE (row% - 1 + currentLocation%), xCol%, 0 DisplayEntry choice$(currentMenu%, currentLocation%), qfg%, qbg%, hfg%, hBG%, fg%, bg%, marker$, divider$, wdth%, 2 CASE "R" LOCATE (row% - 1) + currentLocation%, (rightColumn - LEN(choice$(currentMenu%, currentLocation%))) DisplayEntry choice$(currentMenu%, currentLocation%), qfg%, qbg%, hfg%, hBG%, fg%, bg%, marker$, divider$, wdth%, 2 CASE "L" LOCATE (row% - 1) + currentLocation%, leftColumn DisplayEntry choice$(currentMenu%, currentLocation%), qfg%, qbg%, hfg%, hBG%, fg%, bg%, marker$, divider$, wdth%, 2 END SELECT '───────────────────────────────────────────────────────────────── ' Reset old location to current. '───────────────────────────────────────────────────────────────── oldLocation% = currentLocation% updateMenu% = FALSE END IF '─────────────────────────────────────────────────────────────────── ' If the mouse was used to click on a menu choice, then return it ' and exit now. '─────────────────────────────────────────────────────────────────── IF returnIt% THEN SubMenu% = currentLocation% EXIT FUNCTION END IF WEND END FUNCTION SUB ViewList (list$(), listLen%, maxWidth%, topRow%, botRow%, leftCol%, fg%, bg%, frameType%, explode%, shadow%, label$, useMouse%) '┌────────────────────────────────────────────────────────────────────────┐ '│ This function accepts a list of string items and from it creates a │ '│ scrolling list. │ '│ │ '│ Parameters are as follows: │ '│ │ '│ list$() - an array containing the list of items to scroll thru │ '│ listLen% - the number of items in the list │ '│ maxWidth% - the width of the widest entry in the list │ '│ topRow% - the top-most screen row of the list │ '│ botRow% - the bottom-most screen row of the list │ '│ leftCol% - the left-most screen column of the list │ '│ fg% - Foreground color of text in the list │ '│ bg% - Background color of text in the list │ '│ frameType% - Type of window frame to use. │ '│ explode% - Explode mode to use for window. │ '│ shadow% - Shadow type for main window. │ '│ label$ - TExt label for window. │ '│ useMouse% - 1 = use mouse support, 0 = don't. │ '└────────────────────────────────────────────────────────────────────────┘ '────────────────────────────────────────────────────────────────────────── ' Define keys that will be used in this function '────────────────────────────────────────────────────────────────────────── enter$ = CHR$(13) esc$ = CHR$(27) UpArrowKey$ = CHR$(0) + CHR$(72) DownArrowKey$ = CHR$(0) + CHR$(80) PgUpKey$ = CHR$(0) + CHR$(73) PgDnKey$ = CHR$(0) + CHR$(81) HomeKee$ = CHR$(0) + CHR$(71) EndKee$ = CHR$(0) + CHR$(79) '────────────────────────────────────────────────────────────────────────── ' Define errortone string to use with PLAY '────────────────────────────────────────────────────────────────────────── errorTone$ = "L60 N1 N0 N1" '────────────────────────────────────────────────────────────────────────── ' Set up our top, bottom, and highlight pointers for the list, as well as ' the starting point for the scroll bar elevator. ' ' - topPtr% will maintain the top of the screen position in the overall ' list. Values will range from 1 to numItems%-numPerScreen%. ' - botPtr% will maintain the bottom of the screen position in the overall ' list. Values will range from numPerScreen% to numItems%. '────────────────────────────────────────────────────────────────────────── numPerScreen% = botRow% - topRow% + 1 topPtr% = 1 botPtr% = numPerScreen% elevatorPos% = 1 '────────────────────────────────────────────────────────────────────────── ' If using the mouse, turn it off before we display. '────────────────────────────────────────────────────────────────────────── IF useMouse% THEN MouseHide END IF '────────────────────────────────────────────────────────────────────────── ' Calculate and display a box AROUND the list. '────────────────────────────────────────────────────────────────────────── MakeWindow topRow% - 1, leftCol% - 1, botRow% + 1, leftCol% + maxWidth% + 2, fg%, bg%, 0, frameType%, shadow%, explode%, label$ '────────────────────────────────────────────────────────────────────────── ' If we are using a mouse, and the number of rows is 2 or more, then we ' will build a scroll bar for the window. The variable 'elevatorFloors%' ' stores the number of possible elevator positions on the scroll bar. '────────────────────────────────────────────────────────────────────────── COLOR fg%, bg% IF ((botRow% - topRow%) + 1 >= 2) AND (useMouse%) THEN scrollBarFlag% = TRUE FOR i% = topRow% + 1 TO botRow% - 1 LOCATE i%, leftCol% + maxWidth% + 2, 0 PRINT CHR$(177); NEXT i% elevatorFloors% = (botRow% - 1) - (topRow% + 1) + 1 QBPrint CHR$(30), topRow%, leftCol% + maxWidth% + 2, fg%, bg% QBPrint CHR$(31), botRow%, leftCol% + maxWidth% + 2, fg%, bg% QBPrint CHR$(219), topRow% + 1, leftCol% + maxWidth% + 2, fg%, bg% END IF '────────────────────────────────────────────────────────────────────────── ' Display first screen's worth of entries '────────────────────────────────────────────────────────────────────────── COLOR fg%, bg% FOR i% = 1 TO (botRow% - topRow%) + 1 LOCATE topRow% + i% - 1, leftCol% + 1, 0 PRINT list$(i%); NEXT i% '────────────────────────────────────────────────────────────────────────── ' Sit in a loop whle the user hits keys. If the ESC key is hit, then set ' function to NULL string and exit. '────────────────────────────────────────────────────────────────────────── updateList% = FALSE done% = FALSE MouseButtonPressInfo RIGHTBUTTON, rmCnt%, mx%, my% MouseButtonPressInfo LEFTBUTTON, lmCnt%, mx%, my% DO '──────────────────────────────────────────────────────────────────────── ' If mouse is around, show it. '──────────────────────────────────────────────────────────────────────── IF useMouse% THEN MouseShow END IF '──────────────────────────────────────────────────────────────────────── ' Get a key from the user '──────────────────────────────────────────────────────────────────────── k$ = "" lmCnt% = 0 rmCnt% = 0 IF useMouse% THEN '────────────────────────────────────────────────────────────────────── ' Determine the status of the mouse buttons, as well as position, if ' a button was down. '────────────────────────────────────────────────────────────────────── MouseButtonStatus lmCnt%, rmCnt%, bc% IF lmCnt% OR rmCnt% THEN MousePosition mx%, my% END IF '────────────────────────────────────────────────────────────────────── ' Did we have any left mouse button presses? If not, check the ' keyboard for input. '────────────────────────────────────────────────────────────────────── IF lmCnt% = 0 THEN k$ = UCASE$(INKEY$) END IF ELSE '────────────────────────────────────────────────────────────────────── ' No mouse available, so wait for keyboard input. '────────────────────────────────────────────────────────────────────── WHILE k$ = "" k$ = UCASE$(INKEY$) WEND END IF '──────────────────────────────────────────────────────────────────────── ' If left mouse was clicked, then see if it was clicked on certain ' "hot spots" we understand. '──────────────────────────────────────────────────────────────────────── IF (lmCnt%) THEN '────────────────────────────────────────────────────────────────────── ' Convert virtual screen mouse coordinates to real 80x25 coordinates. '────────────────────────────────────────────────────────────────────── mx% = (mx% / 8) + 1 my% = (my% / 8) + 1 '────────────────────────────────────────────────────────────────────── ' Check to see if the left button was clicked on the up arrow part ' of the scroll bar. Is so, decrement the pointers. '────────────────────────────────────────────────────────────────────── IF (my% = topRow%) AND (mx% = leftCol% + maxWidth% + 2) THEN k$ = UpArrowKey$ END IF '────────────────────────────────────────────────────────────────────── ' Now check to see if the left button was clicked on the down arrow part ' of the scroll bar. Is so, increment the pointers. '────────────────────────────────────────────────────────────────────── IF (my% = botRow%) AND (mx% = leftCol% + maxWidth% + 2) THEN k$ = DownArrowKey$ END IF '────────────────────────────────────────────────────────────────────── ' If the left mouse button was clicked on the scroll bar itself, then ' execute a PgUp or PgDn, based on where the elevator is. '────────────────────────────────────────────────────────────────────── IF (mx% = leftCol% + maxWidth% + 2) AND (my% < elevatorPos% + (topRow% - 1)) AND (my% >= topRow% + 1) THEN k$ = PgUpKey$ END IF IF (mx% = leftCol% + maxWidth% + 2) AND (my% > elevatorPos% + (topRow% - 1)) AND (my% <= botRow% - 1) THEN k$ = PgDnKey$ END IF END IF '──────────────────────────────────────────────────────────────────────── ' If the right mouse button was pressed, then get outta here. First, ' though, just to be tidy, we're going to drain that right button press ' from the mouse click buffer. '──────────────────────────────────────────────────────────────────────── IF (rmCnt%) THEN MouseButtonPressInfo RIGHTBUTTON, rmCnt%, mx%, my% done% = TRUE END IF '──────────────────────────────────────────────────────────────────────── ' Decide what to do based on the user's keystroke '──────────────────────────────────────────────────────────────────────── SELECT CASE k$ CASE UpArrowKey$ ' Move list up one IF (topPtr% > 1) THEN topPtr% = topPtr% - 1 botPtr% = botPtr% - 1 ' botPtr% = topPtr% + (botRow% - topRow%) updateList% = TRUE END IF CASE DownArrowKey$ ' Move list down one IF (botPtr% < listLen%) THEN botPtr% = botPtr% + 1 topPtr% = topPtr% + 1 updateList% = TRUE END IF CASE PgUpKey$ ' Move up one screen's worth IF topPtr% > (botRow% - topRow%) THEN ' Got a whole screen's worth? topPtr% = topPtr% - (botRow% - topRow%) botPtr% = botPtr% - (botRow% - topRow%) updateList% = TRUE ELSE topPtr% = 1 botPtr% = (botRow% - topRow%) + 1 updateList% = TRUE END IF CASE PgDnKey$, enter$ ' Move down one screen's worth IF botPtr% <= listLen% - (botRow% - topRow%) THEN ' Got a whole screen's worth? topPtr% = topPtr% + (botRow% - topRow%) botPtr% = botPtr% + (botRow% - topRow%) updateList% = TRUE ELSE ' --- No topPtr% = listLen% - (botRow% - topRow%) botPtr% = listLen% updateList% = TRUE END IF CASE HomeKee$ ' Move to top of overall list IF (topPtr% > 1) THEN topPtr% = 1 botPtr% = (botRow% - topRow%) + 1 updateList% = TRUE END IF CASE EndKee$ ' Move to bottom of overall list IF (botPtr% < listLen%) THEN topPtr% = listLen% - (botRow% - topRow%) botPtr% = listLen% updateList% = TRUE END IF CASE esc$ ' User wants out done% = TRUE CASE ELSE ' Invalid key was hit IF k$ <> "" THEN PLAY errorTone$ END IF END SELECT '──────────────────────────────────────────────────────────────────────── ' If required, update the scroll bar display. '──────────────────────────────────────────────────────────────────────── IF (scrollBarFlag%) AND (updateList%) THEN IF useMouse% THEN MouseHide END IF FOR i% = topRow% + 1 TO botRow% - 1 LOCATE i%, leftCol% + maxWidth% + 2, 0 PRINT CHR$(177); NEXT i% elevatorPos% = CalcScrollPos%(listLen% - (botPtr% - topPtr%), elevatorFloors%, topPtr%) QBPrint CHR$(219), topRow% + elevatorPos%, leftCol% + maxWidth% + 2, fg%, bg% END IF '──────────────────────────────────────────────────────────────────────── ' If required, update the display. '──────────────────────────────────────────────────────────────────────── IF updateList% THEN IF useMouse% THEN MouseHide END IF ' Update the list COLOR fg%, bg% FOR i% = topPtr% TO botPtr% LOCATE topRow% + i% - topPtr%, leftCol%, 0 PRINT LEFT$(" " + list$(i%) + SPACE$(maxWidth%), maxWidth% + 1) + " "; NEXT i% updateList% = FALSE END IF LOOP UNTIL done% END SUB SUB Wipe (top%, bottom%, lft%, rght%, back%) '┌────────────────────────────────────────────────────────────────────────┐ '│ This routine clears off a selected portion of the screen. Note that │ '│ the area cleared by this routine is always INSIDE the box defined by │ '│ coordinates passed in. This allows you to use the same values used │ '│ for the window being WIPEd, without having to adjust them by one to │ '│ avoid erasing your window border. │ '│ The passed parameters are: │ '│ │ '│ top% - The top-most row to clear. Allowable range is 1 to 25. │ '│ bottom% - The bottom-most row to clear. Allowable range is │ '│ 1 to 25. │ '│ lft% - The left-most column to clear. Allowable range is 1 to │ '│ 80. │ '│ rght% - The right-most column to clear. Allowable range is │ '│ 1 to 80. │ '│ back% - The background color to clear with. Allowable range is │ '│ 0 to 7. │ '└────────────────────────────────────────────────────────────────────────┘ '───────────────────────────────────────────────────────────────────────── ' Change to the passed background color '───────────────────────────────────────────────────────────────────────── COLOR , back% '───────────────────────────────────────────────────────────────────────── ' Clear the selected portion of the screen by overwriting with spaces '───────────────────────────────────────────────────────────────────────── FOR x% = top% + 1 TO bottom% - 1 LOCATE x%, lft% + 1, 0 PRINT SPACE$(rght% - lft% - 1); NEXT x% END SUB