'ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿ '³ ³ '³ 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