' +---------------------------------------------------------------------+
    ' |                                                                     |
    ' |                     - S h r i n k . B a s -                         |
    ' |                                                                     |
    ' |                                                                     |
    ' |                   Public Domain -  FreeWare                         |
    ' +---------------------------------------------------------------------+ 
    ' +---------------------------------------------------------------------+
    ' |                      - ABOUT THE AUTHOR -                           |
    ' +---------------------------------------------------------------------+
    ' |                                                                     |
    ' | Hello. My name is Don Smith and I am a thirty-year retired teacher  |
    ' | of Math/History/Spanish residing in Orange County, California. I    |
    ' | am also a former six-year Sergeant of Marines. Who-Rah! On certain  |
    ' | forums I am known as MarineDon. My email is: smithdonb@earthlink.net|
    ' |                                                                     |
    ' +---------------------------------------------------------------------+
    ' |                 - COPYING AND DISTIBUTING -                         |
    ' +---------------------------------------------------------------------+
    ' | Since this code is public domain and freeware, anyone may freely    |
    ' | copy and distribute it. If you use the QuickBasic code in one of    |
    ' | your own programs, you do not have to cite my name as the author,   |
    ' | and you may even change its name.                                   |
    ' +---------------------------------------------------------------------+
    ' +---------------------------------------------------------------------+    
    ' |  Shrink Program by Don Smith is Public Domain, FreeWare.            |
    ' |  All SUBs of the Shrink program ar Public Domain, FreeWare.         | 
    ' |  The Shrink program normally is used in conjunction with the        | 
    ' |  Viewport program. Viewport requires that ASCII text files          |
    ' |  have shorter line lengths. So, that is what Shrink does;           |
    ' |  it shrinks or shortens line lengths.                               |  
    ' |                                                                     |   
    ' |  BC: Shrink /e /x                                                   |  
    ' |                                                                     |
    ' |  LINK: Shrink /noe                                                  |  
    ' |                                                                     |
    ' |  LIB: Bcom45                                                        | 
    ' +---------------------------------------------------------------------+


    DECLARE SUB BoxBoy (Title$, ULRow%, ULCol%, LRRow%, LRCol%, TitleRow%, TitleCol%, TitColrFor%, TitColrBak%, BoxColrFor%, BoxColrBak%, BoxStyle%, Shadow%, ShadowColr%, ClearColr%)
    DECLARE SUB SaveRestScrn (ReadLine$(), ReadColr%(), SR.UL.Row%, SR.UL.Col%, SR.LR.Row%, SR.LR.Col%, SaveOrRest%)
    DECLARE SUB EditLoco (EdW$, Row%, Col%, FCol%, LenStr%, See%, TypeOfText$, Caps%, FGColr%, BGGolr%, FKey$, ExitCode%)

    DEFINT A-Z

begin:
    CLEAR
    GOSUB opening.screen
    ON ERROR GOTO errorhandler
question.one:
    EdW$ = "": Row% = 14: Col% = 58: FCol% = 58: LenStr% = 12: See% = 0
    TypeOfText$ = "": Caps% = 1: FGColr% = 14: BGColr% = 1: FKey$ = ""
    CALL EditLoco(EdW$, Row%, Col%, FCol%, LenStr%, See%, TypeOfText$, Caps%, FGColr%, BGColr%, FKey$, ExitCode%)
    OldFile$ = EdW$
    IF ExitCode% = 27 THEN                           '<Esc>
        GOTO leave
    '<Enter> <DnArr> <PgDn>
    ELSEIF ExitCode% = 13 OR ExitCode% = 18 OR ExitCode% = 19 THEN
        FileIs = 1
        OPEN OldFile$ FOR INPUT AS #1
        LINE INPUT #1, ThrowAway$
        CLOSE #1
        GOTO question.two
    END IF
    GOTO question.one
question.two:
    EdW$ = "": Row% = 16: Col% = 52: FCol% = 52: LenStr% = 12: See% = 0
    TypeOfText$ = "": Caps% = 1: FGColr% = 14: BGColr% = 1: FKey$ = ""
    CALL EditLoco(EdW$, Row%, Col%, FCol%, LenStr%, See%, TypeOfText$, Caps%, FGColr%, BGColr%, FKey$, ExitCode%)
    NewFile$ = EdW$
    IF ExitCode% = 27 THEN                           '<Esc>
        GOTO leave
    ELSEIF ExitCode% = 13 OR ExitCode% = 17 THEN     '<Enter> <DnArr>
        FileIs = 2
        OPEN NewFile$ FOR OUTPUT AS #2
        PRINT #2, SPACE$(2)
        CLOSE #2
        GOTO question.three
    ELSEIF ExitCode% = 16 THEN                       '<UpArr>
        GOTO question.one
    END IF
    GOTO question.two

