' +---------------------------------------------------------------------+ ' | | ' | - V i e w p o r t . 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. | ' +---------------------------------------------------------------------+ ' | ViewPort is a program which reads a command file and displays | ' | a menu of items contained within that file on the left side of | ' | a viewing screen. When a menu item is selected, the info | ' | accompanying that particular item is displayed on the right | ' | side of the viewing screen. There may be up to 100 menu items | ' | and each menu item may have up to 1000 lines of information for | ' | that particular menu item. This setup may be used for a many | ' | situations including food menus, scientific items, terms of | ' | definitions, etc. Read the file, VP.Txt. This program | ' | was written by Don Smith on May 10, 2002 and it is declared to | ' | be Public Domain FreeWare. Any part of this program and its | ' | SUBs may be used by anyone without naming me as the author. | ' | | ' | You must see the program in action to see how neat it is. | ' | Please enter at the prompt: VP WWII.Txt. | ' | | ' | Author: Don Smith | ' | EMail: smithdonb@earthlink.net | ' | Date: 05-01-2002 | ' | | ' +---------------------------------------------------------------------+ ' +---------------------------------------------------------------------+ ' | Compiling and Linking: | ' | --------------------- | ' | | ' | BC: VP /e | ' | | ' | LINK: VP /NOE | ' | | ' | LIB: BCOM45 | ' | | ' +---------------------------------------------------------------------+ DECLARE SUB BoxItUp (ULRow%, ULCol%, LRRow%, LRCol%, BoxColrFG%, BoxColrBG%, BoxStyle%, ClearBox%) DECLARE SUB BoxBoy (Title$, ULRow%, ULCol%, LRRow%, LRCol%, TitleRow%, TitleCol%, TitColrFG%, TitColrBG%, BoxColrFG%, BoxColrBG%, BoxStyle%, Shadow%, ShadowColr%, EdgeYN%) DECLARE SUB LMenu (M$(), Choice%, MaxNum%, InOut%, Row%, TopRow%, LastRow%, Col%, LMColrFG%, LMColrBG%, ExitCode%, ComFile$, Box1%, LongLine%, DnArr%) DECLARE SUB SaveRestScrn (ReadLine$(), ReadColr%(), SR.UL.Row%, SR.UL.Col%, SR.LR.Row%, SR.LR.Col%, SaveOrRest%) DECLARE SUB ZeeView (View$(), ZRow%, ULR%, ULC%, LRR%, LRC%, ZVColrFG%, ZVColrBG%, ZeeCount%, LeaveCode%, Box1%, ShowLine%) DEFINT A-Z ComFile$ = COMMAND$ ComFile$ = RTRIM$(LTRIM$(ComFile$)) REDIM M$(101) REDIM TopComment$(5) REDIM F5Comment$(8) ON ERROR GOTO errorhandler OPEN ComFile$ FOR INPUT AS #1 DO CountDaLine = CountDaLine + 1 IF EOF(1) THEN EXIT DO LINE INPUT #1, ReadFile$ IF LEFT$(ReadFile$, 1) = "[" THEN TopLine$ = MID$(ReadFile$, 2, LEN(ReadFile$)) TopLine$ = RTRIM$(LTRIM$(TopLine$)) TippyTop% = 1 'ELSEIF MID$(ReadFile$, 2, 1) = ">" THEN ' LastRow% = LastRow% + 1 ELSEIF LEFT$(ReadFile$, 2) = "*1" THEN TopComment$(1) = MID$(ReadFile$, 3, LEN(ReadFile$)) TopComment$(1) = RTRIM$(LTRIM$(TopComment$(1))) TopCop% = 1 ELSEIF LEFT$(ReadFile$, 2) = "*2" THEN TopComment$(2) = MID$(ReadFile$, 3, LEN(ReadFile$)) TopComment$(2) = RTRIM$(LTRIM$(TopComment$(1))) TopCop% = 1 ELSEIF LEFT$(ReadFile$, 2) = "*3" THEN TopComment$(3) = MID$(ReadFile$, 3, LEN(ReadFile$)) TopComment$(3) = RTRIM$(LTRIM$(TopComment$(1))) TopCop% = 1 ELSEIF LEFT$(ReadFile$, 3) = "*F5" THEN TopComment$(4) = MID$(ReadFile$, 4, LEN(ReadFile$)) TopComment$(4) = RTRIM$(LTRIM$(TopComment$(4))) TopFFive% = 1 ELSEIF LEFT$(ReadFile$, 1) = "*" THEN FF% = FF% + 1 IF FF% < 9 THEN F5Comment$(FF%) = MID$(ReadFile$, 2, LEN(ReadFile$)) END IF ELSEIF LEFT$(ReadFile$, 1) = "#" THEN NumSign$ = MID$(ReadFile$, 2, 3) NumSign$ = RTRIM$(LTRIM$(NumSign$)) Box1% = VAL(NumSign$) ELSEIF LEFT$(ReadFile$, 2) = "->" THEN T$ = "" CoolX = CoolX + 1 M$(CoolX) = MID$(ReadFile$, 3, LEN(ReadFile$) - 1) M$(CoolX) = RTRIM$(LTRIM$(M$(CoolX))) T$ = M$(CoolX) CountM = CountM + 1 BigX = 0 END IF IF CountM > 100 THEN EXIT DO END IF LOOP UNTIL EOF(1) 'added CountM = CountM - 1 CLOSE #1 MaxNum% = CountM MaxNum% = MaxNum% + 1 IF TippyTop% = 0 THEN TopLine$ = " - V i e w P o r t P r o g r a m -" END IF IF TopCop% = 0 THEN TopComment$(1) = "Use: or to change active window" TopComment$(2) = "Use: <> <> to browse Info Window" TopComment$(3) = " Help" TopComment$(5) = " Documentation" END IF IF TopFFive% = 1 THEN TopComment$(4) = " " + TopComment$(4) END IF MT$ = "Use: <> <> " MB$ = "Return: <Í> or " Choice% = 1 ' Notice that Choice and Row are placed BEFORE begin:, Row% = 8 ' causing the menu to reenter at last hi-lighted item. ' To always reenter at the top of menu, put Choice and ' row AFTER begin: InOut = 1 COLOR 15, 1: CLS MColrFG% = 15 MColrBG% = 1 COLOR 0, 7 LOCATE 1, 1: PRINT SPACE$(80) LOCATE 1, 3: PRINT (TopLine$) COLOR 15, 1 LOCATE 3, 7: PRINT TopComment$(1) LOCATE 4, 7: PRINT TopComment$(2) LOCATE 5, 7: PRINT TopComment$(3) LOCATE 5, 19: PRINT TopComment$(4) LOCATE 5, 57: PRINT TopComment$(5) CALL BoxItUp(2, 1, 6, 77, 15, 1, 1, 1) LeaveCode% = 1 'This goes with the SUB ZeeShow Box1% = Box1% + 1 begin: '------------------------------LMenu------------------------------------- IF Box1% < 12 THEN '+----------------------------------------------+ Box1% = 13 '| Box1% is the right column of first window. | ELSEIF Box1% = 0 THEN '+----------------------------------------------+ Box1% = 18 '| Box1% may be adjusted within the command file| ELSEIF Box1% > 31 THEN '| from 12 to 30. Should not be less than 18 | Box1% = 31 '| and not be more than 30. Box1% sets both | END IF '| window widths. If Box1% = 12 then Box2% will | '| be 59 characters wide, and if Box1% were 30, | '| then Box2% will be 41 Characters wide. | '| CHECK THIS!!!!! | '+----------------------------------------------+ IF TopFFive% = 1 THEN LeaveCode% = 2 ExitCode% = 2 END IF TopRow% = 8: Col% = 4: LMColrFG% = 15: LMColrBG% = 1 LastRow% = 23 'LastRow% set by program CALL LMenu(M$(), Choice%, MaxNum%, InOut%, Row%, TopRow%, LastRow%, Col%, LMColrFG%, LMColrBG%, ExitCode%, ComFile$, Box1%, LongLine%, DnArr%) IF ExitCode% = 27 THEN GOTO leave ELSEIF ExitCode% = 1 THEN ' GOSUB f.keys GOTO begin ELSEIF ExitCode% = 2 THEN ' GOSUB f.keys GOTO begin ELSEIF ExitCode% = 10 THEN ' GOSUB save.f.screen SHELL "Trueview.exe" + " " + "VP.Txt" GOSUB restore.f.screen GOTO begin END IF GOSUB save.L.screen CALL BoxItUp(7, 1, 25, Box1%, 7, 1, 1, 1) REDIM ReadL$(25) SP.UL.Row% = 8: SP.UL.Col% = 2: SP.LR.Row% = 24 SP.LR.Col% = Box1% + 4: SAPColrFG% = 7: SAPColrBG% = 0 CALL BoxItUp(7, Box1% + 3, 25, 77, 15, 1, 2, 1) LOCATE 7, ((77 - Box1%) \ 2) + Box1 - 3 COLOR 15, 1 PRINT "[Info Window]"; COLOR 0, 7 LOCATE 8, Box1% + 5 PRINT SPACE$(77 - Box1% - 3); MT$ = LEFT$(MT$, 77 - Box1% - 3) MTLen% = Box1% + ((77 - (Box1% + 11)) \ 2) - 2 LOCATE 8, MTLen% + 6 PRINT MT$; LOCATE 24, Box1% + 5 PRINT SPACE$(77 - Box1% - 3); MBLen% = Box1% + ((77 - (Box1% + 22)) \ 2) - 2 LOCATE 24, MBLen% + 16 MB$ = LEFT$(MB$, 77 - Box1% - 3) PRINT MB$; IF ExitCode% = 27 THEN GOTO leave ' ELSEIF ExitCode% = 20 OR ExitCode% = 21 OR ExitCode% = 22 OR ExitCode = 13 THEN REDIM View$(1 TO 1001) Box2% = 77 - (Box1% + 3) 'Difference between left and right Box2% = Box2% - 2 'column of Box2 OPEN ComFile$ FOR INPUT AS #2 Zork% = 0 IF DiffChoice% <> Choice% THEN ShowLine% = 1 END IF DiffChoice% = Choice% DO IF EOF(2) THEN GOTO show.zeeview END IF LINE INPUT #2, Zippy$ Zippy$ = MID$(Zippy$, 3, Box2%) Zippy$ = RTRIM$(LTRIM$(Zippy$)) IF Zippy$ = RTRIM$(LTRIM$(M$(Choice))) THEN DO IF EOF(2) THEN GOTO show.zeeview END IF LINE INPUT #2, ZeeLand$ Zork% = Zork% + 1 IF Zork% >= 1000 THEN EXIT DO END IF IF RTRIM$(LTRIM$(LEFT$(ZeeLand$, 2))) = "::" THEN Zork% = Zork% - 1 ELSE View$(Zork%) = MID$(ZeeLand$, 1, Box2%) END IF LOOP UNTIL LEFT$(ZeeLand$, 2) = "->" GOTO show.zeeview END IF LOOP show.zeeview: CLOSE #2 ZeeCount% = Zork% ZRow% = 9 ULR% = 9 ULC% = Box1% + 6 LRR% = 23 LRC% = 75 ZVColr% = 31 ZVColrFG% = 15 ZVColrBG% = 1 CALL ZeeView(View$(), ZRow%, ULR%, ULC%, LRR%, LRC%, ZVColrFG%, ZVColrBG%, ZeeCount%, LeaveCode%, Box1%, ShowLine%) DO IF LeaveCode% = 27 THEN GOTO leave ELSEIF LeaveCode% = 20 THEN ' GOSUB f.keys show% = ShowLine% GOTO show.zeeview ELSEIF LeaveCode% = 25 THEN ' GOSUB f.keys show% = ShowLine% GOTO show.zeeview ELSEIF LeaveCode% = 30 THEN ' GOSUB save.f.screen SHELL "Trueview.exe" + " " + "VP.Txt" GOSUB restore.f.screen GOTO show.zeeview ELSEIF LeaveCode% = 1 THEN ' - See Sub GOSUB restore.L.screen InOut = 2 'InOut = 1 ' Use set up to the left to reenter at the 'Row = TopRow ' top of menu. To wit, InOut = 1, 'Choice = 1 ' Row = TopRow. Other wise put InOut = 2 LongLine% = ShowLine% - 1 'CLS : PRINT ShowLine%: END GOTO begin END IF LOOP END IF leave: COLOR 7, 0: CLS : LOCATE 1, 1, 1, 6, 7: END save.L.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 restore.L.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 errorhandler: COLOR 15, 1: CLS ULRow% = 5 ULCol% = 16 LRRow% = 15 LRCol% = 64 BoxColrFG% = 15 BoxColrBG% = 1 BoxStyle% = 1 ClearBox% = 0 CALL BoxItUp(ULRow%, ULCol%, LRRow%, LRCol%, BoxColrFG%, BoxColrBG%, BoxStyle%, ClearBox%) COLOR 12, 1 LOCATE 6, 36: PRINT "<<>>"; COLOR 15, 1 LOCATE 8, 22: PRINT "Either no filename was given, the filename"; LOCATE 9, 22: PRINT "could not be found, or the filename was"; LOCATE 10, 22: PRINT "entered incorrectly. Correct parameter is:"; LOCATE 12, 34: PRINT "VP FileName.Ext"; LOCATE 14, 26: PRINT " - Press Any Key To Continue -" LOCATE 12, 34, 0, 0, 0: COLOR 14, 1: PRINT "VP FileName.Txt"; DO: LOOP WHILE INKEY$ = "" COLOR 7, 0: CLS : LOCATE , , 1, 6, 7: END save.f.screen: REDIM RLine$(25): REDIM RColr%(25, 80) SR.UL.Row% = 1: SR.UL.Col% = 1: SR.LR.Row% = 25: SR.LR.Col% = 80 FOR ViewIt% = SR.UL.Row% TO SR.LR.Row% FOR Horizon% = SR.UL.Col% TO SR.LR.Col% RLine$(ViewIt%) = RLine$(ViewIt%) + CHR$(SCREEN(ViewIt%, Horizon%)) RColr%(ViewIt%, Horizon%) = SCREEN(ViewIt%, Horizon%, 1) NEXT NEXT RETURN restore.f.screen: FOR FindRow% = SR.UL.Row% TO SR.LR.Row% FOR ScrnCol% = SR.UL.Col% TO SR.LR.Col% LOCATE FindRow%, ScrnCol%, 0 OneColr% = RColr%(FindRow%, ScrnCol%) FGScrnColr% = OneColr% MOD 16 BGScrnColr% = OneColr% \ 16 COLOR FGScrnColr%, BGScrnColr% PRINT MID$(RLine$(FindRow%), ScrnCol% - (SR.UL.Col% - 1), 1); NEXT NEXT ERASE RLine$: ERASE RColr% RETURN f.keys: GOSUB save.f.screen 'Box setup - next 4 lines Title$ = "" ULRow% = 8 ULCol% = 20 LRRow% = 19 LRCol% = 61 BoxColrFG% = 15 BoxColrBG% = 4 BoxStyle% = 1 ClearBox% = 2 Shadow% = 1 ShadowColr% = 7 EdgeYN% = 1 SOUND 200, 3 CALL BoxBoy(Title$, ULRow%, ULCol%, LRRow%, LRCol%, TitleRow%, TitleCol%, TitColrFG%, TitColrBG%, BoxColrFG%, BoxColrBG%, BoxStyle%, Shadow%, ShadowColr%, EdgeYN%) IF ExitCode% = 1 OR LeaveCode% = 20 THEN ' pressed COLOR 11, 4 LOCATE 9, 28: PRINT " - The ViewPort Program -" COLOR 15, 4 LOCATE 10, 21: PRINT CHR$(195) + STRING$(41, "Ä") + CHR$(180) LOCATE 11, 23: PRINT "To switch from one screen to the next," LOCATE 12, 23: PRINT "press , <Í> or <Í>. If you are" LOCATE 13, 23: PRINT "in the Info Window, use <>, <>, " LOCATE 14, 23: PRINT ", or . To exit at any" LOCATE 15, 23: PRINT "just press . To jump to items" LOCATE 16, 23: PRINT "on the menu, press the first letter." LOCATE 17, 21: PRINT CHR$(195) + STRING$(41, "Ä") + CHR$(180) COLOR 11, 4 LOCATE 18, 29: PRINT "Press Any Key To Continue" ELSEIF ExitCode% = 2 OR LeaveCode% = 25 THEN ' pressed COLOR 15, 4 FOR ef.five% = 1 TO 8 LOCATE ef.five + 8, 23 PRINT F5Comment$(ef.five%) NEXT COLOR 15, 4 LOCATE 17, 21: PRINT (CHR$(195) + STRING$(41, "Ä") + CHR$(180)) COLOR 11, 4 LOCATE 18, 29: PRINT "Press Any Key To Continue" END IF DO: LOOP WHILE INKEY$ = "" IF TopFFive% = 1 THEN LeaveCode% = 2 ExitCode% = 2 END IF GOSUB restore.f.screen RETURN 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. | ' +--------------------------------------------------------------------+ ' | The SUB BoxBoy was written by Don Smith. This BoxBoy is the | ' | lastest iteration of the SUB - written 12-01-2002. Other | ' | programmers, or anyone else for that matter, 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. | ' +-------------+------------------------------------------------------+ ' | 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 | ' | | BoxStyle% = 3 (Solid 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 EdgeYN% > 1 OR EdgYN% < 0 THEN EdgeYN% = 0 END IF IF ULCol% <= 1 THEN ULCol% = 1 END IF IF LRCol% = 80 THEN LRCol% = 79 END IF make.box: IF BoxStyle% = 0 THEN 'No Lines ULCorner$ = CHR$(255) URCorner$ = CHR$(255) HorLineTop$ = CHR$(255) HorLineBot$ = 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) HorLineTop$ = CHR$(196) HorLineBot$ = 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) HorLineTop$ = CHR$(205) HorLineBot$ = CHR$(205) LeftSide$ = CHR$(199) RightSide$ = CHR$(182) VertLine$ = CHR$(186) LLCorner$ = CHR$(200) LRCorner$ = CHR$(188) ELSEIF BoxStyle% = 3 THEN 'Solid line ULCorner$ = CHR$(219) URCorner$ = CHR$(219) HorLineTop$ = CHR$(223) HorLineBot$ = CHR$(220) LeftSide$ = CHR$(219) RightSide$ = CHR$(219) VertLine$ = CHR$(219) LLCorner$ = CHR$(219) LRCorner$ = CHR$(219) 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%, 0 PRINT Edge$ + ULCorner$ + STRING$(LRCol% - ULCol%, HorLineTop$) + URCorner$ + Edge$; '³ ³ or º º LOCATE ULRow% + 1, ULCol%, 0 PRINT Edge$ + VertLine$ + SPACE$(LRCol% - ULCol%) + VertLine$ + Edge$; IF Title$ <> "" THEN 'ÃÄÄÄ´ or ÇÄÄĶ 'made cross bar if there is a title LOCATE ULRow% + 2, ULCol%, 0 PRINT Edge$ + LeftSide$ + STRING$(LRCol% - ULCol%, 196) + RightSide$ + Edge$; ELSEIF Title$ = "" THEN LOCATE ULRow% + 2, ULCol%, 0 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%, 0 PRINT Edge$ + VertLine$ + SPACE$(LRCol% - ULCol%) + VertLine$ + Edge$; NEXT 'ÀÄÄÄÙ or ÈÍÍͼ LOCATE LRRow%, ULCol%, 0 PRINT Edge$ + LLCorner$ + STRING$(LRCol% - ULCol%, HorLineBot$) + LRCorner$ + Edge$; IF Title$ <> "" THEN LOCATE TitleRow%, TitleCol%, 0 COLOR TitColrFG%, TitColrBG% PRINT Title$; END IF END SUB SUB BoxItUp (ULRow%, ULCol%, LRRow%, LRCol%, BoxColrFG%, BoxColrBG%, BoxStyle%, ClearBox%) '+-------------------------SUB BoxItUp---------------------------------+ '| SUB written by Don Smith on May, 1 2002. It is a much simplified | '| version of BoxBoy; it doesn't have Title, Shadow, etc. Declared | '| Public Domain FreeWare. | '| | '| Don's EMail: smithdonb@earthlink.net | '+-------------+-------------------------------------------------------+ '| 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. | '|-------------+-------------------------------------------------------| '| BoxColrFG% | The box foreground color | '|-------------+-------------------------------------------------------| '| BoxColrBG% The box back ground color | '|-------------+-------------------------------------------------------| '| BoxStyle% | Style% equals 1 - Single line around box | '| | Style% equals 2 - Double line around box | '|-------------+-------------------------------------------------------| '| ClearBox% | ClearBox% = 1 then do not clear box | '| | ClearBox% = 2 then YES clear box | '+-------------+-------------------------------------------------------+ ' ' make.da.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 COLOR BoxColrFG%, BoxColrBG% 'ÚÄÄÄ¿ or ÉÍÍÍ» LOCATE ULRow%, ULCol% PRINT " " + ULCorner$ + STRING$(LRCol% - ULCol%, HorLine$) + URCorner$ + " "; '³ ³ or º º IF ClearBox% = 0 OR ClearBox% = 1 THEN FOR Print.Box = 1 TO (LRRow% - ULRow%) - 1 LOCATE ULRow% + Print.Box%, ULCol% PRINT " " + VertLine$; NEXT FOR Print.Box = 1 TO (LRRow% - ULRow%) - 1 LOCATE ULRow% + Print.Box%, LRCol% + 2 PRINT VertLine$; NEXT ELSEIF ClearBox% = 2 THEN FOR Print.Box = 1 TO (LRRow% - ULRow%) - 1 LOCATE ULRow% + Print.Box%, ULCol% PRINT " " + VertLine$ + SPACE$(LRCol% - ULCol%) + VertLine$ + " "; NEXT END IF 'ÀÄÄÄÙ or ÈÍÍͼ LOCATE LRRow%, ULCol% PRINT " " + LLCorner$ + STRING$(LRCol% - ULCol%, HorLine$) + LRCorner$ + " "; END SUB SUB LMenu (LM$(), Choice%, MaxNum%, InOut%, Row%, TopRow%, LastRow%, Col%, LMColrFG%, LMColrBG%, ExitCode%, ComFile$, Box1%, LongLine%, DnArr%) ' +----------------------SUB LMenu-------------------------------------+ ' | LMenu is a menu which displays a single column of menu items | ' | which may be scolled up or down. The LMenu SUB was written by | ' | Don Smith on May 1, 2002. It is declare Public Domain, FreeWare. | ' | | ' | - Don Smith | ' | EMail: smithdonb@earthlink.net | ' | 04-22-2002 | ' | | ' +--------------------------------------------------------------------+ ' +-----------+---------------------------------------------------------+ ' | LM$() | The menu items must be REDIMed in the main program | ' | | The menu item must be 12 characters or less, otherwise | ' | | it gets chopped | ' +-----------+---------------------------------------------------------+ ' | Choice% | The Choice always gets reported as a number. If | ' | | the NumOrLetr = 2, and letters are being used, then | ' | | D = 4, for example. If you wish to reenter the | ' | | menu with the last Choice hi-lighted, then in the | ' | | main program, place Choice & Row BEFORE begin: | ' +-----------+---------------------------------------------------------+ ' | InOut% | InOut = 2 Use this to reenter menu at last hi-lighted | ' | | place. Otherwise to reenter on top use | ' | | InOut = 1, Row = TopRow and Choice = 1 | ' +-----------+---------------------------------------------------------+ ' | Row% | Row to begin menu | ' +-----------+---------------------------------------------------------+ ' | TopRow% | TopRow is same as Row but Row will change | ' | | TopRow will remain the same | ' +-----------+---------------------------------------------------------+ ' | LastRow% | Last row to show menu | ' +-----------+---------------------------------------------------------+ ' | Col% | Col to begin menu | ' +-----------+---------------------------------------------------------+ ' | LMColrFG% | Menu foreground color | ' +-----------+---------------------------------------------------------+ ' | LMColrBG% | Menu back ground color | ' +-----------+---------------------------------------------------------+ ' | ExitCode% | ExitCode = 27 ExitCode = 1 | ' | | ExitCode = 20 ExitCode = 2 | ' | | ExitCode = 21 | ' | | ExitCode = 22 | ' +-----------+---------------------------------------------------------+ ' | ComFile$ | File as command line parameter. Remove this from | ' | | regular LMenu use. | ' +-----------+---------------------------------------------------------+ ' | Box1% | Left Column of LMenu's window. Remove this from | ' | | regular LMenu use. | ' +-----------+---------------------------------------------------------+ ' | LongLine% | Location and number of last menu item. | ' +-----------+---------------------------------------------------------+ ' | F Keys | See below how to insert keys in program. | ' | | +-----------------------------------------------+ | ' | | | Keys per Cvi Code | | ' | | +-----------------------------------------------+ | ' | | | = 15104 = 16128 = 16896 | | ' | | | = 15360 = 16384 = 17152 | | ' | | | = 15616 = 16640 = 17408 | | ' | | | = 15872 Add 256 each time. | | ' | | +-----------------------------------------------+ | ' | | Extended keys other than keys may be used. | ' | | Example: R is 4864. | ' | | | ' | | Write or cut out the short program that follows to find | ' | | out other CVI numbers you will need. | ' +-----------+---------------------------------------------------------+ ' | '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 | ' | Hit% = CVI(T$ + CHR$(0)) | ' | IF Hit% > 256 THEN | ' | LOCATE , 24, 0: PRINT "Extended Key" + " = " + STR$(T) | ' | ELSE | ' | LOCATE , 35, 0: PRINT T$ + " = " + STR$(T) | ' | END IF | ' | IF Hit% = 27 OR Hit% = 13 THEN | ' | COLOR 7, 0: CLS : LOCATE 1, 1, 1, 6, 7: END | ' | END IF | ' | LOOP | ' +---------------------------------------------------------------------+ ' | Other CVI code numbers: | ' | ~~~~~~~~~~~~~~~~~~~~~~ | ' | = 24064 = 24064 | ' | = 24320 = 24320 | ' | Add 256 each time Add 256 each time | ' | | ' | = 21504 = 1 | ' | = 21760 = 2 | ' | Add 256 each time (Z> = 26 Add 1 each time | ' +---------------------------------------------------------------------+ FOR Super% = 1 TO MaxNum LM$(Super) = RTRIM$(LTRIM$(LEFT$(LM$(Super%), Box1% - 1))) NEXT FOR Jefe = 1 TO MaxNum HotKey$ = HotKey$ + LEFT$(LM$(Jefe), 1) NEXT LMax = 1 FOR a = 1 TO MaxNum% Longest = LEN(LM$(a)) IF Longest > LMax THEN LMax = Longest END IF NEXT LMax = LMax + 2 GOSUB bring.items IF LastRow% = 0 THEN LastRow% = 25 ULRow% = 7 ULCol% = 1 LRRow% = 25 LRCol% = Box1% BoxColrFG% = 15 BoxColrBG% = 1 BoxStyle% = 2 ClearBox% = 1 CALL BoxItUp(ULRow%, ULCol%, LRRow%, LRCol%, BoxColrFG%, BoxColrBG%, BoxStyle%, ClearBox%) CALL BoxItUp(7, Box1% + 3, 25, 77, 7, 1, 1, 1) InfoM% = ((77 - Box1%) \ 2) + Box1% - 3 LOCATE 7, InfoM% PRINT "[Info Window]" sub.works: DO GOSUB display.hilight 'Hilight color DO Hit$ = INKEY$ Hit$ = UCASE$(Hit$) LOOP UNTIL LEN(Hit$) > 0 Hit% = CVI(Hit$ + CHR$(0)) 'CVI code numbers! IF Hit% = 27 THEN ' ExitCode% = 27 EXIT SUB END IF GOSUB display.regular 'regular color 'Hit% = 27 Hit% = 122 is last letter, or "z". IF Hit% > 27 AND Hit% < 123 THEN 'HotKey$ DnArr% = 0 Choice% = Choice% + 1 LetrOrNum% = INSTR(Choice%, HotKey$, UCASE$(Hit$)) Choice% = LetrOrNum% IF LetrOrNum% = 0 THEN ZapO% = 1 ZapO% = ZapO% + 1 Choice% = Choice% + 1 LetrOrNum% = INSTR(Choice%, HotKey$, UCASE$(Hit$)) Choice% = LetrOrNum% IF Choice% = 0 THEN Row% = TopRow% Choice% = 1 END IF END IF 'Row = TopRow + Choice - 1 - ZapO Row% = TopRow% FOR XEffect% = 1 TO LastRow% - TopRow% + 1 TRow% = TopRow% + XEffect% - 1 LOCATE TRow%, Col% - 1, 0 COLOR LMColrFG, LMColrBG PRINT SPACE$(Box1% - 1); LOCATE TRow%, Col% - 1, 0 IF Choice% + XEffect% - 2 < MaxNum% + 1 THEN PRINT LM$(Choice% + XEffect% - 1); END IF NEXT GOSUB display.regular ELSEIF Hit% = 18176 THEN ' Row% = TopRow% Choice% = 1 FOR XEffect% = 1 TO LastRow% - TopRow% + 1 TRow% = TopRow% + XEffect% - 1 COLOR LMColrFG%, LMColrBG% LOCATE TRow%, Col% - 1, 0 PRINT SPACE$(Box1% - 1) LOCATE TRow%, Col% - 1, 0 IF Choice% + XEffect% - 2 < MaxNum% + 1 THEN PRINT LM$(Choice% + XEffect% - 1) END IF NEXT GOSUB display.regular ELSEIF Hit% = 20224 THEN ' Choice% = MaxNum% Row% = LastRow% IF Choice% = MaxNum% THEN DnArr% = DnArr% + 1 IF DnArr% = 1 THEN Row% = Row% + 1 END IF IF Row% >= LastRow% THEN Row% = LastRow% GOSUB bring.items.down ELSEIF Row% + 1 = TopRow% + Choice% - 1 THEN Row% = Row% + 1 END IF END IF ELSEIF Hit% = 18432 THEN ' DnArr% = 0 IF Choice% > 1 THEN Choice% = Choice% - 1 END IF IF Row% >= TopRow% + 1 THEN Row% = Row% - 1 ELSE GOSUB bring.items.up END IF IF Choice% < 1 THEN Choice% = MaxNum% ELSEIF Hit% = 20480 THEN ' IF Choice% < MaxNum% THEN Choice% = Choice% + 1 END IF IF Choice% < MaxNum% THEN Row% = Row% + 1 TRow% = Row% IF Row% >= LastRow% THEN Row% = LastRow% GOSUB bring.items.down END IF ELSEIF Choice% = MaxNum% THEN DnArr% = DnArr% + 1 IF DnArr% = 1 THEN Row% = Row% + 1 END IF IF Row% >= LastRow% THEN Row% = LastRow% GOSUB bring.items.down ELSEIF Row% + 1 = TopRow% + Choice% - 1 THEN Row% = Row% + 1 END IF END IF IF Choice% > MaxNum% THEN Choice% = MaxNum% END IF ELSEIF Hit% = 15104 THEN ' See note above ExitCode% = 1 ' on Keys. EXIT SUB ELSEIF Hit% = 16128 THEN ' ExitCode% = 2 EXIT SUB ELSEIF Hit% = 17408 THEN ' ExitCode% = 10 EXIT SUB ELSEIF Hit% = 9 THEN ' ExitCode% = 20 EXIT SUB ELSEIF Hit% = 19712 THEN ' ExitCode% = 22 EXIT SUB ELSE GOTO sub.works END IF LOOP display.regular: COLOR LMColrFG%, LMColrBG% LOCATE Row%, Col% - 1, 0 PRINT SPACE$(Box1% - 3); LOCATE Row%, Col% - 1, 0 PRINT RTRIM$(LTRIM$(LM$(Choice%))); RETURN display.hilight: COLOR LMColrFG%, LMColrBG% LOCATE Row%, Col% - 1, 0 PRINT SPACE$(Box1% - 1); LOCATE Row%, Col% - 1, 0 COLOR 15, 0 PRINT RTRIM$(LTRIM$(LM$(Choice%))); OPEN ComFile$ FOR INPUT AS #3 REDIM View$(201) Box2% = 77 - (Box1% + 3) Box2% = Box2% - 2 ZorKette% = 0 RowBoat% = 1 DO IF EOF(3) THEN CLOSE #3 RETURN END IF LINE INPUT #3, Zippy$ Zippy$ = MID$(Zippy$, 3, 54) Zippy$ = RTRIM$(LTRIM$(Zippy$)) IF Zippy$ = RTRIM$(LTRIM$(LM$(Choice%))) THEN DO IF EOF(3) THEN CLOSE #3 RETURN END IF LINE INPUT #3, ZeeLand$ IF RTRIM$(LTRIM$(LEFT$(ZeeLand$, 2))) = "::" THEN ZorKette% = ZorKette% - 1 END IF IF LEFT$(ZeeLand$, 2) = "->" THEN EXIT DO END IF IF LongLine% > 0 THEN ZeeLand$ = "" FOR ZuluLand% = 1 TO LongLine% - 1 LINE INPUT #3, ThrowAway$ NEXT LongLine% = 0 RowBoat% = 0 END IF IF ZorKette% = 16 THEN CLOSE #3 RETURN END IF ZorKette% = ZorKette% + 1 IF RTRIM$(LTRIM$(LEFT$(ZeeLand$, 2))) <> "::" THEN View$(ZorKette%) = MID$(ZeeLand$, 1, Box2%) COLOR 7, 1 LOCATE 8 + ZorKette%, Box1% + 6 PRINT SPACE$(Box2%); LOCATE 7 + ZorKette% + RowBoat%, Box1% + 6 PRINT View$(ZorKette%); END IF LOOP UNTIL LEFT$(ZeeLand$, 2) = "->" IF ZorKette% < 16 THEN COLOR 7, 1 FOR ZXCV% = ZorKette% TO 16 LOCATE 7 + ZXCV% + 1, Box1% + 6 PRINT SPACE$(Box2%); NEXT END IF CLOSE #3 RETURN END IF LOOP CLOSE #3 RETURN bring.items: COLOR LMColrFG%, LMColrBG% IF InOut% <> 2 THEN FOR XYZ% = TopRow% TO LastRow% LOCATE XYZ%, Col% - 1, 0 PRINT SPACE$(LMax); LOCATE XYZ%, Col% - 1, 0 PRINT LM$(XYZ% - TopRow% + 1); NEXT END IF RETURN bring.items.down: COLOR LMColrFG%, LMColrBG% FOR XYZ% = 1 TO LastRow% - TopRow% LOCATE XYZ% + TopRow% - 1, Col% - 1, 0 PRINT SPACE$(Box1% - 1); LOCATE XYZ% + TopRow% - 1, Col% - 1, 0 PRINT LM$(Choice% - (LastRow% - TopRow% + 1) + XYZ%); NEXT RETURN bring.items.up: COLOR LMColrFG%, LMColrBG% FOR XYZ% = 1 TO LastRow% - TopRow% + 1 IF Choice% - 1 + XYZ% < MaxNum% + 1 THEN LOCATE XYZ% + TopRow% - 1, Col% - 1, 0 PRINT SPACE$(Box1% - 1); LOCATE XYZ% + TopRow% - 1, Col% - 1, 0 PRINT LM$(Choice% - 1 + XYZ%); END IF NEXT RETURN END SUB SUB SaveRestScrn (ReadLine$(), ReadColr%(), SR.UL.Row%, SR.UL.Col%, SR.LR.Row%, SR.LR.Col%, SaveOrRest%) '+------------------------SUB SaveRestScrn------------------------------+ '| SUB written by Don Smith on 05/01/2002 - Public Domain FreeWare. | '| No need to name Don as the author. 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.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), 1); NEXT NEXT RETURN END SUB SUB ZeeView (View$(), ZRow%, ULR%, ULC%, LRR%, LRC%, ZVColrFG%, ZVColrBG%, ZeeCount%, LeaveCode%, Box1%, ShowLine%) ' +----------------------SUB ZeeView-----------------------------------+ ' | ZeeView actually is an ASCII file browser, and it could very well | ' | by modified to work as one. ZeeView was written by Don Smith | ' | on May 1, 2002 and it is declared to be Public Domain, FreeWare. | ' | EMail: smithdonb@earthlink.net | ' +--------------------------------------------------------------------+ ' +--------------------------------------------------------------------+ ' | View$() | View$ are the strings to view. This must be set up | ' | | in the main program by using DIM or REDIM, opening | ' | | a file and reading the lines. Refer to ViewPort.Doc | ' +------------+-------------------------------------------------------+ ' | ZRow% | Same as ULR% (Upper Left Row) | ' +------------+-------------------------------------------------------+ ' | ULR% | Upper left row to place print on screen | ' +------------+-------------------------------------------------------+ ' | ULC% | Upper left column to place print on screen | ' +------------+-------------------------------------------------------+ ' | LRR% | Lower right row to place print on screen | ' +------------+-------------------------------------------------------+ ' | LRC% | Lower right column to place print on screen | ' +------------+-------------------------------------------------------+ ' | ZVColrFG% | Color of foreground of text to print on screen | ' +------------+-------------------------------------------------------+ ' | ZVColrBG% | Color of back ground of text to print on screen | ' +------------+-------------------------------------------------------+ ' | ZeeCount% | Total lines to view | ' +------------+-------------------------------------------------------+ ' | LeaveCode% | Exits program set to a number. | ' | | LeaveCode = 1 if or is pressed. | ' | | LeaveCode% = 27 if is pressed. | ' | | LeaveCode% = 20 if is pressed. | ' | | LeaveCode% = 25 if is pressed. | ' | | LeaveCode% = 30 if <10> is pressed. | ' +------------+-------------------------------------------------------+ Box2% = 77 - (Box1% + 3) Box2% = Box2% - 2 show% = ShowLine% ShowShow% = ShowLine% begin.zeeshow: COLOR ZVColrFG%, ZVColrBG% FOR ZeeShow% = ULR% TO LRR% IF show% = ZeeCount% THEN EXIT FOR END IF COLOR ZVColrFG%, ZVColrBG% LOCATE ZRow%, ULC% PRINT SPACE$(LRC% - ULC% + 3) LOCATE ZRow%, ULC% 'PRINT View$(show%) PRINT LEFT$(View$(show%), Box2%) ZRow% = ZRow% + 1 show% = show% + 1 IF show% - 14 > 1 THEN TopCount% = show% - 15 BottCount% = show% - 1 ELSEIF show% - 14 < 1 THEN TopCount% = 1 BottCount% = 15 END IF COLOR 0, 7 LOCATE 8, Box1% + 6 PRINT "Top Line:"; LOCATE 8, Box1% + 15 PRINT STR$(TopCount%) + " "; LOCATE 24, Box1% + 6 PRINT "Bottom Line:"; LOCATE 24, Box1% + 18 PRINT STR$(BottCount%) + " "; NEXT DO DO HitKey$ = INKEY$ LOOP UNTIL LEN(HitKey$) > 0 HitKey% = CVI(HitKey$ + CHR$(0)) IF HitKey% = 20480 THEN ' IF ShowShow% + 15 < ZeeCount% THEN ShowShow% = ShowShow% + 1 END IF show% = ShowShow% ZRow% = ULR% GOTO begin.zeeshow ELSEIF HitKey% = 18432 THEN ' IF ShowShow% > 1 THEN ShowShow% = ShowShow% - 1 END IF show% = ShowShow% ZRow% = ULR% GOTO begin.zeeshow ELSEIF HitKey% = 20736 THEN ' IF ShowShow% < (ZeeCount% + 1) - (LRR% - ULR% + 1) THEN ShowShow% = ShowShow% + (LRR% - ULR% + 1) END IF show% = ShowShow% ZRow% = ULR% COLOR ZVColrFG%, ZVColrBG% FOR CleanOut% = ULR% TO LRR% LOCATE CleanOut%, ULC% PRINT SPACE$(LRC% - ULC% + 3); NEXT GOTO begin.zeeshow ELSEIF HitKey% = 18688 THEN ' IF ShowShow% > (LRR% - ULR% + 1) THEN ShowShow% = ShowShow% - (LRR% - ULR% + 1) END IF IF ShowShow% <= LRR% - ULR% + 1 THEN ShowShow% = 1 END IF show% = ShowShow% ZRow% = ULR% COLOR ZVColrFG%, ZVColrBG% FOR CleanOut% = ULR% TO LRR% LOCATE CleanOut%, ULC% PRINT SPACE$(LRC% - ULC% + 3); NEXT GOTO begin.zeeshow ELSEIF HitKey% = 18176 THEN ' show% = 1 ShowShow% = show% ZRow% = ULR% GOTO begin.zeeshow ELSEIF HitKey% = 20224 THEN ' show% = ZeeCount% - (LRR% - ULR% + 1) ShowShow% = show% ZRow% = ULR% GOTO begin.zeeshow ELSEIF HitKey% = 9 OR HitKey% = 19200 THEN ' or 'with LeaveCode% set to 1, then pressed Tab or Left Arrow LeaveCode% = 1 IF show% - 15 > 0 THEN ShowLine% = show% - 15 ELSE ShowLine% = 1 END IF EXIT SUB ELSEIF HitKey% = 15104 THEN ' LeaveCode% = 20 ShowLine% = ShowShow% EXIT SUB ELSEIF HitKey% = 16128 THEN ' IF LeaveCode% = 2 THEN ShowLine% = ShowShow% LeaveCode% = 25 EXIT SUB END IF ELSEIF HitKey% = 17408 THEN ' ShowLine% = ShowShow% LeaveCode% = 30 EXIT SUB ELSEIF HitKey% = 27 THEN LeaveCode% = 27 EXIT SUB END IF LOOP END SUB