' +---------------------------------------------------------------------+ ' | | ' | - 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 fblogo.rc 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 | ' +--------------------------------------------------------------------+ ' | 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 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 | ' | | ' | 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) | ' | LRRow% = LRRow% + 2 ' Lower right row | ' | LRCol% = 80 ' Lower right column | ' | +-----------------------+ ' | CALL DisplayMessage(Message$(), ULRow%, ULCol%, LRRow%, LRCol%, MaxNum%, ColrFG%, ColrBG%) | ' +--------------------------------------------------------------------------------------------+ ' +--------------------------------------------------------------------+ ' | | ' | IF SUB DisplayMessage IS TO BE USED TO VIEW A MESSAGE, | ' | | ' | THEN PLACE SOMETHING LIKE THIS IN THE MAIN MODULE: | ' | | ' +--------------------------------------------------------------------+ ' | | ' | 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. . | ' | ' . | ' | ' . | ' | 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%) | ' +--------------------------------------------------------------------------------------------+ 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