' +----------------------------------------------------------------------+
    ' |                                                                      |
    ' |                     - R e a l o a n . 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.                                    |
    ' +----------------------------------------------------------------------+
    ' +----------------------------------------------------------------------+
    ' | Real Loan Program.    A one-screen program designed to provide a     |
    ' | a quick and easy access to the loan information most sought after    |
    ' | by realtors.     Written by Don Smith On April 1, 1993 and released  |
    ' | to the Public Domain on the same date.  Up date written on:04/01/96. |
    ' | The author may by reached EMail: smithdonb@earthlink.net             |
    ' +----------------------------------------------------------------------+
    ' |                                                                      |
    ' | Compile:                                                             |
    ' |                                                                      |
    ' | BC: realoan                                                          |
    ' |                                                                      |
    ' | LINK:  Link @reallink.txt (see next)                                 |
    ' |          +--------------------------------------------------------+  |
    ' |          |the contents of reallink.txt are:                       |  |
    ' |          +--------------------------------------------------------+  |
    ' |          |  realoan+                                              |  |
    ' |          |  realer+                                               |  |
    ' |          |  realerm+                                              |  |
    ' |          |  rloani1+                                              |  |
    ' |          |  rloadi2 /noe                                          |  |
    ' |          +--------------------------------------------------------+  |
    ' |          |realoan.bas.....is the main program                     |  |
    ' |          |realer.obj......is the opening screen or gui            |  |
    ' |          |realerm.obj.....is the opening screen for monochrome    |  |
    ' |          |rloani1.obj.....is the first info page                  |  |
    ' |          |rloani2.obj.....is the secont info page                 |  |
    ' |          +--------------------------------------------------------+  |
    ' |                                                                      |
    ' | LIB: bcom45 pro                                                      |
    ' +----------------------------------------------------------------------+


    DEFINT A-Z
    '-------------------------------
    DECLARE FUNCTION FUsing$ (number$, Image$)
    DECLARE FUNCTION KeyCode% ()
    DECLARE FUNCTION Peek1% (Segment, Address)
    DECLARE FUNCTION PrinterReady% (LPTNo)
    DECLARE FUNCTION Power (y, n)
    DECLARE FUNCTION PRNReady% (LPTNo)
    DECLARE FUNCTION QPLeft$ (Work$, NumChar%)
    DECLARE FUNCTION QPLen% (Work$)
    DECLARE FUNCTION QPMid$ (Work$, StartChar%, NumChars%)
    DECLARE FUNCTION QPRight$ (Work$, NumChar%)
    DECLARE FUNCTION QPTrim$ (Work$)
    DECLARE FUNCTION QPValI% (Work$)
    DECLARE FUNCTION QPValL& (Work$)
    '-------------------------------
    DECLARE SUB BLPrint (LPTNo%, X$, ErrCount%)
    DECLARE SUB EditString (EditS$, Row%, Col%, FCol%, LenStr%, See%, TypeOfText$, Caps%, Colr%, FKey$, LetterKey$, ExitCode%)
    DECLARE SUB Poke1 (Segment, Address, Value)
    DECLARE SUB Realer (MonoCode%)
    DECLARE SUB RealerM2 (MonoCode%)
    DECLARE SUB RLoanI1 (MonoCode%)
    DECLARE SUB RLoanI2 (MonoCode%)
    '------------------------------
    ComLine$ = COMMAND$
    ComLine$ = QPTrim$(ComLine$)
    IF ComLine$ = "" THEN
        PrintPort$ = "1"
        ColorVal% = 1
        GOTO importgui
    ELSEIF ComLine$ = "h" OR ComLine$ = "H" OR ComLine$ = "?" THEN
        GOSUB information
        CLS : END
    ELSEIF QPLeft$(ComLine$, 1) = "/" THEN
        FOR FindSlash% = 1 TO QPLen%(ComLine$)
            Slash$ = QPMid$(ComLine$, FindSlash%, 1)
            IF Slash$ = "/" THEN
                WhatComLine$ = QPRight$(ComLine$, QPLen%(ComLine$) - FindSlash%)
                WhatComLine$ = QPTrim$(WhatComLine$)
                WhatComLine$ = QPLeft$(WhatComLine$, 1)
                WhatComLine$ = QPTrim$(WhatComLine$)
                CALL Upper(WhatComLine$)
                IF WhatComLine$ = "?" OR WhatComLine$ = "H" OR WhatComLine$ = "h" THEN
                    GOSUB information
                    CLS : END
                ELSEIF WhatComLine$ = "M" OR WhatComLine$ = "m" THEN
                    ColorVal% = 2
                ELSEIF QPValI%(WhatComLine$) = 0 OR QPValI%(WhatComLine$) > 3 THEN
                    PRINT "***Error***  Unable to understand the command line."
                    PRINT "             Use /? or /H to reach the help screen."
                    END
                ELSEIF QPValI%(WhatComLine$) > 1 OR QPValI%(WhatComLine$) < 4 THEN
                    PrintPort$ = WhatComLine$
                END IF
            END IF
        NEXT
    ELSE
        PRINT "***Error***   Unable to understand the command line."
        PRINT "              Use /? or /H to reach the help screen."
        END
    END IF
    IF ColorVal% <> 2 THEN ColorVal% = 1
    IF PrintPort$ = "" THEN PrintPort$ = "1"