question.three:
    EdW$ = "": Row% = 18: Col% = 61: FCol% = 61: LenStr% = 2
    See% = 1: TypeOfText$ = "0123456789": Caps% = 1: FGColr% = 14
    BGColr% = 1: FKey$ = ""
    CALL EditLoco(EdW$, Row%, Col%, FCol%, LenStr%, See%, TypeOfText$, Caps%, FGColr%, BGColr%, FKey$, ExitCode%)
    IF ExitCode% = 27 THEN                            '<Esc>
        GOTO leave
    ELSEIF ExitCode% = 13 OR ExitCode% = 17 THEN      '<Enter> <DnArr>
        LCol% = VAL(EdW$)
        IF LCol% <= 0 OR LCol% > 20 THEN
            Margin = 1
            GOSUB bad.margin
            GOTO question.three
        END IF
        GOTO question.four
    ELSEIF ExitCode% = 16 THEN                        '<UpArr>
        GOTO question.two
    END IF
    GOTO question.three

question.four:
    EdW$ = "": Row% = 20: Col% = 63: FCol% = 63: LenStr% = 2
    See% = 1: TypeOfText$ = "01234567890": Caps% = 1: FGColr% = 14
    BGColr% = 1: FKey$ = ""
    CALL EditLoco(EdW$, Row%, Col%, FCol%, LenStr%, See%, TypeOfText$, Caps%, FGColr%, BGColr%, FKey$, ExitCode%)
    IF ExitCode% = 27 THEN                             '<Esc>
        GOTO leave
    ELSEIF ExitCode% = 13 OR ExitCode% = 17 THEN       '<Enter> <DnArr>
        RCol% = VAL(EdW$)
        IF RCol% < 40 OR RCol% > 80 THEN
            Margin = 2
            GOSUB bad.margin
            GOTO question.four
        END IF
        GOTO make.new.file
    ELSEIF ExitCode% = 16 THEN                         '<UpArr>
        GOTO question.three
    END IF
    GOTO question.four
make.new.file:
    GOSUB save.screen
    LOCATE 22, 32, 0: COLOR 30, 1
    PRINT "- Formatting -"
    OPEN OldFile$ FOR INPUT AS #1
    OPEN NewFile$ FOR OUTPUT AS #2
bring.it.one:
    REDIM MM$(1000)
    IF EOF(1) THEN
        GOTO bring.it.two
    END IF
    LineNum% = LineNum% + 1
    LINE INPUT #1, M$
bring.it.two:
    M$ = RTRIM$(LTRIM$(M$))
    IF M$ = "" THEN
        M$ = STRING$(80, CHR$(255))
        GOTO bring.it.three
    END IF
    MM$ = MM$ + " " + M$ + CHR$(255)
    MM$ = RTRIM$(LTRIM$(MM$))
    IF LEN(MM$) <= RCol% - LCol% THEN
        GOTO bring.it.three
    END IF
    GOTO bring.it.one
