'ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿ '³ ³ '³ Q B S C R . B A S ³ '³ ³ '³ The QBSCR Screen Routines for QuickBASIC 4.0+ Programmers ³ '³ Version 1.5 ³ '³ ³ '³ (C) Copyright 1989 by Tony Martin ³ '³ ³ 'ÃÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ´ '³ ³ '³ This source code is copyright 1989 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. ³ '³ ³ '³ This package is shareware. If you find it useful or use it in any ³ '³ software you release, you are requested to send a donation of $15.00 ³ '³ 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. ³ '³ ³ 'ÃÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ´ '³ ³ '³ Usage Instructions: ³ '³ ³ '³ These routines are designed to be used as a supplement to the ³ '³ programs you write. They provide capabilities not included in the ³ '³ QuickBASIC language. ³ '³ ³ '³ To use the routines, simply start QuickBASIC and load or begin ³ '³ entering the code for your own program. Then load the file ³ '³ QBSCR.BAS. With both programs in QuickBASIC at the same time, you ³ '³ can call any of the QBSCR functions with a CALL statement. If you ³ '³ prefer not to use CALL, then you must include the DECLARE statements ³ '³ for the QBSCR routines in your own program. You can do this by ³ '³ adding the line ³ '³ ³ '³ REM $Include: 'QBSCR.INC' ³ '³ ³ '³ at the beginning of your program. This file contains the necessary ³ '³ DECLARE statements. ³ '³ ³ '³ When you compile your program from the environment, the QBSCR code ³ '³ will be linked in automatically. ³ '³ ³ '³ An alternate method would be to use the Quick Library version of the ³ '³ QBSCR routines. Make a Quick Library version of the Screen Routines ³ '³ by loading this source code into QuickBASIC and selecting the "Make ³ '³ Library" function from the Run menu. Then load the library with your ³ '³ your program when you load it into QuickBASIC. Do this by starting ³ '³ QuickBASIC with the command ³ '³ ³ '³ QB MYPROG /L QBSCR ³ '³ ³ '³ For detailed information, see the QBSCR documentation. ³ '³ ³ 'ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ 'ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ ' DECLARE statements for all the QBSCR routines 'ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ DECLARE FUNCTION BlockSize% (l%, r%, t%, b%) DECLARE FUNCTION ColorChk () DECLARE FUNCTION GetBackground% (row%, col%) DECLARE FUNCTION GetForeground% (row%, col%) DECLARE FUNCTION GetString$ (leftCol!, row%, strLen%, foreColor%, backColor%) DECLARE FUNCTION GetVideoSegment! () DECLARE FUNCTION MakeMenu% (choice$(), numOfChoices%, justify$, leftColumn!, rightColumn!, row%, marker$, fg%, bg%, hfg%, hbg%, qfg%, qbg%) DECLARE FUNCTION SubMenu% (choice$(), currentMenu%, numOfChoices%, justify$, leftColumn!, rightColumn!, row%, marker$, fg%, bg%, hfg%, hbg%, qfg%, qbg%) DECLARE FUNCTION ScreenBlank$ (delay) DECLARE SUB Banner (st$, row%) DECLARE SUB BlockRestore (l%, r%, t%, b%, scrArray%(), segment!) DECLARE SUB BlockSave (l%, r%, t%, b%, scrArray%(), segment!) DECLARE SUB BuildScreen (file$, mode%) DECLARE SUB Center (st$, row%) DECLARE SUB ClrScr (mode%, fillChar$) DECLARE SUB DisplayEntry (entry$, qfg%, qbg%, hfg%, hbg%, fg%, bg%, marker$, actionCode%) DECLARE SUB GetScreen (file$) DECLARE SUB PutScreen (file$) DECLARE SUB MakeWindow (topRow!, leftCol!, botRow!, rightCol!, foreColor%, backColor%, windowType%, frameType%, shadowColor%, explodeType%, label$) DECLARE SUB MultiMenu (menusArray$(), numEntries%(), menuTitles$(), justify$, marker$, shadowCode%, fg%, bg%, hfg%, hbg%, qfg%, qbg%, menuSelected%, menuEntrySelected%) DECLARE SUB OffCenter (st$, row%, leftCol%, rightCol%) DECLARE SUB QBPrint (st$, row%, col%, fore%, back%) DECLARE SUB ScrnRestore (firstLine%, lastLine%, scrArray%(), segment) DECLARE SUB ScrnSave (firstLine%, lastLine%, scrArray%(), segment) DECLARE SUB Wipe (top%, bottom%, lft%, rght%, back%) 'ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ ' CONSTants required by the Screen Routines 'ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ CONST FALSE = 0, TRUE = NOT FALSE CONST LEFTARROWCODE = -99 CONST RIGHTARROWCODE = -98 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: NEXT d ' Delay loop - change delay above to y% = y% - 1 ' regulate speed 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% END SELECT END SUB 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 ELSE ' Programmer passed an invalide 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$, 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. ³ '³ ³ '³ 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. ³ '³ 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%. 'ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ 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 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 cel at row%, col% 'ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ step1% = (PEEK(((row% - 1) * 160) + ((col% - 1) * 2) + 1) 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% 'ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ step1% = (PEEK(((row% - 1) * 160) + ((col% - 1) * 2) + 1) 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 GetString$ (leftCol, row%, strLen%, 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: ³ '³ ³ '³ 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. ³ '³ strLen% - This is a number indicating the maximum length of the ³ '³ string the user is allowed to enter. Allowable range ³ '³ is 1 through 80. ³ '³ 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. ³ 'ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ 'ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ ' Define variables to contain keycodes 'ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ enter$ = CHR$(13) esc$ = CHR$(27) backSpace$ = CHR$(8) 'ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ ' Define errortone string to use with PLAY 'ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ errorTone$ = "L60 N1 N0 N1" 'ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ ' Clear variable that holds keystroke 'ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ key$ = "" 'ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ ' Set count of user-entered characters to 0 'ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ charCount% = 0 'ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ ' Set colors and locate the cursor 'ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ COLOR foreColor%, backColor% LOCATE row%, leftCol, 1 'ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ ' Display an empty entry field and restore cursor location 'ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ PRINT SPACE$(strLen%); LOCATE row%, leftCol, 1 'ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ ' Read keystrokes until ENTER is pressed, signalling completion. 'ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ WHILE key$ <> enter$ 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 'ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ ' If user has not reached the assigned maximum string length, ' then add the new keystroke to the entry. Otherwise, make ' an error tone. 'ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ IF charCount% < strLen% THEN st$ = st$ + key$ charCount% = charCount% + 1 LOCATE row%, leftCol + charCount% - 1, 1 PRINT key$; LOCATE row%, leftCol + charCount%, 1 ELSE PLAY errorTone$ END IF CASE backSpace$ 'ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ ' Allow corrections via the backspace key as long as the user ' has not backspaced to the beginning of the line. If they ' have, then play the error tone. 'ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ IF charCount% > 0 THEN st$ = LEFT$(st$, LEN(st$) - 1) LOCATE row%, leftCol + charCount% - 1, 1 PRINT " "; charCount% = charCount% - 1 LOCATE row%, leftCol + charCount%, 1 ELSE PLAY errorTone$ END IF CASE enter$ 'ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ ' Finished entering string - assign string to function 'ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ GetString$ = st$ CASE esc$ 'ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ ' User hit ESCape - abort entry - exit function 'ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ GetString$ = esc$ EXIT FUNCTION CASE ELSE 'ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ ' Unacceptable key was hit 'ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ PLAY errorTone$ END SELECT ' CASE Key$ WEND ' WHILE Key$ <> Enter$ END FUNCTION 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$, fg%, bg%, hfg%, hbg%, qfg%, qbg%) 'ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿ '³ 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. '³ 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. ³ 'ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ 'ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ ' 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) end$ = CHR$(0) + CHR$(79) pgUp$ = CHR$(0) + CHR$(73) pgDn$ = CHR$(0) + CHR$(81) esc$ = CHR$(27) 'ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ ' 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% < 2 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 choiceLen% = LEN(choice$(x%)) END IF NEXT x% choiceLen% = choiceLen% - 1 'ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ ' Determine left-most column to display highlight bar on 'ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ col = (((rightColumn - leftColumn - 1) - choiceLen%) / 2) + leftColumn 'ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ ' 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$, 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$, 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$, 1 NEXT x% END SELECT 'ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ ' Highlight the first entry in the list. Must take into account the ' justification type. 'ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ currentLocation% = 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$, 2 CASE "R" LOCATE (row% - 1) + currentLocation%, (rightColumn - LEN(choice$(currentLocation%))) DisplayEntry choice$(currentLocation%), qfg%, qbg%, hfg%, hbg%, fg%, bg%, marker$, 2 CASE "L" LOCATE (row% - 1) + currentLocation%, leftColumn DisplayEntry choice$(currentLocation%), qfg%, qbg%, hfg%, hbg%, fg%, bg%, marker$, 2 END SELECT 'ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ ' Read keystrokes and change the highlighted entry appropriately 'ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ exitCode = FALSE WHILE exitCode = FALSE 'ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ ' Read keystrokes 'ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ key$ = "" WHILE key$ = "" LET key$ = UCASE$(INKEY$) WEND SELECT CASE key$ CASE up$, down$, home$, end$, pgUp$, pgDn$ '=== Legal movement 'ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ ' Restore old highlighted choice to normal colors 'ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ COLOR fg%, bg% LOCATE (row% - 1) + currentLocation%, 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$, 1 CASE "R" LOCATE (row% - 1) + currentLocation%, (rightColumn - LEN(choice$(currentLocation%))) DisplayEntry choice$(currentLocation%), qfg%, qbg%, hfg%, hbg%, fg%, bg%, marker$, 1 CASE "L" LOCATE (row% - 1) + currentLocation%, leftColumn, 0 DisplayEntry choice$(currentLocation%), qfg%, qbg%, hfg%, hbg%, fg%, bg%, marker$, 1 END SELECT CASE CHR$(32) TO CHR$(127) 'If valid KEY code, then restore old entry FOR x% = 1 TO numOfChoices% IF key$ = charID(x%) THEN COLOR fg%, bg% LOCATE (row% - 1) + currentLocation%, 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$, 1 EXIT FOR CASE "R" LOCATE (row% - 1) + currentLocation%, (rightColumn - LEN(choice$(currentLocation%))) DisplayEntry choice$(currentLocation%), qfg%, qbg%, hfg%, hbg%, fg%, bg%, marker$, 1 EXIT FOR CASE "L" LOCATE (row% - 1) + currentLocation%, leftColumn, 0 DisplayEntry choice$(currentLocation%), qfg%, qbg%, hfg%, hbg%, fg%, bg%, marker$, 1 EXIT FOR END SELECT END IF NEXT x% CASE ELSE 'Nuthin! END SELECT 'ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ ' Update our highlight bar's location based on which key was hit 'ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ SELECT CASE key$ CASE up$ 'ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ ' Set new currentLocation% 'ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ IF currentLocation% = 1 THEN currentLocation% = numOfChoices% ELSE currentLocation% = currentLocation% - 1 END IF CASE down$ 'ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ ' Set New currentLocation% 'ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ IF currentLocation% = numOfChoices% THEN currentLocation% = 1 ELSE currentLocation% = currentLocation% + 1 END IF CASE enter$ 'ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ ' Set MakeMenu to highlighted selection and exit 'ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ MakeMenu% = currentLocation% 'ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ ' Instead of using exitCode to beak out of this, we have to ' use EXIT FUNCTION, or it never quits. 'ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ EXIT FUNCTION CASE home$, pgUp$ 'ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ ' Set New currentLocation% 'ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ currentLocation% = 1 CASE end$, pgDn$ 'ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ ' Set New currentLocation% 'ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ currentLocation% = numOfChoices% CASE esc$ 'ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ ' User hit ESCAPE key, so set MakeMenu to 0 nd exit 'ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ MakeMenu% = 0 EXIT FUNCTION CASE CHR$(32) TO CHR$(127) 'ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ ' Check for "Quick Access" codes 'ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ validEntry% = FALSE FOR x% = 1 TO numOfChoices% IF key$ = charID(x%) THEN MakeMenu% = x% currentLocation% = x% validEntry% = TRUE END IF NEXT x% IF validEntry% = FALSE THEN PLAY errorTone$ END IF CASE ELSE 'ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ ' Play Error Tone - change this around if your don't like it 'ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ PLAY errorTone$ END SELECT 'ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ ' Highlight the entry indicated by CurrentLocation% 'ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ SELECT CASE key$ CASE up$, down$, home$, end$, pgUp$, pgDn$ 'ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ ' Highlight new choice 'ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ COLOR hfg%, hbg% LOCATE (row% - 1) + currentLocation%, 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$, 2 CASE "R" LOCATE (row% - 1) + currentLocation%, (rightColumn - LEN(choice$(currentLocation%))) DisplayEntry choice$(currentLocation%), qfg%, qbg%, hfg%, hbg%, fg%, bg%, marker$, 2 CASE "L" LOCATE (row% - 1) + currentLocation%, leftColumn, 0 DisplayEntry choice$(currentLocation%), qfg%, qbg%, hfg%, hbg%, fg%, bg%, marker$, 2 END SELECT CASE CHR$(32) TO CHR$(127) FOR x% = 1 TO numOfChoices% IF key$ = charID(x%) THEN 'ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ ' Highlight new choice 'ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ COLOR hfg%, hbg% LOCATE (row% - 1) + currentLocation%, 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$, 2 EXIT FUNCTION CASE "R" LOCATE (row% - 1) + currentLocation%, (rightColumn - LEN(choice$(currentLocation%))) DisplayEntry choice$(currentLocation%), qfg%, qbg%, hfg%, hbg%, fg%, bg%, marker$, 2 EXIT FUNCTION CASE "L" LOCATE (row% - 1) + currentLocation%, leftColumn, 0 DisplayEntry choice$(currentLocation%), qfg%, qbg%, hfg%, hbg%, fg%, bg%, marker$, 2 EXIT FUNCTION END SELECT END IF NEXT x% CASE ELSE 'Nuthin! END SELECT 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 > 22 THEN topRow = 22 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 > 79 THEN leftCol = 79 IF foreColor% < 0 OR foreColor% > 15 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% > 5 THEN frameType% = 0 IF shadowColor% > 16 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 ' 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 ' 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? FOR x% = 1 TO numLines LOCATE (x% + (topRow - 1)), leftCol: PRINT line$(x%); NEXT x% 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 'ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ FOR x% = 1 TO numLines LOCATE (x% + (topRow - 1)), leftCol: PRINT line$(x%); NEXT x% 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 special 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 ELSE END SELECT ' shadowColor% 'ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ ' Add the Window Label, if possible. Set the colors to those passed ' to MakeWindow routine. 'ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ COLOR foreColor%, backColor% 'ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ ' 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 MultiMenu (menusArray$(), numEntries%(), menuTitles$(), justify$, marker$, shadowCode%, fg%, bg%, hfg%, hbg%, qfg%, qbg%, menuSelected%, menuEntrySelected%) 'ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿ '³ 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. ³ '³ 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. ³ '³ 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%. ³ '³ ³ '³ See the QBSCR Screen Routines documentation for more details. ³ 'ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ 'ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ ' Define special keys 'ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ leftArrow$ = CHR$(0) + CHR$(75) rightArrow$ = CHR$(0) + CHR$(77) downArrow$ = CHR$(0) + CHR$(80) homeKey$ = CHR$(0) + CHR$(71) endKey$ = CHR$(0) + CHR$(79) enter$ = CHR$(13) esc$ = CHR$(27) 'ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ ' Determine number of menus 'ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ numMenus% = UBOUND(menusArray$, 1) 'ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ ' Determine all QuickAccess keys for the menu titles 'ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ DIM charID(1 TO numMenus%) AS STRING * 1 FOR x% = 1 TO numMenus% 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% 'ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ ' Display pull-down menus line 'ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ COLOR fg%, bg% LOCATE 1, 1, 0: PRINT SPACE$(80); colCount% = 0 FOR x% = 1 TO numMenus% LOCATE 1, 2 + colCount%, 0: DisplayEntry menuTitles$(x%), qfg%, qbg%, hfg%, hbg%, fg%, bg%, marker$, 1 colCount% = colCount% + LEN(menuTitles$(x%)) + 1 NEXT x% 'ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ ' Display highlight for first entry 'ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ COLOR hfg%, hbg% LOCATE 1, 2, 0: DisplayEntry menuTitles$(1), qfg%, qbg%, hfg%, hbg%, fg%, bg%, marker$, 2 'ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ ' Wait for keystrokes 'ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ currentMenu% = 1 oldMenu% = 1 done% = FALSE DO DO k$ = UCASE$(INKEY$) LOOP UNTIL k$ <> "" SELECT CASE k$ CASE leftArrow$ ' Move highlight to the left IF currentMenu% > 1 THEN currentMenu% = currentMenu% - 1 ELSE currentMenu% = numMenus% END IF CASE rightArrow$ ' Move highlight to the right IF currentMenu% < numMenus% THEN currentMenu% = currentMenu% + 1 ELSE currentMenu% = 1 END IF CASE homeKey$ currentMenu% = 1 CASE endKey$ currentMenu% = numMenus% CASE enter$, downArrow$ ' 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 EXIT FOR END IF NEXT x% END SELECT 'ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ ' Update highlight 'ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ colCount% = 0 FOR x% = 1 TO oldMenu% - 1 colCount% = colCount% + LEN(menuTitles$(x%)) + 1 NEXT x% LOCATE 1, 2 + colCount%, 0: DisplayEntry menuTitles$(x%), qfg%, qbg%, hfg%, hbg%, fg%, bg%, marker$, 1 oldMenu% = currentMenu% colCount% = 0 FOR x% = 1 TO currentMenu% - 1 colCount% = colCount% + LEN(menuTitles$(x%)) + 1 NEXT x% LOCATE 1, 2 + colCount%, 0: DisplayEntry menuTitles$(x%), qfg%, qbg%, hfg%, hbg%, fg%, bg%, marker$, 2 LOOP UNTIL done% 'ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ ' 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% = colCount% + 1 IF lft% < 1 THEN lft% = 1 END IF rght% = lft% + longestEntry% + 2 IF rght% > 78 THEN lft% = lft% - (rght% - 78) rght% = 78 END IF top% = 2 bot% = top% + numEntries%(currentMenu%) + 1 'ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ ' 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, 0, shadowCode%, 0, "" 'ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ ' Make the menu for the current menu 'ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ choice% = SubMenu%(menusArray$(), currentMenu%, numEntries%(currentMenu%), justify$, lft% + 2, rght% - 2, 3, marker$, fg%, bg%, hfg%, hbg%, qfg%, qbg%) 'ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ ' 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 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 'ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ colCount% = 0 FOR x% = 1 TO oldMenu% - 1 colCount% = colCount% + LEN(menuTitles$(x%)) + 1 NEXT x% LOCATE 1, 2 + colCount%, 0: DisplayEntry menuTitles$(x%), qfg%, qbg%, hfg%, hbg%, fg%, bg%, marker$, 1 oldMenu% = currentMenu% colCount% = 0 FOR x% = 1 TO currentMenu% - 1 colCount% = colCount% + LEN(menuTitles$(x%)) + 1 NEXT x% LOCATE 1, 2 + colCount%, 0: DisplayEntry menuTitles$(x%), qfg%, qbg%, hfg%, hbg%, fg%, bg%, marker$, 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 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) 'ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿ '³ 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. ³ 'ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ 'ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ ' 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$ = "" 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."; LOCATE yCoord% + 1, xCoord%, 0: PRINT " Hit any key to return..."; 'ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ ' 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 SubMenu% (choice$(), currentMenu%, numOfChoices%, justify$, leftColumn, rightColumn, row%, marker$, fg%, bg%, hfg%, hbg%, qfg%, qbg%) 'ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿ '³ 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) end$ = CHR$(0) + CHR$(79) pgUp$ = CHR$(0) + CHR$(73) pgDn$ = CHR$(0) + CHR$(81) leftArrow$ = CHR$(0) + CHR$(75) rightArrow$ = CHR$(0) + CHR$(77) 'ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ ' 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 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 choiceLen% = LEN(choice$(currentMenu%, x%)) END IF NEXT x% choiceLen% = choiceLen% - 1 'ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ ' Determine left-most column to display highlight bar on 'ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ col = (((rightColumn - leftColumn - 1) - choiceLen%) / 2) + leftColumn 'ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ ' 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$, 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$, 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$, 1 NEXT x% END SELECT 'ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ ' Highlight the first entry in the list. Must take into account the ' justification type. 'ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ currentLocation% = 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$, 2 CASE "R" LOCATE (row% - 1) + currentLocation%, (rightColumn - LEN(choice$(currentMenu%, currentLocation%))) DisplayEntry choice$(currentMenu%, currentLocation%), qfg%, qbg%, hfg%, hbg%, fg%, bg%, marker$, 2 CASE "L" LOCATE (row% - 1) + currentLocation%, leftColumn DisplayEntry choice$(currentMenu%, currentLocation%), qfg%, qbg%, hfg%, hbg%, fg%, bg%, marker$, 2 END SELECT 'ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ ' Read keystrokes and change the highlighted entry appropriately 'ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ exitCode = FALSE WHILE exitCode = FALSE 'ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ ' Read keystrokes 'ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ key$ = "" WHILE key$ = "" LET key$ = UCASE$(INKEY$) WEND SELECT CASE key$ CASE up$, down$, home$, end$, pgUp$, pgDn$ '=== Legal movement 'ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ ' Restore old highlighted choice to normal colors 'ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ COLOR fg%, bg% LOCATE (row% - 1) + currentLocation%, 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$, 1 CASE "R" LOCATE (row% - 1) + currentLocation%, (rightColumn - LEN(choice$(currentMenu%, currentLocation%))) DisplayEntry choice$(currentMenu%, currentLocation%), qfg%, qbg%, hfg%, hbg%, fg%, bg%, marker$, 1 CASE "L" LOCATE (row% - 1) + currentLocation%, leftColumn, 0 DisplayEntry choice$(currentMenu%, currentLocation%), qfg%, qbg%, hfg%, hbg%, fg%, bg%, marker$, 1 END SELECT CASE leftArrow$ SubMenu% = LEFTARROWCODE EXIT FUNCTION CASE rightArrow$ SubMenu% = RIGHTARROWCODE EXIT FUNCTION CASE CHR$(32) TO CHR$(127) 'If valid KEY code, then restore old entry FOR x% = 1 TO numOfChoices% IF key$ = charID(x%) THEN COLOR fg%, bg% LOCATE (row% - 1) + currentLocation%, 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$, 1 EXIT FOR CASE "R" LOCATE (row% - 1) + currentLocation%, (rightColumn - LEN(choice$(currentMenu%, currentLocation%))) DisplayEntry choice$(currentMenu%, currentLocation%), qfg%, qbg%, hfg%, hbg%, fg%, bg%, marker$, 1 EXIT FOR CASE "L" LOCATE (row% - 1) + currentLocation%, leftColumn, 0 DisplayEntry choice$(currentMenu%, currentLocation%), qfg%, qbg%, hfg%, hbg%, fg%, bg%, marker$, 1 EXIT FOR END SELECT END IF NEXT x% CASE CHR$(27) ' The ESC key SubMenu% = 27 EXIT FUNCTION CASE ELSE 'Nuthin! END SELECT 'ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ ' Update our highlight bar's location based on which key was hit 'ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ SELECT CASE key$ CASE up$ 'ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ ' Set new currentLocation% 'ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ IF currentLocation% = 1 THEN currentLocation% = numOfChoices% ELSE currentLocation% = currentLocation% - 1 END IF CASE down$ 'ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ ' Set New currentLocation% 'ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ IF currentLocation% = numOfChoices% THEN currentLocation% = 1 ELSE currentLocation% = currentLocation% + 1 END IF CASE enter$ 'ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ ' Set MakeMenu to highlighted selection and exit 'ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ SubMenu% = currentLocation% 'ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ ' Instead of using exitCode to beak out of this, we have to ' use EXIT FUNCTION, or it never quits. 'ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ EXIT FUNCTION CASE home$, pgUp$ 'ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ ' Set New currentLocation% 'ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ currentLocation% = 1 CASE end$, pgDn$ 'ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ ' Set New currentLocation% 'ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ currentLocation% = numOfChoices% CASE CHR$(32) TO CHR$(127) 'ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ ' Check for "Quick Access" codes 'ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ validEntry% = FALSE FOR x% = 1 TO numOfChoices% IF key$ = charID(x%) THEN SubMenu% = x% currentLocation% = x% validEntry% = TRUE END IF NEXT x% IF validEntry% = FALSE THEN PLAY errorTone$ END IF CASE ELSE 'ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ ' Play Error Tone - change this around if your don't like it 'ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ PLAY errorTone$ END SELECT 'ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ ' Highlight the entry indicated by CurrentLocation% 'ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ SELECT CASE key$ CASE up$, down$, home$, end$, pgUp$, pgDn$ 'ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ ' Highlight new choice 'ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ COLOR hfg%, hbg% LOCATE (row% - 1) + currentLocation%, 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$, 2 CASE "R" LOCATE (row% - 1) + currentLocation%, (rightColumn - LEN(choice$(currentMenu%, currentLocation%))) DisplayEntry choice$(currentMenu%, currentLocation%), qfg%, qbg%, hfg%, hbg%, fg%, bg%, marker$, 2 CASE "L" LOCATE (row% - 1) + currentLocation%, leftColumn, 0 DisplayEntry choice$(currentMenu%, currentLocation%), qfg%, qbg%, hfg%, hbg%, fg%, bg%, marker$, 2 END SELECT CASE CHR$(32) TO CHR$(127) FOR x% = 1 TO numOfChoices% IF key$ = charID(x%) THEN 'ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ ' Highlight new choice 'ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ COLOR hfg%, hbg% LOCATE (row% - 1) + currentLocation%, 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$, 2 EXIT FUNCTION CASE "R" LOCATE (row% - 1) + currentLocation%, (rightColumn - LEN(choice$(currentMenu%, currentLocation%))) DisplayEntry choice$(currentMenu%, currentLocation%), qfg%, qbg%, hfg%, hbg%, fg%, bg%, marker$, 2 EXIT FUNCTION CASE "L" LOCATE (row% - 1) + currentLocation%, leftColumn, 0 DisplayEntry choice$(currentMenu%, currentLocation%), qfg%, qbg%, hfg%, hbg%, fg%, bg%, marker$, 2 EXIT FUNCTION END SELECT END IF NEXT x% CASE ELSE 'Nuthin! END SELECT WEND END FUNCTION 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