importgui:
    ScanCode% = 1
    LOCATE 1, 1, 0, 0, 0
    IF ColorVal% = 1 THEN
        MonoCode% = 0
        CALL Realer(MonoCode%)
        'BLOAD "Realer.Bsv"
    ELSEIF ColorVal% = 2 THEN
        MonoCode% = 0
        CALL RealerM2(MonoCode%)
        'BLOAD "RealerM2.Bsv"
    END IF
    LOCATE 19, 69
    IF ColorVal% = 1 THEN
        CALL MQPrint(": LPT" + PrintPort$, 62)
    ELSEIF ColorVal% = 2 THEN
        CALL MQPrint(": LPT" + PrintPort$, 15)
    END IF
    ' +--------------------------------------------------------------------+
    ' |  INPUT VALUES=> P = AMOUNT OF LOAN; R=YEARLY % ; L= NO. OF MONTHS  |
    ' +--------------------------------------------------------------------+
begin:
     'CLEAR
     DIM TheNum AS DOUBLE
     DIM P AS DOUBLE
     DIM Rate AS DOUBLE
     DIM L AS DOUBLE
     DIM M AS DOUBLE
     DIM I AS DOUBLE
     '--------------------------------
first.input:
     Row% = 13: Col% = 8: FCol% = 8: LenStr% = 13: InputNum = 1
     GOSUB input.amount
     P = TheNum
     '--------------------------------
second.input:
     Row% = 13: Col% = 37: FCol% = 37: LenStr% = 8: InputNum = 2
     GOSUB input.amount
     Rate = TheNum
     '--------------------------------
