' +--------------------------------------------------------------------+ ' | | ' | - M e n u B o x . B a s - | ' | | ' | Public Domain - FreeWare | ' +--------------------------------------------------------------------+ ' | MenuBox.Bas is FreeWare Public Domain software by Don Smith | ' | written on 03/25/2002. | ' +--------------------------------------------------------------------+ ' +--------------------------------------------------------------------+ ' | - ABOUT THE AUTHOR - | ' +--------------------------------------------------------------------+ ' | | ' |Hello. My name is Don Smith and I am a retired Math/History/Spanish | ' |teacher residing in Orange County, California. I am also a former | ' |6-year Sergeant of Marines. Who-Rah! On certain forums I am known | ' |as MarineDon. My email is: smithdonb@earthlink.net | ' | | ' +--------------------------------------------------------------------+ ' +--------------------------------------------------------------------+ ' | - COPYING AND DISTIBUTING - | ' +--------------------------------------------------------------------+ ' | Since this code is public domain and freeware, anyone may freely | ' | copy and distribute it. If you use the QuickBasic code in one of | ' | your own programs, you do not have to cite my name as the author, | ' | and you may even change its name. | ' +--------------------------------------------------------------------+ ' +--------------------------------------------------------------------+ ' | Menu&Box.Bas was written by Don Smith on 03/25/2002. | ' | Don's EMail: smithdonb@earthlink.net | ' +--------------------------------------------------------------------+ ' | There are four SUBs: (1) BBMenu, (2) BoxBoy, | ' | (3) BoxNoLines and (4) SaveRestScrn | ' +--------------------------------------------------------------------+ ' | Anyone may use these four SUBs anywhere they wish without naming | ' | me as the author. Menu&Box.Bas, SUB BBMenu, SUB BoxBoy | ' | SUB BoxNoLines and SUB SaveRestScrn are this date, March 25, 2002,| ' | placed in the Public Domain as FreeWare. Only regular QuickBASIC | ' | commands are needed here. No special Library or QuickLibrary | ' | is required. | ' +--------------------------------------------------------------------+ ' | SUB Information: | ' | --------------- | ' | (1) BBMenu is a complete menu system, whereby a programmer | ' | will be able to (use) : (See BBMenu SUB for info) | ' | | ' | 1. Single or double spaced menu items. | ' | 2. Letters, numbers or plain. | ' | 3. Horizontal lines placed in menu. | ' | 4. Start menu at a selection preset | ' | by the programmer. | ' | 5. keys and other extended keys may | ' | be pressed. | ' | | ' | (2) BoxBoy is designed to be a fairly complete box or | ' | window system. A programmer will be able to: | ' | (See BoxBoy SUB for more info) | ' | | ' | 1. Select the size and type of box, with | ' | single or double lines. | ' | 2. Place a shadow either to the left or to | ' | the right or no shadow at all. | ' | 3. Include a title at the top or not. | ' | | ' | (3) BoxNoLines is a very neat box with no lines. | ' | | ' | 1. It has a title box area as one solid color. | ' | 2. A shadow may be placed to the right, left | ' | or no shadow. | ' | 3. A light colored line along the side of the | ' | box may be used to good effect. | ' | | ' | | ' | (4) SaveRestScrn is to be used with BoxBoy above (or | ' | anywhere else) so that a section of an underlying | ' | screen may be saved and later restored enabling a | ' | programmer to pop up a window or box as a special | ' | help screen or for other reasons. When the | ' | underlying screen is restored, the correct and | ' | matching colors are also restored. | ' | (See SaveRestScrn SUB for more info. | ' +--------------------------------------------------------------------+ ' | This program demos the power of MenuBox.Bas. Try it. You'll like | ' | it! Check SUB BBMenu for info on CVI Code. | ' +--------------------------------------------------------------------+ ' | | ' | Compile: | ' | BC: menubox | ' | LINK: menubox | ' | LIB: bcom45 | ' | | ' +--------------------------------------------------------------------+ DEFINT A-Z '------------------------------------------------------------------------ DECLARE SUB BBMenu (Menu$(), Row, Column, MaxItems, FG, BG, HiLiteFG, HiLiteBG, SD, LenLine, Last, HotItem, Selection) DECLARE SUB BoxBoy (Title$, ULRow%, ULCol%, LRRow%, LRCol%, TitleRow%, TitleCol%, TitColrFG%, TitColrBG%, BoxColrFG%, BoxColrBG%, BoxStyle%, Shadow%, ShadowColr%, EdgeYN%) DECLARE SUB SaveRestScrn (ReadLine$(), ReadColr%(), SR.UL.Row%, SR.UL.Col%, SR.LR.Row%, SR.LR.Col%, SaveOrRest%) DECLARE SUB BoxNoLines (ULR%, ULC%, LRR%, LRC%, NLColrFG%, NLColrBG%, Shade%, Title$, LineYN%, RowOfTitle%, ColOfTitle%, TopColrFG%, TopColrBG%, FGColrTit%, BGColrTit%, LightLine%, ClearDaScrn%) menu.one: '----Box Items--------+--(See SUB BoxBoy for detailed explanation)------+ Title$ = "Menu One" ' | Title of the menu (Use Title$ = "" if NO Title) | ULRow% = 3 ' | Upper Left Row (Corner) | ULCol% = 20 ' | Upper Left Column | LRRow% = 16 ' | Lower Right Row (Corner) | LRCol% = 55 ' | Lower Right Column | TitleRow% = 4 ' | Row number to place the title of box | TitleCol% = 35 ' | Column number to place the title of box | TitColrFG% = 1 ' | Foreground color of the title (1-15) | TitColrBG% = 7 ' | Back ground color of the title (1-7) | BoxColrFG% = 0 ' | Foreground color of the box (1-15) | BoxColrBG% = 7 ' | Back ground color of the box(1-7) | BoxStyle% = 2 ' | Box style. 1 = single line. 2 = double line | Shadow% = 1 ' | Right shadow = 1. Left shadow = 2. No shadow = 0| ShadowColr% = 8 ' | Will clear (1) or not clear (2) | EdgeYN% = 1 ' | Yes, edge will be one space right & left. | '---------------------+-------------------------------------------------+ '-------------------See SUB BBMenu for complete details-----------------+ Row = 6 '........Row to place menu. | Column = 29 '........Column to place menu. | MaxItems = 10 '........Number of menu items. | FG = 0 '........Menu foreground color. | BG = 7 '........Menu back grounc color. | HiLiteFG = 15 '........Hi light foreground color. | HiLiteBG = 0 '........Hi light back grounc color. | SD = 1 '........SD = 1 (single spaced). SD = 2 (double spaced).| LenLine = 20 '........Length of line(s) placed in menu (if any). | HotItem = 0 '........HotItem = 0 | ' ----------- | ' The extreme left character when pressed, will | ' exit with the number of that character. It | ' will always be reported as a number. | ' Example: A/a = 1. D/d = 4 | ' | ' HotItem = 1 | ' ----------- | ' Only , and | ' are active. Leading character action turned off.| ' | Selection = 1 '........Which item to initially hi light. | '---------------+-------------------------------------------------------+ '--Menu Items----------Menu 1------+------------------------------------+ REDIM Menu$(MaxItems + 1) '| REDIM by MaxItems% + 1 | Menu$(1) = "1. Look Up A Name" '| -----------------------------------+ Menu$(2) = "2. Input A Name" '| Suggest using numbers up to 10. | Menu$(3) = "3. Edit A Name" '| For 10, press (0) or zero. | Menu$(4) = "4. Remove A Name" '| For longer menus, use letters | Menu$(5) = "5. Print Name(s)" '| A to Y. Letters will be reported | Menu$(6) = "6. View Names" '| as Selection% numbers 1-26. | Menu$(7) = "7. Documentation" '| | Menu$(8) = "8. To Do List" '| | Menu$(9) = "9. Regular Clients" '| | Menu$(10) = "0. Exit Program" '| | '---------------------------------+------------------------------------+ COLOR 15, 0: CLS COLOR 0, 7 LOCATE 1, 2 COLOR 9, 1 PRINT " " + "Ú" + STRING$(74, "Â") + "¿" + " "; FOR MkScrn = 2 TO 24 LOCATE MkScrn, 2 COLOR 9, 1 PRINT " " + "Ã" + STRING$(74, "Å") + "´" + " "; NEXT LOCATE 25, 2 PRINT " " + "À" + STRING$(74, "Á") + "Ù" + " "; CALL BoxBoy(Title$, ULRow%, ULCol%, LRRow%, LRCol%, TitleRow%, TitleCol%, TitColrFG%, TitColrBG%, BoxColrFG%, BoxColrBG%, BoxStyle%, Shadow%, ShadowColr%, EdgeYN%) COLOR 15, 1 LOCATE 19, 24: PRINT " Press on a number, " LOCATE 20, 24: PRINT " or press a number 1 - 10. " LOCATE 22, 16: PRINT " NOTE 1: Shadow to the right. "; LOCATE 23, 16: PRINT " NOTE 2: Underlying screen under shadow is saved. "; ExitCode% = 0 go.one: CALL BBMenu(Menu$(), Row, Column, MaxItems, FG, BG, HiLiteFG, HiLiteBG, SD, LenLine, HotItem, Selection, ExitCode) FirstX% = FirstX% + 1 IF FirstX% = 1 THEN 'The following shows how to use the SUB SaveRestScrn: REDIM ReadLine$(25) REDIM ReadColr%(25, 80) CALL SaveRestScrn(ReadLine$(), ReadColr%(), 1, 1, 25, 80, 1) CALL BoxBoy("Demo Of SUB SaveRestScrn", 6, 19, 13, 50, 7, 24, 15, 4, 15, 4, 1, 1, 8, 1) COLOR 15, 4 LOCATE 9, 30: PRINT "Press Any Key" LOCATE 10, 31: PRINT "To Continue" LOCATE 11, 20: PRINT "Ã" + STRING$(31, "Ä") + "´" LOCATE 12, 29: PRINT "(You Selected" + STR$(Selection%) + ")" DO: LOOP WHILE INKEY$ = "" CALL SaveRestScrn(ReadLine$(), ReadColr%(), 1, 1, 25, 80, 2) ERASE ReadLine$: ERASE ReadColr% FOR MkScrn = 19 TO 24 LOCATE MkScrn, 2 COLOR 9, 1 PRINT " " + "Ã" + STRING$(74, "Å") + "´" + " "; NEXT CALL BoxBoy("", 19, 26, 21, 50, 1, 1, 1, 1, 15, 4, 1, 1, 8, 1) LOCATE 20, 30: COLOR 15, 4: PRINT "- Please continue -" SOUND 200, 2 GOTO go.one END IF GOSUB choice menu.two: '---------------BBMenu Sub Settings for Menu Two------------------------- Row = 6 Column = 29 MaxItems = 8 FG = 15 BG = 4 HiLiteFG = 15 HiLiteBG = 0 SD = 2 LenLine = 20 NoHot = 1 HotItem = 0 Selection = 7 '-------------------------------Menu 2----------------------------------- REDIM Menu$(MaxItems + 1) Menu$(1) = "1. Correspondense" Menu$(2) = "2. Billing" Menu$(3) = "-" Menu$(4) = "3. Meetings" Menu$(5) = "4. Personal" Menu$(6) = "-" Menu$(7) = "5. Word" Menu$(8) = "6. Exit Program" '------------------------------------------------------------------------ COLOR 15, 1: CLS CALL BoxBoy("Menu Two", 2, 21, 21, 52, 3, 33, 11, 4, 15, 4, 1, 2, 8, 1) line1$ = CHR$(195) + STRING$(31, CHR$(196)) + CHR$(180)'Put in 2 longer COLOR 15, 1 GOSUB short.message COLOR 15, 4 LOCATE 10, 22: PRINT line1$ 'The orginal line which was set LOCATE 16, 22: PRINT line1$ 'up in the menu was too short! COLOR 15, 1: LOCATE 24, 23: PRINT "Try Pressing or "; ExitCode% = 0 CALL BBMenu(Menu$(), Row, Column, MaxItems, FG, BG, HiLiteFG, HiLiteBG, SD, LenLine, HotItem, Selection, ExitCode) GOSUB choice menu.three: '---------------BBMenu SUB Settings for Menu Three----------------------- Row = 9 Column = 31 MaxItems = 8 FG = 15 BG = 2 HiLiteFG = 15 HiLiteBG = 0 SD = 1 LenLine = 20 HotItem = 0 Selection = 1 '------------------------------Menu 3------------------------------------- REDIM Menu$(MaxItems + 1) Menu$(1) = "A. Find A File" Menu$(2) = "B. Delete File" Menu$(3) = "C. Shred A File" Menu$(4) = "D. Delete Directory" Menu$(5) = "-" Menu$(6) = "E. Print Routine" Menu$(7) = "F. Documentation" Menu$(8) = "G. Exit Program" '------------------------------------------------------------------------- COLOR 15, 1: CLS CALL BoxBoy("* Menu Three *", 6, 22, 17, 54, 7, 34, 15, 2, 15, 2, 1, 0, 8, 1) line2$ = CHR$(195) + STRING$(32, CHR$(196)) + CHR$(180) COLOR 15, 2: LOCATE 13, 23: PRINT line2$ COLOR 15, 1 LOCATE 19, 26: PRINT "Letters Are Used This Time." LOCATE 21, 29: PRINT "No Shadow On This Box." ' Notice that for line 25 it is necessary to end with a semi-colon ' otherwise printing to the screen will be thrown off. See Below (). LOCATE 23, 25: PRINT "Try pressing: or ."; ExitCode% = 0 CALL BBMenu(Menu$(), Row, Column, MaxItems, FG, BG, HiLiteFG, HiLiteBG, SD, LenLine, HotItem, Selection, ExitCode) GOSUB choice menu.four: '-----------------BBMenu SUB Settings for Menu Four---------------------- Row = 5 Column = 31 MaxItems = 13 FG = 15 BG = 0 HiLiteFG = 0 HiLiteBG = 3 SD = 1 'LenLine = 20 HotItem = 1 'only and are pressed. Selection = 1 '-----------------------Menu Items---Menu 4------------------------------ REDIM Menu$(MaxItems% + 1) Menu$(1) = "Rolodex A" Menu$(2) = "Rolodex B" Menu$(3) = "Rolodex C" Menu$(4) = "Rolodex D" Menu$(5) = "Rolodex E" Menu$(6) = "Rolodex F" Menu$(7) = "Rolodex G" Menu$(8) = "Rolodex H" Menu$(9) = "Rolodex I" Menu$(10) = "Rolodex J" Menu$(11) = "Rolodex K" Menu$(12) = "Rolodex L" Menu$(13) = "Rolodex M" '------------------------------------------------------------------------ COLOR 11, 0: CLS CALL BoxBoy("", 4, 26, 18, 44, 1, 1, 1, 1, 11, 0, 1, 0, 8, 0) COLOR 14, 0: LOCATE 20, 26: PRINT "No Title To This Menu." LOCATE 21, 26: PRINT "No Shadow To This Menu." COLOR 15, 0: LOCATE 22, 17: PRINT "Use , and press ," LOCATE 23, 24: PRINT "or press or ." ExitCode% = 0 CALL BBMenu(Menu$(), Row, Column, MaxItems, FG, BG, HiLiteFG, HiLiteBG, SD, LenLine, HotItem, Selection, ExitCode) GOSUB choice menu.five: '-----------------------Special Box With No Lines------------------------ ULR% = 3 ' | Upper left row to place box ULC% = 20 ' | Upper left column to place box LRR% = 16 ' | Lower right row to place box LRC% = 60 ' | Lower right column to place box NLColrFG% = 0 ' | Foreground color of box NLColrBG% = 7 ' | Back ground color of box Shade% = 2 ' | Shade equals 1 = shadow to the right ' | Shade equals 2 = shadow to the left ' | Shade equals 0 = no shadow Title$ = "Main Menu" ' | Title of box LineYN% = 1 ' | LineYN equals 1 = place line under title ' | LineYN equals 0 = do NOT place line under title RowOfTitle% = 4 ' | Row to place title ColOfTitle% = 36 ' | Column to place title TopColrFG% = 15 ' | Foreground color of top title area TopColrBG% = 0 ' | Background color of top title area FGColrTit% = 12 ' | Foreground color title itself BGColrTit% = 0 ' | Back ground color of title itself LightLine% = 1 ' | LightLine equals 1 = yes, use a light color ' | line along side of lower box ' | LightLine equals 0 = do not use a light line ClearDaScrn% = 1 ' | ClearDaScrn equals 1 = clear screen with 1; ' | use numbers 0 to 7. ' | ClearDaScrn equals 1000 = do not clear screen '-----------------------+------------------------------------------------ CALL BoxNoLines(ULR%, ULC%, LRR%, LRC%, NLColrFG%, NLColrBG%, Shade%, Title$, LineYN%, RowOfTitle%, ColOfTitle%, TopColrFG%, TopColrBG%, FGColrTit%, BGColrTit%, LightLine%, ClearDaScrn%) '---------------BBMenu Sub Settings for Menu Five------------------------- Row = 7 Column = 30 MaxItems = 10 FG = 0 BG = 7 HiLiteFG = 15 HiLiteBG = 0 SD = 1 LenLine = 20 NoHot = 1 HotItem = 0 Selection = 1 '-------------------------------Menu 5----------------------------------- REDIM Menu$(MaxItems + 1) Menu$(1) = "1. Correspondense" Menu$(2) = "2. Billing" Menu$(3) = "3. Special Letters" Menu$(4) = "4. Meetings" Menu$(5) = "5. Personal" Menu$(6) = "6. News Reports" Menu$(7) = "7. Word" Menu$(8) = "8. Spread Sheet" Menu$(9) = "9. Telephone Numbers" Menu$(10) = "0. Exit Program" '----------------------------------------------------------------------- COLOR 15, 1 LOCATE 21, 31: PRINT "Shadow to the left."; LOCATE 22, 31: PRINT "No lines around box."; LOCATE 24, 25: PRINT "Try Pressing or "; ExitCode% = 0 CALL BBMenu(Menu$(), Row, Column, MaxItems, FG, BG, HiLiteFG, HiLiteBG, SD, LenLine, HotItem, Selection, ExitCode) GOSUB choice leave: COLOR 15, 2: CLS CALL BoxBoy("", 11, 25, 14, 48, 1, 1, 1, 1, 0, 7, 2, 1, 8, 1) COLOR 0, 7 LOCATE 12, 30: PRINT "That's All Folks!" LOCATE 13, 30: PRINT "~~~~~~~~~~~~~~~~~" COLOR 15, 2: LOCATE 17, 33: PRINT " Enjoy! " FOR SoundMachine = 1 TO 2 FOR SoundOff = 1 TO 150 STEP 8 SOUND SoundOff + 300, 1 NEXT NEXT FOR SoundOff = 1500 TO 850 STEP -20 SOUND SoundOff + 300, 1 NEXT LOCATE 16, 34: PRINT " " LOCATE , , 1, 6, 7 COLOR 7, 0: CLS : LOCATE 1, 1: END choice: COLOR 15, 1: CLS LOCATE 2, 20 PRINT "Press Any Key To Continue." LOCATE 3, 20: PRINT STRING$(25, CHR$(196)) LOCATE 7, 20: PRINT "Your Selection Was " + STR$(Selection); LOCATE 9, 20: PRINT "The Menu Item Was : " + Menu$(Selection); COLOR 15, 4 LOCATE 9, 40: PRINT " " + Menu$(Selection) + " " LOCATE 11, 20: COLOR 15, 1 PRINT "Last Key Pressed Was CVI Code -" + STR$(ExitCode) IF ExitCode = 15104 OR ExitCode = 16128 OR ExitCode = 17408 THEN LOCATE 15, 20: PRINT "Yep! You Pressed an Key." ELSEIF ExitCode = 27 THEN LOCATE 18, 20: PRINT "You pressed "; END END IF DO: LOOP WHILE INKEY$ = "" RETURN short.message: CALL BoxBoy("Please Notice Í", 3, 57, 20, 78, 4, 61, 15, 1, 15, 1, 1, 0, 8, 0) COLOR 15, 1 LOCATE 6, 58: PRINT "1.The beginning menu" LOCATE 7, 58: PRINT " selection is 5." LOCATE 9, 58: PRINT "2.Shadow to the left." LOCATE 11, 58: PRINT "3.Menu double spaced." LOCATE 13, 58: PRINT "4.Notice two lines -" LOCATE 14, 58: PRINT " between 2 and 3 and" LOCATE 15, 58: PRINT " between 4 and 5." LOCATE 16, 57: PRINT CHR$(195) + STRING$(21, CHR$(196)) + CHR$(180) LOCATE 17, 58: PRINT " The line just under" LOCATE 18, 58: PRINT " the title was made" LOCATE 19, 58: PRINT " by the BoxBoy SUB." RETURN SUB BBMenu (Menu$(), Row, Column, MaxItems, FGColr, BGColr, HiLiteFG, HiLiteBG, SD, LenLine, HotItem, Selection, ExitCode) ' +---------------------------------------------------------------------+ ' | BBmenuQB.Bas was written by Don Smith. | ' | EMail: smithdonb@earthlink.net | ' | Todays date is: 03/25/2002 | ' +---------------------------------------------------------------------+ ' +---------------------------------------------------------------------+ ' | - ABOUT THE AUTHOR - | ' +---------------------------------------------------------------------+ ' | | ' |Hello. My name is Don Smith and I am a retired Math/History/Spanish | ' |teacher residing in Orange County, California. I am also a former | ' |6-year Sergeant of Marines. Who-Rah! On certain forums I am known | ' |as MarineDon. My email is: smithdonb@earthlink.net | ' | | ' +---------------------------------------------------------------------+ ' +---------------------------------------------------------------------+ ' | - COPYING AND DISTIBUTING - | ' +---------------------------------------------------------------------+ ' | Since this code is public domain and freeware, anyone may freely | ' | copy and distribute it. If you use the QuickBasic code in one of | ' | your own programs, you do not have to cite my name as the author, | ' | and you may even change its name. | ' +---------------------------------------------------------------------+ ' +---------------------------------------------------------------------+ ' | I got the idea for the Bounce Bar Menu (BBmenuQB.Bas) from an old | ' | basic menu called QBMenu. I downloaded this basic code from one | ' | of the many bulletin boards I used to belong to; that was before | ' | the days of the wide spread use of internet. It was dated 01-17-80.| ' | The author's name wasn't given. I liked the menu's idea but didn't | ' | like the way it was written. I completely rewrote it, using | ' | my own code. | ' | | ' | This menu, BBmenuQB.Bas, needs no special libraries. The "QB" is | ' | used because of the name of the QBMenu and because it only needs | ' | dear 'ol QuickBASIC. | ' +---------------------------------------------------------------------+ ' | Eventhough it appears that this program is lengthy, the SUB is only | ' | 76 lines of code if REM lines are removed. With the beginning | ' | main program examples, and counting all the REM lines, the code | ' | becomes bloated to 258 lines. Please discard what isn't needed. | ' | Of course, REM (or ') lines are not compiled; QuickBASIC ignores | ' | them. | ' +-----------+---------------------------------------------------------+ ' | Menu$() | Menu items are written in the main program section. | ' | | Be sure to REDIM (Example: REDIM Menu$(MaxItems + 1) | ' | | Normally what happens with the BBMenu is that when | ' | | HotItem = 0, the SUB BBMenu reads the extreme left | ' | | character of the menu items. These letters or numbers | ' | | may be used by the user to press. When pressed, the | ' | | SUB will exit with the Selection given as a number. | ' | | Of course, the user may opt to press | ' | | and to choose a menu item. | ' | | | ' | | Example with numbers: | ' | | REDIM MenuTT(MaxItems + 1) | ' | | MenuTT$(1) = "1. Utilities" | ' | | MenuTT$(2) = "2. Graphics" | ' | | Example with letters: | ' | | REDIM MenuGG(MaxItems + 1) | ' | | MenuGG$(1) = "A. Utilities" | ' | | MenuGG$(2) = "B. Graphics" | ' | | | ' | | With BBMenu please do not make the extreme left | ' | | hand character a parathesis. Example: | ' | | | ' | | (THIS IS A NO-NO!) | ' | | MenuHH$ = "(1) Correspondence" | ' | |  NO! | ' | | You may indeed use the above scheme if you turn off | ' | | HotItem, in which case HotItem = 1. | ' | | | ' | | NOTE: Another thing, beginning numbers and letters | ' | | may exist in the same menu. Example: | ' | | | ' | | Menu$(1) = "1. Finance" | ' | | Menu$(1) = "2. To Do List" | ' | | Menu$(1) = "-,20" | ' | | Menu$(1) = "A. Phone Calls" | ' | | Menu$(1) = "B. Letters To Mom" | ' |-----------+---------------------------------------------------------+ ' | Row | Row to place menu. If you wish the menu to reenter | ' | | always at the top row, then place the Row statement | ' | | after the loop. However, if you desire for the menu to | ' | | reenter at the last hi lighted row, then the Row | ' | | statement has to be placed before loop. Example: | ' | | | ' | | Row = 6 (Notice Row = 6 comes before "begin:" | ' | | Place before the loop in order that | ' | | menu will reenter at the last | ' | | hi lighted item.) | ' | | begin: | ' | | (Row = 6) (Place here to always reenter at | ' | | Row 6 - hopefully the top row. | ' | | | ' | | REDIM Menu$(MaxItems + 1) | ' | | Menu$(1) = "1. SpreadSheet" | ' | | Menu$(2) = "2. MS Word" | ' | | . . . . . . . . . . . . . | ' | | | ' | | call BBMenu(Menu$(), Row, Col.....(etc.) | ' | | IF Selection = 1 then | ' | | GOSUB spread | ' | | goto begin | ' | | ELSEIF Selection = 2 | ' | | GOSUB word | ' | | goto begin | ' | | (Etc.) | ' +-----------+---------------------------------------------------------+ ' | Column | Column to place menu. | ' +-----------+---------------------------------------------------------+ ' | MaxItems | The total number of menu items. | ' +-----------+---------------------------------------------------------+ ' | FGColr | Fore ground color of the menu. | ' +-----------+---------------------------------------------------------+ ' | BGColr | Back ground color of the menu. | ' +-----------+---------------------------------------------------------+ ' | HiLiteFG | The fore ground color of the hi lighted items. | ' +-----------+---------------------------------------------------------+ ' | HiLiteBG | The background color of the hi lighted items. | ' +-----------+---------------------------------------------------------+ ' | SD | Single space: SD = 1. Double space: SD = 2 | ' +-----------+---------------------------------------------------------+ ' | LenLine | Gives length of line(s) in menu. Example: M$(3) = "-" | ' +-----------+---------------------------------------------------------+ ' | HotItem | HotItem = 0 | ' | | The extreme left character when pressed, will exit with | ' | | the number of that character. It will always be | ' | | reported as a number. Example: A/a = 1. D/d = 4 | ' | +---------------------------------------------------------+ ' | | HotItem = 1 | ' | | Only may be used. | ' +-----------+---------------------------------------------------------+ ' | Selection | When a number, letter or is pressed the SUB will| ' | | exit. You may use either numbers, letters or neither | ' | | when you design your menu, but when the SUB exits, the | ' | | Selection is always a number. IMPORTANT! PLEASE READ | ' | | THIS: Each item is numbered and that includes the | ' | | horizontal lines, so keep that in mind when you trap | ' | | after the SUB exits. If you use neither numbers or | ' | | letters, then the SUB will exit when is pressed.| ' | | Example: | ' | | ------- | ' | | Menu$(1) = "1. Word" | ' | | Menu$(2) = "2. Correspondence" | ' | | Menu$(3) = "-" ' <- A line goes here. | ' | | Menu$(4) = "3. Finances" | ' | |  | ' | |  | ' | | (Use this number as Selection number!) | ' | | | ' | | ' "Finances" will be reported as | ' | | ' Selection 4, NOT 3! | ' | | | ' | | CALL BBMenu(Menu$(), Row, Column, (etc) | ' | | 'For next line, see above Menu$(4) = "3. Finances" | ' | | IF Selection = 4 then  | ' | | GOSUB finances Use this number | ' | | ELSEIF | ' | | (etc) | ' +-----------+---------------------------------------------------------+ ' | ExitCode | Gives the ASCII number of last key pressed. | ' +-----------+---------------------------------------------------------+ ' | F Keys | See the note about F Keys mid point in the SUB routine. | ' | | +-----------------------------------------------+ | ' | | | Keys per Cvi Code | | ' | | +-----------------------------------------------+ | ' | | | = 15104 = 16128 = 16896 | | ' | | | = 15360 = 16384 = 17152 | | ' | | | = 15616 = 16640 = 17408 | | ' | | | = 15872 | | ' | | +-----------------------------------------------+ | ' | | Extended keys other than keys may be used. | ' | | Example: R is 4864. See key example mid | ' | | point in the SUB. | ' | | | ' | | Write or cut out the short program that follows to find | ' | | out which CVI numbers you need for the BBMenu SUB. | ' +-----------+---------------------------------------------------------+ ' | 'CviCode.Bas | ' | COLOR 15, 1: CLS | ' | LOCATE 3, 22: PRINT "- C V I C o d e P r o g r a m -" | ' | LOCATE 5, 22: PRINT "Press a key or combination of keys." | ' | LOCATE 6, 24, 0: PRINT "Press Or To Exit." | ' | PRINT : PRINT | ' | LOCATE , 30 | ' | DO | ' | DO | ' | T$ = INKEY$ | ' | LOOP UNTIL LEN(T$) > 0 | ' | T = CVI(T$ + CHR$(0)) '<- Cvi Code produced here. | ' | IF T > 256 THEN | ' | LOCATE , 24, 0: PRINT "Extended Key" + " = " + STR$(T) | ' | ELSE | ' | LOCATE , 35, 0: PRINT T$ + " = " + STR$(T) | ' | END IF | ' | 'NOTE - PLEASE READ -> -> = 13 and = 27 | ' | IF T = 27 OR T = 13 THEN | ' | COLOR 7, 0: CLS : LOCATE 1, 1, 1, 6, 7: END | ' | END IF | ' | LOOP | ' +---------------------------------------------------------------------+ IF HotItem = 0 THEN 'Read Extreme left hand character. FOR zoom = 1 TO MaxItems HotKey$ = HotKey$ + LEFT$(Menu$(zoom), 1) NEXT END IF HotKey$ = UCASE$(HotKey$) LetrOrNum = 0 HotKey$ = UCASE$(HotKey$) IF Selection = 0 THEN Selection = 1 FindRow = Row FOR MenuChoices = 1 TO MaxItems COLOR FGColr, BGColr LOCATE FindRow, Column, 0 IF Menu$(MenuChoices) = "-" THEN PRINT STRING$(LenLine, 196); ELSE PRINT " " + Menu$(MenuChoices) + " "; END IF FindRow = Row + (MenuChoices * SD) NEXT begin.it: DO LOCATE Row + (Selection * SD) - SD, Column, 0 COLOR HiLiteFG, HiLiteBG PRINT " " + Menu$(Selection) + " "; IF LetrOrNum THEN EXIT DO DO DO TouchKey$ = INKEY$ LOOP UNTIL LEN(TouchKey$) > 0 Touch = CVI(TouchKey$ + CHR$(0)) 'Cvi Code Produced here. ExitCode = Touch IF Touch = 13 OR Touch = 27 THEN '=13. =27. ExitCode = Touch EXIT SUB 'See Key Example ->> = 15104. = 16128. = 17408. ELSEIF Touch = 15104 OR Touch = 16128 OR Touch = 17408 THEN ExitCode = Touch EXIT SUB ' = 18432. = 20482. ELSEIF Touch = 18432 OR Touch = 20480 THEN GOSUB up.or.down EXIT DO ELSEIF LEN(STR$(LetrOrNum)) > 0 THEN IF TouchKey$ <> "-" THEN LetrOrNum = INSTR(HotKey$, UCASE$(TouchKey$)) IF LetrOrNum <> 0 THEN Selection = LetrOrNum EXIT SUB END IF END IF END IF LOOP LOOP up.or.down: LOCATE Row + (Selection * SD) - SD, Column, 0 COLOR FGColr, BGColr PRINT " " + Menu$(Selection) + " "; IF Touch = 18432 THEN ' Selection = Selection - 1 IF Selection = 0 THEN Selection = MaxItems IF Menu$(Selection) = "-" THEN Selection = Selection - 1 END IF ELSEIF Touch = 20480 THEN ' Selection = Selection + 1 IF Selection > MaxItems THEN Selection = 1 IF Menu$(Selection) = "-" THEN Selection = Selection + 1 END IF ELSE Selection = LetrOrNum END IF RETURN END SUB SUB BoxBoy (Title$, ULRow%, ULCol%, LRRow%, LRCol%, TitleRow%, TitleCol%, TitColrFG%, TitColrBG%, BoxColrFG%, BoxColrBG%, BoxStyle%, Shadow%, ShadowColr%, EdgeYN%) ' +--------------------------------------------------------------------+ ' | | ' | SUB BoxBoy | ' | | ' +--------------------------------------------------------------------+ ' | Not counting REM (') lines, SUB BoxBoy has 121 lines. | ' +--------------------------------------------------------------------+ ' | Version 1.0 of SUB BoxBoy was written by Don Smith on 03/25/2002. | ' | This is Version 2.0 and it was written on 10/01/2002. Both | ' | versions are declared Public Domain FreeWare. Other programmers | ' | may use this SUB without naming me as the author, and they may | ' | modify the code in any way they see fit. | ' | | ' | Don's EMail: smithdonb@earthlink.net | ' | | ' | This SUB only saves that portion of the underlying screen under | ' | the box and repaints with a shadow. So recommend using the SUB | ' | SaveRestScrn to save/restore the complete screen, or a larger | ' | portion of the screen than the box. | ' +--------------------------------------------------------------------+ ' +--------------------------------------------------------------------+ ' | - ABOUT THE AUTHOR - | ' +--------------------------------------------------------------------+ ' | | ' |Hello. My name is Don Smith and I am a retired Math/History/Spanish | ' |teacher residing in Orange County, California. I am also a former | ' |6-year Sergeant of Marines. Who-Rah! On certain forums I am known | ' |as MarineDon. My email is: smithdonb@earthlink.net | ' | | ' +--------------------------------------------------------------------+ ' +--------------------------------------------------------------------+ ' | - COPYING AND DISTIBUTING - | ' +--------------------------------------------------------------------+ ' | Since this code is public domain and freeware, anyone may freely | ' | copy and distribute it. If you use the QuickBasic code in one of | ' | your own programs, you do not have to cite my name as the author, | ' | and you may even change its name. | ' +--------------------------------------------------------------------+ ' +-------------+------------------------------------------------------+ ' | Title$ | The title of the menu. To make a box without a title,| ' | | use: Title$ = "". When there is no Title, the cross | ' | | bar is not deployed. | ' +-------------+------------------------------------------------------+ ' | ULRow% | The upper left row to place the box. | ' +-------------+------------------------------------------------------+ ' | ULCol% | The upper left column to place the box. | ' +-------------+------------------------------------------------------+ ' | LRRow% | The lower right row to place the box. | ' +-------------+------------------------------------------------------+ ' | LRCol% | The lower right column to place the box. | ' +-------------+----------------------------------+-------------------+ ' | TitleRow% | The row to place the title. | If Title$ = "" | ' +-------------+----------------------------------| (or NO title), | ' | TitleCol% | The column to place the title. | report these four | ' +-------------+----------------------------------| values as zero (0)| ' | TitColrFG% | The foreground color of the title| . . . . . . . . | ' +-------------+----------------------------------| Example -> | ' | TitColrBG% | The background color of the title| TitColrFG% = 0 | ' +-------------+----------------------------------+-------------------+ ' | BoxColrFG% | The foreground color of the box itself. | ' +-------------+------------------------------------------------------+ ' | BoxColrBG% | The back ground color of the box. | ' +-------------+------------------------------------------------------+ ' | BoxStyle% | BoxStyle% = 0 (No line around box) | ' | | BoxStyle% = 1 (Single line around box | ' | | BoxStyle% = 2 (Double line around box | ' +-------------+------------------------------------------------------+ ' | Shadow% | If Shadow% equals 0, there will be no shadow. | ' | | If Shadow% equals 1, there will be a right shadow. | ' | | If Shadow% equals 2, there will be a left shadow | ' | +------------------------------------------------------+ ' | | NOTE #1: | ' | | ------- | ' | | When a shadow is used, the underlying text will | ' | | be saved and printed with the ShadeColr% (just | ' | | below). This causes the shadow to look like a | ' | | real shadow. | ' | | | ' | | NOTE #2: | ' | | ------- | ' | | If the first four values of BoxBoy are 1, 1, 25, 80, | ' | | in other words a full screen, please set Shadow% = 0;| ' | | otherwise an error will result (no room for shadow). | ' +-------------+------------------------------------------------------+ ' | ShadowColr% | The ShadowColr% is the foreground color of the | ' | | shadow. The background color will always be | ' | | black. Either choose ShadowColr% = 7 or | ' | | ShadowColr% = 8. | ' | | | ' | | ShadowColr% = 7 saves the foreground color and | ' | | changes it to a shade darker, if possible. For | ' | | example, a bright white on blue (COLOR 15, 1) | ' | | becomes dim white on black (COLOR 7, 0). A bright | ' | | blue on blue (COLOR 9, 1) becomes regular blue | ' | | on black (COLOR 1, 0). Very realistic. | ' | | | ' | | ShadowColr% = 8 saves the foreground and reprints | ' | | it as COLOR 8, 0. Darker then ShadowColr% = 7 | ' +-------------+----------------+-------------------------------------+ ' | EdgeYN% | EdgeYN% = 0 | Do NOT print an edge of one space | ' | | | with BoxColrFG% color on the right | ' | | | and left edges of the box. | ' | +----------------+-------------------------------------+ ' | | EdgeYN% = 1 | YES, DO print an edge of one space | ' | | | with BoxColrFG% color on the right | ' | | | and left edges of the box. | ' | +----------------+-------------------------------------+ ' | | What does it mean to "print an edge of one space | ' | | with BoxColrFG% color on the right and left edges | ' | | of the box". Well, I will attempt to demonstrate | ' | | by drawing the boxes with non-extended ASCII | ' | | characters. The X's represent a shadow to the | ' | | right. | ' | | | ' | | NO EDGE RIGHT/LEFT 1 SPACE EDGE RIGHT/LEFT | ' | | ~~~~~~~~~~~~~~~~~~ ~~~~~~~~~~~~~~~~~~~~~~~ | ' | | (EdgeYN% = 0) (EdgeYN% = 1 | ' | | | ' | | +-----------------+ +-------------------+ | ' | | |+---------------+| | +---------------+ | | ' | | || ||XX | | | |XX | ' | | || ||XX | | | |XX | ' | | || ||XX | | | |XX | ' | | || ||XX | | | |XX | ' | | || ||XX | | | |XX | ' | | || ||XX | | | |XX | ' | | || ||XX | | | |XX | ' | | |+---------------+|XX | +---------------+ |XX | ' | | +-----------------+XX +-------------------+XX | ' | | XXXXXXXXXXXXXXXXXXX XXXXXXXXXXXXXXXXXXXXX | ' | | | ' +-------------+------------------------------------------------------+ IF ULCol% <= 1 THEN ULCol% = 1 END IF IF LRCol% = 80 THEN LRCol% = 77 END IF make.box: IF BoxStyle% = 0 THEN 'No Lines ULCorner$ = CHR$(255) URCorner$ = CHR$(255) HorLine$ = CHR$(255) LeftSide$ = CHR$(255) RightSide$ = CHR$(255) VertLine$ = CHR$(255) LLCorner$ = CHR$(255) LRCorner$ = CHR$(255) ELSEIF BoxStyle% = 1 THEN 'Single Line ULCorner$ = CHR$(218) URCorner$ = CHR$(191) HorLine$ = CHR$(196) LeftSide$ = CHR$(195) RightSide$ = CHR$(180) VertLine$ = CHR$(179) LLCorner$ = CHR$(192) LRCorner$ = CHR$(217) ELSEIF BoxStyle% = 2 THEN 'Double Line ULCorner$ = CHR$(201) URCorner$ = CHR$(187) HorLine$ = CHR$(205) LeftSide$ = CHR$(199) RightSide$ = CHR$(182) VertLine$ = CHR$(186) LLCorner$ = CHR$(200) LRCorner$ = CHR$(188) END IF IF Shadow% > 0 THEN IF EdgeYN% = 1 THEN IF Shadow% = 1 THEN LeftLimit% = ULCol% + 2 RightLimit% = LRCol% + 5 ELSEIF Shadow% = 2 THEN LeftLimit% = ULCol% - 2 RightLimit% = LRCol% END IF ELSEIF EdgeYN% = 0 THEN IF Shadow% = 1 THEN LeftLimit% = ULCol% + 2 RightLimit% = LRCol% + 3 ELSEIF Shadow% = 2 THEN LeftLimit% = ULCol% - 2 RightLimit% = LRCol% - 1 END IF END IF REDIM ReadLine$(25): REDIM ReadColr%(25, 80) FOR ViewIt% = ULRow% + 1 TO LRRow% + 1 FOR Horizon% = LeftLimit% TO RightLimit% ReadLine$(ViewIt%) = ReadLine$(ViewIt%) + CHR$(SCREEN(ViewIt%, Horizon%)) ReadColr%(ViewIt%, Horizon%) = SCREEN(ViewIt%, Horizon%, 1) NEXT NEXT FOR FindRow% = ULRow% + 1 TO LRRow% + 1 FOR ScrnCol% = LeftLimit% TO RightLimit% LOCATE FindRow%, ScrnCol%, 0 OneColr% = ReadColr%(FindRow%, ScrnCol%) FGScrnColr% = OneColr% MOD 16 'make colors less bright IF FGScrnColr% = 0 THEN FGScrnColr% = 7 IF FGScrnColr% = 9 THEN FGScrnColr% = 1 IF FGScrnColr% = 10 THEN FGScrnColr% = 2 IF FGScrnColr% = 11 THEN FGScrnColr% = 3 IF FGScrnColr% = 12 THEN FGScrnColr% = 4 IF FGScrnColr% = 13 THEN FGScrnColr% = 5 IF FGScrnColr% = 14 THEN FGScrnColr% = 7 IF FGScrnColr% = 15 THEN FGScrnColr% = 7 BGScrnColr% = OneColr% \ 16 IF ShadowColr% = 7 THEN COLOR FGScrnColr%, 0 ELSEIF ShadowColr% = 8 THEN COLOR 8, 0 END IF IF Shadow% = 1 THEN PRINT MID$(ReadLine$(FindRow%), ScrnCol% - (ULCol% + 1)); ELSEIF Shadow% = 2 THEN PRINT MID$(ReadLine$(FindRow%), ScrnCol% - (ULCol% - 3)); END IF NEXT NEXT ERASE ReadLine$: ERASE ReadColr% END IF IF EdgeYN% = 1 THEN Edge$ = " " END IF Title.Length% = LEN(Title$) COLOR BoxColrFG%, BoxColrBG% 'ÚÄÄÄ¿ or ÉÍÍÍ» LOCATE ULRow%, ULCol% PRINT Edge$ + ULCorner$ + STRING$(LRCol% - ULCol%, HorLine$) + URCorner$ + Edge$; '³ ³ or º º LOCATE ULRow% + 1, ULCol% PRINT Edge$ + VertLine$ + SPACE$(LRCol% - ULCol%) + VertLine$ + Edge$; IF Title$ <> "" THEN 'ÃÄÄÄ´ or ÇÄÄĶ 'made cross bar if there is a title LOCATE ULRow% + 2, ULCol% PRINT Edge$ + LeftSide$ + STRING$(LRCol% - ULCol%, 196) + RightSide$ + Edge$; ELSEIF Title$ = "" THEN LOCATE ULRow% + 2, ULCol% PRINT Edge$ + VertLine$ + SPACE$(LRCol% - ULCol%) + VertLine$ + Edge$; END IF '³ ³ or º º FOR Print.Box% = 1 TO (LRRow% - ULRow%) - 3 LOCATE ULRow% + Print.Box% + 2, ULCol% PRINT Edge$ + VertLine$ + SPACE$(LRCol% - ULCol%) + VertLine$ + Edge$; NEXT 'ÀÄÄÄÙ or ÈÍÍͼ LOCATE LRRow%, ULCol%, 0 PRINT Edge$ + LLCorner$ + STRING$(LRCol% - ULCol%, HorLine$) + LRCorner$ + Edge$; IF Title$ <> "" THEN LOCATE TitleRow%, TitleCol% COLOR TitColrFG%, TitColrBG% PRINT Title$; END IF END SUB SUB BoxNoLines (ULR%, ULC%, LRR%, LRC%, NLColrFG%, NLColrBG%, Shade%, Title$, LineYN%, RowOfTitle%, ColOfTitle%, TopColrFG%, TopColrBG%, FGColrTit%, BGColrTit%, LightLine%, ClearDaScrn%) ' +---------------------------------------------------------------------+ ' | SUB BoxNoLines written by Don Smith on 03/25/2002. It is a | ' | Public Domain and FreeWare. This sub imitates the style of | ' | the box or window of the opening screen of PFS:First Choice | ' | word processor. | ' +---------------------------------------------------------------------+ ' | - ABOUT THE AUTHOR - | ' +---------------------------------------------------------------------+ ' | | ' |Hello. My name is Don Smith and I am a retired Math/History/Spanish | ' |teacher residing in Orange County, California. I am also a former | ' |6-year Sergeant of Marines. Who-Rah! On certain forums I am known | ' |as MarineDon. My email is: smithdonb@earthlink.net | ' | | ' +---------------------------------------------------------------------+ ' +---------------------------------------------------------------------+ ' | - COPYING AND DISTIBUTING - | ' +---------------------------------------------------------------------+ ' | Since this code is public domain and freeware, anyone may freely | ' | copy and distribute it. If you use the QuickBasic code in one of | ' | your own programs, you do not have to cite my name as the author, | ' | and you may even change its name. | ' +---------------------------------------------------------------------+ ' +---------------+-----------------------------------------------------+ ' | ULR% | Upper left row to place box | ' +---------------+-----------------------------------------------------+ ' | ULC% | Upper left column to place box | ' +---------------+-----------------------------------------------------+ ' | LRR% | Lower right row to place box | ' +---------------+-----------------------------------------------------+ ' | LRC% | Lower right column to place box | ' +---------------+-----------------------------------------------------+ ' | NLColrFG% | Foreground color of box (0-15) | ' +---------------+-----------------------------------------------------+ ' | NLColrBG% | Back ground color of box (0-7) | ' +---------------+-----------------------------------------------------+ ' | Shade% | Shade equals 1 = shadow to the right | ' | | Shade equals 2 = shadow to the left | ' | | Shade equals 0 = no shadow | ' +---------------+-----------------------------------------------------+ ' | Title$ | Title of box | ' +---------------+-----------------------------------------------------+ ' | LineYN% | LineYN equals 1 = place line under title | ' | | LineYN equals 0 = do NOT place line under title | ' +---------------+-----------------------------------------------------+ ' | RowOfTitle% | Row to place title | ' +---------------+-----------------------------------------------------+ ' | ColOfTitle% | Column to place title | ' +---------------+-----------------------------------------------------+ ' | TopColrFG% | Foreground color of top title area (0-15) | ' +---------------+-----------------------------------------------------+ ' | TopColrBG% | Background color of top title area (0-7) | ' +---------------+-----------------------------------------------------+ ' | FGColrTit% | Foreground color title itself (0-15) | ' +---------------+-----------------------------------------------------+ ' | BGColrTit% | Back ground color of title itself (0-7) | ' +---------------+-----------------------------------------------------+ ' | LightLine% | LightLine equals 1 = yes, use a light line along | ' | | the side of the lower box. | ' | | LightLine equals 0 = do not use a light line | ' | | - - - - - - - - - - - - - - - | ' | | This light line works well with some colors; | ' | | with others, it doesn't. Experiment. | ' +---------------+-----------------------------------------------------+ ' | ClearDaScrn% | ClearDaScrn equals 1 = clear screen with 1; | ' | | use numbers 0 to 7. | ' | | ClearDaScrn equals 1000 = do not clear screen | ' +---------------+-----------------------------------------------------+ IF ClearDaScrn% <> 1000 THEN COLOR , ClearDaScrn%: CLS END IF IF Shade% > 0 THEN FOR Tree% = ULR% TO LRR% + 1 IF Shade% = 1 THEN LOCATE Tree% + 1, ULC% + 2 ELSEIF Shade% = 2 THEN LOCATE Tree% + 1, ULC% - 2 END IF COLOR ClearDaScrn%, 0 PRINT STRING$(LRC% - ULC% + 1, CHR$(177)); NEXT END IF FOR Plain% = 1 TO 3 'top title area COLOR TopColrFG%, TopColrBG% LOCATE ULR% + Plain% - 1, ULC% PRINT SPACE$(LRC% - ULC% + 1) NEXT LOCATE ULR% + 2, ULC% COLOR 15, BGColrTit% StringLen% = LRC% - ULC% + 1 IF LineYN% = 0 THEN PRINT STRING$(StringLen%, " ") ELSEIF LineYN% = 1 THEN PRINT STRING$(StringLen%, "_"); END IF FOR MenuBody% = ULR% + 3 TO LRR% + 1 'box body COLOR NLColrFG%, NLColrBG% LOCATE MenuBody%, ULC% PRINT SPACE$(LRC% - ULC% + 1) NEXT IF LightLine% = 1 THEN FOR MenuBody% = ULR% + 3 TO LRR% + 1 COLOR 15, NLColrBG% IF Shade% = 1 THEN LOCATE MenuBody%, ULC% PRINT CHR$(221); ELSEIF Shade% = 2 THEN LOCATE MenuBody%, LRC% PRINT CHR$(222); END IF NEXT END IF COLOR FGColrTit%, BGColrTit% LOCATE RowOfTitle%, ColOfTitle% PRINT Title$; END SUB SUB SaveRestScrn (ReadLine$(), ReadColr%(), SR.UL.Row%, SR.UL.Col%, SR.LR.Row%, SR.LR.Col%, SaveOrRest%) '+----------------------------------------------------------------------+ '| SUB written by Don Smith on 03/25/02 - Public Domain FreeWare. | '| No need to name Don as the author. EMail: smithdonb@earthlink.net | '+----------------------------------------------------------------------+ '+----------------------------------------------------------------------+ '| - ABOUT THE AUTHOR - | '+----------------------------------------------------------------------+ '| | '|Hello. My name is Don Smith and I am a retired Math/History/Spanish | '|teacher residing in Orange County, California. I am also a former | '|6-year Sergeant of Marines. Who-Rah! On certain forums I am known | '|as MarineDon. My email is: smithdonb@earthlink.net | '| | '+----------------------------------------------------------------------+ '+----------------------------------------------------------------------+ '| - COPYING AND DISTIBUTING - | '+----------------------------------------------------------------------+ '| Since this code is public domain and freeware, anyone may freely | '| copy and distribute it. If you use the QuickBasic code in one of | '| your own programs, you do not have to cite my name as the author, | '| and you may even change its name. | '+----------------------------------------------------------------------+ '+----------------------------------------------------------------------+ '| PROGRAM SETS NUMBERS 1 AND 2 -> | '+------------------+---------------------------------------------------+ '| (1) ReadLine$() | Program self reads data at each Row and Column | '+------------------+---------------------------------------------------+ '| (2) ReadColr%() | Program self reads color at each Row and Column | '+------------------+---------------------------------------------------+ '+----------------------------------------------------------------------+ '| THE PROGRAMMER MUST SET NUMBERS 3 TO 9 -> | '+----------------------------------------------------------------------+ '| (Note: The "SR" below means "Save" Or "Restore") | '+------------------+---------------------------------------------------+ '| (3) SR.UL.Row% | Screen to save or restore at upper left row. | '| (4) SR.UL.Col% | Screen to save or restore at upper left column. | '| (5) SR.LR.Row% | Screen to save or restore at lower right row. | '| (6) SR.LR.Col% | Screen to save or restore at lower right column.| '| +---------------------------------------------------+ '| | SPECIAL CAUTION: | '| | --------------- | '| | When you call the SUB to restore the underlying | '| | screen, use MUST use the same row and column | '| | numbers as you used when you first called the | '| | SUB to save the screen. | '+------------------+---------------------------------------------------+ '| (7) SaveOrRest% | SaveOrRest% = 1 (1 means save the screen) | '| | SaveOrRest% = 2 (2 means restore the screen) | '+------------------+----------+----------------------------------------+ '| (8) REDIM ReadLine$(25) | The REDIM for ReadLine$ and ReadColr% | '| REDIM ReadColr%(25, 80) | must be placed in the main program | '| | before calling the SUB. The 25 and 80 | '| | reflects a screen of 25 lines and 80 | '| | columns. You may use smaller amounts | '| | of memory if you do not need all 25 | '| | lines and 80 columns. | '+-----------------------------+----------------------------------------+ '| (9) ERASE ReadLine$ | Reclaim memory after calling the SUB | '| ERASE ReadColr% | to restore the screen. Use REDIM and | '| | ERASE in main program please! | '+-----------------------------+----------------------------------------+ IF SR.LR.Col% > 80 THEN SR.LR.Col% = 80 END IF IF SR.LR.Row% > 25 THEN SR.LR.Row% = 25 END IF IF SaveOrRest% = 1 THEN GOSUB save.screen ELSEIF SaveOrRest% = 2 THEN GOSUB restore.screen END IF EXIT SUB save.screen: FOR ViewIt% = SR.UL.Row% TO SR.LR.Row% FOR Horizon% = SR.UL.Col% TO SR.LR.Col% ReadLine$(ViewIt%) = ReadLine$(ViewIt%) + CHR$(SCREEN(ViewIt%, Horizon%)) ReadColr%(ViewIt%, Horizon%) = SCREEN(ViewIt%, Horizon%, 1) NEXT NEXT RETURN restore.screen: FOR FindRow% = SR.UL.Row% TO SR.LR.Row% FOR ScrnCol% = SR.UL.Col% TO SR.LR.Col% LOCATE FindRow%, ScrnCol%, 0 OneColr% = ReadColr%(FindRow%, ScrnCol%) FGScrnColr% = OneColr% MOD 16 BGScrnColr% = OneColr% \ 16 COLOR FGScrnColr%, BGScrnColr% PRINT MID$(ReadLine$(FindRow%), ScrnCol% - (SR.UL.Col% - 1)); NEXT NEXT RETURN END SUB