' +--------------------------------------------------------------------+ ' | | ' | - R o l i d e x . B a s - | ' | | ' | | ' | Public Domain - FreeWare | ' +--------------------------------------------------------------------+ ' +--------------------------------------------------------------------+ ' | - ABOUT THE AUTHOR - | ' +--------------------------------------------------------------------+ ' | | ' | Hello. My name is Don Smith and I am a thirty-year retired teacher | ' | of Math/History/Spanish residing in Orange County, California. I | ' | am also a former six-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. | ' +--------------------------------------------------------------------+ ' +--------------------------------------------------------------------+ ' | ROLIDEX.BAS | ' +--------------------------------------------------------------------+ ' | Rolidex.Bas was written by Don Smith on 08/01/2002, and is | ' | Public Domain FreeWare. It was written to illustrate how | ' | to write the code for a patterned menu. Such a program could | ' | be used as a rolidex of telephone numbers, or days of the month. | ' +--------------------------------------------------------------------+ ' | Rolidex.Bas and all parts of it, SUBs BoxBoy, Rolidex, | ' | SaveRestScrn and OneLine, are Public Domain FreeWare. Other | ' | programmers need not name me as the author. For specifics, | ' | please refer to the individual SUBs. | ' | | ' | EMail: smithdons@earthlink.net | ' +--------------------------------------------------------------------+ ' | With remark lines (') (REM) removed, the SUBs contain: | ' | | ' | # of Lines: Size in Kilobytes: | ' | ---------- ----------------- | ' | SUB BoxBoy.............. 102 lines.......... 3.4 Kb | ' | SUB Rolidex............. 203 lines.......... 7.0 Kb | ' | SUB SaveRestScrn........ 36 lines.......... 1.2 Kb | ' | SUB OneLine............. 20 lines.......... 0.6 Kb | ' | | ' +--------------------------------------------------------------------+ ' | Compile: | ' | BC: Rolidex | ' | LINK: Rolidex | ' | LIB: Bcom45 | ' +--------------------------------------------------------------------+ DECLARE SUB BoxBoy (Title$, ULRow%, ULCol%, LRRow%, LRCol%, TitleRow%, TitleCol%, TitColrFor%, TitColrBak%, BoxColrFor%, BoxColrBak%, BoxStyle%, Shadow%, ShadowColr%, ClearColr%) DECLARE SUB Rolidex (M$(), TopRow%, Row%, FirstCol%, Col%, NumOfCols%, NumOfRows%, ColrFG%, ColrBG%, BoxColrFG%, BoxColrBG%, VertInterval%, HorizInterval%, Box%, MaxNum%, FKeys$, ExitCode%) DECLARE SUB SaveRestScrn (ReadLine$(), ReadColr%(), SR.UL.Row%, SR.UL.Col%, SR.LR.Row%, SR.LR.Col%, SaveOrRest%) DECLARE SUB OneLine (Style%, OLRow%, OLCol%, OLColrFG%, OLColrBG%, LenLine%) DEFINT A-Z thetop: '======================================================================== ' Make GUI: (1) Form 3 boxes with SUB Boxboy, (2) Place comments '======================================================================== Title$ = "" ULRow% = 7 ULCol% = 1 LRRow% = 25 LRCol% = 80 TitleRow% = 1 TitleCol% = 1 TitColrFor% = 1 TitColrBak% = 1 BoxColrFor% = 15 BoxColrBak% = 1 BoxStyle% = 2 Shadow% = 0 ShadowColr% = 8 ClearColr% = 1 CALL BoxBoy(Title$, ULRow%, ULCol%, LRRow%, LRCol%, TitleRow%, TitleCol%, TitColrFor%, TitColrBak%, BoxColrFor%, BoxColrBak%, BoxStyle%, Shadow%, ShadowColr%, ClearColr%) CALL BoxBoy("", 1, 17, 6, 63, 1, 1, 1, 1, 15, 1, 2, 0, 8, 1000) CALL BoxBoy("", 19, 54, 21, 75, 1, 1, 1, 1, 15, 1, 2, 0, 8, 1000) LOCATE 19, 67: PRINT CHR$(209) LOCATE 20, 67: PRINT CHR$(179) LOCATE 21, 67: PRINT CHR$(207) CALL OneLine(2, 3, 18, 15, 1, 46) COLOR 11, 1 LOCATE 2, 29: PRINT CHR$(240) + " Rolidex Demo Program " + CHR$(240) COLOR 14, 1 LOCATE 2, 29: PRINT CHR$(240) LOCATE 2, 53: PRINT CHR$(240) COLOR 15, 1 LOCATE 4, 24: PRINT "Program By Don Smith - Public Domain" COLOR 11, 1 LOCATE 5, 21: PRINT "09/01/2002 EMail:smithdonb@earthlink.net" COLOR 15, 1 LOCATE 5, 23: PRINT "/": LOCATE 5, 26: PRINT "/" LOCATE 5, 39: PRINT ":": LOCATE 5, 49: PRINT "@" LOCATE 5, 59: PRINT "." CALL OneLine(2, 22, 2, 15, 1, 76) LOCATE 8, 6: PRINT "Press On a Letter To Access That File." LOCATE 8, 55: PRINT "MOVE: <" + CHR$(24) + "> <" + CHR$(25) + "> <" + CHR$(27) + "> <" + CHR$(26) + ">" CALL OneLine(2, 9, 2, 15, 1, 76) COLOR 11, 1 LOCATE 8, 13: PRINT "Enter" LOCATE 8, 55: PRINT "MOVE" LOCATE 8, 62: PRINT CHR$(24) LOCATE 8, 66: PRINT CHR$(25) LOCATE 8, 70: PRINT CHR$(27) LOCATE 8, 74: PRINT CHR$(26) COLOR 15, 1 LOCATE 23, 21: PRINT " and Are Help Files." LOCATE 24, 11: PRINT "Press To Exit, Or Cursor To And Press ."; COLOR 11, 1 LOCATE 23, 22: PRINT "F1"; LOCATE 23, 27: PRINT "F5"; LOCATE 23, 36: PRINT "F10"; LOCATE 24, 18: PRINT "Esc"; LOCATE 24, 46: PRINT "Exit"; LOCATE 24, 63: PRINT "Enter"; '======================================================================== ' Dimension Array M$ '======================================================================== REDIM M$(27) M$(1) = "A" M$(2) = "B" M$(3) = "C" M$(4) = "D" M$(5) = "E" M$(6) = "F" M$(7) = "G" M$(8) = "H" M$(9) = "I" M$(10) = "J" M$(11) = "K" M$(12) = "L" M$(13) = "M" M$(14) = "N" M$(15) = "O" M$(16) = "P" M$(17) = "Q" M$(18) = "R" M$(19) = "S" M$(20) = "T" M$(21) = "U" M$(22) = "V" M$(23) = "W" M$(24) = "X" M$(25) = "Y" M$(26) = "Z" M$(27) = "Exit" '======================================================================== ' Setup for SUB Rolidex '======================================================================== TopRow% = 11 Row% = TopRow% FirstCol% = 8 Col% = FirstCol% NumOfCols% = 6 NumOfRows% = 5 ColrFG% = 15 ColrBG% = 1 BoxColrFG% = 14 BoxColrBG% = 1 VertInterval% = 2 HorizInterval% = 13 Box% = 1 MaxNum% = 27 FKeys$ = "150" make.menu: CALL Rolidex(M$(), TopRow%, Row%, FirstCol%, Col%, NumOfCols%, NumOfRows%, ColrFG%, ColrBG%, BoxColrFG%, BoxColrBG%, VertInterval%, HorizInterval%, Box%, MaxNum%, FKeys$, ExitCode%) M$ = RTRIM$(LTRIM$(UCASE$(M$(Box%)))) IF ExitCode% = 27 THEN ' was pressed GOTO leave ' ELSEIF ExitCode% = 1 OR ExitCode% = 5 OR ExitCode% = 10 OR ExitCode% = 13 THEN IF Box% = 27 THEN ' Box GOTO leave ELSE GOSUB save.screen COLOR 15, 0: CLS FOR MkScrn = 2 TO 23 COLOR 9, 1 LOCATE MkScrn, 3 PRINT STRING$(76, CHR$(21)); NEXT Title$ = "AND THE RESULTS ARE " + CHR$(205) + CHR$(16): ULRow% = 7: ULCol% = 15 LRRow% = 16: LRCol% = 65: TitleRow% = 8: TitleCol% = 23 TitColrFor% = 1: TitColrBak% = 7: BoxColrFor% = 0 BoxColrBak% = 7: BoxStyle% = 1: Shadow% = 1 ShadowColr% = 8: ClearColr% = 1000 CALL BoxBoy(Title$, ULRow%, ULCol%, LRRow%, LRCol%, TitleRow%, TitleCol%, TitColrFor%, TitColrBak%, BoxColrFor%, BoxColrBak%, BoxStyle%, Shadow%, ShadowColr%, ClearColr%) LOCATE 8, 43: COLOR 15, 7: PRINT CHR$(205); CHR$(16) COLOR 0, 7 LOCATE 10, 23: PRINT "ExitCode% Was" + STR$(ExitCode%) + "." END IF IF ExitCode% = 1 OR ExitCode% = 5 OR ExitCode% = 10 THEN LOCATE 12, 23, 0 PRINT " Was Pressed." ELSEIF ExitCode% = 13 THEN LOCATE 12, 23, 0 PRINT "Menu Item #" + RTRIM$(LTRIM$(STR$(Box%))); PRINT ", Letter " + CHR$(34) + RTRIM$(LTRIM$(M$(Box%))); PRINT CHR$(34) + " Was Pressed." END IF CALL OneLine(1, 14, 16, 0, 7, 50) COLOR 1, 7: LOCATE 15, 28, 0: PRINT "" DO: LOOP WHILE INKEY$ = "" GOSUB restore.screen GOTO make.menu ELSE GOTO make.menu END IF GOTO thetop '================================================================================= ' Setup for SUB SaveRestScrn - Save Screen 25X80 '================================================================================= save.screen: REDIM ReadLine$(25) REDIM ReadColr%(25, 80) SR.UL.Row% = 1 SR.UL.Col% = 1 SR.LR.Row% = 25 SR.LR.Col% = 80 SaveOrRest% = 1 CALL SaveRestScrn(ReadLine$(), ReadColr%(), SR.UL.Row%, SR.UL.Col%, SR.LR.Row%, SR.LR.Col%, SaveOrRest%) RETURN '================================================================================= ' Setup for SUB SaveRestScrn - Restore Screen 25X80 '================================================================================= restore.screen: SR.UL.Row% = 1 SR.UL.Col% = 1 SR.LR.Row% = 25 SR.LR.Col% = 80 SaveOrRest% = 2 CALL SaveRestScrn(ReadLine$(), ReadColr%(), SR.UL.Row%, SR.UL.Col%, SR.LR.Row%, SR.LR.Col%, SaveOrRest%) ERASE ReadLine$: ERASE ReadColr% RETURN leave: WIDTH 80: COLOR 7, 0: CLS : LOCATE 1, 1, 1, 6, 7: END SUB BoxBoy (Title$, ULRow%, ULCol%, LRRow%, LRCol%, TitleRow%, TitleCol%, TitColrFor%, TitColrBak%, BoxColrFor%, BoxColrBak%, BoxStyle%, Shadow%, ShadowColr%, ClearColr%) '+---------------------------------------------------------------------+ '| SUB BoxBoy | '+---------------------------------------------------------------------+ '| SUB written by Don Smith on March 25, 2002. Declared Public | '| Domain FreeWare. Other programmers may use this SUB without | '| naming me as the author. Don's EMail: smithdonb@earthlink.net | '| | '| This SUB only saves the underlying screen to repaint with a shadow. | '| So recommend using the SUB SaveRestScrn to save/restore screen. | '| Please read: SUB SaveRestScrn. | '+-------------+-------------------------------------------------------+ '| 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 there is to be | '|-------------+----------------------------------| NO title, these 4 | '| TitleCol% | The column to place the title. | values will be | '|-------------+----------------------------------| ignored. If that | '| TitColrFor% | The foreground color of the title| is the case, these | '|-------------+----------------------------------| values may be | '| TitColrBak% | The background color of the title| omitted. | '|-------------+----------------------------------+--------------------| '| BoxColrFor% | The foreground color of the box itself. | '|-------------+-------------------------------------------------------| '| BoxColrBak% | The back ground color of the box. | '+-------------+-------------------------------------------------------+ '| Style% | Style% equals 1 - Single line around box | '| | Style% equals 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 COLOR 8, 0 (very dim). | '| | This causes the shadow to look like a real shadow. | '| | | '| | NOTE #2: | '| | ------- | '| | If the first four values of BoxBoy are 1, 1, 25, 89, | '| | in other words a full screen, please set Shadow% = 0 | '| | otherwise an error will result (no room for shadow). | '+-------------+-------------------------------------------------------+ '| ShadeColr% | The foreground color of the shadow. Usually | '| | this color is 8 or 7 (Normally 8). | '+-------------+-------------------------------------------------------+ '| ClearColr% | What color (0-7) to clear screen before making box. | '| | To disable this feature, use ClearColr% = 1000 | '| | | '| | COLOR VALUES: | '| | ---------------------------------- | '| | 0 is black 4 is red | '| | 1 is blue 5 is purple | '| | 2 is green 6 is orange | '| | 3 is light blue 7 is light white | '| | | '+-------------+-------------------------------------------------------+ IF ClearColr% <> 1000 THEN COLOR , ClearColr%: CLS END IF IF ULCol% <= 1 THEN ULCol% = 1 END IF IF LRCol% = 80 THEN LRCol% = 77 END IF make.box: IF 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% = 1 THEN REDIM ReadLine$(25) FOR ViewIt% = ULRow% + 1 TO LRRow% + 1 FOR Horizon% = ULCol% + 2 TO LRCol% + 5 ReadLine$(ViewIt%) = ReadLine$(ViewIt%) + CHR$(SCREEN(ViewIt%, Horizon%)) NEXT NEXT COLOR ShadowColr%, 0 FOR Scratch% = ULRow% + 1 TO LRRow% + 1 LOCATE Scratch%, ULCol% + 2 PRINT ReadLine$(Scratch%); NEXT ELSEIF Shadow% = 2 THEN REDIM ReadLine$(25) FOR ViewIt% = ULRow% + 1 TO LRRow% + 1 FOR Horizon% = ULCol% - 2 TO LRCol% + 1 ReadLine$(ViewIt%) = ReadLine$(ViewIt%) + CHR$(SCREEN(ViewIt%, Horizon%)) NEXT NEXT COLOR ShadowColr%, 0 FOR Scratch% = ULRow% + 1 TO LRRow% + 1 LOCATE Scratch%, ULCol% - 2 PRINT ReadLine$(Scratch%); NEXT END IF Title.Length% = LEN(Title$) COLOR BoxColrFor%, BoxColrBak% ' +-----+ '+-----+ |+---+| '| | or || || LOCATE ULRow%, ULCol% PRINT " " + ULCorner$ + STRING$(LRCol% - ULCol%, HorLine$) + URCorner$ + " "; '| | or || || LOCATE ULRow% + 1, ULCol% PRINT " " + VertLine$ + SPACE$(LRCol% - ULCol%) + VertLine$ + " "; IF Title$ <> "" THEN '| | || || '+-----+ or ++-----++ make cross if there is a titlt '| | || || LOCATE ULRow% + 2, ULCol% PRINT " " + LeftSide$ + STRING$(LRCol% - ULCol%, 196) + RightSide$ + " "; ELSEIF Title$ = "" THEN LOCATE ULRow% + 2, ULCol% PRINT " " + VertLine$ + SPACE$(LRCol% - ULCol%) + VertLine$ + " "; END IF '| | or || || FOR Print.Box% = 1 TO (LRRow% - ULRow%) - 3 LOCATE ULRow% + Print.Box% + 2, ULCol% PRINT " " + VertLine$ + SPACE$(LRCol% - ULCol%) + VertLine$ + " "; NEXT ' || || '| | |+---+| '+-----+ or +-----+ LOCATE LRRow%, ULCol%, 0 PRINT " " + LLCorner$ + STRING$(LRCol% - ULCol%, HorLine$) + LRCorner$ + " "; IF Title$ <> "" THEN LOCATE TitleRow%, TitleCol% COLOR TitColrFor%, TitColrBak% PRINT Title$; END IF END SUB SUB OneLine (Style%, OLRow%, OLCol%, OLColrFG%, OLColrBG%, LenLine%) ' +-------------------------------------------------------------------+ ' | SUB OneLine | ' +-------------------------------------------------------------------+ ' | SUB OneLine was written by Don Smith on 09/01/2002 and is Public | ' | Domain FreeWare. I use SUB OneLine to place a line in a program. | ' | It is easier to use a SUB than having to write the code each time.| ' | Other programmers need not name me as author of the SUB. | ' | | ' | EMail: smithdonb@earthlink.net | ' +------------+------------------------------------------------------+ ' | Style% | Style has three forms: | ' | | | ' | | | | | | | ' | | Style = 1 is +--------------------+ | ' | | | | | ' | | | ' | | || || | ' | | Style = 2 is |+------------------+| | ' | | || || | ' | | | ' | | || || | ' | | Style = 3 is |+------------------+| | ' | | |+------------------+| | ' | | || || | ' | | | ' +------------+------------------------------------------------------+ ' | OLRow% | OneLine row to place the line. | ' +------------+------------------------------------------------------+ ' | OLCol% | OneLine column to place the line. | ' +------------+------------------------------------------------------+ ' | OLColrFG% | OneLine foreground color. | ' +------------+------------------------------------------------------+ ' | OLColrBG% | OneLine back ground color. | ' +------------+------------------------------------------------------+ ' | LenLine% | Length of the line in the middle. | ' +------------+------------------------------------------------------+ COLOR OLColrFG%, OLColrBG% IF Style% = 1 THEN LeftChr$ = CHR$(195) MidChar$ = CHR$(196) RightChr$ = CHR$(180) ELSEIF Style% = 2 THEN LeftChr$ = CHR$(199) MidChar$ = CHR$(196) RightChr$ = CHR$(182) ELSEIF Style% = 3 THEN LeftChr$ = CHR$(204) MidChar$ = CHR$(205) RightChr$ = CHR$(185) END IF LOCATE OLRow%, OLCol% PRINT LeftChr$ + STRING$(LenLine%, MidChar$) + RightChr$; END SUB SUB Rolidex (M$(), TopRow%, Row%, FirstCol%, Col%, NumOfCols%, NumOfRows%, ColrFG%, ColrBG%, BoxColrFG%, BoxColrBG%, VertInterval%, HorizInterval%, Box%, MaxNum%, FKeys$, ExitCode%) ' +-------------------------------------------------------------------+ ' | Rolidex Program | ' +-------------------------------------------------------------------+ ' | Rolidex.Bas was written by Don Smith on 09/01/2002 and it is | ' | Public Domain, FreeWare. Other programmers need not name me | ' | as author of the SUB. EMail: smithdonb@earthlink.net | ' | | ' | Rolidex has 203 lines, not counting remark lines (') (REM). | ' +----------------+--------------------------------------------------+ ' | M$() | The menu items as used here are letters (A-Z), | ' | | but they could be used for other items as well. | ' | | Days of the month, for example. | ' +----------------+--------------------------------------------------+ ' | TopRow% | The top row to begin placing the menu items (M$) | ' +----------------+--------------------------------------------------+ ' | Row% | Set Row to Row% = TopRow% in main part of | ' | | program. Otherwise the program uses this to | ' | | enter and reenter as the user presses | ' | | or other keys, such as . | ' +----------------+--------------------------------------------------+ ' | FirstCol% | The first column to place menu items (M$). | ' +----------------+--------------------------------------------------+ ' | Col% | Set Col to Col% = FirstCol% in main program. | ' | | Otherwise, the program keeps track of Col%. | ' +----------------+--------------------------------------------------+ ' | NumOfCols% | Number of columns to place on screen. | ' +----------------+--------------------------------------------------+ ' | NumOfRows% | Number of rows to place on screen. | ' | | As used here, there are 6 colunns and | ' | | 5 rows. That means that the last row, | ' | | row 5, only has 3 items, whereas the first | ' | | 4 rows have 6 items. Special provision is | ' | | made for this problem under "down.arrow", | ' | | "up.arrow", "right.arrow" and "left.arrow". | ' | | If you change to other columns and rows, | ' | | you will need to hack those subroutines. | ' +----------------+--------------------------------------------------+ ' | ColrFG% | Foreground color of menu items. | ' +----------------+--------------------------------------------------+ ' | ColrBG% | Back ground color of menu items. | ' +----------------+--------------------------------------------------+ ' | BoxColrFG% | Foreground color of cursor box. | ' +----------------+--------------------------------------------------+ ' | BoxColrBG% | Back ground color of cursor box. | ' +----------------+--------------------------------------------------+ ' | VertInterval% | Vertical interval between menu items. | ' +----------------+--------------------------------------------------+ ' | HorizInterval% | Horizontal interval between menu items. | ' +----------------+--------------------------------------------------+ ' | Box% | Set Box% = 1 in main progam. Thereafter, | ' | | the program keeps track of Box%. | ' +----------------+--------------------------------------------------+ ' | MaxNum% | Maximum number of menu items. Must REDIM | ' | | M$ (menu items) with this in main program. | ' | | Example: REDIM M$(MaxNum%) | ' +----------------+--------------------------------------------------+ ' | FKeys$ | I wrote a routine into the SUB Rolidex to handle | ' | | the keys, to . The routine | ' | | automatically sets an ExitCode% number and exits | ' | | the SUB when the set keys are pressed. You | ' | | should set the key(s) in the main program, | ' | | using FKeys$ = "". If, for example, you have | ' | | FKeys$ = "150" then the SUB will set | ' | | and . When one of these keys are | ' | | pressed, the SUB will set ExitCode% 1, 5 or 10 | ' | | and EXIT SUB. By the way, the "0" in "150" is | ' | | used for . For other special use keys, | ' | | read ExitCode% below. | ' +----------------+--------------------------------------------------+ ' | ExitCode% | ExitCode% is set by program to reflect | ' | | the user pressing or . | ' | | is ExitCode% = 13 and is | ' | | ExitCode% = 27. | ' | | | ' | | to are ExitCode% = 1 to 10. | ' | | | ' | | To set other special keys, use KEYCODE.BAS | ' | | below to find the special CVI number for your | ' | | key(s). Example: is 21504. In the | ' | | SUB Rolidex, find: | ' | | | ' | | DO | ' | | DO | ' | | Hit$ = INKEY$ | ' | | LOOP UNTIL LEN(Hit$) > 0 | ' | | Hit% = CVI(Hit$ + CHR$(0)) | ' | | | ' | | This CVI number so determined will be able to | ' | | be used in a series of IFs and ELSEIFs. To | ' | | set up , use: | ' | | | ' | | (Goes below double DO:LOOP | ' | | ELSEIF Hit% = 21504 THEN ' | ' | | (code goes here) | ' | | | ' | | Find the double DO:LOOPs below and find out | ' | | how I wrote the code. | ' +----------------+--------------------------------------------------+ ' | Refer to the "pre-set amounts" just below KEYCODE.BAS for | ' | directions on how to adjust the cursor box. | ' +-------------------------------------------------------------------+ ' +-------------------------------------------------------------------+ ' | Use KEYCODE.BAS below to find out what the CVI numbers will be | ' | for keys you wish to trap. | ' +-------------------------------------------------------------------+ ' | ' KeyCode.Bas - By Don Smith. FreeWare and Public Domain Program.| ' | ' Date: 09/01/2002. | ' | ' +-------------------------------------------------------------+ | ' | ' | Note: To reach the extended ASCII characters 127 to 255, | | ' | ' | press down on the key, and while pressed down, | | ' | ' | type in the number on your keypad, not the numbers | | ' | ' | above then keys. | | ' | ' +-------------------------------------------------------------+ | ' +-------------------------------------------------------------------+ ' | <- ("Tear off" first 3 characters) | ' | ("Tear off" last character) -> | ' | | ' | COLOR 14, 1: CLS | ' | Top1$ = "Press a key and the KeyCode% value will be displayed." | ' | Top2$ = "~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~" | ' | Top3$ = "(Press To Quit" | ' | COLOR 15, 1 | ' | LOCATE 2, 15: PRINT Top1$ | ' | LOCATE 3, 15: PRINT Top2$ | ' | COLOR 11, 1 | ' | LOCATE 4, 30, 0: PRINT Top3$ | ' | PRINT : PRINT | ' | COLOR 14, 1 | ' | DO | ' | DO | ' | Hit$ = INKEY$ | ' | IF Hit$ = CHR$(27) THEN | ' | PRINT | ' | LOCATE , 10: COLOR 15, 1: PRINT STRING$(62, "-"); | ' | PRINT | ' | LOCATE , 34: COLOR 11, 1: PRINT "Program Ends"; | ' | PRINT : PRINT | ' | END | ' | END IF | ' | LOOP UNTIL Hit$ <> "" | ' | Hit% = CVI(Hit$ + CHR$(0)) | ' | Key$ = STR$(Hit%) | ' | IF Hit% < 256 THEN | ' | LOCATE , 32, 0 | ' | PRINT Hit$ + SPACE$(9) + "= " + Key$ | ' | ELSEIF Hit% > 255 THEN | ' | LOCATE , 21, 0 | ' | PRINT "Extended Key" + SPACE$(9) + "= " + Key$; "" | ' | END IF | ' | LOOP | ' | | ' +-------------------------------------------------------------------+ '=======================pre-set amounts===============================+ '| ADJUST CURSOR BOX HERE (1 & 2): | '+-------------------------------------+ BoxWidth% = HorizInterval% - 3 '| 1. Adjust width of cursor box here. | '| Change the 3 to 4, 5 or 6. See | '| ColLessAmt% just below. | '| (Note: These amounts are set here| '| and not in the main program) | '-------------------------------+-------------------------------------+ ColLessAmt% = 5 '| 2. Set the (Col)column (of menu | '| items), (Less) the (Amt) amount | '| of spaces to begin placing the | '| box. Change the 5 to 4 or 3. | '| For both BoxWidth% & ColLessAmt%,| '| try: (4/4, 5/4, 6/3 -> see below)| '| | '| BoxWidth% = HorizInterval% - 4 | '| ColLessAmt% = 4 | '| OR | '| BoxWidth% = HorizInterval% - 5 | '| ColLessAmt% = 4 | '| OR | '| BoxWidth% = HorizInterval% - 6 | '| ColLessAmt% = 3 | '| | '----------------------other pre-set amounts--------------------------+ BottRow% = TopRow% + (VertInterval% * (NumOfRows% - 2)) '| LastCol% = FirstCol% + ((NumOfCols - 1) * HorizInterval%) '| SetHoriz% = HorizInterval% '| PlantRow% = TopRow% '| '=====================================================================+ COLOR ColrFG%, ColrBG% CountHoriz% = 0 FOR ColItems% = 1 TO NumOfRows% FOR RowItems% = 1 TO NumOfCols% MenuItems% = MenuItems% + 1 LOCATE PlantRow%, FirstCol% + CountVert% CountVert% = CountVert% + 13 PRINT M$(MenuItems%); IF MenuItems% = MaxNum% THEN PlantRow% = TopRow% EXIT FOR END IF NEXT PlantRow% = PlantRow% + VertInterval% CountVert% = 0 NEXT GOSUB place.box DO DO Hit$ = INKEY$ LOOP UNTIL LEN(Hit$) > 0 Hit% = CVI(Hit$ + CHR$(0)) LOCATE , , 0 IF Hit% = 27 THEN ' ExitCode% = 27 EXIT SUB ELSEIF Hit% > 64 AND Hit% < 91 OR Hit% > 96 AND Hit% < 123 THEN 'Letters A-Z and a-z IF Hit% > 64 AND Hit% < 91 THEN Box% = Hit% - 64 ELSEIF Hit% > 96 AND Hit% < 123 THEN Box% = Hit% - 96 END IF GOSUB clear.box GOSUB letter.select GOSUB place.box ELSEIF Hit% = 13 THEN ' ExitCode% = 13 EXIT SUB ELSEIF Hit% = 20480 THEN ' GOSUB clear.box GOSUB down.arrow GOSUB place.box ELSEIF Hit% = 18432 THEN ' GOSUB clear.box GOSUB up.arrow GOSUB place.box ELSEIF Hit% = 19712 THEN ' GOSUB clear.box GOSUB right.arrow GOSUB place.box ELSEIF Hit% = 19200 THEN ' GOSUB clear.box GOSUB left.arrow GOSUB place.box ELSEIF Hit% > 15103 AND Hit% < 17409 THEN 'F1 - F10 IdentKey$ = STR$(((Hit% - 15104) \ 256) + 1) IdentKey$ = LTRIM$(RTRIM$(IdentKey$)) IF IdentKey$ = "10" THEN IdentKey$ = "0" END IF IF INSTR(FKeys$, IdentKey$) > 0 THEN IF IdentKey$ = "0" THEN ExitCode% = 10 EXIT SUB ELSE ExitCode% = VAL(IdentKey$) EXIT SUB END IF END IF END IF LOOP '================================================================================= ' If you have a rolidex-style screen different from the one establish ' here, be careful with this Line Label "letter.select". You'll need ' to change the Row% and Col% numbers to fit your new rolidex screen. '================================================================================= letter.select: SELECT CASE Box% CASE 1 TO 6 Row% = 11 CASE 7 TO 12 Row% = 13 CASE 13 TO 18 Row% = 15 CASE 19 TO 24 Row% = 17 CASE 25 TO 26 Row% = 19 END SELECT SELECT CASE Box% CASE 1, 7, 13, 19, 25 Col% = 8 CASE 2, 8, 14, 20, 26 Col% = 21 CASE 3, 9, 15, 21 Col% = 34 CASE 4, 10, 16, 22 Col% = 47 CASE 5, 11, 17, 23 Col% = 60 CASE 6, 12, 18, 24 Col% = 73 END SELECT RETURN place.box: COLOR 11, 1 LOCATE 20, 57 IF Box% = 27 THEN COLOR 14, 1: PRINT " Exit " ELSE PRINT "Letter "; LOCATE 20, 64: COLOR 15, 1: PRINT CHR$(Box% + 64); END IF COLOR 11, 1: LOCATE 20, 69: PRINT "Item " COLOR 15, 1 LOCATE 20, 74: PRINT RTRIM$(LTRIM$(STR$(Box%))) + " "; COLOR BoxColrFG%, BoxColrBG% LOCATE Row% - 1, Col% - ColLessAmt% PRINT CHR$(218) + STRING$(BoxWidth% - 1, CHR$(196)) + CHR$(191); LOCATE Row%, Col% - ColLessAmt% PRINT CHR$(179); LOCATE Row%, Col% + BoxWidth% - ColLessAmt% PRINT CHR$(179); LOCATE Row% + 1, Col% - ColLessAmt%, 0 PRINT CHR$(192) + STRING$(BoxWidth% - 1, CHR$(196)) + CHR$(217); RETURN clear.box: COLOR ColrFG%, ColrBG% LOCATE Row% - 1, Col% - ColLessAmt% PRINT " " + STRING$(BoxWidth% - 1, " ") + " "; LOCATE Row%, Col% - ColLessAmt% PRINT " "; LOCATE Row%, Col% + BoxWidth% - ColLessAmt% PRINT " "; LOCATE Row% + 1, Col% - ColLessAmt%, 0 PRINT " " + STRING$(BoxWidth% - 1, " ") + " "; RETURN down.arrow: 'next 5 lines for last row info IF Row% = BottRow% + VertInterval% THEN Box% = Box% - (NumOfCols% * (NumOfRows% - 1)) Row% = TopRow% RETURN END IF IF Row% = BottRow% THEN IF Row% = BottRow% AND Col% = FirstCol% OR Col% = FirstCol% + SetHoriz% OR Col% = FirstCol% + SetHoriz% + SetHoriz% THEN Row% = Row% + VertInterval% Box% = Box% + NumOfCols% RETURN ELSEIF Row% = BottRow% THEN Box% = Box% - (NumOfCols% * (NumOfRows% - 2)) Row% = TopRow% END IF ELSEIF Row% = TopRow% THEN Box% = Box% + NumOfCols% Row% = Row% + VertInterval% ELSEIF Row% > TopRow% OR Row% < BottRow% THEN Box% = Box% + NumOfCols% Row% = Row% + VertInterval% END IF RETURN up.arrow: 'next 5 lines for last row info IF Row% = TopRow% AND Col% = FirstCol% OR Row% = TopRow% AND Col% = FirstCol% + SetHoriz% OR Row% = TopRow% AND Col% = FirstCol% + SetHoriz% + SetHoriz% THEN Row% = BottRow% + VertInterval% Box% = Box% + (NumOfCols% * (NumOfRows% - 1)) RETURN END IF IF Row% = BottRow% THEN Box% = Box% - NumOfCols% Row% = Row% - VertInterval% ELSEIF Row% = TopRow% THEN Box% = Box% + (NumOfCols% * (NumOfRows% - 2)) Row% = BottRow% ELSEIF Row% > TopRow% OR Row% < BottRow% THEN Box% = Box% - NumOfCols% Row% = Row% - VertInterval% END IF RETURN right.arrow: 'next 15 lines for last row info: IF Row% = BottRow% + VertInterval% THEN IF Col% = FirstCol% THEN Col% = FirstCol% + SetHoriz% ELSEIF Col% = FirstCol% + SetHoriz% THEN Col% = FirstCol% + SetHoriz% + SetHoriz% ELSEIF Col% = FirstCol% + SetHoriz% + SetHoriz% THEN Col% = FirstCol% END IF Box% = Box% + 1 IF Box% = 28 THEN Box% = 25 Col% = FirstCol% END IF RETURN END IF IF Col% = LastCol% THEN Box% = Box% - NumOfCols% + 1 Col% = FirstCol% ELSEIF Col% = FirstCol% THEN Box% = Box% + 1 Col% = Col% + SetHoriz% ELSEIF Col% > FirstCol% OR Col% < LastRow% THEN Box% = Box% + 1 Col% = Col% + SetHoriz% END IF RETURN left.arrow: 'next 12 lines for last row info IF Row% = BottRow% + VertInterval% THEN IF Col% = FirstCol% THEN Box% = 28 Col% = FirstCol% + SetHoriz% + SetHoriz% ELSEIF Col% = FirstCol% + SetHoriz% THEN Col% = FirstCol% ELSEIF Col% = FirstCol% + SetHoriz% + SetHoriz% THEN Col% = FirstCol% + SetHoriz% END IF Box% = Box% - 1 RETURN END IF IF Col% = FirstCol% THEN Box% = Box% + NumOfCols% - 1 Col% = LastCol% ELSEIF Col% > FirstCol% OR Col% < LastCol% THEN Box% = Box% - 1 Col% = Col% - SetHoriz% ELSEIF Col% = LastCol% THEN Box% = Box% - 1 Col% = Col% - SetHoriz% - SetHoriz% END IF RETURN END SUB SUB SaveRestScrn (ReadLine$(), ReadColr%(), SR.UL.Row%, SR.UL.Col%, SR.LR.Row%, SR.LR.Col%, SaveOrRest%) '+----------------------------------------------------------------------+ '| SUB SaveRestScrn was written by Don Smith on 03/25/02 and is Public | '| Domain FreeWare. Other programmers need not name me as author of | '| the SUB. | '| | '| EMail: smithdonb@earthlink.net | '+----------------------------------------------------------------------+ '+----------------------------------------------------------------------+ '| 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.scrn ELSEIF SaveOrRest% = 2 THEN GOSUB restore.scrn END IF EXIT SUB save.scrn: 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.scrn: 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