third.input:
     Row% = 13: Col% = 63: FCol% = 63: LenStr% = 6: InputNum = 3
     GOSUB input.amount
     L = TheNum
     '--------------------------------
     I = Rate / 1200
     M = 1 - 1 / (1 + I) ^ L
     M = M / I
     M = P / M
     Image$ = "#############################,.##"
     EntireAmt$ = FUsing$(STR$(M), Image$)
     PrintAmt$ = LTRIM$(RTRIM$(EntireAmt$))
     LenAmt% = QPLen%(PrintAmt$)
     AmtColumn = 39 - (LenAmt% \ 2)
     DollarColumn = AmtColumn - 2
     IF ColorVal% = 1 THEN
         AmtColr% = 79
     ELSEIF ColorVal% = 2 THEN
         AmtColr% = 112
     END IF
     IF LenAmt% > 22 THEN
         LongAmt = 1
         LOCATE 19, 17: CALL MQPrint(STRING$(25, " "), AmtColr%)
         LOCATE 18, 24: CALL MQPrint(CHR$(205), AmtColr%)
         LOCATE 19, 24: CALL MQPrint(CHR$(255), AmtColr%)
         LOCATE 20, 24: CALL MQPrint(CHR$(205), AmtColr%)
         LOCATE 18, 16: CALL MQPrint(CHR$(203), AmtColr%)
         LOCATE 19, 16: CALL MQPrint(CHR$(186), AmtColr%)
         LOCATE 20, 16: CALL MQPrint(CHR$(202), AmtColr%)
         LOCATE 19, 35 - (LenAmt% \ 2): CALL MQPrint(PrintAmt$, AmtColr%)
         LOCATE 19, 35 - (LenAmt% \ 2) - 2, 0: CALL MQPrint("$", AmtColr%)
     ELSE
         LOCATE 19, AmtColumn: CALL MQPrint(PrintAmt$, AmtColr%)
         LOCATE 19, DollarColumn, 0: CALL MQPrint("$", AmtColr%)
     END IF
waitingloop:
     DO
         DO
             HitKey$ = INKEY$
         LOOP UNTIL HitKey$ <> ""
         '
         KeyC% = CVI(HitKey$ + CHR$(0))
         '
         IF KeyC% = 72 OR KeyC% = 104 THEN        ' H,h - Information
                 GOSUB save.screen
                 GOSUB information
                 GOSUB restore.screen
         ELSEIF KeyC% = 80 OR KeyC% = 112 THEN    ' P,p - Print
                 GOTO Printout
         ELSEIF KeyC% = 68 OR KeyC% = 100 THEN    ' D,d - Do Another
                 GOSUB cleanupscreen
                 GOTO first.input
         ELSEIF KeyC% = 88 OR KeyC% = 120 THEN    ' X,x - Exit
                 GOTO leaveprogram
         ELSEIF KeyC% = 27 THEN
                 GOTO leaveprogram   ' Exit
         ELSE
                 GOTO waitingloop
         END IF
     LOOP
input.num.1:
    GOSUB get.info.window
    Input1.1$ = "Enter the dollar amount of the loan."
    Input1.2$ = "Do not use commas or a dollar sign."
    LOCATE 12, 22: CALL MQPrint(Input1.1$, HelpColr%)
    LOCATE 13, 22: CALL MQPrint(Input1.2$, HelpColr%)
    GOSUB go.info
    RETURN
input.num.2:
    GOSUB get.info.window
    Input2.1$ = "Give the interest rate of the loan. "
    Input2.2$ = "Eventhough the lowest useful rate is"
    Input2.3$ = ".01%, lower amounts may be entered. "
    LOCATE 11, 22: CALL MQPrint(Input2.1$, HelpColr%)
    LOCATE 12, 22: CALL MQPrint(Input2.2$, HelpColr%)
    LOCATE 13, 22: CALL MQPrint(Input2.3$, HelpColr%)
    GOSUB go.info
    RETURN
input.num.3:
    GOSUB get.info.window
    Input3.1$ = "Indicate the number of months of the"
    Input3.2$ = "loan.   Multipy the number of years"
    Input3.3$ = "by twelve."
    LOCATE 11, 22: CALL MQPrint(Input3.1$, HelpColr%)
    LOCATE 12, 22: CALL MQPrint(Input3.2$, HelpColr%)
    LOCATE 13, 22: CALL MQPrint(Input3.3$, HelpColr%)
    GOSUB go.info
    RETURN
get.info.window:
    Bottom1$ = "To return to the main screen, Press <Esc>. To access"
    Bottom2$ = "the Program Information window, Press <Enter>."
    CALL PaintBox0(9, 13, 19, 71, 8)
    CALL ClearScr0(9, 12, 17, 68, 119)
    CALL Box0(8, 11, 18, 69, 2, 112)
    Line$ = CHR$(199) + STRING$(57, 196) + CHR$(182)
    LOCATE 10, 11: CALL MQPrint(Line$, 112)
    LOCATE 15, 11: CALL MQPrint(Line$, 112)
    LOCATE 9, 22: CALL MQPrint("-  H  E  L  P     W  I  N  D  O  W  -", 112)
    LOCATE 16, 15: CALL MQPrint(Bottom1$, 112)
    LOCATE 17, 15, 0, 0, 0: CALL MQPrint(Bottom2$, 112)
    RETURN
