' +--------------------------------------------------------------------+ ' | | ' | F I G T a i l . B a s | ' | | ' | Public Domain - Freeware | ' | ______ _____ _____ _____ _ _ ______ | ' | | ___|_ _| __ \_ _| (_) | | ___ \ | ' | | |_ | | | | \/ | | __ _ _| | | |_/ / __ _ ___ | ' | | _| | | | | __ | |/ _` | | | | ___ \/ _` / __| | ' | | | _| |_| |_\ \ | | (_| | | |_| |_/ / (_| \__ \ | ' | \_| \___/ \____/ \_/\__,_|_|_(_)____/ \__,_|___/ | ' | | ' +--------------------------------------------------------------------+ ' | | ' | FIGTAIL.Bas was written for and compiled by QuickBASIC 4.5. | ' | No special libraries are needed to compile the program. | ' +--------------------------------------------------------------------+ ' | - 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. | ' +--------------------------------------------------------------------+ ' +--------------------------------------------------------------------+ ' | The FIGTail.Bas program was created on June 29, 2007. I was | ' | cruising the internet and came across the FIGLet font program, | ' | designed to make large fonts out of regular ASCII characters. The | ' | above "FIGTail.Bas" was made with the "doom" font, written by Fraus| ' | P. de Vries in 1996. | ' | | ' | My name, Don Smith, written below in puffy font and graffiti font: | ' | | ' | puffy font was written by Juan Car in 1994. | ' | ___ ___ _ _ | ' | ( _`\ ( _`\ _ ( )_ ( ) | ' | | | ) | _ ___ | (_(_) ___ ___ (_)| ,_)| |__ | ' | | | | ) /'_`\ /' _ `\ `\__ \ /' _ ` _ `\| || | | _ `\ | ' | | |_) |( (_) )| ( ) | ( )_) || ( ) ( ) || || |_ | | | | | ' | (____/'`\___/'(_) (_) `\____)(_) (_) (_)(_)`\__)(_) (_) | ' | | ' | | ' | graffiti font, written by Leigh Purdie in 1994 | ' | ________ _________ .__ __ .__ | ' | \______ \ ____ ____ / _____/ _____ |__|/ |_| |__ | ' | | | \ / _ \ / \ \_____ \ / \| \ __\ | \ | ' | | ` ( <_> ) | \ / \ Y Y \ || | | Y \ | ' | /_______ /\____/|___| / /_______ /__|_| /__||__| |___| / | ' | \/ \/ \/ \/ \/ | ' | | ' | Neat-O, right? Well, I soon downloaded the software and begin | ' | trying out different fonts. It was slow progress because I was | ' | doing everything at the DOS prompt. For example: | ' | | ' | FIGLet -f doom Don Smith > Don.Txt | ' | | ' | These parameters puts my name into the "doom" font into | ' | the text file "Don.Txt". Well, I soon tired of this. I then | ' | remembered a certain menu program, Mesamenu, which I made | ' | back it 2002. I thought to myself, "I can easily design | ' | a program around Mesamenu to show the various FIGLet fonts. | ' | | ' | So, this is the results, FIGTail.Bas. Below is an explanation | ' | of Mesamenu and its four SUBS. | ' | | ' | If you would like to download the FIGLet program and .FLF fon | ' | files, just go to: | ' | | ' | http://www.kammerl.de/ascii/AsciiSignature.php | ' | | ' +--------------------------------------------------------------------+ ' +--------------------------------------------------------------------+ ' | Five SUB programs of Figtail.Bas | ' +--------------------------------------------------------------------+ ' | The five SUBs used in this program are all Public Domain, FreeWare.| ' | They do not need a special Library or Quick Library, just plain ol'| ' | QuickBASIC. Below is a brief description of each one. To find | ' | out more, visit each SUB and read the information at the top. | ' | | ' | (1) BoxBoy - All you need to make boxes or windows | ' | of various sizes, styles and shadows. | ' | (2) DisplayMessage - This SUB will make a scroll- | ' | able message on screen | ' | (3) MesaMenu - Places on screen a table menu of | ' | designated items - this program. | ' | (4) SaveRestScrn - This SUB will save and or | ' | restore a portion or all the current screen. | ' | (5) EditLoco is a one-line editor which may also be used | ' | in password mode, displaying a series of these: ùùùù | ' +--------------------------------------------------------------------+ ' +--------------------------------------------------------------------+ ' | Compile: | ' | BC FIGTail /e (e for ON ERROR) | ' | | ' | LINK: FIGTail | ' | LIB : BCom45 | ' +--------------------------------------------------------------------+ ' | +----------------+ | ' | | CAUTION | | ' | +----------------+ | ' | This is a public domain program! DO NOT accept | ' | anything for granted. The author has tried out the program | ' | many times searching for bugs. The author personally feels | ' | that this program is bug free. However, as in every program | ' | there might be an unknown bug. If so, contact the author | ' | through EMail: smithdonb@earthlink.net | ' | | ' | +----------------+ | ' | | DISCLAIMER | | ' | +----------------+ | ' | As for the executable program, Figtail.Exe, the | ' | author, Don Smith, accepts no liability for damages resulting | ' | from its use or misuse. Please read carefully the CAUTION | ' | given above! The Figtail program is offered in an "as is" | ' | condition. | ' | | ' | +------------+ | ' | | AUTHOR | | ' | +------------+ | ' | Hi! My name is Don Smith and and I am a retired | ' | math/history/Spanish teacher residing in Orange County, | ' | California, United States of America. I may be reached through | ' | EarthLink if there are questions or input. | ' | | ' | +--------------------------------------------------------------+ | ' | | | | ' | | Author : Donald Bernard Smith | | ' | +--------------------------------------------------------------+ | ' | | EMail address : smithdonb@earthlink.net | | ' | | | | ' | +--------------------------------------------------------------+ | ' | | ' | +------------------------+ | ' | | - Happy Computing - | | ' | +------------------------+ | ' +--------------------------------------------------------------------+ DEFINT A-Z '----------------------------------------------------------------------- DECLARE SUB BoxBoy (Title$, ULRow%, ULCol%, LRRow%, LRCol%, TitleRow%, TitleCol%, TitColrFor%, TitColrBak%, BoxColrFor%, BoxColrBak%, BoxStyle%, Shadow%, ShadowColr%, ClearColr%) DECLARE SUB DisplayMessage (Message$(), ULRow%, ULCol%, LRRow%, LRCol%, MaxNum%, ColrFG%, ColrBG%) DECLARE SUB EditLoco (EdW$, Row%, Col%, FCol%, LenStr%, See%, TypeOfText$, Caps%, FGColr%, BGColr%, FKey$, InS%, PW%, ExitCode%) DECLARE SUB MesaMenu (M$(), Start%, Count%, RegColrFG%, RegColrBG%, HiLiteFG%, HiLiteBG%, MaxScrRows%, MaxScrCols%, ColumnPointer%, TweenSpace%, TableULRow%, TableULCol%, CurrentRow%, CurrentCol%, ItemNum%, ItemWidth%, FKey$, ExitCode%) DECLARE SUB SaveRestScrn (ReadLine$(), ReadColr%(), SR.UL.Row%, SR.UL.Col%, SR.LR.Row%, SR.LR.Col%, SaveOrRest%) '----------------------------------------------------------------------- Exten$ = "*.flf" Exten$ = RTRIM$(LTRIM$(Exten$)) Exten$ = UCASE$(Exten$) SHELL "dir" + " " + Exten$ + ">" + "FAKE.XXX" OPEN "FAKE.XXX" FOR INPUT AS #1 LookExten$ = MID$(Exten$, 3, LEN(Exten$) - 1) LookExten$ = RTRIM$(LTRIM$(LookExten$)) DO MaxNum% = MaxNum% + 1 LINE INPUT #1, ThrowAway$ LOOP UNTIL EOF(1) CLOSE #1 ON ERROR GOTO errorhandler OPEN "Figlet.Exe" FOR INPUT AS #1 CLOSE #1 IF MaxNum% = 0 THEN GOTO errorhandler END IF OPEN "FAKE.XXX" FOR INPUT AS #1 REDIM M$(MaxNum% + 10) begin.do.loop: DO BringNum% = BringNum% + 1 LINE INPUT #1, M$(BringNum%) IF M$(BringNum%) = "" THEN BringNum% = BringNum% - 1 GOTO begin.do.loop ELSEIF MID$(M$(BringNum%), 19, 1) = " " THEN 'check for 0 size files BringNum% = BringNum% - 1 END IF IF Exten$ <> "*" AND Exten$ <> "*." THEN FOR ReadInput% = 1 TO LEN(M$(BringNum%)) FindExten$ = MID$(M$(BringNum%), ReadInput%, LEN(LookExten$)) IF FindExten$ = LookExten$ THEN LineNum% = LineNum% + 1 FindLast% = ReadInput% + (LEN(Exten$) - 1) M$(BringNum%) = LEFT$(M$(BringNum%), FindLast%) FOR FindSpace% = 1 TO LEN(M$(BringNum%)) LilBit$ = MID$(M$(BringNum%), FindSpace%, 1) IF LilBit$ = " " THEN M$(BringNum%) = RTRIM$(LTRIM$(LEFT$(M$(BringNum%), FindSpace%))) + "." + LookExten$ M$(LineNum%) = M$(BringNum%) M$(LineNum%) = M$(LineNum%) + SPACE$(12 - LEN(M$(LineNum%))) IF RTRIM$(LTRIM$(M$(1))) = RTRIM$(LTRIM$(MID$(Exten$, 2, LEN(Exten$)))) THEN LineNum% = LineNum% - 1 END IF END IF NEXT EXIT FOR END IF NEXT END IF LOOP UNTIL EOF(1) CLOSE #1 KILL "FAKE.XXX" Start% = 1 IF BringNum% <= 3 THEN GOTO errorhandler END IF 'create "FigTail1.Txt" anew each time OPEN "FigTail1.Txt" FOR OUTPUT AS #2 PRINT #2, "Hello World" CLOSE #2 '===================================================================== ' SUB BoxBoy. Borderless box at bottom. '===================================================================== COLOR 15, 1: CLS Title$ = "" ULRow% = 16 ULCol% = 4 LRRow% = 24 LRCol% = 74 '+--------------------+ TitleRow% = 0 '| See SUB BoxBoy for | TitleCol% = 0 '| a detailed review | TitColrFor% = 0 '| of the SUB's | TitColrBak% = 0 '| parameters | BoxColrFor% = 0 '+--------------------+ BoxColrBak% = 15 BoxStyle% = 1 Shadow% = 0 ShadowColr% = 8 ClearColr% = 1 CALL BoxBoy(Title$, ULRow%, ULCol%, LRRow%, LRCol%, TitleRow%, TitleCol%, TitColrFor%, TitColrBak%, BoxColrFor%, BoxColrBak%, BoxStyle%, Shadow%, ShadowColr%, ClearColr%) '===================================================================== ' Informational Row '===================================================================== LOCATE 17, 6, 0 COLOR 0, 15 PRINT " View Info MOVE: <-> Home End PgDn PgUp Exit "; COLOR 9, 15 LOCATE 17, 8, 0: PRINT "Enter"; LOCATE 17, 21, 0: PRINT "F1"; 'COLOR 14, 0 'LOCATE 16, 35, 0 'PRINT CHR$(24); 'LOCATE 16, 36, 0 'PRINT CHR$(25); 'LOCATE 16, 37, 0 'PRINT "<->"; COLOR 9, 15 LOCATE 17, 38, 0: PRINT "<->"; LOCATE 17, 44, 0: PRINT "Home"; LOCATE 17, 49, 0: PRINT "End"; LOCATE 17, 53, 0: PRINT "PgDn"; LOCATE 17, 58, 0: PRINT "PgUp"; LOCATE 17, 64, 0: PRINT "Esc"; COLOR 12, 15 LOCATE 17, 69, 0: PRINT "Exit"; COLOR 0, 15: LOCATE 18, 5 PRINT CHR$(195) + STRING$(70, CHR$(196)) + CHR$(180); 'LOCATE 16, 30: PRINT CHR$(194); 'LOCATE 17, 30: PRINT CHR$(179); 'LOCATE 18, 30: PRINT CHR$(193); '===================================================================== ' SUB MesaMenu routine with 5 columns and 7 rows '===================================================================== Start% = 1 ' <- <- put Start% above "top" top: Count% = LineNum% RegColrFG% = 0 RegColrBG% = 15 HiLiteFG% = 15 HiLiteBG% = 13 ' +-------------------------+ MaxScrRows% = 5 ' | See SUB MesaMenu for a | MaxScrCols% = 5 ' | a detailed review of | ColumnPointer% = 1 ' | the SUB's parameters. | TweenSpace% = 1 ' +-------------------------+ TableULRow% = 19 TableULCol% = 7 CurrentRow% = 0 CurrentCol% = 0 ItemNum% = Start% ItemWidth% = 12 FKey$ = "157" GOSUB topsection begin.complete.menu: CALL MesaMenu(M$(), Start%, Count%, RegColrFG%, RegColrBG%, HiLiteFG%, HiLiteBG%, MaxScrRows%, MaxScrCols%, ColumnPointer%, TweenSpace%, TableULRow%, TableULCol%, CurrentRow%, CurrentCol%, ItemNum%, ItemWidth%, FKey$, ExitCode%) IF ExitCode% = 27 THEN ' KILL "FigTail1.Txt" KILL "FigTail2.Txt" COLOR 7, 0: CLS : LOCATE 1, 1, 1: END ELSEIF ExitCode% = 13 THEN ' GOSUB save.screen SHELL "ViewIt.Exe" + " " + M$(ItemNum%) GOSUB restore.screen Start% = ItemNum% GOTO top ELSEIF ExitCode% = 5 THEN ' GOSUB save.screen Row% = 3 Col% = 63 FCol% = 63 LenStr% = 12 See% = 1 TypeOfText$ = "" Caps% = 0 FGColr% = 15 BGColr% = 0 FKey$ = "" PW% = 0 InS% = 0 CALL EditLoco(EdW$, Row%, Col%, FCol%, LenStr%, See%, TypeOfText$, Caps%, FGColr%, BGColr%, FKey$, InS%, PW%, ExitCode%) IF EdW$ = "" THEN EdW$ = "Hello World" END IF IF ExitCode% = 27 THEN GOSUB restore.screen Start% = ItemNum% FKey$ = "157" GOTO top END IF OPEN "FigTail1.Txt" FOR OUTPUT AS #2 PRINT #2, EdW$ CLOSE #2 REDIM FigTail$(9) SHELL "figlet.exe" + " " + "-f" + M$(ItemNum%) + "<" + "FigTail1.Txt" + ">" + "FigTail2.Txt" OPEN "FigTail2.Txt" FOR INPUT AS #1 COLOR 15, 1 FOR ClearDaScrn% = 1 TO 9 LOCATE ClearDaScrn% + 5, 1 PRINT SPACE$(80) NEXT FOR FirstRead% = 1 TO 9 IF EOF(1) THEN CLOSE #1 EXIT FOR END IF LINE INPUT #1, FigTail$(FirstRead%) LOCATE FirstRead% + 4, 2 PRINT LEFT$(FigTail$(FirstRead%), 80); NEXT CLOSE #1 GOSUB restore.screen Start% = ItemNum% FKey$ = "157" GOTO top ELSEIF ExitCode% = 1 THEN ' GOSUB save.screen GOSUB program.info GOSUB restore.screen Start% = ItemNum% GOTO top ELSE GOTO top END IF topsection: '===================================================================== ' SUB BoxBoy box at top - program title '===================================================================== Title$ = "" ULRow% = 2 ULCol% = 4 LRRow% = 4 LRCol% = 20 TitleRow% = 4 TitleCol% = 19 TitColrFor% = 1 TitColrBak% = 7 BoxColrFor% = 15 BoxColrBak% = 13 BoxStyle% = 1 Shadow% = 0 ShadowColr% = 8 ClearColr% = 1000 CALL BoxBoy(Title$, ULRow%, ULCol%, LRRow%, LRCol%, TitleRow%, TitleCol%, TitColrFor%, TitColrBak%, BoxColrFor%, BoxColrBak%, BoxStyle%, Shadow%, ShadowColr%, ClearColr%) Title$ = "" ULRow% = 2 ULCol% = 25 LRRow% = 4 LRCol% = 55 TitleRow% = 0 TitleCol% = 0 TitColrFor% = 0 TitColrBak% = 0 BoxColrFor% = 9 BoxColrBak% = 15 BoxStyle% = 1 Shadow% = 0 ShadowColr% = 8 ClearColr% = 1000 CALL BoxBoy(Title$, ULRow%, ULCol%, LRRow%, LRCol%, TitleRow%, TitleCol%, TitColrFor%, TitColrBak%, BoxColrFor%, BoxColrBak%, BoxStyle%, Shadow%, ShadowColr%, ClearColr%) Title$ = "" ULRow% = 2 ULCol% = 60 LRRow% = 4 LRCol% = 74 TitleRow% = 0 TitleCol% = 0 TitColrFor% = 0 TitColrBak% = 0 BoxColrFor% = 9 BoxColrBak% = 15 BoxStyle% = 1 Shadow% = 0 ShadowColr% = 8 ClearColr% = 1000 CALL BoxBoy(Title$, ULRow%, ULCol%, LRRow%, LRCol%, TitleRow%, TitleCol%, TitColrFor%, TitColrBak%, BoxColrFor%, BoxColrBak%, BoxStyle%, Shadow%, ShadowColr%, ClearColr%) COLOR 15, 13 LOCATE 3, 6: PRINT "FIGTail Program"; COLOR 9, 15 LOCATE 3, 27: PRINT "Press F5 To Change Phrase"; LOCATE 3, 53: PRINT "ÍÍ"; LOCATE 3, 62 COLOR 15, 0 IF EdW$ = "" THEN PRINT " Hello World "; ELSE PRINT " " + EdW$ + " "; END IF RETURN 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 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 errorhandler: CLOSE KILL "FAKE.XXX" COLOR 15, 0: CLS CALL BoxBoy("<<>>", 2, 13, 17, 65, 3, 36, 12, 0, 15, 0, 1, 0, 7, 0) LOCATE 5, 32: COLOR 11, 0: PRINT "FIGTail Program Í" COLOR 15, 0 LOCATE 6, 17, 0: PRINT "There was an error. Either the companion file," LOCATE 7, 17, 0: PRINT CHR$(34) + "FIGLet.Exe" + CHR$(34) + " wasn't on this directory, or there" LOCATE 7, 18, 0: COLOR 14, 0: PRINT "FIGLet.Exe": COLOR 15, 0 LOCATE 8, 17, 0: PRINT "were no .FLF font files on this directoy." LOCATE 8, 25, 0: COLOR 10, 0: PRINT ".FLF": COLOR 15, 0 LOCATE 10, 17, 0: PRINT "The FIGLet.Exe program must be placed in the same" LOCATE 10, 21, 0: COLOR 14, 0: PRINT "FIgLet.Exe": COLOR 15, 0 LOCATE 11, 17, 0: PRINT "directory as this program. Likewise all the" LOCATE 12, 17, 0: PRINT ".FLF files must in the same director as both" LOCATE 12, 17, 0: COLOR 10, 0: PRINT ".FLF": COLOR 15, 0 LOCATE 13, 17, 0: PRINT "the FIGTail and FIGLet programs." COLOR 14, 0 LOCATE 13, 21, 0: PRINT "FIGTail" LOCATE 13, 33, 0: PRINT "FIGLet" COLOR 11, 0 LOCATE 15, 26, 0: PRINT "Press To Exit, or"; LOCATE 16, 26, 0: PRINT "Press To View Info File"; COLOR 15, 0 LOCATE 15, 33, 0: PRINT "Esc"; LOCATE 16, 33, 0: PRINT "Enter"; DO: KK$ = INKEY$ IF KK$ = CHR$(27) THEN COLOR 7, 0: CLS : LOCATE , , 1: END ELSEIF KK$ = CHR$(13) THEN Title$ = "Move : <" + CHR$(24) + "> <" + CHR$(25) + ">" + " Press To Exit." CALL BoxBoy(Title$, 2, 10, 22, 64, 3, 20, 10, 0, 7, 0, 1, 0, 0, 0) COLOR 15, 0 LOCATE 3, 29: PRINT CHR$(24): LOCATE 3, 33: PRINT CHR$(25); LOCATE 3, 45: PRINT "Esc" ULRow% = 5: ULCol% = 15: LRRow% = 23: LRCol% = 66 MaxNum% = 88: ColrFG% = 15: ColrBG% = 0 GOSUB da.message COLOR 7, 0: CLS : LOCATE , , 1: END END IF LOOP program.info: '===================================================================== ' Press and the a message box pops up. The routine ' uses two SUBs: 1..........SUB BoxBoy ' 2..........SUB DisplayMessage '===================================================================== Title$ = "" ULRow% = 6 ULCol% = 10 LRRow% = 22 LRCol% = 64 TitleRow% = 7 TitleCol% = 27 TitColrFor% = 11 TitColrBak% = 1 BoxColrFor% = 15 BoxColrBak% = 13 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%) Line$ = CHR$(198) + STRING$(54, CHR$(205)) + CHR$(181) COLOR 15, 5 LOCATE 20, 11, 0, 0, 0: PRINT Line$; LOCATE 20, 38: PRINT CHR$(209); LOCATE 21, 38: PRINT CHR$(179); LOCATE 22, 38: PRINT CHR$(193); COLOR 15, 13 COLOR 11, 13 LOCATE 21, 43, 0, 0, 0: PRINT "Press To Exit"; : COLOR 15, 13 LOCATE 21, 50, 0, 0, 0: PRINT "Esc"; COLOR 14, 13 LOCATE 21, 16, 0, 0, 0: PRINT "Use <" + CHR$(24) + "> <" + CHR$(25) + "> Arrows"; COLOR 15, 13 LOCATE 21, 21, 0, 0, 0: PRINT CHR$(24); LOCATE 21, 25, 0, 0, 0: PRINT CHR$(25); '===================================================================== ' SUB DisplayMessage routine when F1 pressed '===================================================================== ULRow% = 7 ULCol% = 15 LRRow% = 21 'LRRow% - ULRow% - 1 LRCol% = 66 MaxNum% = 91 ColrFG% = 15 ColrBG% = 13 da.message: REDIM Message$(MaxNum%) Message$(1) = " ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»" Message$(2) = " º - FIGTail Program - º" Message$(3) = " ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ" Message$(4) = " ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿" Message$(5) = " ³ Today's Date: June 29, 2007 ³" Message$(6) = " ³ Public Domain - FreeWare ³" Message$(7) = " ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ" Message$(8) = "______ _____ _____ _____ _ _ ______ " Message$(9) = "| ___|_ _| __ \_ _| (_) | | ___ \ " Message$(10) = "| |_ | | | | \/ | | __ _ _| | | |_/ / __ _ ___ " Message$(11) = "| _| | | | | __ | |/ _` | | | | ___ \/ _` / __|" Message$(12) = "| | _| |_| |_\ \ | | (_| | | |_| |_/ / (_| \__ \" Message$(13) = "\_| \___/ \____/ \_/\__,_|_|_(_)____/ \__,_|___/" Message$(14) = SPACE$(45) Message$(15) = "Reason For Program:" Message$(16) = "ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ" Message$(17) = "The FIGTail program is an executable program to be" Message$(18) = "used in conjunciton with the FIGLet font program." Message$(19) = "The object of the program is to allow the user to" Message$(20) = "see a sample phrase, like " + CHR$(34) + "Hello World" + CHR$(34) + ", in all" Message$(21) = "the .FLF font files listed." Message$(22) = SPACE$(45) Message$(23) = "How It Works:" Message$(24) = "ÄÄÄÄÄÄÄÄÄÄÄÄ" Message$(25) = "Essentially, the FIGTail program loads all font" Message$(26) = "files ending with .FLF into a menu. A sample" Message$(27) = "phrases, " + CHR$(34) + "Hello World" + CHR$(34) + ", is displayed on screen" Message$(28) = "with the font of the first .FLF file. When an" Message$(29) = "arrow key is pressed, the block cursor will move" Message$(30) = "to another font file and the program displays" Message$(31) = "the sample phrase with the new font. The user" Message$(32) = "will be able to find out quickly which fonts" Message$(33) = "are interesting to him/her." Message$(34) = SPACE$(45) Message$(35) = "The FIGTail program words by utilizing the" Message$(36) = "command line parameters:" Message$(37) = SPACE$(45) Message$(38) = "figlet.exe -f fontfile FigTail2.Txt" Message$(39) = SPACE$(45) Message$(40) = "The file FigTail1.Txt only has one line and it" Message$(41) = "is " + CHR$(34) + "Hello World" + CHR$(34) + ". The executable, " + CHR$(34) + "FIGLet.Exe" + CHR$(34) + "," Message$(42) = "creates a new file, " + CHR$(34) + "FIGTail2.Txt" + CHR$(34) + " containing the" Message$(43) = "phrase " + CHR$(34) + "Hello World" + CHR$(34) + " with large fonts configured" Message$(44) = "with the new .FLF font. The file " + CHR$(34) + "FIGTail2.Txt" + CHR$(34) Message$(45) = "is then placed on screen for viewing." Message$(46) = SPACE$(45) Message$(47) = "Key Presses:" Message$(48) = "ÄÄÄÄÄÄÄÄÄÄÄ" Message$(49) = " F1.....:.View this file." Message$(50) = " :" Message$(51) = " F5.....:.Change the phrase " + CHR$(34) + "Hello World" + CHR$(34) Message$(52) = " : to a new phrase designed by the user" Message$(53) = " :" Message$(54) = " Enter..:.View the file at cursor." Message$(55) = SPACE$(45) Message$(56) = " MOVE...:.<-> Home End PgDn PgUp" Message$(57) = " :" Message$(58) = " Esc....:.Exit" Message$(59) = SPACE$(45) Message$(60) = "When the key is pressed the font file at" Message$(61) = "cursor will be viewed via the ViewIt program," Message$(62) = "written by yours truly. It is a public domain," Message$(63) = "freeware program compiled with FreeBASIC v0.17." Message$(64) = "Both ViewIt.Exe and the source code, ViewIt.Bas" Message$(65) = "have been placed in" + CHR$(34) + "PIGTail.Zip" + CHR$(34) + ". Another" Message$(66) = "possible viewer, MPAD35LE.ZIP has also been" Message$(67) = "included in the ZIP file." Message$(68) = SPACE$(45) Message$(69) = "Disclaimer:" Message$(70) = "ÄÄÄÄÄÄÄÄÄÄ" Message$(71) = "The author of the PIGTail program accepts no" Message$(72) = "responsibility nor liability for damages resulting" Message$(73) = "from its use or misuse." Message$(74) = SPACE$(45) Message$(75) = "Author:" Message$(76) = "ÄÄÄÄÄÄ" Message$(77) = "Hi! My name is Don Smith and I a retired 30-year" Message$(78) = "teacher of Math/History/Spanish residing in Orange" Message$(79) = "County, California. I am also a six-year former" Message$(80) = "Sergeant of Marines. On certain forums, I am" Message$(81) = "known as MarineDon. I may be reached through" Message$(82) = "Earthlink if there are questions or input." Message$(83) = "Email: smithdonb@earthlink.net" Message$(84) = SPACE$(45) Message$(85) = " _____ _____ _ _ _" Message$(86) = "| _ \ / ___| (_) | | |" Message$(87) = "| | | |___ _ __ \ `--. _ __ ___ _| |_| |__" Message$(88) = "| | | / _ \| '_ \ `--. \ '_ ` _ \| | __| '_ \" Message$(89) = "| |/ / (_) | | | | /\__/ / | | | | | | |_| | | |" Message$(90) = "|___/ \___/|_| |_| \____/|_| |_| |_|_|\__|_| |_|" Message$(91) = SPACE$(45) 'Message$(92) = " _ _ " 'Message$(93) = " / | _ _ /_`_ _ ._/_/_ " 'Message$(94) = "/_.'/_// / ._// / // / / / " 'Message$(95) = SPACE$(80) 'Message$(96) = SPACE$(80) CALL DisplayMessage(Message$(), ULRow%, ULCol%, LRRow%, LRCol%, MaxNum%, ColrFG%, ColrBG%) RETURN 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 | '| | Style% equals 0 - No border 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 number 8. Using 8 allows the under- | '| | lying text to shine through. | '+-------------+-------------------------------------------------------+ '| 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% = 0 THEN 'Single Line 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 GOTO makebox ELSEIF 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, 0, 0, 0 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, 0, 0, 0 PRINT ReadLine$(Scratch%); NEXT END IF makebox: Title.Length% = LEN(Title$) COLOR BoxColrFor%, BoxColrBak% 'ÚÄÄÄ¿ or ÉÍÍÍ» LOCATE ULRow%, ULCol%, 0, 0, 0 PRINT " " + ULCorner$ + STRING$(LRCol% - ULCol%, HorLine$) + URCorner$ + " "; '³ ³ or º º LOCATE ULRow% + 1, ULCol%, 0, 0, 0 PRINT " " + VertLine$ + SPACE$(LRCol% - ULCol%) + VertLine$ + " "; IF Title$ <> "" THEN 'ÃÄÄÄ´ or ÇÄÄĶ 'made cross bar if there is a title LOCATE ULRow% + 2, ULCol%, 0, 0, 0 PRINT " " + LeftSide$ + STRING$(LRCol% - ULCol%, 196) + RightSide$ + " "; ELSEIF Title$ = "" THEN LOCATE ULRow% + 2, ULCol%, 0, 0, 0 PRINT " " + VertLine$ + SPACE$(LRCol% - ULCol%) + VertLine$ + " "; END IF '³ ³ or º º FOR Print.Box% = 1 TO (LRRow% - ULRow%) - 3 LOCATE ULRow% + Print.Box% + 2, ULCol%, 0, 0, 0 PRINT " " + VertLine$ + SPACE$(LRCol% - ULCol%) + VertLine$ + " "; NEXT 'ÀÄÄÄÙ or ÈÍÍͼ LOCATE LRRow%, ULCol%, 0, 0, 0 PRINT " " + LLCorner$ + STRING$(LRCol% - ULCol%, HorLine$) + LRCorner$ + " "; IF Title$ <> "" THEN LOCATE TitleRow%, TitleCol%, 0, 0, 0 COLOR TitColrFor%, TitColrBak% PRINT Title$; END IF END SUB SUB DisplayMessage (Message$(), ULRow%, ULCol%, LRRow%, LRCol%, MaxNum%, ColrFG%, ColrBG%) '+---------------------------------------------------------------------+ '| DisplayMessage | '+---------------------------------------------------------------------+ '| The SUB DisplayMessage is a Public Domain, FreeWare program by | '| Don Smith. Date: 08/01/2002. EMail: smithdonb@earthlink.net | '+---------------------------------------------------------------------+ '| DisplayMessage will place a scrollable message on screen at the | '| row and column of choice. The message lines should be placed | '| in the main program together with a rediminsioning placed previous | '| to the message lines. Example-> REDIM Message$(MaxNum% +1). | '| With a bit of tweeking, this SUB should be able to be used as an | '| ASCII text viewer. | '+-------------+-------------------------------------------------------+ '| Message$ | Message lines to be placed in the main program. | '| | The number of message lines also must be | '| | rediminsioned in the main program. | '| | Example: REDIM Message$(58) | '+-------------+-------------------------------------------------------+ '| ULRow% | The upper left row to place message. | '+-------------+-------------------------------------------------------+ '| ULCol% | The upper left columnn to place message. | '+-------------+-------------------------------------------------------+ '| LRRow% | The lower right row of message. | '+-------------+-------------------------------------------------------+ '| LRCol% | The lower right column of message. | '+-------------+-------------------------------------------------------+ '| MaxNum% | The maximum number of message lines + 1. | '+-------------+-------------------------------------------------------+ '| ColrFG% | The foreground color of message. | '+-------------+-------------------------------------------------------+ '| ColrBG% | The back ground color of message. | '+-------------+-------------------------------------------------------+ COLOR ColrFG%, ColrBG% FOR place% = 1 TO LRRow% - ULRow% - 1 LOCATE place% + ULRow% - 1, ULCol%, 0, 0, 0 PRINT Message$(place%); NEXT DO DO Press$ = INKEY$ LOOP UNTIL LEN(Press$) > 0 Press% = CVI(Press$ + CHR$(0)) IF Press% = 27 THEN Where% = 0 EXIT SUB ELSEIF Press% = 20480 THEN 'DnArrow Where% = Where% + 1 IF Where% = MaxNum% - (LRRow% - ULRow% - 1) THEN '8 THEN SOUND 200, 2 END IF ELSEIF Press% = 18432 THEN 'UpArrow Where% = Where% - 1 IF Where% = -1 THEN SOUND 200, 2 END IF ELSEIF Press% = 20736 THEN 'PgDn Where% = Where% + (LRRow% - ULRow%) ELSEIF Press% = 18688 THEN 'PgUp Where% = Where% - (LRRow% - ULRow%) ELSEIF Press% = 20224 THEN 'End Where% = MaxNum% - 5 COLOR 15, 1 ELSEIF Press% = 18176 THEN 'Home Where% = 0 END IF GOSUB place.down LOOP place.down: COLOR ColrFG%, ColrBG% FOR PlaceDn% = 1 TO LRRow% - ULRow% - 1 IF PlaceDn% + Where% - 1 = MaxNum% + 1 THEN RETURN ELSE IF Where% > MaxNum% - (LRRow% - ULRow%) THEN Where% = MaxNum% - (LRRow% - ULRow%) ELSEIF Where% <= 0 THEN Where% = 0 END IF LOCATE PlaceDn% + ULRow% - 1, ULCol%, 0, 0, 0 Work$ = LEFT$(Message$(PlaceDn% + Where%), LRCol% - ULCol%) Work$ = Work$ + SPACE$((LRCol% - ULCol%) - LEN(Work$)) PRINT Work$; END IF NEXT RETURN END SUB SUB EditLoco (EdW$, Row%, Col%, FCol%, LenStr%, See%, TypeOfText$, Caps%, FGColr%, BGColr%, FKey$, InS%, PW%, ExitCode%) STATIC ' +--------------------------------------------------------------------+ ' | SUB EditLoco: | ' +--------------------------------------------------------------------+ ' | This is a version of SUB EditString is called SUB EditLoco. The | ' | SUB EditString is compiled with the Pro.Lib from Cresent SoftWare.| ' | This version, called SUB EditLoco is compiled with regular ol' | ' | QuickBASIC v4.5 and needs no special library. | ' +--------------------------------------------------------------------+ ' | EdW$ | The string to be edited. | ' +--------------+-----------------------------------------------------+ ' | Row% | The row to begin the editing. | ' +--------------+-----------------------------------------------------+ ' | Col% | The column to begin the editing. | ' +--------------+-----------------------------------------------------+ ' | FCol% | Use same number as Col% | ' +--------------+-----------------------------------------------------+ ' | LenStr% | Length of the string to edit. | ' +--------------+-----------------------------------------------------+ ' | See% | If See% = 0 then existing text will be displayed. | ' | | If See% = 1 existing text will be wiped. | ' +--------------+-----------------------------------------------------+ ' | TypeOfText$ | For all ASCII characers 32 to 255, TypeOfText = "" | ' | | For numbers only, TypeOfText$ = "1234567890" | ' | | For numbers with commas and decimals points, | ' | | TypeOfText$ = ".,1234567890" | ' | | For Yes or No answers, TypeOfText$ = "YNyn" | ' | | Whatever is included within the parethesis | ' | | is what will be accepted. | ' +--------------+-----------------------------------------------------+ ' | Caps% | Capital letters enabled, Caps% = 1 | ' +--------------+-----------------------------------------------------+ ' | FGColr% | The text foreground color. | ' +--------------+-----------------------------------------------------+ ' | BGColr% | The text back ground color. | ' +--------------+-----------------------------------------------------+ ' | FKey$ | Which keys to enable. To enabled | ' | | and , FKey$ = "150" ("0" is F10). | ' +--------------+-----------------------------------------------------+ ' | PW% | PW% = 1 - password mode enabled. | ' | | PW% = 0 - password mode NOT enabled. | ' +--------------+-----------------------------------------------------+ ' | Ins% | Ins% = 0 then INSERT OFF. Ins% = 1 then INSERT ON | ' +--------------+-----------------------------------------------------+ ' | The ExitCode% is derived from the unique CVI Basic command. | ' | The ExitCode% for the keys gets changed to 101 to 110. | ' | To enable programmers to use the CVI code in their own programs, | ' | I have attached a short program, KeyCode.Bas (just below this | ' | section) | ' +------------------------------------+-------------------------------+ ' | ExitCode% = 101 is F1 key | I arbitrarily changed | ' | ExitCode% = 102 is F2 key | through to 101-110. | ' | ExitCode% = 103 is F3 key | Their CVI Codes are: | ' | ExitCode% = 104 is F4 key +-------------------------------+ ' | ExitCode% = 105 is F5 key | CVI: ExitCode: | ' | ExitCode% = 106 is F6 key | ---- --- -------- | ' | ExitCode% = 107 is F7 key | 15104 101 | ' | ExitCode% = 108 is F8 key | 15360 102 | ' | ExitCode% = 109 is F9 key | 15616 103 | ' | ExitCode% = 110 is F10 key | 15872 104 | ' | ExitCode% = 13 is ENTER key | 16128 105 | ' | ExitCode% = 18432 is Up Arrow | 16384 106 | ' | ExitCode% = 20480 is Down Arrow| 16640 107 | ' | ExitCode% = 9 is TAB key | 16896 108 | ' | ExitCode% = 27 is EXIT key | 17152 109 | ' | | 17408 110 | ' +------------------------------------+-------------------------------+ ' | Please include at the top of the routine DEFINT A-Z | ' +--------------------------------------------------------------------+ ' +--------------------------------------------------------------------+ ' | 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. | | ' | ' +-------------------------------------------------------------+ | ' +--------------------------------------------------------------------+ ' | | ' | 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 | ' | | ' +--------------------------------------------------------------------+ EdW$ = "": Ky$ = "" IF See% = 1 THEN LOCATE Row%, Col% COLOR FGColr%, BGColr% PRINT STRING$(LenStr%, " "); END IF begin.edit.line: DO IF InS% = 1 THEN 'Insert On COLOR FGColr%, BGColr%: LOCATE Row%, Col%, 1, 4, 7 ELSEIF InS% = 0 THEN 'Insert Off COLOR FGColr%, BGColr%: LOCATE Row%, Col%, 1, 6, 7 END IF DO Ky$ = INKEY$ IF PW% = 1 THEN IF BlankIt% = 1 THEN BlankIt% = 0 END IF END IF LOOP UNTIL LEN(Ky$) > 0 SlamKey% = CVI(Ky$ + CHR$(0)) ' IF SlamKey% > 31 AND SlamKey% < 256 THEN 'CHR$(31) to CHR$255) IF TypeOfText$ = "" THEN 'CHR$(32) is IF PW% = 0 THEN GOSUB show.char ELSEIF PW% = 1 THEN GOSUB edit.password END IF ELSEIF TypeOfText$ <> "" THEN IF INSTR(TypeOfText$, Ky$) > 0 THEN IF PW% = 0 THEN GOSUB show.char ELSEIF PW% = 1 THEN GOSUB edit.password END IF END IF END IF ELSEIF SlamKey% = 27 THEN ' Key ExitCode% = 27 GOSUB get.string EXIT SUB ELSEIF SlamKey% = 19712 THEN ' Arrow Col% = Col% + 1 IF Col% > FCol% + LenStr% - 1 THEN Col% = FCol% ELSE LOCATE Row%, Col%, 1, 6, 7 END IF ELSEIF SlamKey% = 19200 THEN ' Col% = Col% - 1 IF Col% = FCol% - 1 OR Col% < FCol% THEN Col% = FCol% + LenStr% - 1 END IF ELSEIF SlamKey% = 13 THEN ' IF PW% = 0 THEN GOSUB get.string END IF ExitCode% = 13 EXIT SUB ' or or - If not used, REM these 3 out. ELSEIF SlamKey% = 9 OR SlamKey% = 18432 OR SlamKey% = 20480 THEN GOSUB get.string ExitCode% = SlamKey% EXIT SUB ELSEIF SlamKey% = 8 THEN ' Col% = Col% - 1 IF Col% = FCol% OR Col% < FCol% THEN Col% = FCol% END IF LOCATE Row%, Col% COLOR FGColr%, BGColr%: PRINT " "; IF PW% = 1 THEN EdW$ = LEFT$(EdW$, LEN(EdW$) - 1) END IF ELSEIF SlamKey% = 20992 THEN ' 'If 1 (on), turn off (0). If 0 (off), turn on (1). IF InS% = 1 THEN InS% = 0 'unREM if need to print "Insert Off/On" 'LOCATE 2, 66: Print "Insert Off "; ELSEIF InS% = 0 THEN 'REM out "Insert Off/On" if not used. InS% = 1 'LOCATE 2, 66: Print "Insert On "; END IF ELSEIF SlamKey% = 21248 THEN ' FOR DelK% = Col% + 1 TO FCol% + LenStr% SaveScr$ = SaveScr$ + CHR$(SCREEN(Row%, DelK%)) NEXT SaveScr$ = MID$(SaveScr$, 1, LEN(SaveScr$) - 1) LOCATE Row%, Col% COLOR FGColr%, BGColr% PRINT EdW$ + SaveScr$; SaveScr$ = "" ELSEIF SlamKey% = 18176 THEN ' Col% = FCol% ELSEIF SlamKey% = 20224 THEN ' GOSUB get.string Col% = FCol% + LEN(EdW$) LOCATE Row%, Col%, 1, 6, 7 ELSEIF SlamKey% = 25 THEN ' = clears line of LOCATE Row%, FCol% 'all text. WipeOut$ = SPACE$(LenStr%) COLOR FGColr%, BGColr% PRINT WipeOut$; ELSEIF SlamKey% > 15103 OR SlamKey% < 17409 THEN ' to IdentKey$ = STR$(((SlamKey% - 15104) \ 256) + 1) IdentKey$ = LTRIM$(RTRIM$(IdentKey$)) IF IdentKey$ = "10" THEN IdentKey$ = "0" END IF IF INSTR(FKey$, IdentKey$) > 0 THEN IF IdentKey$ = "0" THEN ExitCode% = 110 GOSUB get.string EXIT SUB ELSE ExitCode% = VAL(IdentKey$) + 100 GOSUB get.string EXIT SUB END IF END IF END IF LOOP show.char: IF InS% = 1 THEN ' FOR Horizontal% = Col% TO FCol% + LenStr% - 1 EditL$ = EditL$ + CHR$(SCREEN(Row%, Horizontal%)) NEXT IF Caps% > 0 THEN EditL$ = UCASE$(EditL$) Ky$ = UCASE$(Ky$) END IF COLOR FGColr%, BGColr% LOCATE Row%, Col%, 1 PRINT LEFT$(Ky$ + EditL$, FCol% + LenStr% - Col%); IF Col% = FCol% + LenStr% THEN Col% = FCol% - 1 END IF Col% = Col% + 1 EditL$ = "" ELSEIF InS% = 0 THEN ' LOCATE Row%, Col% IF Caps% > 0 THEN COLOR FGColr%, BGColr%: PRINT UCASE$(Ky$); ELSEIF Caps% = 0 THEN COLOR FGColr%, BGColr%: PRINT Ky$; END IF Col% = Col% + 1 IF Col% = FCol% + LenStr% THEN Col% = FCol% RETURN END IF END IF RETURN get.string: EditLine$ = SPACE$(LenStr%) FOR Horizontal% = FCol% TO FCol% + LenStr% EditLine$ = EditLine$ + CHR$(SCREEN(Row%, Horizontal%)) NEXT EditLine$ = LTRIM$(RTRIM$(EditLine$)) EdW$ = EditLine$ RETURN edit.password: EdW$ = UCASE$(EdW$) + UCASE$(Ky$) COLOR FGColr%, BGColr% LOCATE Row%, Col% PRINT "ù"; 'CHR$(249) LOCATE Row%, Col% + 1, 1, 6, 7 IF Col% = FCol% + LenStr% THEN Col% = FCol% - 1 END IF Col% = Col% + 1 RETURN END SUB SUB MesaMenu (M$(), Start%, Count%, RegColrFG%, RegColrBG%, HiLiteFG%, HiLiteBG%, MaxScrRows%, MaxScrCols%, ColumnPointer%, TweenSpace%, TableULRow%, TableULCol%, CurrentRow%, CurrentCol%, ItemNum%, ItemWidth%, FKey$, ExitCode%) ' +--------------------------------------------------------------------+ ' | MesaMenu was created by Don Smith on 08/01/2002. MesaMenu is | ' | declared Public Domain FreeWare. | ' | - - - - - - - - - - - - - - - - - - - - - - - - | ' | The MesaMenu SUB seems long, but with all the REM lines removed, | ' | it is just 254 lines in length. | ' | - - - - - - - - - - - - - - - - - - - - - - - - | ' | The MesaMenu name is abbreviated as MM to make it easier to | ' | enter at the command prompt. | ' | - - - - - - - - - - - - - - - - - - - - - - - - | ' | The object of MesaMenu is to display on screen a table menu | ' | of selected items. These may be files on the current directory, | ' | or other menu choices. Enter as a parameter a group of files | ' | which have a common extension. Example: "MM *.txt"(without quotes)| ' | For this example, MM.EXE will bring up in a viewing window all | ' | files on the current directory having the extension of .TXT. Find | ' | the word "Exten$" 14 lines from the top of the main program | ' | To view ALL the files on the current directory, use "MM *.*" | ' | To change to your QuickBASIC files, use "MM *.bas" To view files | ' | with NO extension, use "MM *." . If the DOS command, "DIR *." | ' | is used at the prompt, it will display all directories and files | ' | having no extensions. | ' | - - - - - - - - - - - - - - - - - - - - - - - - | ' | The program user may move the block cursor by pressing: | ' | . In | ' | addition, the user may press a letter, a number, an exclamation | ' | , or an underline <_>. The hi-lite cursor | ' | will jump to the first item beginning with the letter pressed, | ' | and, if there are any more items beginning with that letter, it | ' | will move down at each press of that letter. This SUB is not | ' | set up to use a mouse. | ' | - - - - - - - - - - - - - - - - - - - - - - - - | ' | If you press or the SUB will exit and a screen | ' | will be displayed. To find out how to use all the keys, | ' | refer to FKey$ below. | ' +----------------+---------------------------------------------------+ ' | M$() | Menu Item. In main program rediminsion: | ' | | REDIM M$(MaxNum% + 10) | ' +----------------+---------------------------------------------------+ ' | Start% | Which item to hi-light first. | ' +----------------+---------------------------------------------------+ ' | Count% | Count of total menu items. | ' +----------------+---------------------------------------------------+ ' | RegColrFG% | Regular fore ground color. | ' +----------------+---------------------------------------------------+ ' | RegColrBG% | Regular background color. | ' +----------------+---------------------------------------------------+ ' | HiLiteFG% | Hi-light foreground color. | ' +----------------+---------------------------------------------------+ ' | HiLiteBG% | Hi-light background color. | ' +----------------+---------------------------------------------------+ ' | MaxScrRows% | Number of rows to display on screen. | ' +----------------+---------------------------------------------------+ ' | MaxScrCols% | Number of columns to display on screen. | ' +----------------+---------------------------------------------------+ ' | ColumnPointer% | Points to current column in use. | ' +----------------+---------------------------------------------------+ ' | TweenSpace% | Number of spaces between columns. | ' +----------------+---------------------------------------------------+ ' | TableULRow% | Upper left row to place menu. | ' +----------------+---------------------------------------------------+ ' | TableULCol% | Upper left column to place menu. | ' +----------------+---------------------------------------------------+ ' | CurrentRow% | Current row of hi-light item. | ' +----------------+---------------------------------------------------+ ' | CurrentCol% | Current column of hi-light item. | ' +----------------+---------------------------------------------------+ ' | ItemNum% | Menu item number of the hi-lighted item. | ' | | In main program Start% and ItemNum% should be | ' | | the same. | ' +----------------+---------------------------------------------------+ ' | ItemWidth% | Width of menu items. | ' +----------------+---------------------------------------------------+ ' | FKey$ | To exit when an key is pressed, designate | ' | | the keys by placing them between paranthesis. | ' | | Example: FKey$ = "150". This means the SUB will | ' | | exit on pressing , or . The "0" | ' | | means "10". In the main program, indicate the | ' | | keys with ExitCode%. to is | ' | | ExitCode% = 1 to ExitCode% = 10. | ' | | | ' | | Example: | ' | | ------- | ' | | IF ExitCode% = 1 THEN ' | ' | | GOSUB save.screen | ' | | COLOR 15, 1: CLS | ' | | LOCATE 2, 33 | ' | | PRINT "Help Screen" | ' | | DO: LOOP WHILE INKEY$ = "" | ' | | GOSUB restore.screen | ' | | Start% = ItemNum% | ' | | GOTO begin.complete.menu | ' | | END IF | ' +----------------+---------------------------------------------------+ ' | ExitCode% | The exit number as explained below. | ' +--------------------------------------------------------------------+ ' | In the code below this REM (') section, find the area beginning | ' | "loopdeloop" and notice the keys trap below it. In QuickBASIC | ' | it is very easy to trap for any key on the keyboard by using the | ' | CVI command. It is accomplished through the use of a double | ' | DO/LOOP and then a series of IF/THENs (See Example). | ' | | ' | Example: | ' | ------- | ' | COLOR 15, 1: CLS | ' | PRINT "Press or X. To exit, press " | ' | PRINT | ' | DO | ' | DO | ' | Hit$ = INKEY$ | ' | LOOP UNTIL LEN(Hit$) > 0 | ' | Hit% = CVI(Hit$ + CHR$(0)) | ' | IF Hit% = 27 THEN ' | ' | CLS : END | ' | ELSEIF Hit% = 15104 THEN ' | ' | PRINT "F1 - Yeah!" | ' | ELSEIF Hit% = 24 THEN ' or | ' | PRINT "Ctrl-X. Yeah!" | ' | END IF | ' | LOOP | ' | | ' +--------------------------------------------------------------------+ ' | Use the KEYCODE.BAS program below to find the CVI numbers for | ' | the keys you need to trap. | ' +--------------------------------------------------------------------+ ' | ' KeyCode.Bas - By Don Smith. FreeWare and Public Domain Program. | ' | ' | ' | ' +-------------------------------------------------------------+ | ' | ' | 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. | | ' | ' +-------------------------------------------------------------+ | ' | | ' | COLOR 15, 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 | ' | | ' +--------------------------------------------------------------------+ OneTime% = OneTime% + 1 REDIM Read1st$(9) IF OneTime% = 1 THEN FigTail$ = "figlet.exe" + " " + "-f" + " " + M$(1) + "<" + "FigTail1.Txt" + ">" + "FigTail2.Txt" SHELL FigTail$ OPEN "FigTail2.Txt" FOR INPUT AS #1 COLOR 15, 1 FOR FirstRead% = 1 TO 9 IF EOF(1) THEN CLOSE #1 EXIT FOR END IF LINE INPUT #1, Read1st$(FirstRead%) LOCATE FirstRead% + 5, 2 PRINT Read1st$(FirstRead%); NEXT CLOSE #1 END IF FOR EqWidth% = 1 TO Count% M$(EqWidth%) = M$(EqWidth%) + SPACE$(ItemWidth% - LEN(M$(EqWidth%))) NEXT subtop: DivideIt% = Count% \ MaxScrRows% Remainder% = Count% MOD MaxScrRows% IF Remainder% > 0 THEN Remainder% = 1 END IF NumColsPossible% = DivideIt% + Remainder% LeftOver% = Count% MOD MaxScrRows% 'Count of items of last row IF Start% = 1 THEN CurrentRow% = TableULRow% CurrentCol% = TableULCol% ColumnPointer% = 1 ELSE LocateRow% = Start% MOD MaxScrRows% IF LocateRow% = 0 THEN LocateRow% = MaxScrRows% ColumnPointer% = (Start% \ MaxScrRows%) ELSE ColumnPointer% = (Start% \ MaxScrRows%) + 1 END IF CurrentRow% = TableULRow% + LocateRow% - 1 LocateCol% = (Start% \ MaxScrRows%) IF Start% MOD MaxScrRows% > 0 THEN LocateCol% = LocateCol% + 1 END IF IF LocateCol% > MaxScrCols% THEN LocateCol% = LocateCol% - MaxScrCols% FOR Spy% = 1 TO NumColsPossible% IF LocateCol% > MaxScrCols% THEN LocateCol% = LocateCol% - MaxScrCols% END IF IF LocateCol% <= MaxScrCols% THEN EXIT FOR END IF NEXT TheFactor% = ColumnPointer% \ MaxScrCols% IF ColumnPointer% MOD MaxScrCols% = 0 THEN show% = (MaxScrCols% * MaxScrRows%) * (TheFactor% - 1) ELSE show% = (MaxScrCols% * MaxScrRows%) * TheFactor% END IF IF LocateCol% <= 1 THEN CurrentCol% = TableULCol% END IF END IF END IF IF CurrentCol% < TableULCol% THEN CurrentCol% = TableULCol% + ((LocateCol% - 1) * (ItemWidth% + TweenSpace%)) END IF bring.in.display: FOR display% = TableULRow% TO TableULRow% + MaxScrRows% - 1 COLOR RegColrFG%, RegColrBG% LOCATE display%, TableULCol%, 0, 0, 0 show% = show% + 1 IF show% <= Count% THEN PRINT M$(show%) + SPACE$(TweenSpace%); ELSE PRINT SPACE$(ItemWidth% + TweenSpace%); END IF FOR ExecuteNext% = 1 TO MaxScrCols% - 1 IF show% + (ExecuteNext% * MaxScrRows%) <= Count% THEN IF LEN(M$(show% + (ExecuteNext% * MaxScrRows%))) = ItemWidth% THEN PRINT M$(show% + (ExecuteNext% * MaxScrRows%)) + SPACE$(TweenSpace%); ELSEIF LEN(M$(show% + (ExecuteNext% * MaxScrRows%))) = 0 THEN PRINT SPACE$(ItemWidth% + TweenSpace%); END IF ELSE IF Count% > (MaxScrRows% * MaxScrCols%) THEN PRINT SPACE$(ItemWidth% + TweenSpace%); END IF END IF NEXT NEXT COLOR HiLiteFG%, HiLiteBG% LOCATE CurrentRow%, CurrentCol%, 0, 0, 0 PRINT M$(ItemNum%); loopdeloop: DO GOSUB showfont DO HitKey$ = INKEY$ LOOP UNTIL LEN(HitKey$) > 0 Hit% = CVI(HitKey$ + CHR$(0)) LOCATE CurrentRow%, CurrentCol%, 0, 0, 0 COLOR RegColrFG%, RegColrBG% PRINT M$(ItemNum%); IF Hit% = 27 THEN ' ExitCode% = 27 EXIT SUB ELSEIF Hit% = 13 THEN ' ExitCode% = 13 EXIT SUB ELSEIF Hit% = 20480 THEN ' IF LeftOver% = 0 AND ItemNum% = Count% THEN CurrentRow% = TableULRow% - 1 ItemNum% = Count% - MaxScrRows% END IF IF ItemNum% < Count% THEN CurrentRow% = CurrentRow% + 1 ItemNum% = ItemNum% + 1 IF CurrentRow% = TableULRow% + MaxScrRows% THEN CurrentRow% = TableULRow% ItemNum% = ItemNum% - MaxScrRows% END IF ELSE CurrentRow% = TableULRow% ItemNum% = Count% - LeftOver% + 1 END IF ELSEIF Hit% = 18432 THEN ' CurrentRow% = CurrentRow% - 1 ItemNum% = ItemNum% - 1 IF CurrentRow% = TableULRow% - 1 THEN CurrentRow% = TableULRow% + MaxScrRows% - 1 ItemNum% = ItemNum% + MaxScrRows% IF ItemNum% > Count% THEN ItemNum% = Count% CurrentRow% = TableULRow% + LeftOver% - 1 END IF END IF ELSEIF Hit% = 19712 THEN ' IF ItemNum% <= Count% - LeftOver% THEN CurrentCol% = CurrentCol% + TweenSpace% + ItemWidth% ItemNum% = ItemNum% + MaxScrRows% ColumnPointer% = ColumnPointer% + 1 IF ItemNum% > Count% THEN ItemNum% = Count% IF LeftOver% = 0 THEN CurrentCol% = CurrentCol% - (TweenSpace% + ItemWidth%) CurrentRow% = TableULRow% + MaxScrRows% - 1 ItemNum% = Count% ColumnPointer% = ColumnPointer% - 1 ELSEIF LeftOver% > 0 THEN CurrentRow% = TableULRow% + LeftOver% - 1 END IF END IF END IF IF ColumnPointer% > MaxScrCols% THEN Start% = ItemNum% show% = 0 ColumnPointer% = 0 GOTO subtop END IF GOSUB showfont ELSEIF Hit% = 19200 THEN ' IF ColumnPointer% <= 0 THEN ColumnPointer% = 1 END IF IF ColumnPointer% > 1 THEN CurrentCol% = CurrentCol% - (TweenSpace% + ItemWidth%) ItemNum% = ItemNum% - MaxScrRows% ColumnPointer% = ColumnPointer% - 1 END IF IF ColumnPointer% >= MaxScrCols% THEN ColumnPointer% = 0 Start% = ItemNum% show% = 0 GOTO subtop END IF ELSEIF Hit% = 18176 THEN ' CurrentRow% = 0 CurrentCol% = 0 show% = 0 ItemNum% = 1 Start% = 1 GOTO subtop ELSEIF Hit% = 20224 THEN ' show% = 0 ItemNum% = Count% Start% = Count% CurrentCol% = 0 GOTO subtop ELSEIF Hit% = 20736 THEN ' ItemNum% = ItemNum% + (MaxScrRows% * MaxScrCols%) IF ItemNum% > Count% THEN ItemNum% = Count% END IF Start% = ItemNum% CurrentCol% = 0 show% = 0 GOTO subtop ELSEIF Hit% = 18688 THEN ' ItemNum% = ItemNum% - (MaxScrRows% * MaxScrCols%) IF ItemNum% <= 0 THEN ItemNum% = 1 END IF Start% = ItemNum% CurrentCol% = 0 show% = 0 GOTO subtop 'PRESS: Letters A - Z (or a - z), Numbers 0 - 9, ' Exclamation , or Underline <_>. ELSEIF Hit% > 64 AND Hit% < 91 OR Hit% > 96 AND Hit% < 123 OR Hit% > 47 AND Hit% < 58 OR Hit% = 33 OR Hit% = 95 THEN IF Hit% > 96 AND Hit% < 123 THEN Hit% = Hit% - 32 END IF FOR XYZ% = 1 TO Count% Letr$ = LEFT$(M$(XYZ%), 1) IF XYZ% = Count% AND ASC(Letr$) <> Hit% THEN show% = 0 GOTO subtop ELSEIF ASC(Letr$) = Hit% THEN EXIT FOR END IF NEXT FOR YYY% = 1 TO Count% CurrentLetr$ = LEFT$(M$(ItemNum%), 1) IF CurrentLetr$ <> FindLetr$ THEN TryLetters% = 0 END IF NEXT TryLetters% = TryLetters% + 1 FOR zzz% = TryLetters% TO Count% FindLetr$ = LEFT$(M$(zzz%), 1) IF ASC(FindLetr$) = Hit% THEN Start% = zzz% TryLetters% = zzz% ItemNum% = Start% ColumnPointer% = 0 show% = 0 CurrentCol% = 0 IF zzz% = Count% THEN ItemNum% = Count% TryLetters% = 0 END IF GOTO subtop END IF IF zzz% = Count% THEN zzz% = 0 END IF NEXT 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(FKey$, IdentKey$) > 0 THEN IF IdentKey$ = "0" THEN ExitCode% = 10 EXIT SUB ELSE ExitCode% = VAL(IdentKey$) EXIT SUB END IF END IF END IF LOCATE CurrentRow%, CurrentCol%, 0, 0, 0 COLOR HiLiteFG%, HiLiteBG% PRINT M$(ItemNum%); LOOP showfont: REDIM FigTail$(9) SHELL "figlet.exe" + " " + "-f" + M$(ItemNum%) + "<" + "FigTail1.Txt" + ">" + "FigTail2.Txt" OPEN "FigTail2.Txt" FOR INPUT AS #1 COLOR 15, 1 FOR ClearDaScrn% = 1 TO 9 LOCATE ClearDaScrn% + 5, 1 PRINT SPACE$(80) NEXT FOR FirstRead% = 1 TO 9 IF EOF(1) THEN CLOSE #1 RETURN END IF LINE INPUT #1, FigTail$(FirstRead%) LOCATE FirstRead% + 5, 2 PRINT LEFT$(FigTail$(FirstRead%), 80); NEXT CLOSE #1 RETURN 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 | '+----------------------------------------------------------------------+ '+----------------------------------------------------------------------+ '| PLACE NUMBERS 1 AND 2 IN MAIN PROGRAM. See line number 313 in main | '| module. Also, refer to numbers 7, 8 and 9 below. | '+------------------+---------------------------------------------------|+ '| (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 BEFORE CALLING THIS SUB -> | '+----------------------------------------------------------------------+ '| (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.da.screen ELSEIF SaveOrRest% = 2 THEN GOSUB restore.da.screen END IF EXIT SUB save.da.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.da.screen: FOR FindRow% = SR.UL.Row% TO SR.LR.Row% FOR ScrnCol% = SR.UL.Col% TO SR.LR.Col% LOCATE FindRow%, ScrnCol%, 0, 0, 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