bring.it.three:
    TheLen% = RCol% - LCol% - 1
    MM$ = RTRIM$(LTRIM$(MM$))
    FOR Measure% = TheLen% TO 1 STEP -1
        HoundDog$ = MID$(MM$, Measure%, 1)
        IF HoundDog$ = " " OR HoundDog$ = "." OR HoundDog$ = CHR$(255) THEN
            MMM$ = LEFT$(MM$, Measure%)
            MMM$ = STRING$(LCol% - 1, CHR$(255)) + MMM$
            MMM$ = RTRIM$(LTRIM$(MMM$))
            PRINT #2, MMM$
            MM$ = MID$(MM$, Measure% + 1, LEN(MM$) - Measure% + 1)
            MM$ = RTRIM$(LTRIM$(MM$))
            EXIT FOR
        END IF
    NEXT
    IF EOF(1) THEN
        GOTO last.item
    ELSEIF MM$ = "" OR MMM$ = "" THEN
        M$ = "": MM$ = "": MMM$ = "": Measure% = 0: TheLen% = 0
        GOTO bring.it.one
    ELSEIF LEN(MM$) <= RCol% - LCol% - 1 THEN
        PRINT #2, STRING$(LCol% - 1, CHR$(255)) + MM$
        PRINT #2, STRING$(70, CHR$(255))
        M$ = "": MM$ = "": MMM$ = "": Measure% = 0: TheLen% = 0
        GOTO bring.it.one
    ELSEIF LEN(MM$) > RCol% - LCol% THEN
        M$ = "": MMM$ = "": TheLen% = 0: Measure% = 0
        GOTO bring.it.three
    ELSEIF LEN(FourM$) > 0 THEN
        M$ = "": MM$ = "": MMM$ = "": TheLen% = 0: Measure% = 0
        FourM$ = STRING$(LCol% - 1, CHR$(255)) + FourM$
        FourM$ = RTRIM$(LTRIM$(FourM$))
        PRINT #2, FourM$
        GOTO bring.it.one
    END IF

    M$ = "": MM$ = "": MMM$ = "": Measure% = 0: TheLen% = 0
    GOTO bring.it.one

last.item:
    CLOSE #1: CLOSE #2
    SHELL "seebee.exe" + " " + NewFile$

    CLS : PRINT 123, "last.item": END


    GOSUB restore.screen
    GOSUB save.screen
    Title$ = ""
    ULRow% = 11
    ULCol% = 14
    LRRow% = 15
    LRCol% = 66
    TitleRow% = 12
    TitleCol% = 19
    TitColrFor% = 15
    TitColrBak% = 4
    BoxColrFor% = 15
    BoxColrBak% = 4
    BoxStyle% = 2
    ShadowColr% = 7
    Shadow% = 1
    ClearColr% = 1000
    CALL BoxBoy(Title$, ULRow%, ULCol%, LRRow%, LRCol%, TitleRow%, TitleCol%, TitColrFor%, TitColrBak%, BoxColrFor%, BoxColrBak%, BoxStyle%, Shadow%, ShadowColr%, ClearColr%)
    LOCATE 12, 18: COLOR 15, 4
    PRINT "Your new file, " + UCASE$(NewFile$) + ", is ready!.  Press"
    LOCATE 14, 18
    PRINT "<Esc> to exit, or press <Enter> to begin over."
    COLOR 11, 4
    LOCATE 14, 19, 0: PRINT "Esc"
    LOCATE 14, 43, 0: PRINT "Enter"
    SOUND 200, 2
    DO
        K$ = INKEY$
        IF K$ = CHR$(27) THEN
            GOTO leave
        ELSEIF K$ = CHR$(13) THEN
            GOSUB restore.screen
            GOTO begin
        END IF
    LOOP
leave:
    COLOR 7, 0: CLS : LOCATE 1, 1, 1, 6, 7: END
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
bad.margin:
    GOSUB save.screen
    Title$ = "<<<Error>>>"
    ULRow% = 9
    ULCol% = 23
    LRRow% = 15
    LRCol% = 53
    TitleRow% = 10
    TitleCol% = 34
    TitColrFor% = 14
    TitColrBak% = 4
    BoxColrFor% = 15
    BoxColrBak% = 4
    BoxStyle% = 2
    Shadow% = 1
    ShadowColr% = 7
    ClearColr% = 1000
    CALL BoxBoy(Title$, ULRow%, ULCol%, LRRow%, LRCol%, TitleRow%, TitleCol%, TitColrFor%, TitColrBak%, BoxColrFor%, BoxColrBak%, BoxStyle%, Shadow%, ShadowColr%, ClearColr%)
    COLOR 15, 4
    IF Margin = 1 THEN
        LOCATE 12, 27: PRINT "Left margin must be 1-20"
    ELSEIF Margin = 2 THEN
        LOCATE 12, 27: PRINT "Right margin must be 40-80"
    END IF
    LOCATE 13, 24:  COLOR 15, 4: PRINT "Η" + STRING$(30, "Δ") + "Ά"
    LOCATE 14, 28, 0: PRINT "Press <Esc> To Continue."
    LOCATE 14, 35, 0: COLOR 11, 4: PRINT "Esc"
    SOUND 200, 2
    DO: LOOP UNTIL INKEY$ = CHR$(27)
    GOSUB restore.screen
    RETURN