go.info:
    DO
        DO
            InFoKey$ = INKEY$
        LOOP UNTIL InFoKey$ <> ""
        InFoKey% = CVI(InFoKey$ + CHR$(0))
        IF InFoKey% = 13 THEN
            GOSUB information
            RETURN
        ELSEIF InFoKey% = 27 THEN
            RETURN
        END IF
    LOOP
cleanupscreen:
     IF ColorVal% = 1 THEN
         CleanColr1% = 112
         CleanColr2% = 79
     ELSEIF ColorVal% = 2 THEN
         CleanColr1% = 112
         CleanColr2% = 112
     END IF
     'Cannot use the following 3 lines to clear because the line
     'retains the background characteristic
         'LOCATE 13, 7: CALL MQPrint(STRING$(15, 255), CleanColr1%)
         'LOCATE 13, 33: CALL MQPrint(STRING$(14, 255), CleanColr1%)
         'LOCATE 13, 58: CALL MQPrint(STRING$(16, 255), CleanColr1%)
     CALL ClearScr0(13, 7, 13, 22, 112)
     CALL ClearScr0(13, 33, 13, 47, 112)
     CALL ClearScr0(13, 58, 13, 74, 112)

     IF LongAmt = 1 THEN
         LOCATE 19, 17: CALL MQPrint(STRING$(34, " "), CleanColr2%)
         LOCATE 18, 16: CALL MQPrint(CHR$(205), CleanColr2%)
         LOCATE 19, 16: CALL MQPrint(CHR$(255), CleanColr2%)
         LOCATE 20, 16: CALL MQPrint(CHR$(205), CleanColr2%)
         LOCATE 18, 24: CALL MQPrint(CHR$(203), CleanColr2%)
         LOCATE 19, 24: CALL MQPrint(CHR$(186), CleanColr2%)
         LOCATE 20, 24: CALL MQPrint(CHR$(202), CleanColr2%)
         LOCATE 19, 16: CALL MQPrint("PAYMENT", CleanColr2%)
     ELSEIF LongAmt = 0 THEN
         LOCATE 19, 25
         CALL MQPrint(STRING$(26, 255), CleanColr2%)
     END IF
     P = 0: R = 0: L = 0: M = 0: I = 0: LongAmt = 0
     RETURN
