' +---------------------------------------------------------+ ' | | ' | WARNING WARNING WARNING | ' | ------- ------- ------- | ' | When you load this program into QuickBASIC 4.5, you must also | ' | load QuickBASIC's quick library. So, at the prompt enter: | ' | | ' | QB /L QB.QLB RLoanQB.Bas | ' | | ' +----------------------------------------------------------------------+ ' +----------------------------------------------------------------------+ ' | | ' | - R L o a n Q P. B a s - | ' | | ' | | ' | Public Domain - FreeWare | ' | | ' | - - - - - - - - - - - - - - - - - | ' | | ' | "RLoanQB" stands for Realoan program written for | ' | QuickBASIC without any supporting library other | ' | then the QB library which is part of QuickBasic. | ' | | ' +----------------------------------------------------------------------+ ' +----------------------------------------------------------------------+ ' | - 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. Also, you may substitute your | ' | name for mine at line #553. | ' +----------------------------------------------------------------------+ ' | - DISCLAIMER - | ' +----------------------------------------------------------------------+ ' | The author, Don Smith, accepts no liability for damages resulting | ' | from the use or misuse of RLoanQB.Bas and/or RLoanQB.Exe. There is | ' | no warrantee nor guarantee given to either program. In opening and | ' | using either program, the computer programmer and/or user accepts | ' | it in an "as is" condition and further accepts total responsibility | ' | for it and its use. | ' +----------------------------------------------------------------------+ ' | 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 via EMail: smithdonb@earthlink.net | ' +----------------------------------------------------------------------+ ' +----------------------------------------------------------------------+ ' | The six SUBs used in this program are all Public Domain, FreeWare. | ' | They do not need a special Library or Quick Library, just plain ol' | ' | QuickBASIC. Below is a brief description of each one. To find | ' | out more, visit each SUB and read the information at the top. | ' | | ' | (1) BoxBoy - All you need to make boxes or windows | ' | of various sizes, styles and shadows. | ' | (2) SaveRestScrn - This SUB will save and or | ' | restore a portion or all the current screen. | ' | (3) EditString is a one-line editor. | ' | (4) InterruptX must be used to enable SUBs 5 and 6 next. | ' | When using the QuickBASIC editor with this program | ' | please use: QB /L QB.QLB REALOAN.BAS | ' | (5) GetFileAttributes determines if a file exists or not. | ' | (6) WriteString - quickly writes a line of text directly | ' | to screen, bypassing QuickBASIC. | ' +----------------------------------------------------------------------+ ' +----------------------------------------------------------------------+ ' | Compile Info: | ' | ------------ | ' | | ' | BC: RLoanQB | ' | | ' | LINK: RLoanQB | ' | | ' | LIB: BCom45 QB | ' +----------------------------------------------------------------------+ tippy.top: '========================================================================= ' The next twelve lines set up: ' (1) SUB GetFileAttributes, (2) SUB InterruptX & (3) SUB WriteString '========================================================================= TYPE RegTypeX ax AS INTEGER bx AS INTEGER cx AS INTEGER dx AS INTEGER bp AS INTEGER si AS INTEGER di AS INTEGER flags AS INTEGER ds AS INTEGER es AS INTEGER END TYPE '===================================================================== ' Five SUBs: '===================================================================== DECLARE SUB BoxBoy (Title$, ULRow%, ULCol%, LRRow%, LRCol%, TitleRow%, TitleCol%, TitColrFG%, TitColrBG%, BoxColrFG%, BoxColrBG%, BoxStyle%, Shadow%, ShadowColr%, EdgeYN%) DECLARE SUB EditString (EditS$, Row%, Col%, FCol%, LenStr%, See%, TypeOfText$, Caps%, FGColr%, BGColr%, FKey$, LetterKey$, ExitCode%) DECLARE SUB GetFileAttributes (FileName$, result) DECLARE SUB InterruptX (intnum%, inreg AS RegTypeX, outreg AS RegTypeX) DECLARE SUB SaveRestScrn (ReadLine$(), ReadColr%(), SR.UL.Row%, SR.UL.Col%, SR.LR.Row%, SR.LR.Col%, SaveOrRest%) DECLARE SUB WriteString (Line$, Row%, Col%, ColrAttr%) opening.gui: '===================================================================== ' SUB Boxboy displays the GUI Title '===================================================================== COLOR 15, 1: CLS Title$ = "" ULRow% = 3 ULCol% = 18 LRRow% = 7 LRCol% = 59 TitleRow% = 7 TitleCol% = 27 TitColrFor% = 11 TitColrBak% = 1 BoxColrFor% = 0 BoxColrBak% = 3 BoxStyle% = 2 Shadow% = 1 ShadowColr% = 8 EdgeYN% = 0 CALL BoxBoy(Title$, ULRow%, ULCol%, LRRow%, LRCol%, TitleRow%, TitleCol%, TitColrFor%, TitColrBak%, BoxColrFor%, BoxColrBak%, BoxStyle%, Shadow%, ShadowColr%, ClearColr%) inner.box: '===================================================================== ' SUB Boxboy displays the inside box of GUI Title '===================================================================== Title$ = "" ULRow% = 4 ULCol% = 20 LRRow% = 6 LRCol% = 57 TitleRow% = 7 TitleCol% = 27 TitColrFor% = 11 TitColrBak% = 1 BoxColrFor% = 1 BoxColrBak% = 3 BoxStyle% = 1 Shadow% = 0 ShadowColr% = 8 EdgeYN% = 0 CALL BoxBoy(Title$, ULRow%, ULCol%, LRRow%, LRCol%, TitleRow%, TitleCol%, TitColrFor%, TitColrBak%, BoxColrFor%, BoxColrBak%, BoxStyle%, Shadow%, ShadowColr%, ClearColr%) ColrAttr% = 15 + 16 * 3 WriteString "R E A L L O A N P R O G R A M", 5, 23, ColrAttr% amount.of.loan.box: '===================================================================== ' SUB Boxboy displays "Amount of Loan" box '===================================================================== Title$ = "Amount Of Loan" ULRow% = 10 ULCol% = 5 LRRow% = 14 LRCol% = 21 TitleRow% = 11 TitleCol% = 7 TitColrFor% = 1 TitColrBak% = 7 BoxColrFor% = 0 BoxColrBak% = 7 BoxStyle% = 2 Shadow% = 1 ShadowColr% = 8 EdgeYN% = 0 CALL BoxBoy(Title$, ULRow%, ULCol%, LRRow%, LRCol%, TitleRow%, TitleCol%, TitColrFor%, TitColrBak%, BoxColrFor%, BoxColrBak%, BoxStyle%, Shadow%, ShadowColr%, ClearColr%) interest.rate.box: '===================================================================== ' SUB Boxboy displays "Interest" box '===================================================================== Title$ = "Interest Rate" ULRow% = 10 ULCol% = 31 LRRow% = 14 LRCol% = 46 TitleRow% = 11 TitleCol% = 33 TitColrFor% = 1 TitColrBak% = 7 BoxColrFor% = 0 BoxColrBak% = 7 BoxStyle% = 2 Shadow% = 1 ShadowColr% = 8 EdgeYN% = 0 CALL BoxBoy(Title$, ULRow%, ULCol%, LRRow%, LRCol%, TitleRow%, TitleCol%, TitColrFor%, TitColrBak%, BoxColrFor%, BoxColrBak%, BoxStyle%, Shadow%, ShadowColr%, ClearColr%) num.Of.months.box: '===================================================================== ' SUB Boxboy displays "Number of Months" box '===================================================================== Title$ = "Number Of Months" ULRow% = 10 ULCol% = 56 LRRow% = 14 LRCol% = 73 TitleRow% = 11 TitleCol% = 58 TitColrFor% = 1 TitColrBak% = 7 BoxColrFor% = 0 BoxColrBak% = 7 BoxStyle% = 2 Shadow% = 1 ShadowColr% = 8 EdgeYN% = 0 CALL BoxBoy(Title$, ULRow%, ULCol%, LRRow%, LRCol%, TitleRow%, TitleCol%, TitColrFor%, TitColrBak%, BoxColrFor%, BoxColrBak%, BoxStyle%, Shadow%, ShadowColr%, ClearColr%) monthly.payment.box: '===================================================================== ' SUB Boxboy displays "Monthly Payment" box '===================================================================== Title$ = "" ULRow% = 18 ULCol% = 5 LRRow% = 20 LRCol% = 49 TitleRow% = 0 TitleCol% = 0 TitColrFor% = 0 TitColrBak% = 0 BoxColrFor% = 15 BoxColrBak% = 4 BoxStyle% = 2 Shadow% = 1 ShadowColr% = 8 EdgeYN% = 0 CALL BoxBoy(Title$, ULRow%, ULCol%, LRRow%, LRCol%, TitleRow%, TitleCol%, TitColrFor%, TitColrBak%, BoxColrFor%, BoxColrBak%, BoxStyle%, Shadow%, ShadowColr%, ClearColr%) ColrAttr% = 15 + 16 * 4 WriteString "MONTHLY PAYMENT", 19, 8, ColrAttr% WriteString CHR$(203), 18, 24, ColrAttr% WriteString CHR$(186), 19, 24, ColrAttr% WriteString CHR$(202), 20, 24, ColrAttr% help.box: '===================================================================== 'SUB Boxboy displays the Help Box found at the GUI's lower right side '===================================================================== Title$ = "" ULRow% = 17 ULCol% = 56 LRRow% = 22 LRCol% = 73 TitleRow% = 0 TitleCol% = 0 TitColrFor% = 0 TitColrBak% = 0 BoxColrFor% = 0 BoxColrBak% = 3 BoxStyle% = 2 Shadow% = 1 ShadowColr% = 8 EdgeYN% = 0 CALL BoxBoy(Title$, ULRow%, ULCol%, LRRow%, LRCol%, TitleRow%, TitleCol%, TitColrFor%, TitColrBak%, BoxColrFor%, BoxColrBak%, BoxStyle%, Shadow%, ShadowColr%, ClearColr%) ColrAttr1% = 15 + 16 * 3 WriteString "H - Help", 18, 58, ColrAttr1% WriteString "P - Print Report", 19, 58, ColrAttr1% WriteString "D - Do Another", 20, 58, ColrAttr1% WriteString "X - Exit ", 21, 58, ColrAttr1% ColrAttr2% = 14 + 16 * 3 WriteString "H", 18, 58, ColrAttr2% WriteString "P", 19, 58, ColrAttr2% WriteString "D", 20, 58, ColrAttr2% WriteString "X", 21, 58, ColrAttr2% WriteString "Esc", 21, 68, ColrAttr2% begin: '===================================================================== ' DIM (diminsions) the variables of the Monthly Payment algorithm '===================================================================== DIM TheNum AS DOUBLE DIM P AS DOUBLE DIM Rate AS DOUBLE DIM L AS DOUBLE DIM M AS DOUBLE DIM I AS DOUBLE '===================================================================== ' Input the variables "Loan Amount", "Interest" and "Months" '===================================================================== 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% = 5: InputNum = 2 GOSUB input.amount Rate = TheNum '-------------------------------- third.input: Row% = 13: Col% = 63: FCol% = 63: LenStr% = 6: InputNum = 3 GOSUB input.amount Input3% = 3 L = TheNum GOSUB monthly.payment COLOR 15, 4 LOCATE 19, 38 - (LenAmt% \ 2): PRINT USING Image$; M; waitingloop: '===================================================================== ' Do:LOOP setup to trap keys "H", "P","D", "X" or "Esc" '===================================================================== DO DO LOCATE , , 0, 0, 0 HitKey$ = INKEY$ LOOP UNTIL HitKey$ <> "" ' KeyC% = CVI(HitKey$ + CHR$(0)) IF KeyC% = 72 OR KeyC% = 104 THEN ' H,h - Information GOSUB save.screen GOSUB program.info GOSUB restore.screen ELSEIF KeyC% = 80 OR KeyC% = 112 THEN ' P, p - Print Report WaitOne% = 0 GOSUB save.screen GOSUB Printout GOSUB restore.screen LOCATE , , 0, 0, 0 ELSEIF KeyC% = 68 OR KeyC% = 100 THEN ' D,d - Do Another DoAnother% = 0 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 monthly.payment: '===================================================================== ' Monthly Payment algorithm '===================================================================== I = Rate / 1200 M = 1 - 1 / (1 + I) ^ L M = M / I M = P / M Image$ = "$$##################,.##" OPEN "Bobito.Txt" FOR OUTPUT AS #1 PRINT #1, USING Image$; M CLOSE #1 OPEN "Bobito.Txt" FOR INPUT AS #1 LINE INPUT #1, MonthlyPayment$ CLOSE #1 KILL "Bobito.Txt" LenAmt% = LEN(MonthlyPayment$) AmtFGColr% = 15 AmtBGColr% = 4 ColrAttr% = 15 + 16 * 4 RETURN input.num.1: '===================================================================== '3 HELP Window comments for: "Amount of Loan", "Interest" and "Months" '===================================================================== GOSUB get.info.window Input1.1$ = "Enter the dollar amount of the loan. The highest amount" Input1.2$ = "is 9999999999999 or nine trillion, nine billion, nine" Input1.3$ = "thousand, nine hundred ninety-nine. The least amount" Input1.4$ = "which may be entered is one (1)." ColrAttr% = 11 + 16 * 5 WriteString Input1.1$, 11, 12, ColrAttr% WriteString Input1.2$, 12, 12, ColrAttr% WriteString Input1.3$, 13, 12, ColrAttr% WriteString Input1.4$, 14, 12, ColrAttr% GOSUB go.info RETURN input.num.2: GOSUB get.info.window Input2.1$ = "Give the interest rate of the loan." Input2.2$ = "The lowest interest rate accepted" Input2.3$ = "is one percent, or 1. The highest" Input2.4$ = "interest rate accepted is 99999." ColrAttr% = 11 + 16 * 5 WriteString Input2.1$, 11, 22, ColrAttr% WriteString Input2.2$, 12, 22, ColrAttr% WriteString Input2.3$, 13, 22, ColrAttr% WriteString Input2.4$, 14, 22, ColrAttr% GOSUB go.info RETURN input.num.3: GOSUB get.info.window Input3.1$ = "Indicate the number of months of the loan." Input3.2$ = "Multiply the number of years by twelve." Input3.3$ = "Example:" Input3.4$ = "6 years X 12 months = 72 months" ColrAttr% = 11 + 16 * 5 WriteString Input3.1$, 11, 18, ColrAttr% WriteString Input3.2$, 12, 18, ColrAttr% WriteString Input3.3$, 13, 34, 95 WriteString Input3.4$, 14, 24, 94 GOSUB go.info RETURN get.info.window: '===================================================================== ' HELP window setup which is reached by pressing "H" '===================================================================== Bottom1$ = "To return to the main screen, Press . To access" Bottom2$ = "the Program Information window, Press ." Title$ = "" ULRow% = 8 ULCol% = 9 LRRow% = 18 LRCol% = 67 TitleRow% = 0 TitleCol% = 0 TitColrFor% = 0 TitColrBak% = 0 BoxColrFor% = 15 BoxColrBak% = 5 BoxStyle% = 1 Shadow% = 1 ShadowColr% = 8 EdgeYN% = 0 CALL BoxBoy(Title$, ULRow%, ULCol%, LRRow%, LRCol%, TitleRow%, TitleCol%, TitColrFor%, TitColrBak%, BoxColrFor%, BoxColrBak%, BoxStyle%, Shadow%, ShadowColr%, EdgeYN%) Line$ = CHR$(195) + STRING$(58, 196) + CHR$(180) ColrAttr% = 15 + 16 * 5 WriteString Line$, 10, 9, ColrAttr% WriteString Line$, 15, 9, ColrAttr% WriteString "- H E L P W I N D O W -", 9, 22, ColrAttr% WriteString Bottom1$, 16, 14, ColrAttr% WriteString Bottom2$, 17, 14, ColrAttr% ColrAttr% = 11 + 16 * 5 WriteString "Esc", 16, 51, ColrAttr% WriteString "Enter", 17, 53, ColrAttr% RETURN go.info: '===================================================================== ' Setup to read the general Help comments containing program info '===================================================================== DO DO InFoKey$ = INKEY$ LOOP UNTIL InFoKey$ <> "" InFoKey% = CVI(InFoKey$ + CHR$(0)) IF InFoKey% = 13 THEN GOSUB program.info RETURN ELSEIF InFoKey% = 27 THEN RETURN END IF LOOP cleanupscreen: ColrAttr% = 15 + 16 * 4 WriteString STRING$(25, " "), 19, 25, ColrAttr% ColrAttr% = 0 + 16 * 7 WriteString STRING$(14, CHR$(255)), 13, 7, ColrAttr% WriteString STRING$(14, CHR$(255)), 13, 33, ColrAttr% WriteString STRING$(16, CHR$(255)), 13, 58, ColrAttr% P = 0: R = 0: L = 0: M = 0: I = 0: LongAmt = 0 RETURN input.amount: '===================================================================== ' One-line editor SUB EditString - inputs the loan variables '===================================================================== Dot = 0 TheNum = 0 EditS$ = "" 'Row% = given previously 'Col% = " 'FCol% = " 'LenStr% = " See% = 0 TypeOfText$ = ".1234567890" Caps% = 0 FGColr% = 0 BGColr% = 7 FKey$ = "" LetterKey$ = "HhPpDdXxVv" ExitCode% = 0 DO CALL EditString(EditS$, Row%, Col%, FCol%, LenStr%, See%, TypeOfText$, Caps%, FGColr%, BGColr%, 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 LEN(EditNum$) Dot$ = MID$(EditNum$, FindDots, 1) IF Dot$ = "." THEN Dot = Dot + 1 IF Dot = 2 THEN Message = 1 GOSUB error.message Dot = 0 GOTO input.amount END IF ELSEIF Dot$ = " " THEN Message = 3 GOSUB error.message Dot = 0 GOTO input.amount END IF NEXT TheNum = VAL(EditNum$) IF TheNum = 0 THEN Message = 2 Dot = 0 GOSUB error.message ELSEIF TheNum < 1 THEN Message = 4 Dot = 0 GOSUB error.message ELSE RETURN END IF ELSEIF ExitCode% = 72 OR ExitCode% = 104 THEN 'H,h GOSUB save.screen 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 '================================================================= ' Pop-up error messages when user prematurely presses "P" or "D" '================================================================= 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 'UpArrow 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: '===================================================================== ' When user pressed "P" it branches here. The loan information is ' printed into a form and saved as "MonthPay.Txt". Subsequently, ' the file "MonthPay.Txt" is presented in the Notepad text editor. '===================================================================== LoanAmount$ = RTRIM$(LTRIM$(STR$(P))) IntRate$ = RTRIM$(LTRIM$(STR$(Rate))) NumMonths$ = RTRIM$(LTRIM$(STR$(L))) LA$ = "$" + LoanAmount$ LA% = LEN(LA$) IR$ = RTRIM$(LTRIM$(IntRate$)) + "% YEARLY" IR% = LEN(IR$) IF VAL(NumMonths$) > 1 THEN MonthAmt$ = "MONTHS" ELSE MonthAmt$ = "MONTH" END IF NM$ = NumMonths$ + " " + MonthAmt$ NM% = LEN(NM$) MP$ = RTRIM$(LTRIM$(MonthlyPayment$)) MP% = LEN(MP$) OPEN "MonthPay.Txt" FOR OUTPUT AS #1 PRINT #1, STRING$(40, " "); PRINT #1, " " PRINT #1, " ________________________________________________________________" PRINT #1, " | |" PRINT #1, " | R E A L L O A N P R O G R A M |" PRINT #1, " | |" PRINT #1, " | _________________________________________________ |" PRINT #1, " | |" PRINT #1, " | 04/01/1996 DON SMITH - EMail:smithdonb@earthlink.net |" PRINT #1, " | Public Domain FreeWare |" PRINT #1, " |______________________________________________________________|" PRINT #1, " | |" PRINT #1, " | |" PRINT #1, " | A M O U N T O F L O A N ......... " + "$" + LoanAmount$ + SPACE$(20 - LA%) + "|" PRINT #1, " | |" PRINT #1, " | |" PRINT #1, " | |" PRINT #1, " | I N T E R E S T R A T E ........... " + RTRIM$(LTRIM$(IntRate$)) + "% YEARLY" + SPACE$(20 - IR%) + "|" PRINT #1, " | |" PRINT #1, " | |" PRINT #1, " | |" PRINT #1, " | N U M B E R O F M O N T H S ..... " + NumMonths$ + " " + MonthAmt$ + SPACE$(20 - NM%) + "|" PRINT #1, " | |" PRINT #1, " |______________________________________________________________|" PRINT #1, " | |" IF LEN(MP$) > 21 THEN PRINT #1, " | M O N T H L Y P A Y M E N T .... " + RTRIM$(LTRIM$(MonthlyPayment$)) + SPACE$(23 - MP%) + "|" ELSE PRINT #1, " | M O N T H L Y P A Y M E N T ....... " + RTRIM$(LTRIM$(MonthlyPayment$)) + SPACE$(20 - MP%) + "|" END IF PRINT #1, " | |" PRINT #1, " |______________________________________________________________|" PRINT #1, SPACE$(40) PRINT #1, SPACE$(40) PRINT #1, SPACE$(40) PRINT #1, SPACE$(40) CLOSE #1 'P, p - Print Report IF KeyC% = 80 OR KeyC% = 112 THEN '+--------------------------------------------------------------+ '| - NOTEPAD - | '+--------------------------------------------------------------+ '| Since RLoanQB.Bas, as presently configured, is set up to | '| use Notepad, it is not necessary to check whether or not | '| it exists, as it always will exist under WindowsXP. If | '| another text editor is used, then its existance needs to | '| be checked. Just substitute the two instances of | '| "NotePad.Exe" below with the name of your text editor | '| and remove the leading apostrophe marks ('). | '| | '| Do not attempt to use the next routine just below to | '| check the existance of Notepad.exe because it will | '| report that it does not exist. Notepad.exe has been made | '| globally available by WindowsXP; it will not appear in | '| your local directory. | '+--------------------------------------------------------------+ 'CALL GetFileAttributes("Notepad.Exe", result) ''If result = 0 file exists. If results > 0 file doesn't exist. 'IF result > 0 THEN ' PrintFile$ = "Notepad.Exe" ' GOSUB print.not.exist: ' NotExist% = 1 ' RETURN 'END IF GOSUB text.editor IF WaitOne% = 1 THEN RETURN END IF '+--------------------------------------------------------------+ '| Explanation on the use of SHELL in the next program line: | '+--------------------------------------------------------------+ '| The QuickBASIC command "LPRINT" used to print out the | '| lines of the the Realoan form simply will not work under | '| WindowsXP. Therefore, I have written the program so as to | '| create a text file called "MonthPay.Txt" containing the | '| form and subsequently call upon the WindowsXP's text editor | '| "Notepad.Exe" to view/print it. Notepad.Exe is globally | '| available and may be called from any command directory | '| or subdirectory. The programmer, however, may substitute | '| another text editor such as Metapad.Exe. | '+--------------------------------------------------------------+ SHELL "cmd /c Notepad.Exe" + " " + "MonthPay.Txt" RETURN END IF print.not.exist: '===================================================================== ' This QB Line Label (print.not.exist:) is used only in the event ' the programmer wishes to use another text editor other than ' Notepad. If after checking for its existance, and not finding ' it on the current directory, this error message will pop up. '===================================================================== CALL BoxBoy("", 15, 9, 17, 61, 0, 0, 0, 0, 15, 5, 1, 1, 8, 1000) ColrAttr% = 15 + 16 * 5 WriteString "Unable to find " + CHR$(34) + PrintFile$ + CHR$(34) + " program", 16, 11, ColrAttr% WriteString CHR$(194), 15, 48, ColrAttr% WriteString CHR$(179), 16, 48, ColrAttr% WriteString CHR$(193), 17, 48, ColrAttr% WriteString "Press ", 16, 50, ColrAttr% ColrAttr% = 11 + 16 * 5 WriteString "Esc", 16, 57, ColrAttr% SOUND 200, 3 DO NoZeroKey$ = INKEY$ IF NoZeroKey$ = CHR$(27) THEN LOCATE Row%, Col%, 1, 6, 7 RETURN END IF LOOP RETURN no.provide: '===================================================================== ' When the user inputs the "Amount of Loan", "Interest" and ' "Months" and the "Monthly Payment" is given, the user ' has four options from the small help menu at GUI lower ' right: ' H - Help ' P - Print ' D - Do Another ' X - Exit ' ' That is normally how things work. However, if the user has ' not arrived yet at the Monthly Payment amount and presses ' one of these keys prematurely, a small window will pop up ' informing that that key is not yet available. Example if the ' "P" key is prematurely pressed: ' ' ****************************************** ' | The PRINT function | ' | ~~~~~ | ' | is unavailable at the present time. | ' ****************************************** ' | Press To Continue | ' ****************************************** ' '===================================================================== GOSUB save.screen ULRow% = 11 ULCol% = 20 LRRow% = 17 LRCol% = 60 TitleRow% = 12 TitleCol% = 22 TitColrFor% = 15 TitColrBak% = 5 BoxColrFor% = 15 BoxColrBak% = 5 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%) ColrAttr% = 15 + 16 * 5 NotLine$ = "픔컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴캘" WriteString NotLine$, 15, 20, ColrAttr% NoMess2$ = "The " + NoMess1$ + " function" UnderL$ = STRING$(LEN(NoMess1$), "~") NoMess3$ = "is unavailable at the present time." NoMess4$ = "Press To Continue" 'ColrAttr% = 15 + 16 * 3 WriteString NoMess2$, 12, 30, ColrAttr% WriteString UnderL$, 13, 34, ColrAttr% WriteString NoMess3$, 14, 23, ColrAttr% WriteString NoMess4$, 16, 29, ColrAttr% ColrAttr% = 11 + 16 * 5 WriteString "Esc", 16, 36, ColrAttr% SOUND 200, 3 DO NoAvailKey$ = INKEY$ IF NoAvailKey$ = CHR$(27) THEN LOCATE Row%, Col%, 1, 6, 7 GOSUB restore.screen RETURN END IF LOOP RETURN text.editor: '===================================================================== ' When user presses "P" to print, this informative window pops up '===================================================================== Title$ = "P l e a s e N o t e :" ULRow% = 6 ULCol% = 17 LRRow% = 17 LRCol% = 61 TitleRow% = 7 TitleCol% = 28 TitColrFor% = 15 TitColrBak% = 5 BoxColrFor% = 15 BoxColrBak% = 5 BoxStyle% = 2 Shadow% = 1 ShadowColr% = 7 EdgeYN% = 0 CALL BoxBoy(Title$, ULRow%, ULCol%, LRRow%, LRCol%, TitleRow%, TitleCol%, TitColrFor%, TitColrBak%, BoxColrFor%, BoxColrBak%, BoxStyle%, Shadow%, ShadowColr%, EdgeYN%) Mess1$ = "When you press , the payment form" Mess2$ = "will appear in the Notepad program," Mess3$ = "the free-to-use WindowsXP text editor." Mess4$ = "From there, you'll be able to view and" Mess5$ = "print out the monthly payment form." Mess6$ = "Press to continue to the Notepad" Mess7$ = "program, or, press to return." ColrAttr% = 15 + 16 * 5 WriteString Mess1$, 9, 20, ColrAttr% WriteString Mess2$, 10, 20, ColrAttr% WriteString Mess3$, 11, 20, ColrAttr% WriteString Mess4$, 12, 20, ColrAttr% WriteString Mess5$, 13, 20, ColrAttr% WriteString Mess6$, 15, 20, ColrAttr% WriteString Mess7$, 16, 20, ColrAttr% ColrAttr% = 11 + 16 * 5 WriteString "Enter", 9, 36, ColrAttr% WriteString "Enter", 15, 27, ColrAttr% WriteString "Esc", 16, 40, ColrAttr% ColrAttr% = 15 + 16 * 5 DaLine$ = "픔컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴캘" WriteString DaLine$, 14, 17, ColrAttr% SOUND 200, 3 DO WaitOne$ = INKEY$ IF WaitOne$ = CHR$(13) THEN EXIT DO ELSEIF WaitOne$ = CHR$(27) THEN WaitOne% = 1 RETURN END IF LOOP RETURN error.message: '======================================================================== ' Various error messages. Example of incorrect Interest -> "7..5" '======================================================================== 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 Message$ = "Unusable number - Try again!" ELSEIF Message = 4 THEN Message$ = "Cannot input a value less than 1" ELSEIF Message = 5 THEN Message$ = "Unable to find " + CHR$(34) + "PrintIt.Exe" + CHR$(34) + " program" ELSEIF Message = 6 THEN Message$ = "Print program used already. Do over." END IF GOSUB save.screen Title$ = "" ULRow% = 15 ULCol% = 9 LRRow% = 17 LRCol% = 61 TitleRow% = 0 TitleCol% = 0 TitColrFor% = 0 TitColrBak% = 0 BoxColrFor% = 15 BoxColrBak% = 5 BoxStyle% = 1 Shadow% = 1 ShadowColr% = 8 ClearColr% = 1000 CALL BoxBoy(Title$, ULRow%, ULCol%, LRRow%, LRCol%, TitleRow%, TitleCol%, TitColrFor%, TitColrBak%, BoxColrFor%, BoxColrBak%, BoxStyle%, Shadow%, ShadowColr%, ClearColr%) ColrAttr% = 15 + 16 * 5 WriteString Message$, 16, 12, ColrAttr% WriteString CHR$(194), 15, 48, ColrAttr% WriteString CHR$(179), 16, 48, ColrAttr% WriteString CHR$(193), 17, 48, ColrAttr% WriteString "Press ", 16, 50, ColrAttr% ColrAttr% = 11 + 16 * 5 WriteString "Esc", 16, 57, ColrAttr% SOUND 200, 3 DO NoZeroKey$ = INKEY$ IF NoZeroKey$ = CHR$(27) THEN LOCATE Row%, Col%, 1, 6, 7 GOSUB restore.screen RETURN END IF LOOP RETURN save.screen: '===================================================================== ' SUB SaveRestScrn - saves entire screen: 25 rows and 80 columns '===================================================================== 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: '===================================================================== ' SUB SaveRestScrn - restores entire screen: 25 rows and 80 columns '===================================================================== 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 program.info: '===================================================================== ' General Help screen with information about Real Loan '===================================================================== ColrAttr% = 15 + 16 * 1 WriteString " 旼컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴커", 1, 1, ColrAttr% WriteString " � �袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴� �", 2, 1, ColrAttr% WriteString " � � R e a l L o a n P r o g r a m � �", 3, 1, ColrAttr% WriteString " � 훤袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴暠 �", 4, 1, ColrAttr% WriteString " � �", 5, 1, ColrAttr% WriteString " � 靈컴컴컴컴컴컴컴커 �", 6, 1, ColrAttr% WriteString " � � PUBLIC DOMAIN :� The Real Loan Program was written on 04/01/96 �", 7, 1, ColrAttr% WriteString " � 聃컴컴컴컴컴컴컴켸 and released to the Public Domain. The �", 8, 1, ColrAttr% WriteString " � Real Loan Program may be freely copied and/or distributed. �", 9, 1, ColrAttr% WriteString " � �", 10, 1, ColrAttr% WriteString " � 靈컴컴컴컴컴컴컴커 �", 11, 1, ColrAttr% WriteString " � � PURPOSE : � The purpose of the Real Loan Program is to �", 12, 1, ColrAttr% WriteString " � 聃컴컴컴컴컴컴컴켸 quickly obtain the monthly payment of a loan. �", 13, 1, ColrAttr% WriteString " � This information is needed more than any other financial data. �", 14, 1, ColrAttr% WriteString " � �", 15, 1, ColrAttr% WriteString " � 靈컴컴컴컴컴컴컴커 �", 16, 1, ColrAttr% WriteString " � � LIABILITY : � You may use the Real Loan Program at your own �", 17, 1, ColrAttr% WriteString " � 聃컴컴컴컴컴컴컴켸 risk. The author does not guarantee nor �", 18, 1, ColrAttr% WriteString " � warranty accuracy. In addition, the author accepts no liability �", 19, 1, ColrAttr% WriteString " � for damages resulting from its use or misuse. �", 20, 1, ColrAttr% WriteString " � �", 21, 1, ColrAttr% WriteString " � �", 22, 1, ColrAttr% WriteString " � (Press Any Key To Continue) �", 23, 1, ColrAttr% WriteString " 읕컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴켸", 24, 1, ColrAttr% ColrAttr% = 14 + 16 * 1 WriteString "Press Any Key To Continue", 23, 28, ColrAttr% ColrAttr% = 8 + 16 * 1 WriteString "(Page 1 of 2)", 23, 60, ColrAttr% 'next page DO: LOOP WHILE INKEY$ = "" ColrAttr% = 15 + 16 * 1 WriteString " 旼컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴커", 1, 1, ColrAttr% WriteString " � �", 2, 1, ColrAttr% WriteString " � �", 3, 1, ColrAttr% WriteString " � �袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴� �", 4, 1, ColrAttr% WriteString " � � R e a l L o a n P r o g r a m � �", 5, 1, ColrAttr% WriteString " � 훤袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴暠 �", 6, 1, ColrAttr% WriteString " � �", 7, 1, ColrAttr% WriteString " � 靈컴컴컴컴컴컴컴커 �", 8, 1, ColrAttr% WriteString " � � EDITING KEYS : � To clear numbers, use DELETE, BACKSPACE or �", 9, 1, ColrAttr% WriteString " � 聃컴컴컴컴컴컴컴켸 SPACEBAR. In addition, CTRL-Y will clear the �", 10, 1, ColrAttr% WriteString " � entire field. Use ENTER or TAB to move to the next field. �", 11, 1, ColrAttr% WriteString " � To move to a previous field, use UPARROW or PAGEUP. �", 12, 1, ColrAttr% WriteString " � �", 13, 1, ColrAttr% WriteString " � �", 14, 1, ColrAttr% WriteString " � 靈컴컴컴컴컴컴컴커 �", 15, 1, ColrAttr% WriteString " � � AUTHOR: � Hello. My name is Don Smith and I am a thirty �", 16, 1, ColrAttr% WriteString " � 聃컴컴컴컴컴컴컴켸 year retired teacher of Math/History/Spanish �", 17, 1, ColrAttr% WriteString " � residing in Orange County, California. I am also a former six- �", 18, 1, ColrAttr% WriteString " � year Sergeant of Marines. Who-Rah! On certain forums I am known �", 19, 1, ColrAttr% WriteString " � as MarineDon. Email: smithdonb@earthlink.net �", 20, 1, ColrAttr% WriteString " � �", 21, 1, ColrAttr% WriteString " � �", 22, 1, ColrAttr% WriteString " � (Press Any Key To Continue) �", 23, 1, ColrAttr% WriteString " 읕컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴켸", 24, 1, ColrAttr% ColrAttr% = 14 + 16 * 1 WriteString "Press Any Key To Continue", 23, 28, ColrAttr% ColrAttr% = 8 + 16 * 1 WriteString "(Page 2 of 2)", 23, 60, ColrAttr% DO: LOOP WHILE INKEY$ = "" RETURN SUB BoxBoy (Title$, ULRow%, ULCol%, LRRow%, LRCol%, TitleRow%, TitleCol%, TitColrFG%, TitColrBG%, BoxColrFG%, BoxColrBG%, BoxStyle%, Shadow%, ShadowColr%, EdgeYN%) ' +--------------------------------------------------------------------+ ' | | ' | SUB BoxBoy | ' | | ' | - SUB BoxBoy is Public Domain FreeWare - | ' +--------------------------------------------------------------------+ ' | Not counting REM (') lines, SUB BoxBoy has 121 lines. | ' +--------------------------------------------------------------------+ ' | The SUB BoxBoy was written by Don Smith. This BoxBoy is the | ' | lastest iteration of the SUB - written 12-01-2002. Other | ' | programmers, or anyone else for that matter, may use this SUB | ' | without naming me as the author, and they may modify the code | ' | in any way they see fit. | ' | | ' | Don's EMail: smithdonb@earthlink.net | ' | | ' | This SUB only saves that portion of the underlying screen under | ' | the box and repaints with a shadow. So recommend using the SUB | ' | SaveRestScrn to save/restore the complete screen, or a larger | ' | portion of the screen than the box. | ' +-------------+------------------------------------------------------+ ' | 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 Title$ = "" | ' +-------------+----------------------------------| (or NO title), | ' | TitleCol% | The column to place the title. | report these four | ' +-------------+----------------------------------| values as zero (0)| ' | TitColrFG% | The foreground color of the title| . . . . . . . . | ' +-------------+----------------------------------| Example -> | ' | TitColrBG% | The background color of the title| TitColrFG% = 0 | ' +-------------+----------------------------------+-------------------+ ' | BoxColrFG% | The foreground color of the box itself. | ' +-------------+------------------------------------------------------+ ' | BoxColrBG% | The back ground color of the box. | ' +-------------+------------------------------------------------------+ ' | BoxStyle% | BoxStyle% = 0 (No line around box) | ' | | BoxStyle% = 1 (Single line around box) | ' | | BoxStyle% = 2 (Double line around box) | ' | | BoxStyle% = 3 (Solid 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 the ShadowColr% (just | ' | | below). This causes the shadow to look like a | ' | | real shadow. | ' | | | ' | | NOTE #2: | ' | | ------- | ' | | If the first four values of BoxBoy are 1, 1, 25, 80, | ' | | in other words a full screen, please set Shadow% = 0;| ' | | otherwise an error will result (no room for shadow). | ' +-------------+------------------------------------------------------+ ' | ShadowColr% | The ShadowColr% is the foreground color of the | ' | | shadow. The background color will always be | ' | | black. Either choose ShadowColr% = 7 or | ' | | ShadowColr% = 8. | ' | | | ' | | ShadowColr% = 7 saves the foreground color and | ' | | changes it to a shade darker, if possible. For | ' | | example, a bright white on blue (COLOR 15, 1) | ' | | becomes dim white on black (COLOR 7, 0). A bright | ' | | blue on blue (COLOR 9, 1) becomes regular blue | ' | | on black (COLOR 1, 0). Very realistic. | ' | | | ' | | ShadowColr% = 8 saves the foreground and reprints | ' | | it as COLOR 8, 0. Darker then ShadowColr% = 7 | ' +-------------+----------------+-------------------------------------+ ' | EdgeYN% | EdgeYN% = 0 | Do NOT print an edge of one space | ' | | | with BoxColrFG% color on the right | ' | | | and left edges of the box. | ' | +----------------+-------------------------------------+ ' | | EdgeYN% = 1 | YES, DO print an edge of one space | ' | | | with BoxColrFG% color on the right | ' | | | and left edges of the box. | ' | +----------------+-------------------------------------+ ' | | What does it mean to "print an edge of one space | ' | | with BoxColrFG% color on the right and left edges | ' | | of the box". Well, I will attempt to demonstrate | ' | | by drawing the boxes with non-extended ASCII | ' | | characters. The X's represent a shadow to the | ' | | right. | ' | | | ' | | NO EDGE RIGHT/LEFT 1 SPACE EDGE RIGHT/LEFT | ' | | ~~~~~~~~~~~~~~~~~~ ~~~~~~~~~~~~~~~~~~~~~~~ | ' | | (EdgeYN% = 0) (EdgeYN% = 1) | ' | | | ' | | +-----------------+ +-------------------+ | ' | | |+---------------+| | +---------------+ | | ' | | || ||XX | | | |XX | ' | | || ||XX | | | |XX | ' | | || ||XX | | | |XX | ' | | || ||XX | | | |XX | ' | | || ||XX | | | |XX | ' | | || ||XX | | | |XX | ' | | || ||XX | | | |XX | ' | | |+---------------+|XX | +---------------+ |XX | ' | | +-----------------+XX +-------------------+XX | ' | | XXXXXXXXXXXXXXXXXXX XXXXXXXXXXXXXXXXXXXXX | ' | | | ' +-------------+------------------------------------------------------+ IF EdgeYN% > 1 OR EdgYN% < 0 THEN EdgeYN% = 0 END IF IF ULCol% <= 1 THEN ULCol% = 1 END IF IF LRCol% = 80 THEN LRCol% = 79 END IF make.box: IF BoxStyle% = 0 THEN 'No Lines ULCorner$ = CHR$(255) URCorner$ = CHR$(255) HorLineTop$ = CHR$(255) HorLineBot$ = CHR$(255) LeftSide$ = CHR$(255) RightSide$ = CHR$(255) VertLine$ = CHR$(255) LLCorner$ = CHR$(255) LRCorner$ = CHR$(255) ELSEIF BoxStyle% = 1 THEN 'Single Line ULCorner$ = CHR$(218) URCorner$ = CHR$(191) HorLineTop$ = CHR$(196) HorLineBot$ = 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) HorLineTop$ = CHR$(205) HorLineBot$ = CHR$(205) LeftSide$ = CHR$(199) RightSide$ = CHR$(182) VertLine$ = CHR$(186) LLCorner$ = CHR$(200) LRCorner$ = CHR$(188) ELSEIF BoxStyle% = 3 THEN 'Solid line ULCorner$ = CHR$(219) URCorner$ = CHR$(219) HorLineTop$ = CHR$(223) HorLineBot$ = CHR$(220) LeftSide$ = CHR$(219) RightSide$ = CHR$(219) VertLine$ = CHR$(219) LLCorner$ = CHR$(219) LRCorner$ = CHR$(219) END IF IF Shadow% > 0 THEN IF EdgeYN% = 1 THEN IF Shadow% = 1 THEN LeftLimit% = ULCol% + 2 RightLimit% = LRCol% + 5 ELSEIF Shadow% = 2 THEN LeftLimit% = ULCol% - 2 RightLimit% = LRCol% END IF ELSEIF EdgeYN% = 0 THEN IF Shadow% = 1 THEN LeftLimit% = ULCol% + 2 RightLimit% = LRCol% + 3 ELSEIF Shadow% = 2 THEN LeftLimit% = ULCol% - 2 RightLimit% = LRCol% - 1 END IF END IF REDIM ReadLine$(25): REDIM ReadColr%(25, 80) FOR ViewIt% = ULRow% + 1 TO LRRow% + 1 FOR Horizon% = LeftLimit% TO RightLimit% ReadLine$(ViewIt%) = ReadLine$(ViewIt%) + CHR$(SCREEN(ViewIt%, Horizon%)) ReadColr%(ViewIt%, Horizon%) = SCREEN(ViewIt%, Horizon%, 1) NEXT NEXT FOR FindRow% = ULRow% + 1 TO LRRow% + 1 FOR ScrnCol% = LeftLimit% TO RightLimit% LOCATE FindRow%, ScrnCol%, 0 OneColr% = ReadColr%(FindRow%, ScrnCol%) FGScrnColr% = OneColr% MOD 16 'make colors less bright IF FGScrnColr% = 0 THEN FGScrnColr% = 7 IF FGScrnColr% = 9 THEN FGScrnColr% = 1 IF FGScrnColr% = 10 THEN FGScrnColr% = 2 IF FGScrnColr% = 11 THEN FGScrnColr% = 3 IF FGScrnColr% = 12 THEN FGScrnColr% = 4 IF FGScrnColr% = 13 THEN FGScrnColr% = 5 IF FGScrnColr% = 14 THEN FGScrnColr% = 7 IF FGScrnColr% = 15 THEN FGScrnColr% = 7 BGScrnColr% = OneColr% \ 16 IF ShadowColr% = 7 THEN COLOR FGScrnColr%, 0 ELSEIF ShadowColr% = 8 THEN COLOR 8, 0 END IF IF Shadow% = 1 THEN PRINT MID$(ReadLine$(FindRow%), ScrnCol% - (ULCol% + 1)); ELSEIF Shadow% = 2 THEN PRINT MID$(ReadLine$(FindRow%), ScrnCol% - (ULCol% - 3)); END IF NEXT NEXT ERASE ReadLine$: ERASE ReadColr% END IF IF EdgeYN% = 1 THEN Edge$ = " " END IF Title.Length% = LEN(Title$) COLOR BoxColrFG%, BoxColrBG% '旼컴� or �袴敲 LOCATE ULRow%, ULCol%, 0 PRINT Edge$ + ULCorner$ + STRING$(LRCol% - ULCol%, HorLineTop$) + URCorner$ + Edge$; '� � or � � LOCATE ULRow% + 1, ULCol%, 0 PRINT Edge$ + VertLine$ + SPACE$(LRCol% - ULCol%) + VertLine$ + Edge$; IF Title$ <> "" THEN '쳐컴� or 픔컴� 'made cross bar if there is a title LOCATE ULRow% + 2, ULCol%, 0 PRINT Edge$ + LeftSide$ + STRING$(LRCol% - ULCol%, 196) + RightSide$ + Edge$; ELSEIF Title$ = "" THEN LOCATE ULRow% + 2, ULCol%, 0 PRINT Edge$ + VertLine$ + SPACE$(LRCol% - ULCol%) + VertLine$ + Edge$; END IF '� � or � � FOR Print.Box% = 1 TO (LRRow% - ULRow%) - 3 LOCATE ULRow% + Print.Box% + 2, ULCol%, 0 PRINT Edge$ + VertLine$ + SPACE$(LRCol% - ULCol%) + VertLine$ + Edge$; NEXT '읕컴� or 훤袴� LOCATE LRRow%, ULCol%, 0 PRINT Edge$ + LLCorner$ + STRING$(LRCol% - ULCol%, HorLineBot$) + LRCorner$ + Edge$; IF Title$ <> "" THEN LOCATE TitleRow%, TitleCol%, 0 COLOR TitColrFG%, TitColrBG% PRINT Title$; END IF END SUB SUB EditString (EditS$, Row%, Col%, FCol%, LenStr%, See%, TypeOfText$, Caps%, FGColr%, BGColr%, FKey$, LetterKey$, ExitCode%) STATIC ' +---------------------------------------------------------------------+ ' | - SUB EditString is Public Domain FreeWare - | ' +---------------------------------------------------------------------+ ' | 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 | ' | FGColr% = Color of foreground color. | ' | BGColr% = Color of background color. | ' | 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% 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 INSTR(LetterKey$, EdW$) > 0 THEN ExitCode% = SlamKey% EXIT 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 EXIT SUB ELSEIF SlamKey% = 19712 THEN 'Right Arrow Col% = Col% + 1 IF Col% > FCol% + LenStr% - 1 THEN Col% = FCol% ELSE LOCATE Row%, Col%, 1, 6, 7 END IF ELSEIF SlamKey% = 19200 THEN 'Left Arrow Col% = Col% - 1 IF Col% = FCol% - 1 OR Col% < FCol% THEN Col% = FCol% + LenStr% - 1 END IF ELSEIF SlamKey% = 18432 OR SlamKey% = 18688 THEN 'Up Arrow GOSUB get.string 'PageUp ExitCode% = 16 EXIT SUB ELSEIF SlamKey% = 20480 OR SlamKey% = 20736 THEN 'Down Arrow GOSUB get.string: 'PageDn ExitCode% = 17 EXIT SUB ELSEIF SlamKey% = 13 THEN 'Enter GOSUB get.string ExitCode% = 13 EXIT SUB ELSEIF SlamKey% = 9 THEN 'Tab GOSUB get.string ExitCode% = 18 EXIT SUB 'ELSEIF SlamKey% = 18176 THEN 'Home ' Col% = FCol% ' GOSUB get.string 'ELSEIF SlamKey% = 20224 THEN 'End ' Col% = FCol% + LenStr% ' GOSUB get.string 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 SaveScr$ = "" FOR DelK% = Col% + 1 TO FCol% + LenStr% SaveScr$ = SaveScr$ + CHR$(SCREEN(Row%, DelK%)) NEXT SaveScr$ = MID$(SaveScr$, 1, LEN(SaveScr$)) LOCATE Row%, Col% COLOR FGColr%, BGColr% PRINT SaveScr$; SaveScr$ = "" ELSEIF SlamKey% = 18176 THEN 'Home Key Col% = FCol% ELSEIF SlamKey% = 20224 THEN 'End Key GOSUB get.string Col% = FCol% + LEN(EditS$) - 1 ELSEIF SlamKey% = 25 THEN 'Ctrl-Y LOCATE Row%, FCol% WipeOut$ = SPACE$(LenStr%) COLOR FGColr%, BGColr% PRINT WipeOut$; Col% = FCol% LOCATE Row%, Col% 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 EXIT SUB ELSE ExitCode% = VAL(IdentKey$) EXIT SUB END IF END IF END IF LOOP show.char: LOCATE Row%, Col% COLOR FGColr%, BGColr% IF Caps% > 0 THEN PRINT UCASE$(EdW$); ELSEIF Caps% = 0 THEN 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$ = RTRIM$(LTRIM$(EditLine$)) EditS$ = EditLine$ RETURN END SUB REM $DYNAMIC SUB GetFileAttributes (FileName$, result) STATIC ' +---------------------------------------------------------------------+ ' | - SUB GetFileAttributes is Public Domain FreeWare _ | ' +---------------------------------------------------------------------+ ' | GetFileAttributes is used to determine if a file exists or not. | ' | To use this SUB within QuickBASIC 4.5, you must load the QuickBASIC | ' | Quick Library. At the prompt it would be: | ' | | ' | QB /L QB.QLB Magmenu1.Bas (and press ENTER) | ' | | ' | See example, below: | ' +---------------------------------------------------------------------+ ' | | ' | To use SUB GetFileAttributes -> | ' | | ' | CALL GetFileAttributes (fileName$, result) | ' | IF result > 0 THEN | ' | 'file does not exist. Use a pop-up screen and | ' | 'back out. | ' | ELSEIF result = 0 THEN | ' | 'file does indeed exist. Continue with routine. | ' | END IF | ' | | ' +---------------------------------------------------------------------+ DIM regX AS RegTypeX regX.ax = &H4300 F$ = FileName$ + CHR$(0) regX.ds = VARSEG(F$) regX.dx = SADD(F$) InterruptX &H21, regX, regX IF regX.flags AND 1 THEN result = regX.ax ELSE result = 0 END IF END SUB REM $STATIC 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 | '| SUB SaveRestScrn is Public Domain FreeWare. | '+----------------------------------------------------------------------+ '+----------------------------------------------------------------------+ '| PLACE NUMBERS 1 AND 2 IN MAIN PROGRAM. See line number 313 in main | '| module. Also, refer to numbers 7, 8 and 9 below. | '+------------------+---------------------------------------------------|+ '| (1) ReadLine$() | Program self reads data at each Row and Column | '+------------------+---------------------------------------------------+ '| (2) ReadColr%() | Program self reads color at each Row and Column | '+------------------+---------------------------------------------------+ '+----------------------------------------------------------------------+ '| THE PROGRAMMER MUST SET NUMBERS 3 TO 9 BEFORE CALLING THIS SUB -> | '+----------------------------------------------------------------------+ '| (Note: The "SR" below means "Save" Or "Restore") | '+------------------+---------------------------------------------------+ '| (3) SR.UL.Row% | Screen to save or restore at upper left row. | '| (4) SR.UL.Col% | Screen to save or restore at upper left column. | '| (5) SR.LR.Row% | Screen to save or restore at lower right row. | '| (6) SR.LR.Col% | Screen to save or restore at lower right column.| '| +---------------------------------------------------+ '| | SPECIAL CAUTION: | '| | --------------- | '| | When you call the SUB to restore the underlying | '| | screen, use MUST use the same row and column | '| | numbers as you used when you first called the | '| | SUB to save the screen. | '+------------------+---------------------------------------------------+ '| (7) SaveOrRest% | SaveOrRest% = 1 (1 means save the screen) | '| | SaveOrRest% = 2 (2 means restore the screen) | '+------------------+----------+----------------------------------------+ '| (8) REDIM ReadLine$(25) | The REDIM for ReadLine$ and ReadColr% | '| REDIM ReadColr%(25, 80) | must be placed in the main program | '| | before calling the SUB. The 25 and 80 | '| | reflects a screen of 25 lines and 80 | '| | columns. You may use smaller amounts | '| | of memory if you do not need all 25 | '| | lines and 80 columns. | '+-----------------------------+----------------------------------------+ '| (9) ERASE ReadLine$ | Reclaim memory after calling the SUB | '| ERASE ReadColr% | to restore the screen. Use REDIM and | '| | ERASE in main program please! | '+-----------------------------+----------------------------------------+ IF SR.LR.Col% > 80 THEN SR.LR.Col% = 80 END IF IF SR.LR.Row% > 25 THEN SR.LR.Row% = 25 END IF IF SaveOrRest% = 1 THEN GOSUB save.da.screen ELSEIF SaveOrRest% = 2 THEN GOSUB restore.da.screen END IF EXIT SUB save.da.screen: FOR ViewIt% = SR.UL.Row% TO SR.LR.Row% FOR Horizon% = SR.UL.Col% TO SR.LR.Col% ReadLine$(ViewIt%) = ReadLine$(ViewIt%) + CHR$(SCREEN(ViewIt%, Horizon%)) ReadColr%(ViewIt%, Horizon%) = SCREEN(ViewIt%, Horizon%, 1) NEXT NEXT RETURN restore.da.screen: FOR FindRow% = SR.UL.Row% TO SR.LR.Row% FOR ScrnCol% = SR.UL.Col% TO SR.LR.Col% LOCATE FindRow%, ScrnCol%, 0, 0, 0 OneColr% = ReadColr%(FindRow%, ScrnCol%) FGScrnColr% = OneColr% MOD 16 BGScrnColr% = OneColr% \ 16 COLOR FGScrnColr%, BGScrnColr% PRINT MID$(ReadLine$(FindRow%), ScrnCol% - (SR.UL.Col% - 1)); NEXT NEXT RETURN END SUB SUB WriteString (Line$, Row%, Col%, ColrAttr%) ' +--------------------------------------------------------------------+ ' | | ' | SUB WriteString | ' | | ' | Public Domain - FreeWare | ' | | ' | SUB WriteString is a fast write directly to screen, bypassing | ' | QuickBASIC's PRINT command. | ' | | ' +--------------------------------------------------------------------+ ' +--------------------------------------------------------------------+ ' | - 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. | ' +--------------------------------------------------------------------+ ' +--------------------------------------------------------------------+ ' | For this code to work, you must use QuickBasics' quick library. | ' | So, when you enter the QuickBasic editor, type: | ' | | ' | QB/L QB.QLB RLOANQB.BAS | ' | | ' | | ' | At the very top of your main module, place this code; it will | ' | make use of InterruptX to write text directly to the screen | ' | bepassing QuickBasic: | ' | | ' | | ' | TYPE RegTypeX | ' | ax AS INTEGER | ' | bx AS INTEGER | ' | cx AS INTEGER | ' | dx AS INTEGER | ' | bp AS INTEGER | ' | si AS INTEGER | ' | di AS INTEGER | ' | flags AS INTEGER | ' | ds AS INTEGER | ' | es AS INTEGER | ' | END TYPE | ' | | ' | Next step is to place these 2 DECLARE SUB statements: +---+ ' | | ' | DECLARE SUB InterruptX (intnum%, inreg AS RegTypeX, outreg AS RegTypeX)| ' | DECLARE SUB WriteString (Line$, Row%, Col%, ColrAttr%) | ' | | ' | | ' +-------------+------------------------------------------------------+---+ ' | Line$ | The text string to be written to screen | ' +-------------+------------------------------------------------------+ ' | Row% | The row to place the string on screen | ' +-------------+------------------------------------------------------+ ' | Col% | The column to place the string on screen | ' +-------------+------------------------------------------------------+ ' | ColrAttr% | The single color attribute to write the string. | ' | | To derive this number, use this formula: | ' | | ColrAttr% = foreground color + 16 * background color | ' | | | ' | | Example for COLOR 15, 1 (bright white on blue): | ' | | ---------------------------------------------- | ' | | ColrAttr% = 15 + 16 * 1 | ' | | ColrAttr% = 31 | ' +-------------+------------------------------------------------------+ SHARED ireg AS RegTypeX, oreg AS RegTypeX ireg.ax = &H1300 ireg.bx = ColrAttr% ireg.cx = LEN(Line$) ireg.dx = (Row% - 1) * 256 + (Col% - 1) ireg.bp = SADD(Line$) ireg.es = VARSEG(Line$) InterruptX &H10, ireg, oreg END SUB