no.find.file:
    GOSUB save.screen
    Title$ = "<<<Error>>>"
    ULRow% = 9
    ULCol% = 20
    LRRow% = 15
    LRCol% = 60
    TitleRow% = 10
    TitleCol% = 36
    TitColrFor% = 14
    TitColrBak% = 4
    BoxColrFor% = 15
    BoxColrBak% = 4
    BoxStyle% = 2
    Shadow% = 1
    ShadowColr% = 7
    ClearColr% = 1000
    CALL BoxBoy(Title$, ULRow%, ULCol%, LRRow%, LRCol%, TitleRow%, TitleCol%, TitColrFor%, TitColrBak%, BoxColrFor%, BoxColrBak%, BoxStyle%, Shadow%, ShadowColr%, ClearColr%)
    LOCATE 12, 26
    IF FileIs = 1 THEN
        LOCATE 12, 26: COLOR 15, 4: PRINT "Unable to find: "
        IF OldFile$ = "" THEN OldFile$ = "- Empty Line -"
        LOCATE 12, 42: COLOR 11, 4: PRINT OldFile$
    ELSEIF FileIs = 2 THEN
        LOCATE 12, 26: COLOR 15, 4: PRINT "Not Valid Name:"
        IF NewFile$ = "" THEN NewFile$ = "- Empty Line -"
        LOCATE 12, 42: COLOR 11, 4: PRINT NewFile$
    END IF
    LOCATE 13, 21:  COLOR 15, 4: PRINT "Η" + STRING$(40, "Δ") + "Ά"
    LOCATE 14, 28, 0: COLOR 15, 4: PRINT "Press <Esc> To Continue."
    LOCATE 14, 35, 0: COLOR 11, 4: PRINT "Esc"
    SOUND 200, 2
    DO: LOOP UNTIL INKEY$ = CHR$(27)
    GOSUB restore.screen
    IF FileIs = 1 THEN
        GOTO question.one
    ELSEIF FileIs = 2 THEN
        GOTO question.two
    END IF
errorhandler:
    IF ERR = 14 THEN
        END
    END IF
    IF ERR = 64 OR ERR = 52 OR ERR = 53 THEN
        GOSUB no.find.file
        IF FileIs = 1 THEN
            GOTO question.one
        ELSEIF FileIs = 2 THEN
            GOTO question.two
        END IF
    ELSE
        GOSUB save.screen
        Title$ = "<<<Error>>>"
        ULRow% = 9
        ULCol% = 23
        LRRow% = 15
        LRCol% = 53
        TitleRow% = 10
        TitleCol% = 34
        TitColrFor% = 14
        TitColrBak% = 4
        BoxColrFor% = 15
        BoxColrBak% = 4
        BoxStyle% = 2
        Shadow% = 1
        ShadowColr% = 8
        ClearColr% = 1000
        CALL BoxBoy(Title$, ULRow%, ULCol%, LRRow%, LRCol%, TitleRow%, TitleCol%, TitColrFor%, TitColrBak%, BoxColrFor%, BoxColrBak%, BoxStyle%, Shadow%, ShadowColr%, ClearColr%)
        COLOR 15, 4
        LOCATE 12, 32:  PRINT "Unknown Error!"
        LOCATE 13, 24:  PRINT "Η" + STRING$(30, "Δ") + "Ά"
        LOCATE 14, 28, 0: PRINT "Press <Esc> To Continue."
        LOCATE 14, 35, 0: COLOR 11, 4: PRINT "Esc"
        SOUND 200, 2
        DO: LOOP UNTIL INKEY$ = CHR$(27)
        GOSUB restore.screen
        RESUME NEXT
    END IF