input.amount:
    Dot = 0
    TheNum = 0
    TypeOfText$ = ".1234567890"
    LetterKey$ = "HhPpDdXx"
    Colr% = 112
    DO
        CALL EditString(EditS$, Row%, Col%, FCol%, LenStr%, See%, TypeOfText$, Caps%, Colr%, FKey$, LetterKey$, ExitCode%)
        IF ExitCode% = 27 THEN
            GOTO leaveprogram
        'Enter, Tab and Down Keys
        ELSEIF ExitCode% = 13 OR ExitCode% = 18 OR ExitCode% = 17 THEN
            EditNum$ = EditS$
            EditS$ = ""
            FOR FindDots = 1 TO QPLen%(EditNum$)
                Dot$ = QPMid$(EditNum$, FindDots, 1)
                IF Dot$ = "." THEN
                    Dot = Dot + 1
                    IF Dot = 2 THEN
                        Message = 1
                        GOSUB no.zero.nor.2decimals
                        Dot = 0
                        GOTO input.amount
                    END IF
                ELSEIF Dot$ = " " THEN
                    Message = 3
                    GOSUB no.zero.nor.2decimals
                    Dot = 0
                    GOTO input.amount
                END IF
            NEXT
            'TheNum is the number value reported by EditNum.bas
            TheNum = VAL(EditNum$)
            IF TheNum = 0 THEN
                Message = 2
                Dot = 0
                GOSUB no.zero.nor.2decimals
            ELSE
                RETURN
            END IF
        ELSEIF ExitCode% = 72 OR ExitCode = 104 THEN             'H,h
            GOSUB save.screen
            IF ColorVal% = 1 THEN
                HelpColr% = 113
            ELSEIF ColorVal% = 2 THEN
                HelpColr% = 112
            END IF
            IF InputNum = 1 THEN
                GOSUB input.num.1
            ELSEIF InputNum = 2 THEN
                GOSUB input.num.2
            ELSEIF InputNum = 3 THEN
                GOSUB input.num.3
            END IF
            GOSUB restore.screen
        ELSEIF ExitCode% = 80 OR ExitCode% = 112 THEN            'P,p
            NoMess1$ = "PRINT"
            GOSUB no.provide
        ELSEIF ExitCode% = 68 OR ExitCode% = 100 THEN            'D,d
            NoMess1$ = "DO ANOTHER"
            GOSUB no.provide
        ELSEIF ExitCode% = 88 OR ExitCode% = 120 THEN            'X,x
            GOTO leaveprogram
        ELSEIF ExitCode% = 16 THEN
            IF InputNum = 2 THEN
                GOTO first.input
            ELSEIF InputNum = 3 THEN
                GOTO second.input
            END IF
        END IF
    LOOP
leaveprogram:
     COLOR 7, 0: CLS : SYSTEM: END
Printout:
     LoanAmount$ = FUsing$(STR$(P), Image$)
     LoanAmount$ = RTRIM$(LTRIM$(LoanAmount$))
     IntRate$ = RTRIM$(LTRIM$(STR$(Rate)))
     NumMonths$ = RTRIM$(LTRIM$(STR$(L)))
     REDIM Pr$(35)
     Pr$(1) = STRING$(40, 255)
     Pr$(2) = STRING$(40, 255)
     Pr$(3) = STRING$(40, 255)
     Pr$(4) = "                                                                        "
     Pr$(5) = "                                                                        "
     Pr$(6) = "        ****************************************************************"
     Pr$(7) = "        *                                                              *"
     Pr$(8) = "        *       R  E  A  L     L  O  A  N     P  R  O  G  R  A  M      *"
     Pr$(9) = "        *      -----------------------------------------------------   *"
     Pr$(10) = "        *      04/01/96  DON SMITH  -  EMail:smithdonb@earthlink.net   *"
     Pr$(11) = "        *                     Public Domain FreeWare                   *"
     Pr$(12) = "        ****************************************************************"
     Pr$(13) = "                                                                        "
     Pr$(14) = "                                                "
     Pr$(15) = "             A M O U N T   O F   L O A N ----->    " + "$ " + LoanAmount$
     Pr$(16) = "                                                "
     Pr$(17) = "                                                                        "
     Pr$(18) = "                                                "
     Pr$(19) = "             I N T E R E S T   R A T E  ------>    " + IntRate$ + " % YEARLY"
     Pr$(20) = "                                                "
     Pr$(21) = "                                                                        "
     Pr$(22) = "                                                "
     IF QPValI%(NumMonths$) > 1 THEN
         MonthAmt$ = "MONTHS"
     ELSE
         MonthAmt$ = "MONTH"
     END IF
     Pr$(23) = "             N U M B E R   O F   M O N T H S ->    " + NumMonths$ + " " + MonthAmt$
     Pr$(24) = "                                                "
     Pr$(25) = "        ================================================================"
     Pr$(26) = "         "
     IF QPLen%(PrintAmt$) > 16 THEN
         Pr$(27) = "             M O N T H L Y  ===>  " + "$ " + PrintAmt$
     ELSE
         Pr$(27) = "             M O N T H L Y   P A Y M E N T ===>    " + "$ " + PrintAmt$
     END IF
     Pr$(28) = "         "
     Pr$(29) = "        ================================================================"
     Pr$(30) = STRING$(40, 255)
     Pr$(31) = STRING$(40, 255)
     Pr$(32) = STRING$(40, 255)
     Pr$(33) = STRING$(40, 255)
     Pr$(34) = CHR$(12)
     'STRING$(40, 255)
