SUB DisplayMessage (Message$(), ULRow%, ULCol%, LRRow%, LRCol%, MaxNum%, ColrFG%, ColrBG%) ' +--------------------------------------------------------------------+ ' | - S U B D i s p l a y M e s s a g e - | ' | | ' | Public Domain - FreeWare | ' +--------------------------------------------------------------------+ ' | Author: Donald B. "Don" Smith | ' | Email : smithdonb@earthlink.net | ' | Date: 08/01/2002 | ' +--------------------------------------------------------------------+ ' | - 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. | ' +--------------------------------------------------------------------+ ' +--------------------------------------------------------------------+ ' | 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. If this | ' | | number is unknown to you because it is an exterior | ' | | file, do this in main module: | ' | +------------------------------------------------------+ ' | | ComFile% = COMMAND$ | ' | | OPEN ComFile% FOR INPUT AS #1 | ' | | DO | ' | | IF EOF(1) THEN | ' | | EXIT DO | ' | | END IF | ' | | LINE INPUT #1, ThrowAway$ | ' | | MaxNum% = MaxNum + 1 | ' | | LOOP UNTIL EOF(1) | ' +-------------+------------------------------------------------------+ ' | ColrFG% | The foreground color of message. | ' +-------------+------------------------------------------------------+ ' | ColrBG% | The back ground color of message. | ' +--------------------------------------------------------------------+ ' +--------------------------------------------------------------------+ ' | | ' | IF SUB DisplayMessage IS TO BE USED TO VIEW A TEXT | ' | | ' | FILE AND SUBSEQUENTLY COMPILED WITH FreeBASIC 0.17, | ' | | ' | START AT LINE NUMBER 302. | ' | | ' +--------------------------------------------------------------------+ ' +--------------------------------------------------------------------+ ' | | ' | IF SUB DisplayMessage IS TO BE USED TO VIEW | ' | | ' | A FILE, THEN PLACE THIS IN THE MAIN MODULE: | ' | | ' +--------------------------------------------------------------------+ ' | | ' | FileName$ = COMMAND$ | ' | FileName$ = RTRIM$(LTRIM$(FileName$)) | ' | 'ON ERROR GOTO errorhandler | ' | OPEN FileName$ FOR INPUT AS #1 | ' | DO | ' | IF EOF(1) THEN EXIT DO | ' | LINE INPUT #1, ThrowAway$ | ' | MaxLine% = MaxLine% + 1 | ' | LOOP UNTIL EOF(1) | ' | CLOSE #1 | ' | | ' | REDIM Message$(MaxLine% + 1) | ' | OPEN FileName$ FOR INPUT AS #1 | ' | DO | ' | LineNum% = LineNum% + 1 | ' | IF EOF(1) THEN EXIT DO | ' | LINE INPUT #1, Message$(LineNum%) | ' | LOOP UNTIL EOF(1) | ' | CLOSE #1 | ' | | ' | If LineNum% = 0 THEN | ' | GOTO errorhandler | ' | END IF | ' | | ' | TopBottFG = 0 ' Foreground color of top/bottom strip (0-15)| ' | TopBottBG% = 15 ' Back ground color of top/bottom strip (0-7)| ' | 'If there is to be no top/bottom strip, remove next 6 lines. | ' | COLOR TopBottFG%, TopBottBG% | ' | LOCATE 1, 1: PRINT STRING$(80, " "); | ' | LOCATE 1, 2: PRINT "File: " + FileName$ | ' | LOCATE 25, 1: PRINT STRING$(80, " "); | ' | LOCATE 1, 61: PRINT "Top Line: " + " " + "1" + STRING$(6, " "); +----------------------------------------------------------------------+ ' | LOCATE 25, 14: PRINT "MOVE: <" + CHR$(24) + "> <" + CHR$(25) + "> <" + CHR$(27) + "> <" + CHR$(26) + "> Aborts"; | ' | +----------------------------------------------------------------------+ ' | ULRow% = 2 ' Upper left row to place text. | ' | ULCol% = 1 ' Upper left column to place text. | ' | LRRow% = 24 ' Lower right row to place text. | ' | LRCol% = 80 ' Lower right column to place text. | ' | MaxNum% = LineNum% ' Maximum number of lines to view. | ' | ColrFG% = 15 ' Foreground color of text (0-15). | ' | ColrBG% = 1 ' Back ground color of text (0-7) | ' | +--------------------------+ ' | CALL DisplayMessage(Message$(), ULRow%, ULCol%, LRRow%, LRCol%, MaxNum%, ColrFG%, ColrBG%) | ' | CLS: END | ' | | ' |errorhandler: | ' | CLS | ' | PRINT : PRINT | ' | PRINT " <<>>. Sorry, unable to read your file. Correct Usage:" | ' | PRINT " DMessage.Exe YourFile.Txt. DMessage is the the executable" | ' | PRINT " and YourFile.Txt is the ASCII text file to read. Press any" | ' | PRINT " key to continue." | ' | DO: LOOP WHILE INKEY$ = "" | ' | CLS : END | ' +-----------------------------------------------------------------------------------------------+ ' +--------------------------------------------------------------------+ ' | | ' | IF SUB DisplayMessage IS TO BE USED TO VIEW A MESSAGE, | ' | | ' | THEN PLACE SOMETHING LIKE THIS IN THE MAIN MODULE: | ' | | ' +--------------------------------------------------------------------+--------------+ ' | | ' | '- - - - - - - - - - Set Up SUB TinyBox - - - - - - - - - - - - - | ' | ULRow = 6: ULCol = 10: LRRow = 22: LRCol = 65 | ' | BoxFGColr = 15: BoxBGColr = 13: SingOrDoub = 1 | ' | CALL TinyBox(ULRow, ULCol, LRRow, LRCol, BoxFGColr, BoxBGColr, SingOrDoub) | ' | | ' | Line$ = CHR$(198) + STRING$(55, CHR$(205)) + CHR$(181) | ' | COLOR 15, 5 | ' | LOCATE 20, 10, 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); | ' | | ' | '- - - - - - - - Set Up SUB DisplayMessage - - - - - - - - - - - - - | ' | REDIM Message$(50) +--------------+ ' | Message$(1) = SPACE$(45) | ' | Message$(2) = " MESAMENU PROGRAM "| ' | Message$(3) = " ---------------- "| ' | Message$(4) = "The purpose of the MesaMenu Program is to demon- "| ' | Message$(5) = "strate how to write the QuickBASIC code of a menu "| ' | Message$(6) = "consisting of a table of rows and columns. The "| ' | Message$(7) = "file extension will be placed as a parameter: "| ' | ' . | ' | ' . | ' | ' etc. . - - - More text here - - - | ' | ' . | ' | ' . | ' | Message$(50) = "Last line" | ' | | ' | ULRow% = 7 ' Upper left row to place text. | ' | ULCol% = 15 ' Upper left column to place text. | ' | LRRow% = 21 ' Lower right row to place text. | ' | LRCol% = 66 ' Lower right column to place text. | ' | MaxNum% = 50 ' Maximum number of lines to view. | ' | ColrFG% = 15 ' Foreground color of text (0-15). | ' | ColrBG% = 1 ' Back ground color of text (0-7) | ' | +-----------------------+ ' | CALL DisplayMessage(Message$(), ULRow%, ULCol%, LRRow%, LRCol%, MaxNum%, ColrFG%, ColrBG%) | ' +----------------------------------------------------------------------------+---------------+ ' | | ' | | ' | SUB TinyBox (ULRow, ULCol, LRRow, LRCol, BoxFGColr, BoxBGColr, SingOrDoub) | ' | | ' | ' +----------------------------------------------------------------------+ | ' | ' | SUB TinyBox | | ' | ' +----------------------------------------------------------------------+ | ' | ' | ULRow = Upper Left Row. ULCol = Upper Left Column. | | ' | ' | LRRow = Lower Right Row. LRCol = Lower Right Column. | | ' | ' | BoxFGColr = The Foreground Color The Box. | | ' | ' | BoxBGColr = The Back Ground Color Of The Box. | | ' | ' | SingOrDoub = 1 (Single Line Box). SingOrDoub = 2 (Double Line Box). | | ' | ' +----------------------------------------------------------------------+ | ' | | ' | COLOR BoxFGColr, BoxBGColr | ' | IF SingOrDoub = 1 THEN | ' | LOCATE ULRow, ULCol | ' | PRINT CHR$(218) + STRING$(LRCol - ULCol, CHR$(196)) + CHR$(191); | ' | FOR BoxY = ULRow + 1 TO LRRow - 1 | ' | LOCATE BoxY, ULCol | ' | PRINT CHR$(179) + STRING$(LRCol - ULCol, " ") + CHR$(179); | ' | NEXT | ' | LOCATE LRRow, ULCol | ' | PRINT CHR$(192) + STRING$(LRCol - ULCol, CHR$(196)) + CHR$(217); | ' | ELSEIF SingOrDoub = 2 THEN | ' | LOCATE ULRow, ULCol | ' | PRINT CHR$(201) + STRING$(LRCol - ULCol, CHR$(205)) + CHR$(187); | ' | FOR BoxY = ULRow + 1 TO LRRow - 1 | ' | LOCATE BoxY, ULCol | ' | PRINT CHR$(186) + STRING$(LRCol - ULCol, " ") + CHR$(186); | ' | NEXT | ' | LOCATE LRRow, ULCol | ' | PRINT CHR$(200) + STRING$(LRCol - ULCol, CHR$(205)) + CHR$(188); | ' | END IF | ' | | ' | END SUB | ' +----------------------------------------------------------------------------+ COLOR ColrFG%, ColrBG% 'First, next 4 lines clears screen: FOR ClearScrn% = ULRow% TO LRRow% LOCATE ClearScrn%, ULCol% PRINT SPACE$(LRCol% - ULCol%); NEXT FOR place% = 1 TO LRRow% - ULRow% - 1 LOCATE place% + ULRow% - 1, ULCol%, 0, 0, 0 PRINT Message$(place%); NEXT DO 'If SUB DisplayMessage is used to view a 'a text file, include next line: 'LOCATE 1, 70: COLOR 0, 15: PRINT where% + 1 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 ' +---------------------------------------------------------------------+ ' | | ' | THIS VERION OF SUB DisplayMessage IS TO BE USED TO VIEW | ' | | ' | A TEXT FILE AND THEN COMPILED WITH FreeBASIC V0.17. | ' | | ' | THE PROGRAM IT PRODUCES I CALL ViewIt. | ' | | ' +---------------------------------------------------------------------+ ' +---------------------------------------------------------------------+ ' | | ' | - V i e w I t . B a s - | ' | | ' | | ' | Public Domain - FreeWare | ' | Compiled With FreeBASIC v0.17 | ' +---------------------------------------------------------------------+ ' +---------------------------------------------------------------------+ ' | ViewIt is a simple ASCII text file browser. It mainly relies on | ' | SUB DisplayMessage to do the magic. | ' +---------------------------------------------------------------------+ ' +---------------------------------------------------------------------+ ' | - ABOUT THE AUTHOR - | ' +---------------------------------------------------------------------+ ' | | ' | Hello. My name is Don Smith and I am a retired thiry-year teacher | ' | of Math/History/Spanish residing in Orange County, California. I am | ' | also a former 6-year Sergeant of Marines. Who-Rah! On certain forums| ' | I am known as MarineDon. My email is: smithdonb@earthlink.net | ' | | ' +---------------------------------------------------------------------+ ' +---------------------------------------------------------------------+ ' | - COPYING AND DISTIBUTING - | ' +---------------------------------------------------------------------+ ' | Since this code is public domain and freeware, anyone may freely | ' | copy and distribute it. If you use the QuickBasic code in one of | ' | your own programs, you do not have to cite my name as the author, | ' | and you may even change its name. | ' +---------------------------------------------------------------------+ ' +---------------------------------------------------------------------+ ' | | ' | Compile for FreeBASIC v0.17: | ' | | ' | fbc viewit.bas | ' +---------------------------------------------------------------------+ ' ' Dim Title As String ' Title = "ViewIt Text Browser - Public Domain/FreeWare" ' WindowTitle Title ' 'Compile For Icon: fbc fblogo.rc ViewIt.Bas ' ' ' DECLARE SUB DisplayMessage () ' DECLARE SUB UpDown ' ' Common Shared As Integer Maxline, LineNum, TopBottFG, TopBottBG, ULRow, ULCol, LRRow, LRCol,_ ' MaxNum, ColrFG, ColrBG, ClearScrn, place, Hit, Where, PlaceDn, PostIt ' ' Common Shared As String FileName, ThrowAway, Message(), Work, HitKey, NewLine ' ' FileName = COMMAND$ ' FileName = RTRIM$(LTRIM$(FileName)) ' OPEN FileName FOR INPUT AS #1 ' DO ' IF EOF(1) THEN EXIT DO ' LINE INPUT #1, ThrowAway ' MaxLine = MaxLine + 1 ' If LEN(ThrowAway) > 80 THEN ' MaxLine = MaxLine + 1 ' END IF ' LOOP UNTIL EOF(1) ' CLOSE #1 ' ' DIM Message(MaxLine + 1) AS STRING ' OPEN FileName FOR INPUT AS #1 ' DO ' LineNum = LineNum + 1 ' IF EOF(1) THEN EXIT DO ' LINE INPUT #1, Message(LineNum) ' LOOP UNTIL EOF(1) ' CLOSE #1 ' ' 'error handler routine: ' If FileName = "" Or LineNum = 0 THEN 'check for errors ' GOTO errorhandler ' End If ' ' Screen 12 'Put Screen 12 here which is after the error handler routine. If there's an error ' 'and Screen 12 is at the top, Screen 12 opens-closes and then error screen 13 ' 'opens. This makes for a blurred and jagged motion. Therefore, put it here. ' ' TopBottFG = 0 ' Foreground color of top/bottom strip (0-15) ' TopBottBG = 10 ' Back ground color of top/bottom strip (0-7) ' COLOR TopBottFG, TopBottBG ' LOCATE 1, 1: PRINT STRING$(80, " "); ' LOCATE 1, 2: PRINT "File: " + FileName ' LOCATE 30, 1: PRINT STRING$(80, " "); ' LOCATE 1, 62: PRINT "Top Line: " + STRING$(6, " "); ' LOCATE 30, 4: PRINT "MOVE: <" + CHR$(24) + "> <" + CHR$(25) + "> Exit" + Space$(14) + "Bottom Line: " + STRING$(6, " "); ' ' ULRow = 2 ' Upper left row to place text. ' ULCol = 1 ' Upper left column to place text. ' LRRow = 27 ' Lower right row to place text. ' LRCol = 80 ' Lower right column to place text. ' MaxNum = LineNum ' Maximum number of lines to view. ' ColrFG = 0 ' Foreground color of text (0-15). ' ColrBG = 15 ' Back ground color of text (0-7) ' LRRow = LRRow + 2 ' Lower right row ' LRCol = 80 ' Lower right column ' ' DisplayMessage ' ' END ' ' 'errorhandler: ' Dim ErrorTitle As String ' ErrorTitle = "ViewIt - Public Domain ' WindowTitle ErrorTitle ' 'Compile For Icon: fbc fblogo.rc PrintIt.Bas ' Screen 13 ' Color 15, 1 ' Cls ' Print ' Print ' Print ' Print " 旼컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴커" ' Print " � �" ' Print " � You must include a file to view. �" ' Print " � �" ' Print " � Example: ViewIt MyFile.Txt �" ' Print " � �" ' Print " 팠袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴孤" ' Print " � �" ' Print " � Public Domain FreeWare by �" ' Print " � �" ' Print " � � Don Smith � �" ' Print " � �" ' Print " 팠袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴孤" ' Print " � �" ' Print " 쿟oday's Date : 08/08/2007 �" ' Print " � �" ' Print " 쿏on's Email:smithdonb@eartlink.net�" ' Print " � �" ' Print " 읕컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴켸" ' Sleep ' End ' ' 'SUB DisplayMessage ' ' ' +--------------------------------------------------------------------+ ' ' | - S U B D i s p l a y M e s s a g e - | ' ' | | ' ' | Public Domain - FreeWare | ' ' | | ' ' | ATTENTION: This verion of SUB DisplayMessage | ' ' | is to be COMPILED WITH FreeBASIC V0.17! | ' ' +--------------------------------------------------------------------+ ' ' COLOR ColrFG, ColrBG 'First of all, clear screen with next 4 lines: ' FOR ClearScrn = ULRow TO LRRow ' LOCATE ClearScrn, ULCol ' PRINT SPACE$(LRCol - ULCol + 1); ' NEXT ' ' For place = 1 to LRRow - ULRow + 1 ' LOCATE place + ULRow - 1, ULCol, 0 ' PRINT Message(place); ' NEXT ' ' DO '+------------------------------------------+ ' If Where = 0 Then '| The top/bottom information lines contain | ' PostIt = 1 '| "Top Line:" and "Bottom Line:". These | ' ElseIf Where = 1 Or Where > 1 Then '| eight lines here keep track of the top | ' PostIt = Where + 1 '| and bottom line amounts. | ' End If '| . | ' COLOR 0, 10 '+------------------------------------------+ ' LOCATE 1, 70: PRINT Space$(10);: LOCATE 1, 70: PRINT PostIt; ' LOCATE 30, 70: PRINT Space$(8);: LOCATE 30, 70: PRINT PostIt + 27; ' ' DO ' HitKey = INKEY$ ' LOOP UNTIL LEN(HitKey) > 0 ' ' IF HitKey = Chr(255) + "k" THEN 'program ends when user ' CLS : END 'clicks x at upper right ' END IF ' ' Hit = CVI(HitKey + CHR$(0) + CHR$(0)) ' IF Hit < 255 THEN ' Hit = CVI(HitKey + CHR$(0) + CHR$(0) + CHR$(0)) ' END IF ' ' IF Hit = 27 THEN ' Where = 0 ' EXIT SUB ' ELSEIF Hit = 20735 THEN ' ' Where = Where + 1 ' ELSEIF Hit = 18687 THEN ' ' Where = Where - 1 ' ELSEIF Hit = 20991 THEN ' ' Where = Where + (LRRow - ULRow + 1) ' ELSEIF Hit = 18943 THEN ' ' Where = Where - (LRRow - ULRow + 1) ' ELSEIF Hit = 20479 THEN ' ' Where = MaxNum - 5 ' COLOR 15, 1 ' ELSEIF Hit = 18431 THEN ' ' Where = 0 ' END IF ' UpDown ' LOOP 'End Sub ' 'SUB UpDown ' COLOR ColrFG, ColrBG ' For PlaceDn = 1 to LRRow - ULRow + 1 ' IF PlaceDn + Where - 1 = MaxNum + 1 THEN ' Exit Sub ' 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 ' Work = LEFT$(Message(PlaceDn + Where), LRCol - ULCol) ' Work = Work + SPACE$((LRCol - ULCol) - LEN(Work) + 1) ' PRINT Work; ' END IF ' NEXT 'END SUB