opening.screen:
    COLOR 15, 1: CLS
    PRINT "                    ΙΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝ»                 ";
    PRINT "                    Ί  π  S h r i n k   P r o g r a m  π  Ί                 ";
    PRINT "                    ΘΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΌ                 ";
    LOCATE 2, 24: COLOR 14, 1: PRINT "π"
    LOCATE 2, 56: COLOR 14, 1: PRINT "π"
    LOCATE 2, 27: COLOR 11, 1: PRINT "S h r i n k   P r o g r a m"
    COLOR 15, 1
    PRINT
    PRINT "    ΪΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΏ";
    PRINT "    ³  Shrink is a utility designed to shrink the horizontal lines of an   ³";
    PRINT "    ³  ASCII text files to a shorter length. Please give below the name of ³";
    PRINT "    ³  the file to revise, the name of the new file, the left margin and   ³";
    PRINT "    ³  the right margin.  You may have a left margin from 1 to 20 and a    ³";
    PRINT "    ³  right margin from 40 to 80.  The extreme left and right margins are ³";
    PRINT "    ³  1 and 80. The Shrink Program is Public Domain FreeWare by Don Smith.³";
    PRINT "    ³  Today's date is 06/10/2002.  EMail: smithdonb@earthlink.net.        ³";
    PRINT "    ΖΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝ΅";
    PRINT "    ³                                                                      ³";
    PRINT "    ³        1. What is the name of the file to revise:                    ³";
    PRINT "    ³                                                                      ³";
    PRINT "    ³        2. What is the name of the new file:                          ³";
    PRINT "    ³                                                                      ³";
    PRINT "    ³        3. What is the left margin of new file (1-20):                ³";
    PRINT "    ³                                                                      ³";
    PRINT "    ³        4. What is the right margin of new file (40-80):              ³";
    PRINT "    ³                                                                      ³";
    PRINT "    ³                                                                      ³";
    PRINT "    ΖΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝ΅";
    PRINT "    ³                   Press <Esc> At Any Time To Exit                    ³";
    LOCATE 25, 1:
    PRINT "    ΐΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΩ";
    LOCATE 24, 32: COLOR 11, 1: PRINT "Esc";
    COLOR 14, 1
    LOCATE 14, 56: PRINT STRING$(20, " ")
    LOCATE 16, 50: PRINT STRING$(26, " ")
    LOCATE 18, 60: PRINT STRING$(16, " ")
    LOCATE 20, 62: PRINT STRING$(14, " ")
    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              |
    '+-------------+-------------------------------------------------------+
    '| Shadow%     | If Shadow% equals 0, there will be no shadow .        |
    '|             | If Shadow% equals 1, there will be a right shadow.    |
    '|             | If Shadow% equals 2, there will be a left shadow      |
    '|             +-------------------------------------------------------+
    '|             | NOTE #1:                                              |
    '|             | -------                                               |
    '|             | When a shadow is used, the underlying text will       |
    '|             | be saved and printed with COLOR 8, 0 (very dim).      |              |
    '|             | This causes the shadow to look like a real shadow.    |
    '|             |                                                       |
    '|             | NOTE #2:                                              |
    '|             | -------                                               |
    '|             | If the first four values of BoxBoy are 1, 1, 25, 89,  |
    '|             | in other words a full screen, please set Shadow% = 0  |
    '|             | otherwise an error will result (no room for shadow).  |
    '+-------------+-------------------------------------------------------+
    '| ShadeColr%  |  The foreground color of the shadow.   Usually        |
    '|             |  this color is 8 or 7 (Normally 8).                   |      |
    '+-------------+-------------------------------------------------------+
    '| ClearColr%  |  What color (0-7) to clear screen before making box.  |
    '|             |  To disable this feature, use ClearColr% = 1000       |
    '|             |                                                       |
    '|             |                   COLOR VALUES:                       |
    '|             |         ----------------------------------            |
    '|             |         0 is black         4 is red                   |
    '|             |         1 is blue          5 is purple                |
    '|             |         2 is green         6 is orange                |
    '|             |         3 is light blue    7 is light white           |
    '|             |                                                       |
    '+-------------+-------------------------------------------------------+
   
    IF ClearColr% <> 1000 THEN
        COLOR , ClearColr%: CLS
    END IF

    IF ULCol% <= 1 THEN
       ULCol% = 1
    END IF
    IF LRCol% = 80 THEN
       LRCol% = 77
    END IF
    