print.routine:
     LPTNo% = QPValI%(PrintPort$)
     Ready = PrinterReady%(LPTNo%)
     IF NOT Ready THEN
         GOTO errorscreen
     END IF
     FOR Printout = 1 TO 34
         Work$ = Pr$(Printout) + CHR$(13) + CHR$(10)    'add a CR/LF to the line
         CALL BLPrint(LPTNo%, Work$, Er%)
         IF Er% <> -1 THEN                 'anything but -1 means error
             GOTO errorscreen
         END IF
     NEXT
     GOTO waitingloop
errorscreen:
     GOSUB save.screen
     IF ColorVal% = 1 THEN
          PrnErrColr1% = 79
          PrnErrColr2% = 78
      ELSEIF ColorVal% = 2 THEN
          PrnErrColr1% = 80
          PrnErrColr2% = 80
     END IF
     CALL PaintBox0(7, 31, 18, 55, 8)
     LOCATE 6, 29: CALL MQPrint(" ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ» ", PrnErrColr1%)
     LOCATE 7, 29: CALL MQPrint(" º                     º ", PrnErrColr1%)
     LOCATE 7, 33: CALL MQPrint(" **** ERROR **** ", PrnErrColr2%)
     LOCATE 8, 29: CALL MQPrint(" ÌÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ͹ ", PrnErrColr1%)
     LOCATE 9, 29: CALL MQPrint(" º There is a possible º ", PrnErrColr1%)
     LOCATE 10, 29: CALL MQPrint(" º printer problem!    º ", PrnErrColr1%)
     LOCATE 11, 29: CALL MQPrint(" ÇÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄĶ ", PrnErrColr1%)
     LOCATE 12, 29: CALL MQPrint(" º Select ÄÄ          º ", PrnErrColr1%)
     LOCATE 13, 29: CALL MQPrint(" º ~~~~~~              º ", PrnErrColr1%)
     LOCATE 14, 29: CALL MQPrint(" º  <R> Retry Printing º ", PrnErrColr1%)
     LOCATE 15, 29: CALL MQPrint(" º  <X> Exit This      º ", PrnErrColr1%)
     LOCATE 16, 29: CALL MQPrint(" º      Screen         º ", PrnErrColr1%)
     LOCATE 17, 29, 0: CALL MQPrint(" ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ ", PrnErrColr1%)
     CALL Chime(6)
error.loop:
     DO
         DO
             PrintKey$ = INKEY$
         LOOP UNTIL PrintKey$ <> ""
         PrintKey% = CVI(PrintKey$ + CHR$(0))
         'R or r
         IF PrintKey% = 82 OR PrintKey% = 114 THEN
             Work$ = RIGHT$(Work$, LEN(Work$) - Er%)
             GOSUB restore.screen
             GOTO print.routine
         'X or x or <Esc>
         ELSEIF PrintKey% = 88 OR PrintKey% = 120 OR PrintKey% = 27 THEN
                 GOSUB restore.screen
                 GOTO waitingloop
         END IF
     LOOP
save.screen:
    REDIM ScrnArray%(6000)
    CALL ScrnSave0(1, 1, 25, 80, SEG ScrnArray%(1))
    RETURN
restore.screen:
    CALL ScrnRest0(1, 1, 25, 80, SEG ScrnArray%(1))
    RETURN
information:
    LOCATE 1, 1, 0, 0, 0
    MonoCode% = 0
    CALL RLoanI3(MonoCode%)
    'BLOAD "rloanI3.bsv"
    DO: LOOP WHILE INKEY$ = ""
    CALL RLoanI4(MonoCode%)
    'BLOAD "rloani4.bsv"
    DO: LOOP WHILE INKEY$ = ""
    RETURN
no.provide:
     GOSUB save.screen
     IF ColorVal% = 1 THEN
         NotAvailColr% = 47
     ELSEIF ColorVal% = 2 THEN
         NotAvailColr% = 32
     END IF
     CALL PaintBox0(12, 21, 18, 63, 8)
     CALL ClearScr0(11, 19, 17, 61, NotAvailColr%)
     CALL Box0(11, 20, 17, 60, 1, NotAvailColr%)
     NotLine$ = "ÃÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ´"
     NoMess2$ = "The " + NoMess1$ + " function"
     UnderL$ = STRING$(LEN(NoMess1$), "~")
     NoMess3$ = "is unavailable at the present time."
     NoMess4$ = "Press <Esc> To Continue"
     LOCATE 12, 31: CALL MQPrint(NoMess2$, NotAvailColr%)
     LOCATE 13, 35: CALL MQPrint(UnderL$, NotAvailColr%)
     LOCATE 14, 24: CALL MQPrint(NoMess3$, NotAvailColr%)
     LOCATE 15, 20: CALL MQPrint(NotLine$, NotAvailColr%)
     LOCATE 16, 30, 0: CALL MQPrint(NoMess4$, NotAvailColr%)
     CALL Chime(6)
     DO
         NoAvailKey$ = INKEY$
         IF NoAvailKey$ = CHR$(27) THEN
             LOCATE Row%, Col%, 1, 6, 7
             GOSUB restore.screen
             RETURN
         END IF
     LOOP
no.zero.nor.2decimals:
     IF Message = 1 THEN
         Dot = 0
         Message$ = "Please!  No more than one decimal."
     ELSEIF Message = 2 THEN
         Message$ = "Cannot input the value of zero (0)"
     ELSEIF Message = 3 THEN
         'COLOR 15, 1: CLS : COLOR 0, 7: PRINT EditNum$: END
         Message$ = "Unusable number - Try again!"
     END IF
     NoZero.1$ = " ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÒÄÄÄÄÄÄÄÄÄÄÄÄÄ¿ "
     NoZero.2$ = " ³                                       º Press <Esc> ³ "
     NoZero.3$ = " ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÐÄÄÄÄÄÄÄÄÄÄÄÄÄÙ "
     GOSUB save.screen
     CALL PaintBox0(16, 14, 18, 70, 8)
     IF ColorVal% = 1 THEN
         ErrorColr% = 47
     ELSEIF ColorVal% = 2 THEN
         ErrorColr% = 10
     END IF
     LOCATE 15, 12, 0: CALL MQPrint(NoZero.1$, ErrorColr%)
     LOCATE 16, 12, 0: CALL MQPrint(NoZero.2$, ErrorColr%)
     LOCATE 16, 16, 0: CALL MQPrint(Message$, ErrorColr%)
     LOCATE 17, 12, 0: CALL MQPrint(NoZero.3$, ErrorColr%)
     LOCATE 16, 62, 0: CALL MQPrint("Esc", ErrorColr%)
     CALL Chime(6)
     DO
         NoZeroKey$ = INKEY$
         IF NoZeroKey$ = CHR$(27) THEN
             LOCATE Row%, Col%, 1, 6, 7
             GOSUB restore.screen
             RETURN
         END IF
     LOOP