make.box:
    IF BoxStyle% = 1 THEN           'Single Line
        ULCorner$ = CHR$(218)
        URCorner$ = CHR$(191)
        HorLine$ = CHR$(196)
        LeftSide$ = CHR$(195)
        RightSide$ = CHR$(180)
        VertLine$ = CHR$(179)
        LLCorner$ = CHR$(192)
        LRCorner$ = CHR$(217)
    ELSEIF BoxStyle% = 2 THEN      'Double Line
        ULCorner$ = CHR$(201)
        URCorner$ = CHR$(187)
        HorLine$ = CHR$(205)
        LeftSide$ = CHR$(199)
        RightSide$ = CHR$(182)
        VertLine$ = CHR$(186)
        LLCorner$ = CHR$(200)
        LRCorner$ = CHR$(188)
    END IF
   
    IF Shadow% = 1 THEN
        REDIM ReadLine$(25)
        FOR ViewIt% = ULRow% + 1 TO LRRow% + 1
            FOR Horizon% = ULCol% + 2 TO LRCol% + 5
                ReadLine$(ViewIt%) = ReadLine$(ViewIt%) + CHR$(SCREEN(ViewIt%, Horizon%))
            NEXT
        NEXT
        COLOR ShadowColr%, 0
        FOR Scratch% = ULRow% + 1 TO LRRow% + 1
            LOCATE Scratch%, ULCol% + 2
            PRINT ReadLine$(Scratch%);
        NEXT
    ELSEIF Shadow% = 2 THEN
        REDIM ReadLine$(25)
        FOR ViewIt% = ULRow% + 1 TO LRRow% + 1
            FOR Horizon% = ULCol% - 2 TO LRCol% + 1
                ReadLine$(ViewIt%) = ReadLine$(ViewIt%) + CHR$(SCREEN(ViewIt%, Horizon%))
            NEXT
        NEXT
        COLOR ShadowColr%, 0
        FOR Scratch% = ULRow% + 1 TO LRRow% + 1
            LOCATE Scratch%, ULCol% - 2
            PRINT ReadLine$(Scratch%);
        NEXT
    END IF

    Title.Length% = LEN(Title$)
    COLOR BoxColrFor%, BoxColrBak%
    'ΪΔΔΔΏ   or  ΙΝΝΝ»
    LOCATE ULRow%, ULCol%
    PRINT " " + ULCorner$ + STRING$(LRCol% - ULCol%, HorLine$) + URCorner$ + " ";

    '³   ³   or  Ί   Ί
    LOCATE ULRow% + 1, ULCol%
    PRINT " " + VertLine$ + SPACE$(LRCol% - ULCol%) + VertLine$ + " ";
   
    IF Title$ <> "" THEN
        'ΓΔΔΔ΄   or  ΗΔΔΔΆ         'made cross bar if there is a title
        LOCATE ULRow% + 2, ULCol%
        PRINT " " + LeftSide$ + STRING$(LRCol% - ULCol%, 196) + RightSide$ + " ";
    ELSEIF Title$ = "" THEN
        LOCATE ULRow% + 2, ULCol%
        PRINT " " + VertLine$ + SPACE$(LRCol% - ULCol%) + VertLine$ + " ";
    END IF
   
    '³   ³   or  Ί   Ί
    FOR Print.Box% = 1 TO (LRRow% - ULRow%) - 3
        LOCATE ULRow% + Print.Box% + 2, ULCol%
        PRINT " " + VertLine$ + SPACE$(LRCol% - ULCol%) + VertLine$ + " ";
    NEXT

    'ΐΔΔΔΩ  or  ΘΝΝΝΌ
    LOCATE LRRow%, ULCol%, 0
    PRINT " " + LLCorner$ + STRING$(LRCol% - ULCol%, HorLine$) + LRCorner$ + " ";
    IF Title$ <> "" THEN
        LOCATE TitleRow%, TitleCol%
        COLOR TitColrFor%, TitColrBak%
        PRINT Title$;
    END IF

END SUB

SUB EditLoco (EdW$, Row%, Col%, FCol%, LenStr%, See%, TypeOfText$, Caps%, FGColr%, BGColr%, FKey$, ExitCode%) STATIC

    ' +---------------------------------------------------------------------+
    ' |  Explanation of SUB EditLoco:                                       |
    ' +--------------+------------------------------------------------------+
    ' |  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%     |  Foreground color of text                            |
    ' +--------------+------------------------------------------------------+
    ' |  BGColr%     |  Back ground color of text                           |
    ' +--------------+------------------------------------------------------+
    ' |  FKey$       |  What F keys to enable.  To enabled F keys 1,        |
    ' |              |  5 and 10, FKey$ = "150" ("0" is F10).               |
    ' +--------------+------------------------------------------------------+
    ' |  ExitCode%   |   1 is F1 key                                        |
    ' |  ExitCode%   |   2 is F2 key                                        |
    ' |  ExitCode%   |   3 is F3 key                                        |
    ' |  ExitCode%   |   4 is F4 key                                        |
    ' |  ExitCode%   |   5 is F5 key                                        |
    ' |  ExitCode%   |   6 is F6 key                                        |
    ' |  ExitCode%   |   7 is F7 key                                        |
    ' |  ExitCode%   |   8 is F8 key                                        |
    ' |  ExitCode%   |   9 is F9 key                                        |
    ' |  ExitCode%   |  10 is F10 key                                       |
    ' |  ExitCode%   |  13 is ENTER key                                     |
    ' |  ExitCode%   |  14 is Right Arrow ->                                |
    ' |  ExitCode%   |  15 is Left Arrow <-                                 |
    ' |  ExitCode%   |  16 is Up Arrow                                      |
    ' |  ExitCode%   |  17 is Down Arrow                                    |
    ' |  ExitCode%   |  18 is TAB key                                       |
    ' |  ExitCode%   |  27 is EXIT key                                      |
    ' +--------------+------------------------------------------------------+
    ' |  Please include at the top of the routine DEFINT A-Z                |
    ' +---------------------------------------------------------------------+
    IF See% = 1 THEN
        LOCATE Row%, Col%: COLOR FGColr%, BGColr%: PRINT STRING$(LenStr%, " ");
    END IF

begin.edit.line:
    DO
        LOCATE Row%, Col%, 1, 6, 7
        DO
            EdW$ = INKEY$
        LOOP UNTIL LEN(EdW$) > 0
        SlamKey% = CVI(EdW$ + CHR$(0))
        '
        IF SlamKey% > 31 AND SlamKey% < 256 THEN   'chr$(32) to chr$255)
            IF TypeOfText$ = "" THEN
                GOSUB show.char
            ELSEIF TypeOfText$ <> "" THEN
                IF INSTR(TypeOfText$, EdW$) > 0 THEN
                    GOSUB show.char
                END IF
            END IF
         ELSEIF SlamKey% = 27 THEN                 'Esc Key
             ExitCode% = 27
             GOSUB get.string
             GOTO leave.sub
         ELSEIF SlamKey% = 19712 THEN              'Right Arrow
             Col% = Col% + 1
             IF Col% > FCol% + LenStr% - 1 THEN
                 'GOSUB get.string
                 'ExitCode% = 14
                 'GOTO leave.sub
                 Col% = FCol%
             ELSE
                 LOCATE Row%, Col%, 1, 6, 7
             END IF
         ELSEIF SlamKey% = 19200 THEN               'Left Arrow
             Col% = Col% - 1
             IF Col% = FCol% - 1 OR Col% < FCol% THEN
                 'GOSUB get.string
                 'ExitCode% = 15
                 'GOTO leave.sub
                 Col% = FCol% + LenStr%
             END IF
         ELSEIF SlamKey% = 18432 THEN                'Up Arrow
             GOSUB get.string
             ExitCode% = 16
             GOTO leave.sub
         ELSEIF SlamKey% = 20480 THEN                'Down Arrow
             GOSUB get.string:
             ExitCode% = 17
             GOTO leave.sub
         ELSEIF SlamKey% = 13 THEN                   'Enter
             GOSUB get.string
             ExitCode% = 13
             GOTO leave.sub
         ELSEIF SlamKey% = 9 THEN                    'Tab
             GOSUB get.string
             ExitCode% = 18
             GOTO leave.sub
         ELSEIF SlamKey% = 8 THEN                    'Back Space
             Col% = Col% - 1
             IF Col% = FCol% OR Col% < FCol% THEN
                 Col% = FCol%
             END IF
             LOCATE Row%, Col%: COLOR FGColr%, BGColr%
             PRINT " ";
         ELSEIF SlamKey% = 32 THEN                   'Space Bar
             IF Col% = FCol% + LenStr% THEN
                 LOCATE Row%, FCo4l%
                 Col% = FCol%
             END IF
             LOCATE Row%, Col%: COLOR FGColr%, BGColr%
             PRINT " "
             Col% = Col% + 1
         ELSEIF SlamKey% = 21248 THEN                'Delete Key
             LenToSave = ((FCol% + LenStr%) - Col%) - 1
             SaveScr$ = SPACE$(LenToSave)
             'CALL ReadScrn0(Row%, Col% + 1, SaveScr$)
             LOCATE Row%, Col%
             SaveScr$ = SaveScr$ + CHR$(SCREEN(Col% + 1, 1))
             LOCATE Row%, Col%: COLOR FGColr%, BGColr%
             PRINT SaveScr$ + " "
         ELSEIF SlamKey% = 18176 THEN               'Home Key
             Col% = FCol%
             LOCATE Row%, Col%, 1, 6, 7
         ELSEIF SlamKey% = 20224 THEN               'End Key
             GOSUB get.string
             Col% = FCol% + LEN(EdW$)
             LOCATE Row%, Col%, 1, 6, 7
         ELSEIF SlamKey% = 25 THEN                  'Ctrl-Y
             LOCATE Row%, FCol%
             WipeOut$ = SPACE$(LenStr%)
             COLOR FGColr%, BGColr%
             PRINT WipeOut$
         ELSEIF SlamKey% > 15103 OR SlamKey% < 17409 THEN         'F1 - F10
             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% = 10
                     GOTO leave.sub
                 ELSE
                     ExitCode% = VAL(IdentKey$)
                     GOTO leave.sub
                 END IF
             END IF
         END IF
     LOOP