DEFSNG A-Z
SUB EditString (EditS$, Row%, Col%, FCol%, LenStr%, See%, TypeOfText$, Caps%, Colr%, FKey$, LetterKey$, ExitCode%) STATIC

    ' +---------------------------------------------------------------------+
    ' |  Explanation of SUB EditString :                                    |
    ' |  -----------------------------                                      |
    ' |  EditS$        =  The string to be edited.                            |
    ' |  Row%        =  The row to begin the editing.                       |
    ' |  Col%        =  The column to begin the editing.                    |
    ' |  FCol%       =  The column of very first character to               |
    ' |                 be edited.  Should be the same 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                   |
    ' |  Colr%       =  Color of text must be one number representing       |
    ' |                 both foreground and background.                     |
    ' |  FKey$       =  What F keys to enable.  To enabled F keys 1,        |
    ' |                 5 and 10, FKey$ = "150" ("0" is F10).               |
    ' |  LetterKey$   =  What just numbers are enabled, can choose letters   |
    ' |                 to be enabled.  Example "x" or "X" to exit.
    ' |  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 and PageUp                            |
    ' |  ExitCode%   = 17 is Down Arrow and PageDn                          |
    ' |  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%: CALL MQPrint(STRING$(LenStr%, " "), Colr%)
    END IF
    BkColr% = (Colr% AND 112) \ 16
    '
begin.edit.line:
    DO
        LOCATE Row%, Col%, 1, 6, 7
        DO
            EdW$ = INKEY$
        LOOP UNTIL LEN(EdW$) > 0
        SlamKey% = CVI(EdW$ + CHR$(0))
        '
        IF INSTR(LetterKey$, EdW$) > 0 THEN
            ExitCode% = SlamKey%
            GOTO leave.sub
        ELSEIF SlamKey% > 32 AND SlamKey% < 256 THEN   'chr$(33) 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   ' Use these lines
                 'ExitCode% = 14     ' to enable Right Arrow
                 'GOTO leave.sub     ' to go to next field
                 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          ' Use these lines
                 'ExitCode% = 15            ' to enable Left Arrow
                 'GOTO leave.sub            ' to go to previous field
                 Col% = FCol% + LenStr% - 1
             END IF
         ELSEIF SlamKey% = 18432 OR SlamKey% = 18688 THEN   'Up Arrow
             GOSUB get.string                               'PageUp
             ExitCode% = 16
             GOTO leave.sub
         ELSEIF SlamKey% = 20480 OR SlamKey% = 20736 THEN   'Down Arrow
             GOSUB get.string:                              'PageDn
             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%
             CALL MQPrint(" ", Colr%)
         ELSEIF SlamKey% = 32 THEN                   'Space Bar
             IF Col% = FCol% + LenStr% THEN
                 LOCATE Row%, FCo4l%
                 Col% = FCol%
             END IF
             LOCATE Row%, Col%
             CALL MQPrint(" ", Colr%)
             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%
             CALL MQPrint(SaveScr$ + " ", Colr%)
         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%)
             CALL MQPrint(WipeOut$, Colr%)
         ELSEIF SlamKey% > 1503 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
        CALL MQPrint(UCASE$(EdW$), Colr%)
    ELSEIF Caps% = 0 THEN
        CALL MQPrint(EdW$, Colr%)
    END IF
    Col% = Col% + 1
    IF Col% = FCol% + LenStr% THEN
        Col% = FCol%
        RETURN
    END IF
    RETURN
get.string:
    EditLine$ = SPACE$(LenStr%)
    CALL ReadScrn0(Row%, FCol%, EditLine$)
    EditLine$ = LTRIM$(RTRIM$(EditLine$))
    EditS$ = EditLine$
    EditLine$ = ""
    RETURN
leave.sub:

END SUB

FUNCTION KeyCode% STATIC
    DO
        k$ = INKEY$
    LOOP UNTIL k$ <> ""
    KeyCode% = CVI(k$ + CHR$(0))
END FUNCTION

DEFINT A-Z
FUNCTION PrinterReady% (LPTNo) STATIC
   RetryAddr = &H477 + LPTNo                    'Calculate BIOS Retry address
   SaveRetries = Peek1%(Zero, RetryAddr)        'Save the current setting
   CALL Poke1(Zero, RetryAddr, 1)               'Set to 1 retry, never use 0!
   PrinterReady% = PRNReady%(LPTNo)             'Check the printer
   CALL Poke1(Zero, RetryAddr, SaveRetries)     'Restore the original Retry
END FUNCTION