show.char:
    LOCATE Row%, Col%
    IF Caps% > 0 THEN
        COLOR FGColr%, BGColr%: PRINT UCASE$(EdW$);
    ELSEIF Caps% = 0 THEN
        COLOR FGColr%, BGColr%: PRINT EdW$;
    END IF
    Col% = Col% + 1
    IF Col% = FCol% + LenStr% THEN
        Col% = FCol%
        RETURN
    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
leave.sub:

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  |
    '+----------------------------------------------------------------------+

    '+----------------------------------------------------------------------+
    '|                    PROGRAM SETS NUMBERS 1 AND 2 ->                   |
    '+------------------+---------------------------------------------------+
    '| (1) ReadLine$()  |   Program self reads data at each Row and Column  |
    '+------------------+---------------------------------------------------+
    '| (2) ReadColr%()  |   Program self reads color at each Row and Column |
    '+------------------+---------------------------------------------------+

    '+----------------------------------------------------------------------+
    '|            THE PROGRAMMER MUST SET NUMBERS 3 TO 9 ->                 |
    '+----------------------------------------------------------------------+
    '|       (Note: The "SR" below means "Save" Or "Restore")               |
    '+------------------+---------------------------------------------------+
    '| (3) SR.UL.Row%   |   Screen to save or restore at upper left row.    |
    '| (4) SR.UL.Col%   |   Screen to save or restore at upper left column. |
    '| (5) SR.LR.Row%   |   Screen to save or restore at lower right row.   |
    '| (6) SR.LR.Col%   |   Screen to save or restore at lower right column.|
    '|                  +---------------------------------------------------+
    '|                  |   SPECIAL CAUTION:                                |
    '|                  |   ---------------                                 |
    '|                  |   When you call the SUB to restore the underlying |
    '|                  |   screen, use MUST use the same row and column    |
    '|                  |   numbers as you used when you first called the   |
    '|                  |   SUB to save the screen.                         |
    '+------------------+---------------------------------------------------+
    '| (7) SaveOrRest%  |   SaveOrRest% = 1 (1 means save the screen)       |
    '|                  |   SaveOrRest% = 2 (2 means restore the screen)    |
    '+------------------+----------+----------------------------------------+
    '| (8) REDIM ReadLine$(25)     | The REDIM for ReadLine$ and ReadColr%  |
    '|     REDIM ReadColr%(25, 80) | must be placed in the main program     |
    '|                             | before calling the SUB.  The 25 and 80 |
    '|                             | reflects a screen of 25 lines and 80   |
    '|                             | columns.  You may use smaller amounts  |
    '|                             | of memory if you do not need all 25    |
    '|                             | lines and 80 columns.                  |
    '+-----------------------------+----------------------------------------+
    '| (9) ERASE ReadLine$         | Reclaim memory after calling the SUB   |
    '|     ERASE ReadColr%         | to restore the screen.  Use REDIM and  |
    '|                             | ERASE in main program please!          |
    '+-----------------------------+----------------------------------------+

    IF SR.LR.Col% > 80 THEN
          SR.LR.Col% = 80
    END IF
    IF SR.LR.Row% > 25 THEN
          SR.LR.Row% = 25
    END IF

    IF SaveOrRest% = 1 THEN
          GOSUB save.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
              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