--- /dev/null
+'\r
+' Q B a s i c M O N E Y M A N A G E R\r
+'\r
+' Copyright (C) Microsoft Corporation 1990\r
+'\r
+' The Money Manager is a personal finance manager that allows you\r
+' to enter account transactions while tracking your account balances\r
+' and net worth.\r
+'\r
+' To run this program, press Shift+F5.\r
+'\r
+' To exit QBasic, press Alt, F, X.\r
+'\r
+' To get help on a BASIC keyword, move the cursor to the keyword and press\r
+' F1 or click the right mouse button.\r
+'\r
+\r
+\r
+'Set default data type to integer for faster operation\r
+DEFINT A-Z\r
+\r
+'Sub and function declarations\r
+DECLARE SUB TransactionSummary (item%)\r
+DECLARE SUB LCenter (text$)\r
+DECLARE SUB ScrollUp ()\r
+DECLARE SUB ScrollDown ()\r
+DECLARE SUB Initialize ()\r
+DECLARE SUB Intro ()\r
+DECLARE SUB SparklePause ()\r
+DECLARE SUB Center (row%, text$)\r
+DECLARE SUB FancyCls (dots%, Background%)\r
+DECLARE SUB LoadState ()\r
+DECLARE SUB SaveState ()\r
+DECLARE SUB MenuSystem ()\r
+DECLARE SUB MakeBackup ()\r
+DECLARE SUB RestoreBackup ()\r
+DECLARE SUB Box (Row1%, Col1%, Row2%, Col2%)\r
+DECLARE SUB NetWorthReport ()\r
+DECLARE SUB EditAccounts ()\r
+DECLARE SUB PrintHelpLine (help$)\r
+DECLARE SUB EditTrans (item%)\r
+DECLARE FUNCTION Cvdt$ (X#)\r
+DECLARE FUNCTION Cvst$ (X!)\r
+DECLARE FUNCTION Cvit$ (X%)\r
+DECLARE FUNCTION Menu% (CurrChoiceX%, MaxChoice%, choice$(), ItemRow%(), ItemCol%(), help$(), BarMode%)\r
+DECLARE FUNCTION GetString$ (row%, col%, start$, end$, Vis%, Max%)\r
+DECLARE FUNCTION Trim$ (X$)\r
+\r
+'Constants\r
+CONST TRUE = -1\r
+CONST FALSE = NOT TRUE\r
+\r
+'User-defined types\r
+TYPE AccountType\r
+ Title AS STRING * 20\r
+ AType AS STRING * 1\r
+ Desc AS STRING * 50\r
+END TYPE\r
+\r
+TYPE Recordtype\r
+ Date AS STRING * 8\r
+ Ref AS STRING * 10\r
+ Desc AS STRING * 50\r
+ Fig1 AS DOUBLE\r
+ Fig2 AS DOUBLE\r
+END TYPE\r
+\r
+'Global variables\r
+DIM SHARED account(1 TO 19) AS AccountType 'Stores the 19 account titles\r
+DIM SHARED ColorPref 'Color Preference\r
+DIM SHARED colors(0 TO 20, 1 TO 4) 'Different Colors\r
+DIM SHARED ScrollUpAsm(1 TO 7) 'Assembly Language Routines\r
+DIM SHARED ScrollDownAsm(1 TO 7)\r
+DIM SHARED PrintErr AS INTEGER 'Printer error flag\r
+\r
+ DEF SEG = 0 ' Turn off CapLock, NumLock and ScrollLock\r
+ KeyFlags = PEEK(1047)\r
+ POKE 1047, &H0\r
+ DEF SEG\r
+ \r
+ 'Open money manager data file. If it does not exist in current directory,\r
+ ' goto error handler to create and initialize it.\r
+ ON ERROR GOTO ErrorTrap\r
+ OPEN "money.dat" FOR INPUT AS #1\r
+ CLOSE\r
+ ON ERROR GOTO 0 'Reset error handler\r
+\r
+ Initialize 'Initialize program\r
+ Intro 'Display introduction screen\r
+ MenuSystem 'This is the main program\r
+ COLOR 7, 0 'Clear screen and end\r
+ CLS\r
+\r
+ DEF SEG = 0 ' Restore CapLock, NumLock and ScrollLock states\r
+ POKE 1047, KeyFlags\r
+ DEF SEG\r
+\r
+ END\r
+\r
+' Error handler for program\r
+' If data file not found, create and initialize a new one.\r
+ErrorTrap:\r
+ SELECT CASE ERR\r
+ ' If data file not found, create and initialize a new one.\r
+ CASE 53\r
+ CLOSE\r
+ ColorPref = 1\r
+ FOR a = 1 TO 19\r
+ account(a).Title = ""\r
+ account(a).AType = ""\r
+ account(a).Desc = ""\r
+ NEXT a\r
+ SaveState\r
+ RESUME\r
+ CASE 24, 25\r
+ PrintErr = TRUE\r
+ Box 8, 13, 14, 69\r
+ Center 11, "Printer not responding ... Press Space to continue"\r
+ WHILE INKEY$ <> "": WEND\r
+ WHILE INKEY$ <> " ": WEND\r
+ RESUME NEXT\r
+ CASE ELSE\r
+ END SELECT\r
+ RESUME NEXT\r
+\r
+\r
+'The following data defines the color schemes available via the main menu.\r
+'\r
+' scrn dots bar back title shdow choice curs cursbk shdow\r
+DATA 0, 7, 15, 7, 0, 7, 0, 15, 0, 0\r
+DATA 1, 9, 12, 3, 0, 1, 15, 0, 7, 0\r
+DATA 3, 15, 13, 1, 14, 3, 15, 0, 7, 0\r
+DATA 7, 12, 15, 4, 14, 0, 15, 15, 1, 0\r
+\r
+'The following data is actually a machine language program to\r
+'scroll the screen up or down very fast using a BIOS call.\r
+DATA &HB8,&H01,&H06,&HB9,&H01,&H04,&HBA,&H4E,&H16,&HB7,&H00,&HCD,&H10,&HCB\r
+DATA &HB8,&H01,&H07,&HB9,&H01,&H04,&HBA,&H4E,&H16,&HB7,&H00,&HCD,&H10,&HCB\r
+\r
+'Box:\r
+' Draw a box on the screen between the given coordinates.\r
+SUB Box (Row1, Col1, Row2, Col2) STATIC\r
+\r
+ BoxWidth = Col2 - Col1 + 1\r
+\r
+ LOCATE Row1, Col1\r
+ PRINT "Ú"; STRING$(BoxWidth - 2, "Ä"); "¿";\r
+\r
+ FOR a = Row1 + 1 TO Row2 - 1\r
+ LOCATE a, Col1\r
+ PRINT "³"; SPACE$(BoxWidth - 2); "³";\r
+ NEXT a\r
+\r
+ LOCATE Row2, Col1\r
+ PRINT "À"; STRING$(BoxWidth - 2, "Ä"); "Ù";\r
+\r
+END SUB\r
+\r
+'Center:\r
+' Center text on the given row.\r
+SUB Center (row, text$)\r
+ LOCATE row, 41 - LEN(text$) / 2\r
+ PRINT text$;\r
+END SUB\r
+\r
+'Cvdt$:\r
+' Convert a double precision number to a string WITHOUT a leading space.\r
+FUNCTION Cvdt$ (X#)\r
+\r
+ Cvdt$ = RIGHT$(STR$(X#), LEN(STR$(X#)) - 1)\r
+\r
+END FUNCTION\r
+\r
+'Cvit$:\r
+' Convert an integer to a string WITHOUT a leading space.\r
+FUNCTION Cvit$ (X)\r
+ Cvit$ = RIGHT$(STR$(X), LEN(STR$(X)) - 1)\r
+END FUNCTION\r
+\r
+'Cvst$:\r
+' Convert a single precision number to a string WITHOUT a leading space\r
+FUNCTION Cvst$ (X!)\r
+ Cvst$ = RIGHT$(STR$(X!), LEN(STR$(X!)) - 1)\r
+END FUNCTION\r
+\r
+'EditAccounts:\r
+' This is the full-screen editor which allows you to change your account\r
+' titles and descriptions\r
+SUB EditAccounts\r
+\r
+ 'Information about each column\r
+ REDIM help$(4), col(4), Vis(4), Max(4), edit$(19, 3)\r
+\r
+ 'Draw the screen\r
+ COLOR colors(7, ColorPref), colors(4, ColorPref)\r
+ Box 2, 1, 24, 80\r
+\r
+ COLOR colors(5, ColorPref), colors(4, ColorPref)\r
+ LOCATE 1, 1: PRINT SPACE$(80)\r
+ LOCATE 1, 4: PRINT "Account Editor";\r
+ COLOR colors(7, ColorPref), colors(4, ColorPref)\r
+\r
+ LOCATE 3, 2: PRINT "No³ Account Title ³ Description ³A/L"\r
+ LOCATE 4, 2: PRINT "ÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄ"\r
+ u$ = "##³\ \³\ \³ ! "\r
+ FOR a = 5 TO 23\r
+ LOCATE a, 2\r
+ X = a - 4\r
+ PRINT USING u$; X; account(X).Title; account(X).Desc; account(X).AType;\r
+ NEXT a\r
+\r
+ 'Initialize variables\r
+ help$(1) = " Account name | <F2=Save and Exit> <Escape=Abort>"\r
+ help$(2) = " Account description | <F2=Save and Exit> <Escape=Abort>"\r
+ help$(3) = " Account type (A = Asset, L = Liability) | <F2=Save and Exit> <Escape=Abort>"\r
+ \r
+ col(1) = 5: col(2) = 26: col(3) = 78\r
+ Vis(1) = 20: Vis(2) = 50: Vis(3) = 1\r
+ Max(1) = 20: Max(2) = 50: Max(3) = 1\r
+\r
+ FOR a = 1 TO 19\r
+ edit$(a, 1) = account(a).Title\r
+ edit$(a, 2) = account(a).Desc\r
+ edit$(a, 3) = account(a).AType\r
+ NEXT a\r
+\r
+ finished = FALSE\r
+\r
+ CurrRow = 1\r
+ CurrCol = 1\r
+ PrintHelpLine help$(CurrCol)\r
+\r
+ 'Loop until F2 or <ESC> is pressed\r
+ DO\r
+ GOSUB EditAccountsShowCursor 'Show Cursor\r
+ DO 'Wait for key\r
+ Kbd$ = INKEY$\r
+ LOOP UNTIL Kbd$ <> ""\r
+\r
+ IF Kbd$ >= " " AND Kbd$ < "~" THEN 'If legal, edit item\r
+ GOSUB EditAccountsEditItem\r
+ END IF\r
+ GOSUB EditAccountsHideCursor 'Hide Cursor so it can move\r
+ 'If it needs to\r
+ SELECT CASE Kbd$\r
+ CASE CHR$(0) + "H" 'Up Arrow\r
+ CurrRow = (CurrRow + 17) MOD 19 + 1\r
+ CASE CHR$(0) + "P" 'Down Arrow\r
+ CurrRow = (CurrRow) MOD 19 + 1\r
+ CASE CHR$(0) + "K", CHR$(0) + CHR$(15) 'Left or Shift+Tab\r
+ CurrCol = (CurrCol + 1) MOD 3 + 1\r
+ PrintHelpLine help$(CurrCol)\r
+ CASE CHR$(0) + "M", CHR$(9) 'Right or Tab\r
+ CurrCol = (CurrCol) MOD 3 + 1\r
+ PrintHelpLine help$(CurrCol)\r
+ CASE CHR$(0) + "<" 'F2\r
+ finished = TRUE\r
+ Save = TRUE\r
+ CASE CHR$(27) 'Esc\r
+ finished = TRUE\r
+ Save = FALSE\r
+ CASE CHR$(13) 'Return\r
+ CASE ELSE\r
+ BEEP\r
+ END SELECT\r
+ LOOP UNTIL finished\r
+\r
+ IF Save THEN\r
+ GOSUB EditAccountsSaveData\r
+ END IF\r
+\r
+ EXIT SUB\r
+\r
+EditAccountsShowCursor:\r
+ COLOR colors(8, ColorPref), colors(9, ColorPref)\r
+ LOCATE CurrRow + 4, col(CurrCol)\r
+ PRINT LEFT$(edit$(CurrRow, CurrCol), Vis(CurrCol));\r
+ RETURN\r
+\r
+EditAccountsEditItem:\r
+ COLOR colors(8, ColorPref), colors(9, ColorPref)\r
+ ok = FALSE\r
+ start$ = Kbd$\r
+ DO\r
+ Kbd$ = GetString$(CurrRow + 4, col(CurrCol), start$, end$, Vis(CurrCol), Max(CurrCol))\r
+ edit$(CurrRow, CurrCol) = LEFT$(end$ + SPACE$(Max(CurrCol)), Max(CurrCol))\r
+ start$ = ""\r
+\r
+ IF CurrCol = 3 THEN\r
+ X$ = UCASE$(end$)\r
+ IF X$ = "A" OR X$ = "L" OR X$ = "" OR X$ = " " THEN\r
+ ok = TRUE\r
+ IF X$ = "" THEN X$ = " "\r
+ edit$(CurrRow, CurrCol) = X$\r
+ ELSE\r
+ BEEP\r
+ END IF\r
+ ELSE\r
+ ok = TRUE\r
+ END IF\r
+ \r
+ LOOP UNTIL ok\r
+ RETURN\r
+\r
+EditAccountsHideCursor:\r
+ COLOR colors(7, ColorPref), colors(4, ColorPref)\r
+ LOCATE CurrRow + 4, col(CurrCol)\r
+ PRINT LEFT$(edit$(CurrRow, CurrCol), Vis(CurrCol));\r
+ RETURN\r
+\r
+\r
+EditAccountsSaveData:\r
+ FOR a = 1 TO 19\r
+ account(a).Title = edit$(a, 1)\r
+ account(a).Desc = edit$(a, 2)\r
+ account(a).AType = edit$(a, 3)\r
+ NEXT a\r
+ SaveState\r
+ RETURN\r
+\r
+END SUB\r
+\r
+'EditTrans:\r
+' This is the full-screen editor which allows you to enter and change\r
+' transactions\r
+SUB EditTrans (item)\r
+\r
+ 'Stores info about each column\r
+ REDIM help$(6), col(6), Vis(6), Max(6), CurrString$(3), CurrFig#(5)\r
+ 'Array to keep the current balance at all the transactions\r
+ REDIM Balance#(1000)\r
+\r
+ 'Open random access file\r
+ file$ = "money." + Cvit$(item)\r
+ OPEN file$ FOR RANDOM AS #1 LEN = 84\r
+ FIELD #1, 8 AS IoDate$, 10 AS IoRef$, 50 AS IoDesc$, 8 AS IoFig1$, 8 AS IoFig2$\r
+ FIELD #1, 11 AS valid$, 5 AS IoMaxRecord$, 8 AS IoBalance$\r
+\r
+ 'Initialize variables\r
+ CurrString$(1) = ""\r
+ CurrString$(2) = ""\r
+ CurrString$(3) = ""\r
+ CurrFig#(4) = 0\r
+ CurrFig#(5) = 0\r
+\r
+ GET #1, 1\r
+ IF valid$ <> "THISISVALID" THEN\r
+ LSET IoDate$ = ""\r
+ LSET IoRef$ = ""\r
+ LSET IoDesc$ = ""\r
+ LSET IoFig1$ = MKD$(0)\r
+ LSET IoFig2$ = MKD$(0)\r
+ PUT #1, 2\r
+ LSET valid$ = "THISISVALID"\r
+ LSET IoMaxRecord$ = "1"\r
+ LSET IoBalance$ = MKD$(0)\r
+ PUT #1, 1\r
+ END IF\r
+\r
+ MaxRecord = VAL(IoMaxRecord$)\r
+\r
+ Balance#(0) = 0\r
+ a = 1\r
+ WHILE a <= MaxRecord\r
+ GET #1, a + 1\r
+ Balance#(a) = Balance#(a - 1) + CVD(IoFig1$) - CVD(IoFig2$)\r
+ a = a + 1\r
+ WEND\r
+ GOSUB EditTransWriteBalance\r
+\r
+ help$(1) = "Date of transaction (mm/dd/yy) "\r
+ help$(2) = "Transaction reference number "\r
+ help$(3) = "Transaction description "\r
+ help$(4) = "Increase asset or debt value "\r
+ help$(5) = "Decrease asset or debt value "\r
+\r
+ col(1) = 2\r
+ col(2) = 11\r
+ col(3) = 18\r
+ col(4) = 44\r
+ col(5) = 55\r
+\r
+ Vis(1) = 8\r
+ Vis(2) = 6\r
+ Vis(3) = 25\r
+ Vis(4) = 10\r
+ Vis(5) = 10\r
+\r
+ Max(1) = 8\r
+ Max(2) = 6\r
+ Max(3) = 25\r
+ Max(4) = 10\r
+ Max(5) = 10\r
+\r
+\r
+ 'Draw Screen\r
+ COLOR colors(7, ColorPref), colors(4, ColorPref)\r
+ Box 2, 1, 24, 80\r
+\r
+ COLOR colors(5, ColorPref), colors(4, ColorPref)\r
+ LOCATE 1, 1: PRINT SPACE$(80);\r
+ LOCATE 1, 4: PRINT "Transaction Editor: " + Trim$(account(item).Title);\r
+\r
+ COLOR colors(7, ColorPref), colors(4, ColorPref)\r
+ LOCATE 3, 2: PRINT " Date ³ Ref# ³ Description ³ Increase ³ Decrease ³ Balance "\r
+ LOCATE 4, 2: PRINT "ÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄÄ"\r
+\r
+ u$ = "\ \³\ \³\ \³"\r
+ u1$ = " ³ ³ ³ ³ ³ "\r
+ u1x$ = "ßßßßßßßß³ßßßßßß³ßßßßßßßßßßßßßßßßßßßßßßßßß³ßßßßßßßßßß³ßßßßßßßßßß³ßßßßßßßßßßßßßß"\r
+ u2$ = "###,###.##"\r
+ u3$ = "###,###,###.##"\r
+ u4$ = " "\r
+\r
+ CurrTopline = 1\r
+ GOSUB EditTransPrintWholeScreen\r
+\r
+ CurrRow = 1\r
+ CurrCol = 1\r
+ PrintHelpLine help$(CurrCol) + "| <F2=Save and Exit> <F9=Insert> <F10=Delete>"\r
+\r
+ GOSUB EditTransGetLine\r
+\r
+ finished = FALSE\r
+\r
+\r
+ 'Loop until <F2> is pressed\r
+ DO\r
+ GOSUB EditTransShowCursor 'Show Cursor, Wait for key\r
+ DO: Kbd$ = INKEY$: LOOP UNTIL Kbd$ <> ""\r
+ GOSUB EditTransHideCursor\r
+\r
+ IF Kbd$ >= " " AND Kbd$ < "~" OR Kbd$ = CHR$(8) THEN 'If legal key, edit item\r
+ GOSUB EditTransEditItem\r
+ END IF\r
+\r
+ SELECT CASE Kbd$ 'Handle Special keys\r
+ CASE CHR$(0) + "H" 'up arrow\r
+ GOSUB EditTransMoveUp\r
+ CASE CHR$(0) + "P" 'Down arrow\r
+ GOSUB EditTransMoveDown\r
+ CASE CHR$(0) + "K", CHR$(0) + CHR$(15) 'Left Arrow,BackTab\r
+ CurrCol = (CurrCol + 3) MOD 5 + 1\r
+ PrintHelpLine help$(CurrCol) + "| <F2=Save and Exit> <F9=Insert> <F10=Delete>"\r
+ CASE CHR$(0) + "M", CHR$(9) 'Right Arrow,Tab\r
+ CurrCol = (CurrCol) MOD 5 + 1\r
+ PrintHelpLine help$(CurrCol) + "| <F2=Save and Exit> <F9=Insert> <F10=Delete>"\r
+ CASE CHR$(0) + "G" 'Home\r
+ CurrCol = 1\r
+ CASE CHR$(0) + "O" 'End\r
+ CurrCol = 5\r
+ CASE CHR$(0) + "I" 'Page Up\r
+ CurrRow = 1\r
+ CurrTopline = CurrTopline - 19\r
+ IF CurrTopline < 1 THEN\r
+ CurrTopline = 1\r
+ END IF\r
+ GOSUB EditTransPrintWholeScreen\r
+ GOSUB EditTransGetLine\r
+ CASE CHR$(0) + "Q" 'Page Down\r
+ CurrRow = 1\r
+ CurrTopline = CurrTopline + 19\r
+ IF CurrTopline > MaxRecord THEN\r
+ CurrTopline = MaxRecord\r
+ END IF\r
+ GOSUB EditTransPrintWholeScreen\r
+ GOSUB EditTransGetLine\r
+ CASE CHR$(0) + "<" 'F2\r
+ finished = TRUE\r
+ CASE CHR$(0) + "C" 'F9\r
+ GOSUB EditTransAddRecord\r
+ CASE CHR$(0) + "D" 'F10\r
+ GOSUB EditTransDeleteRecord\r
+ CASE CHR$(13) 'Enter\r
+ CASE ELSE\r
+ BEEP\r
+ END SELECT\r
+ LOOP UNTIL finished\r
+\r
+ CLOSE\r
+\r
+ EXIT SUB\r
+\r
+\r
+EditTransShowCursor:\r
+ COLOR colors(8, ColorPref), colors(9, ColorPref)\r
+ LOCATE CurrRow + 4, col(CurrCol)\r
+ SELECT CASE CurrCol\r
+ CASE 1, 2, 3\r
+ PRINT LEFT$(CurrString$(CurrCol), Vis(CurrCol));\r
+ CASE 4\r
+ IF CurrFig#(4) <> 0 THEN\r
+ PRINT USING u2$; CurrFig#(4);\r
+ ELSE\r
+ PRINT SPACE$(Vis(CurrCol));\r
+ END IF\r
+ CASE 5\r
+ IF CurrFig#(5) <> 0 THEN\r
+ PRINT USING u2$; CurrFig#(5);\r
+ ELSE\r
+ PRINT SPACE$(Vis(CurrCol));\r
+ END IF\r
+ END SELECT\r
+ RETURN\r
+\r
+\r
+EditTransHideCursor:\r
+ COLOR colors(7, ColorPref), colors(4, ColorPref)\r
+ LOCATE CurrRow + 4, col(CurrCol)\r
+ SELECT CASE CurrCol\r
+ CASE 1, 2, 3\r
+ PRINT LEFT$(CurrString$(CurrCol), Vis(CurrCol));\r
+ CASE 4\r
+ IF CurrFig#(4) <> 0 THEN\r
+ PRINT USING u2$; CurrFig#(4);\r
+ ELSE\r
+ PRINT SPACE$(Vis(CurrCol));\r
+ END IF\r
+ CASE 5\r
+ IF CurrFig#(5) <> 0 THEN\r
+ PRINT USING u2$; CurrFig#(5);\r
+ ELSE\r
+ PRINT SPACE$(Vis(CurrCol));\r
+ END IF\r
+ END SELECT\r
+ RETURN\r
+\r
+\r
+EditTransEditItem:\r
+\r
+ CurrRecord = CurrTopline + CurrRow - 1\r
+ COLOR colors(8, ColorPref), colors(9, ColorPref)\r
+\r
+ SELECT CASE CurrCol\r
+ CASE 1, 2, 3\r
+ Kbd$ = GetString$(CurrRow + 4, col(CurrCol), Kbd$, new$, Vis(CurrCol), Max(CurrCol))\r
+ CurrString$(CurrCol) = new$\r
+ GOSUB EditTransPutLine\r
+ GOSUB EditTransGetLine\r
+ CASE 4\r
+ start$ = Kbd$\r
+ DO\r
+ Kbd$ = GetString$(CurrRow + 4, col(4), start$, new$, Vis(4), Max(4))\r
+ new4# = VAL(new$)\r
+ start$ = ""\r
+ LOOP WHILE new4# >= 999999.99# OR new4# < 0\r
+\r
+ a = CurrRecord\r
+ WHILE a <= MaxRecord\r
+ Balance#(a) = Balance#(a) + new4# - CurrFig#(4) + CurrFig#(5)\r
+ a = a + 1\r
+ WEND\r
+ CurrFig#(4) = new4#\r
+ CurrFig#(5) = 0\r
+ GOSUB EditTransPutLine\r
+ GOSUB EditTransGetLine\r
+ GOSUB EditTransPrintBalances\r
+ GOSUB EditTransWriteBalance\r
+ CASE 5\r
+ start$ = Kbd$\r
+ DO\r
+ Kbd$ = GetString$(CurrRow + 4, col(5), start$, new$, Vis(5), Max(5))\r
+ new5# = VAL(new$)\r
+ start$ = ""\r
+ LOOP WHILE new5# >= 999999.99# OR new5# < 0\r
+\r
+ a = CurrRecord\r
+ WHILE a <= MaxRecord\r
+ Balance#(a) = Balance#(a) - new5# + CurrFig#(5) - CurrFig#(4)\r
+ a = a + 1\r
+ WEND\r
+ CurrFig#(4) = 0\r
+ CurrFig#(5) = new5#\r
+ GOSUB EditTransPutLine\r
+ GOSUB EditTransGetLine\r
+ GOSUB EditTransPrintBalances\r
+ GOSUB EditTransWriteBalance\r
+ CASE ELSE\r
+ END SELECT\r
+ GOSUB EditTransPrintLine\r
+ RETURN\r
+\r
+EditTransMoveUp:\r
+ IF CurrRow = 1 THEN\r
+ IF CurrTopline = 1 THEN\r
+ BEEP\r
+ ELSE\r
+ ScrollDown\r
+ CurrTopline = CurrTopline - 1\r
+ GOSUB EditTransGetLine\r
+ GOSUB EditTransPrintLine\r
+ END IF\r
+ ELSE\r
+ CurrRow = CurrRow - 1\r
+ GOSUB EditTransGetLine\r
+ END IF\r
+ RETURN\r
+\r
+EditTransMoveDown:\r
+ IF (CurrRow + CurrTopline - 1) >= MaxRecord THEN\r
+ BEEP\r
+ ELSE\r
+ IF CurrRow = 19 THEN\r
+ ScrollUp\r
+ CurrTopline = CurrTopline + 1\r
+ GOSUB EditTransGetLine\r
+ GOSUB EditTransPrintLine\r
+ ELSE\r
+ CurrRow = CurrRow + 1\r
+ GOSUB EditTransGetLine\r
+ END IF\r
+ END IF\r
+ RETURN\r
+\r
+EditTransPrintLine:\r
+ COLOR colors(7, ColorPref), colors(4, ColorPref)\r
+ CurrRecord = CurrTopline + CurrRow - 1\r
+ LOCATE CurrRow + 4, 2\r
+ IF CurrRecord = MaxRecord + 1 THEN\r
+ PRINT u1x$;\r
+ ELSEIF CurrRecord > MaxRecord THEN\r
+ PRINT u1$;\r
+ ELSE\r
+ PRINT USING u$; CurrString$(1); CurrString$(2); CurrString$(3);\r
+ IF CurrFig#(4) = 0 AND CurrFig#(5) = 0 THEN\r
+ PRINT USING u4$ + "³" + u4$ + "³" + u3$; Balance#(CurrRecord)\r
+ ELSEIF CurrFig#(5) = 0 THEN\r
+ PRINT USING u2$ + "³" + u4$ + "³" + u3$; CurrFig#(4); Balance#(CurrRecord)\r
+ ELSE\r
+ PRINT USING u4$ + "³" + u2$ + "³" + u3$; CurrFig#(5); Balance#(CurrRecord)\r
+ END IF\r
+ END IF\r
+ RETURN\r
+\r
+EditTransPrintBalances:\r
+ COLOR colors(7, ColorPref), colors(4, ColorPref)\r
+ FOR a = 1 TO 19\r
+ CurrRecord = CurrTopline + a - 1\r
+ IF CurrRecord <= MaxRecord THEN\r
+ LOCATE 4 + a, 66\r
+ PRINT USING u3$; Balance#(CurrTopline + a - 1);\r
+ END IF\r
+ NEXT a\r
+ RETURN\r
+\r
+EditTransDeleteRecord:\r
+ IF MaxRecord = 1 THEN\r
+ BEEP\r
+ ELSE\r
+ CurrRecord = CurrTopline + CurrRow - 1\r
+ MaxRecord = MaxRecord - 1\r
+ a = CurrRecord\r
+ WHILE a <= MaxRecord\r
+ GET #1, a + 2\r
+ PUT #1, a + 1\r
+ Balance#(a) = Balance#(a + 1) - CurrFig#(4) + CurrFig#(5)\r
+ a = a + 1\r
+ WEND\r
+ \r
+ LSET valid$ = "THISISVALID"\r
+ LSET IoMaxRecord$ = Cvit$(MaxRecord)\r
+ PUT #1, 1\r
+ GOSUB EditTransPrintWholeScreen\r
+ CurrRecord = CurrTopline + CurrRow - 1\r
+ IF CurrRecord > MaxRecord THEN\r
+ GOSUB EditTransMoveUp\r
+ END IF\r
+ GOSUB EditTransGetLine\r
+ GOSUB EditTransWriteBalance\r
+ END IF\r
+ RETURN\r
+\r
+EditTransAddRecord:\r
+ CurrRecord = CurrTopline + CurrRow - 1\r
+ a = MaxRecord\r
+ WHILE a > CurrRecord\r
+ GET #1, a + 1\r
+ PUT #1, a + 2\r
+ Balance#(a + 1) = Balance#(a)\r
+ a = a - 1\r
+ WEND\r
+ Balance#(CurrRecord + 1) = Balance#(CurrRecord)\r
+ MaxRecord = MaxRecord + 1\r
+ LSET IoDate$ = ""\r
+ LSET IoRef$ = ""\r
+ LSET IoDesc$ = ""\r
+ LSET IoFig1$ = MKD$(0)\r
+ LSET IoFig2$ = MKD$(0)\r
+ PUT #1, CurrRecord + 2\r
+\r
+ LSET valid$ = "THISISVALID"\r
+ LSET IoMaxRecord$ = Cvit$(MaxRecord)\r
+ PUT #1, 1\r
+ GOSUB EditTransPrintWholeScreen\r
+ GOSUB EditTransGetLine\r
+ RETURN\r
+\r
+EditTransPrintWholeScreen:\r
+ temp = CurrRow\r
+ FOR CurrRow = 1 TO 19\r
+ CurrRecord = CurrTopline + CurrRow - 1\r
+ IF CurrRecord <= MaxRecord THEN\r
+ GOSUB EditTransGetLine\r
+ END IF\r
+ GOSUB EditTransPrintLine\r
+ NEXT CurrRow\r
+ CurrRow = temp\r
+ RETURN\r
+\r
+EditTransWriteBalance:\r
+ GET #1, 1\r
+ LSET IoBalance$ = MKD$(Balance#(MaxRecord))\r
+ PUT #1, 1\r
+ RETURN\r
+\r
+EditTransPutLine:\r
+ CurrRecord = CurrTopline + CurrRow - 1\r
+ LSET IoDate$ = CurrString$(1)\r
+ LSET IoRef$ = CurrString$(2)\r
+ LSET IoDesc$ = CurrString$(3)\r
+ LSET IoFig1$ = MKD$(CurrFig#(4))\r
+ LSET IoFig2$ = MKD$(CurrFig#(5))\r
+ PUT #1, CurrRecord + 1\r
+ RETURN\r
+\r
+EditTransGetLine:\r
+ CurrRecord = CurrTopline + CurrRow - 1\r
+ GET #1, CurrRecord + 1\r
+ CurrString$(1) = IoDate$\r
+ CurrString$(2) = IoRef$\r
+ CurrString$(3) = IoDesc$\r
+ CurrFig#(4) = CVD(IoFig1$)\r
+ CurrFig#(5) = CVD(IoFig2$)\r
+ RETURN\r
+END SUB\r
+\r
+'FancyCls:\r
+' Clears screen in the right color, and draws nice dots.\r
+SUB FancyCls (dots, Background)\r
+\r
+ VIEW PRINT 2 TO 24\r
+ COLOR dots, Background\r
+ CLS 2\r
+\r
+ FOR a = 95 TO 1820 STEP 45\r
+ row = a / 80 + 1\r
+ col = a MOD 80 + 1\r
+ LOCATE row, col\r
+ PRINT CHR$(250);\r
+ NEXT a\r
+\r
+ VIEW PRINT\r
+\r
+END SUB\r
+\r
+'GetString$:\r
+' Given a row and col, and an initial string, edit a string\r
+' VIS is the length of the visible field of entry\r
+' MAX is the maximum number of characters allowed in the string\r
+FUNCTION GetString$ (row, col, start$, end$, Vis, Max)\r
+ curr$ = Trim$(LEFT$(start$, Max))\r
+ IF curr$ = CHR$(8) THEN curr$ = ""\r
+\r
+ LOCATE , , 1\r
+\r
+ finished = FALSE\r
+ DO\r
+ GOSUB GetStringShowText\r
+ GOSUB GetStringGetKey\r
+\r
+ IF LEN(Kbd$) > 1 THEN\r
+ finished = TRUE\r
+ GetString$ = Kbd$\r
+ ELSE\r
+ SELECT CASE Kbd$\r
+ CASE CHR$(13), CHR$(27), CHR$(9)\r
+ finished = TRUE\r
+ GetString$ = Kbd$\r
+ \r
+ CASE CHR$(8)\r
+ IF curr$ <> "" THEN\r
+ curr$ = LEFT$(curr$, LEN(curr$) - 1)\r
+ END IF\r
+\r
+ CASE " " TO "}"\r
+ IF LEN(curr$) < Max THEN\r
+ curr$ = curr$ + Kbd$\r
+ ELSE\r
+ BEEP\r
+ END IF\r
+\r
+ CASE ELSE\r
+ BEEP\r
+ END SELECT\r
+ END IF\r
+\r
+ LOOP UNTIL finished\r
+\r
+ end$ = curr$\r
+ LOCATE , , 0\r
+ EXIT FUNCTION\r
+ \r
+\r
+GetStringShowText:\r
+ LOCATE row, col\r
+ IF LEN(curr$) > Vis THEN\r
+ PRINT RIGHT$(curr$, Vis);\r
+ ELSE\r
+ PRINT curr$; SPACE$(Vis - LEN(curr$));\r
+ LOCATE row, col + LEN(curr$)\r
+ END IF\r
+ RETURN\r
+\r
+GetStringGetKey:\r
+ Kbd$ = ""\r
+ WHILE Kbd$ = ""\r
+ Kbd$ = INKEY$\r
+ WEND\r
+ RETURN\r
+END FUNCTION\r
+\r
+'Initialize:\r
+' Read colors in and set up assembly routines\r
+SUB Initialize\r
+\r
+ WIDTH , 25\r
+ VIEW PRINT\r
+\r
+ FOR ColorSet = 1 TO 4\r
+ FOR X = 1 TO 10\r
+ READ colors(X, ColorSet)\r
+ NEXT X\r
+ NEXT ColorSet\r
+\r
+ LoadState\r
+\r
+ P = VARPTR(ScrollUpAsm(1))\r
+ DEF SEG = VARSEG(ScrollUpAsm(1))\r
+ FOR I = 0 TO 13\r
+ READ J\r
+ POKE (P + I), J\r
+ NEXT I\r
+\r
+ P = VARPTR(ScrollDownAsm(1))\r
+ DEF SEG = VARSEG(ScrollDownAsm(1))\r
+ FOR I = 0 TO 13\r
+ READ J\r
+ POKE (P + I), J\r
+ NEXT I\r
+\r
+ DEF SEG\r
+\r
+END SUB\r
+\r
+'Intro:\r
+' Display introduction screen.\r
+SUB Intro\r
+ SCREEN 0\r
+ WIDTH 80, 25\r
+ COLOR 7, 0\r
+ CLS\r
+\r
+ Center 4, "Q B a s i c"\r
+ COLOR 15\r
+ Center 5, "Ü Ü ÜÜÜÜ Ü Ü ÜÜÜÜ Ü Ü Ü Ü ÜÜÜÜ Ü Ü ÜÜÜÜ ÜÜÜÜÜ ÜÜÜÜ ÜÜÜÜÜ"\r
+ Center 6, "ÛßÜ ÜßÛ Û Û ÛÜ Û Û ÛÜÜÜÛ ÛßÜ ÜßÛ Û Û ÛÜ Û Û Û Û Û Û Û"\r
+ Center 7, "Û ß Û Û Û Û ßÜÛ Ûßßß Û Û ß Û ÛßßÛ Û ßÜÛ ÛßßÛ Û ßßÛ Ûßßß ÛßÛßß"\r
+ Center 8, "Û Û ÛÜÜÛ Û Û ÛÜÜÜ Û Û Û Û Û Û Û Û Û ÛÜÜÜÛ ÛÜÜÜ Û ßÜ"\r
+ COLOR 7\r
+ Center 11, "A Personal Finance Manager written in"\r
+ Center 12, "MS-DOS QBasic"\r
+ Center 24, "Press any key to continue"\r
+\r
+ SparklePause\r
+END SUB\r
+\r
+'LCenter:\r
+' Center TEXT$ on the line printer\r
+SUB LCenter (text$)\r
+ LPRINT TAB(41 - LEN(text$) / 2); text$\r
+END SUB\r
+\r
+'LoadState:\r
+' Load color preferences and account info from MONEY.DAT\r
+SUB LoadState\r
+\r
+ OPEN "money.dat" FOR INPUT AS #1\r
+ INPUT #1, ColorPref\r
+\r
+ FOR a = 1 TO 19\r
+ LINE INPUT #1, account(a).Title\r
+ LINE INPUT #1, account(a).AType\r
+ LINE INPUT #1, account(a).Desc\r
+ NEXT a\r
+ \r
+ CLOSE\r
+\r
+END SUB\r
+\r
+'Menu:\r
+' Handles Menu Selection for a single menu (either sub menu, or menu bar)\r
+' currChoiceX : Number of current choice\r
+' maxChoice : Number of choices in the list\r
+' choice$() : Array with the text of the choices\r
+' itemRow() : Array with the row of the choices\r
+' itemCol() : Array with the col of the choices\r
+' help$() : Array with the help text for each choice\r
+' barMode : Boolean: TRUE = menu bar style, FALSE = drop down style\r
+'\r
+' Returns the number of the choice that was made by changing currChoiceX\r
+' and returns the scan code of the key that was pressed to exit\r
+'\r
+FUNCTION Menu (CurrChoiceX, MaxChoice, choice$(), ItemRow(), ItemCol(), help$(), BarMode)\r
+ \r
+ currChoice = CurrChoiceX\r
+\r
+ 'if in bar mode, color in menu bar, else color box/shadow\r
+ 'bar mode means you are currently in the menu bar, not a sub menu\r
+ IF BarMode THEN\r
+ COLOR colors(7, ColorPref), colors(4, ColorPref)\r
+ LOCATE 1, 1\r
+ PRINT SPACE$(80);\r
+ ELSE\r
+ FancyCls colors(2, ColorPref), colors(1, ColorPref)\r
+ COLOR colors(7, ColorPref), colors(4, ColorPref)\r
+ Box ItemRow(1) - 1, ItemCol(1) - 1, ItemRow(MaxChoice) + 1, ItemCol(1) + LEN(choice$(1)) + 1\r
+ \r
+ COLOR colors(10, ColorPref), colors(6, ColorPref)\r
+ FOR a = 1 TO MaxChoice + 1\r
+ LOCATE ItemRow(1) + a - 1, ItemCol(1) + LEN(choice$(1)) + 2\r
+ PRINT CHR$(178); CHR$(178);\r
+ NEXT a\r
+ LOCATE ItemRow(MaxChoice) + 2, ItemCol(MaxChoice) + 2\r
+ PRINT STRING$(LEN(choice$(MaxChoice)) + 2, 178);\r
+ END IF\r
+ \r
+ 'print the choices\r
+ COLOR colors(7, ColorPref), colors(4, ColorPref)\r
+ FOR a = 1 TO MaxChoice\r
+ LOCATE ItemRow(a), ItemCol(a)\r
+ PRINT choice$(a);\r
+ NEXT a\r
+\r
+ finished = FALSE\r
+\r
+ WHILE NOT finished\r
+ \r
+ GOSUB MenuShowCursor\r
+ GOSUB MenuGetKey\r
+ GOSUB MenuHideCursor\r
+\r
+ SELECT CASE Kbd$\r
+ CASE CHR$(0) + "H": GOSUB MenuUp\r
+ CASE CHR$(0) + "P": GOSUB MenuDown\r
+ CASE CHR$(0) + "K": GOSUB MenuLeft\r
+ CASE CHR$(0) + "M": GOSUB MenuRight\r
+ CASE CHR$(13): GOSUB MenuEnter\r
+ CASE CHR$(27): GOSUB MenuEscape\r
+ CASE ELSE: BEEP\r
+ END SELECT\r
+ WEND\r
+\r
+ Menu = currChoice\r
+\r
+ EXIT FUNCTION\r
+\r
+\r
+MenuEnter:\r
+ finished = TRUE\r
+ RETURN\r
+\r
+MenuEscape:\r
+ currChoice = 0\r
+ finished = TRUE\r
+ RETURN\r
+\r
+MenuUp:\r
+ IF BarMode THEN\r
+ BEEP\r
+ ELSE\r
+ currChoice = (currChoice + MaxChoice - 2) MOD MaxChoice + 1\r
+ END IF\r
+ RETURN\r
+\r
+MenuLeft:\r
+ IF BarMode THEN\r
+ currChoice = (currChoice + MaxChoice - 2) MOD MaxChoice + 1\r
+ ELSE\r
+ currChoice = -2\r
+ finished = TRUE\r
+ END IF\r
+ RETURN\r
+\r
+MenuRight:\r
+ IF BarMode THEN\r
+ currChoice = (currChoice) MOD MaxChoice + 1\r
+ ELSE\r
+ currChoice = -3\r
+ finished = TRUE\r
+ END IF\r
+ RETURN\r
+\r
+MenuDown:\r
+ IF BarMode THEN\r
+ finished = TRUE\r
+ ELSE\r
+ currChoice = (currChoice) MOD MaxChoice + 1\r
+ END IF\r
+ RETURN\r
+\r
+MenuShowCursor:\r
+ COLOR colors(8, ColorPref), colors(9, ColorPref)\r
+ LOCATE ItemRow(currChoice), ItemCol(currChoice)\r
+ PRINT choice$(currChoice);\r
+ PrintHelpLine help$(currChoice)\r
+ RETURN\r
+\r
+MenuGetKey:\r
+ Kbd$ = ""\r
+ WHILE Kbd$ = ""\r
+ Kbd$ = INKEY$\r
+ WEND\r
+ RETURN\r
+\r
+MenuHideCursor:\r
+ COLOR colors(7, ColorPref), colors(4, ColorPref)\r
+ LOCATE ItemRow(currChoice), ItemCol(currChoice)\r
+ PRINT choice$(currChoice);\r
+ RETURN\r
+\r
+\r
+END FUNCTION\r
+\r
+'MenuSystem:\r
+' Main routine that controls the program. Uses the MENU function\r
+' to implement menu system and calls the appropriate function to handle\r
+' the user's selection\r
+SUB MenuSystem\r
+\r
+ DIM choice$(20), menuRow(20), menuCol(20), help$(20)\r
+ LOCATE , , 0\r
+ choice = 1\r
+ finished = FALSE\r
+\r
+ WHILE NOT finished\r
+ GOSUB MenuSystemMain\r
+\r
+ subchoice = -1\r
+ WHILE subchoice < 0\r
+ SELECT CASE choice\r
+ CASE 1: GOSUB MenuSystemFile\r
+ CASE 2: GOSUB MenuSystemEdit\r
+ CASE 3: GOSUB MenuSystemAccount\r
+ CASE 4: GOSUB MenuSystemReport\r
+ CASE 5: GOSUB MenuSystemColors\r
+ END SELECT\r
+ FancyCls colors(2, ColorPref), colors(1, ColorPref)\r
+\r
+ SELECT CASE subchoice\r
+ CASE -2: choice = (choice + 3) MOD 5 + 1\r
+ CASE -3: choice = (choice) MOD 5 + 1\r
+ END SELECT\r
+ WEND\r
+ WEND\r
+ EXIT SUB\r
+\r
+\r
+MenuSystemMain:\r
+ FancyCls colors(2, ColorPref), colors(1, ColorPref)\r
+ COLOR colors(7, ColorPref), colors(4, ColorPref)\r
+ Box 9, 19, 14, 61\r
+ Center 11, "Use arrow keys to navigate menu system"\r
+ Center 12, "Press Enter to select a menu item"\r
+\r
+ choice$(1) = " File "\r
+ choice$(2) = " Accounts "\r
+ choice$(3) = " Transactions "\r
+ choice$(4) = " Reports "\r
+ choice$(5) = " Colors "\r
+\r
+ menuRow(1) = 1: menuCol(1) = 2\r
+ menuRow(2) = 1: menuCol(2) = 8\r
+ menuRow(3) = 1: menuCol(3) = 18\r
+ menuRow(4) = 1: menuCol(4) = 32\r
+ menuRow(5) = 1: menuCol(5) = 41\r
+ \r
+ help$(1) = "Exit the Money Manager"\r
+ help$(2) = "Add/edit/delete accounts"\r
+ help$(3) = "Add/edit/delete account transactions"\r
+ help$(4) = "View and print reports"\r
+ help$(5) = "Set screen colors"\r
+ \r
+ DO\r
+ NewChoice = Menu((choice), 5, choice$(), menuRow(), menuCol(), help$(), TRUE)\r
+ LOOP WHILE NewChoice = 0\r
+ choice = NewChoice\r
+ RETURN\r
+\r
+MenuSystemFile:\r
+ choice$(1) = " Exit "\r
+\r
+ menuRow(1) = 3: menuCol(1) = 2\r
+\r
+ help$(1) = "Exit the Money Manager"\r
+\r
+ subchoice = Menu(1, 1, choice$(), menuRow(), menuCol(), help$(), FALSE)\r
+\r
+ SELECT CASE subchoice\r
+ CASE 1: finished = TRUE\r
+ CASE ELSE\r
+ END SELECT\r
+ RETURN\r
+\r
+\r
+MenuSystemEdit:\r
+ choice$(1) = " Edit Account Titles "\r
+\r
+ menuRow(1) = 3: menuCol(1) = 8\r
+ \r
+ help$(1) = "Add/edit/delete accounts"\r
+\r
+ subchoice = Menu(1, 1, choice$(), menuRow(), menuCol(), help$(), FALSE)\r
+\r
+ SELECT CASE subchoice\r
+ CASE 1: EditAccounts\r
+ CASE ELSE\r
+ END SELECT\r
+ RETURN\r
+\r
+\r
+MenuSystemAccount:\r
+\r
+ FOR a = 1 TO 19\r
+ IF Trim$(account(a).Title) = "" THEN\r
+ choice$(a) = RIGHT$(STR$(a), 2) + ". ------------------- "\r
+ ELSE\r
+ choice$(a) = RIGHT$(STR$(a), 2) + ". " + account(a).Title\r
+ END IF\r
+ menuRow(a) = a + 2\r
+ menuCol(a) = 19\r
+ help$(a) = RTRIM$(account(a).Desc)\r
+ NEXT a\r
+\r
+ subchoice = Menu(1, 19, choice$(), menuRow(), menuCol(), help$(), FALSE)\r
+\r
+ IF subchoice > 0 THEN\r
+ EditTrans (subchoice)\r
+ END IF\r
+ RETURN\r
+\r
+\r
+MenuSystemReport:\r
+ choice$(1) = " Net Worth Report "\r
+ menuRow(1) = 3: menuCol(1) = 32\r
+ help$(1) = "View and print net worth report"\r
+\r
+ FOR a = 1 TO 19\r
+ IF Trim$(account(a).Title) = "" THEN\r
+ choice$(a + 1) = RIGHT$(STR$(a), 2) + ". ------------------- "\r
+ ELSE\r
+ choice$(a + 1) = RIGHT$(STR$(a), 2) + ". " + account(a).Title\r
+ END IF\r
+ menuRow(a + 1) = a + 3\r
+ menuCol(a + 1) = 32\r
+ help$(a + 1) = "Print " + RTRIM$(account(a).Title) + " transaction summary"\r
+ NEXT a\r
+\r
+ subchoice = Menu(1, 20, choice$(), menuRow(), menuCol(), help$(), FALSE)\r
+\r
+ SELECT CASE subchoice\r
+ CASE 1\r
+ NetWorthReport\r
+ CASE 2 TO 20\r
+ TransactionSummary (subchoice - 1)\r
+ CASE ELSE\r
+ END SELECT\r
+ RETURN\r
+\r
+MenuSystemColors:\r
+ choice$(1) = " Monochrome Scheme "\r
+ choice$(2) = " Cyan/Blue Scheme "\r
+ choice$(3) = " Blue/Cyan Scheme "\r
+ choice$(4) = " Red/Grey Scheme "\r
+\r
+ menuRow(1) = 3: menuCol(1) = 41\r
+ menuRow(2) = 4: menuCol(2) = 41\r
+ menuRow(3) = 5: menuCol(3) = 41\r
+ menuRow(4) = 6: menuCol(4) = 41\r
+\r
+ help$(1) = "Color scheme for monochrome and LCD displays"\r
+ help$(2) = "Color scheme featuring cyan"\r
+ help$(3) = "Color scheme featuring blue"\r
+ help$(4) = "Color scheme featuring red"\r
+\r
+ subchoice = Menu(1, 4, choice$(), menuRow(), menuCol(), help$(), FALSE)\r
+\r
+ SELECT CASE subchoice\r
+ CASE 1 TO 4\r
+ ColorPref = subchoice\r
+ SaveState\r
+ CASE ELSE\r
+ END SELECT\r
+ RETURN\r
+\r
+\r
+END SUB\r
+\r
+'NetWorthReport:\r
+' Prints net worth report to screen and printer\r
+SUB NetWorthReport\r
+ DIM assetIndex(19), liabilityIndex(19)\r
+\r
+ maxAsset = 0\r
+ maxLiability = 0\r
+\r
+ FOR a = 1 TO 19\r
+ IF account(a).AType = "A" THEN\r
+ maxAsset = maxAsset + 1\r
+ assetIndex(maxAsset) = a\r
+ ELSEIF account(a).AType = "L" THEN\r
+ maxLiability = maxLiability + 1\r
+ liabilityIndex(maxLiability) = a\r
+ END IF\r
+ NEXT a\r
+\r
+ 'Loop until <F2> is pressed\r
+ finished = FALSE\r
+ DO\r
+ u1$ = "\ \$$###,###,###.##"\r
+ u2$ = "\ \+$$#,###,###,###.##"\r
+\r
+ COLOR colors(5, ColorPref), colors(4, ColorPref)\r
+ LOCATE 1, 1: PRINT SPACE$(80);\r
+ LOCATE 1, 4: PRINT "Net Worth Report: " + DATE$;\r
+ PrintHelpLine "<F2=Exit> <F3=Print Report>"\r
+\r
+ COLOR colors(7, ColorPref), colors(4, ColorPref)\r
+ Box 2, 1, 24, 40\r
+ Box 2, 41, 24, 80\r
+\r
+ LOCATE 2, 16: PRINT " ASSETS "\r
+ assetTotal# = 0\r
+ a = 1\r
+ count1 = 1\r
+ WHILE a <= maxAsset\r
+ file$ = "money." + Cvit$(assetIndex(a))\r
+ OPEN file$ FOR RANDOM AS #1 LEN = 84\r
+ FIELD #1, 11 AS valid$, 5 AS IoMaxRecord$, 8 AS IoBalance$\r
+ GET #1, 1\r
+ IF valid$ = "THISISVALID" THEN\r
+ LOCATE 2 + count1, 3: PRINT USING u1$; account(assetIndex(a)).Title; CVD(IoBalance$)\r
+ assetTotal# = assetTotal# + CVD(IoBalance$)\r
+ count1 = count1 + 1\r
+ END IF\r
+ CLOSE\r
+ a = a + 1\r
+ WEND\r
+\r
+ LOCATE 2, 55: PRINT " LIABILITIES "\r
+ liabilityTotal# = 0\r
+ a = 1\r
+ count2 = 1\r
+ WHILE a <= maxLiability\r
+ file$ = "money." + Cvit$(liabilityIndex(a))\r
+ OPEN file$ FOR RANDOM AS #1 LEN = 84\r
+ FIELD #1, 11 AS valid$, 5 AS IoMaxRecord$, 8 AS IoBalance$\r
+ GET #1, 1\r
+ IF valid$ = "THISISVALID" THEN\r
+ LOCATE 2 + count2, 43: PRINT USING u1$; account(liabilityIndex(a)).Title; CVD(IoBalance$)\r
+ liabilityTotal# = liabilityTotal# + CVD(IoBalance$)\r
+ count2 = count2 + 1\r
+ END IF\r
+ CLOSE\r
+ a = a + 1\r
+ WEND\r
+ IF count2 > count1 THEN count1 = count2\r
+ LOCATE 2 + count1, 25: PRINT "--------------"\r
+ LOCATE 2 + count1, 65: PRINT "--------------"\r
+ LOCATE 3 + count1, 3: PRINT USING u2$; "Total assets"; assetTotal#;\r
+ LOCATE 3 + count1, 43: PRINT USING u2$; "Total liabilities"; liabilityTotal#\r
+\r
+ COLOR colors(5, ColorPref), colors(4, ColorPref)\r
+ LOCATE 1, 43: PRINT USING u2$; " NET WORTH:"; assetTotal# - liabilityTotal#\r
+\r
+ DO: Kbd$ = INKEY$: LOOP UNTIL Kbd$ <> ""\r
+\r
+ SELECT CASE Kbd$ 'Handle Special keys\r
+ CASE CHR$(0) + "<" 'F2\r
+ finished = TRUE\r
+ CASE CHR$(0) + "=" 'F3\r
+ GOSUB NetWorthReportPrint\r
+ CASE ELSE\r
+ BEEP\r
+ END SELECT\r
+ LOOP UNTIL finished\r
+ EXIT SUB\r
+\r
+NetWorthReportPrint:\r
+ PrintHelpLine ""\r
+ \r
+ Box 8, 20, 14, 62\r
+ Center 10, "Prepare printer on LPT1 for report"\r
+ Center 12, "Hit <Enter> to print, or <Esc> to abort"\r
+\r
+ DO: Kbd$ = INKEY$: LOOP WHILE Kbd$ <> CHR$(13) AND Kbd$ <> CHR$(27)\r
+\r
+ IF Kbd$ = CHR$(13) THEN\r
+ Box 8, 20, 14, 62\r
+ Center 11, "Printing report..."\r
+ u0$ = " \ \ "\r
+ u1$ = " \ \ $$###,###,###.##"\r
+ u2$ = " --------------"\r
+ u3$ = " ============="\r
+ u4$ = " \ \+$$#,###,###,###.##"\r
+ PrintErr = FALSE\r
+ ON ERROR GOTO ErrorTrap ' test if printer is connected\r
+ LPRINT\r
+ IF PrintErr = FALSE THEN\r
+ LPRINT : LPRINT : LPRINT : LPRINT : LPRINT\r
+ LCenter "Q B a s i c"\r
+ LCenter "M O N E Y M A N A G E R"\r
+ LPRINT : LPRINT\r
+ LCenter "NET WORTH REPORT: " + DATE$\r
+ LCenter "-------------------------------------------"\r
+ LPRINT USING u0$; "ASSETS:"\r
+ assetTotal# = 0\r
+ a = 1\r
+ WHILE a <= maxAsset\r
+ file$ = "money." + Cvit$(assetIndex(a))\r
+ OPEN file$ FOR RANDOM AS #1 LEN = 84\r
+ FIELD #1, 11 AS valid$, 5 AS IoMaxRecord$, 8 AS IoBalance$\r
+ GET #1, 1\r
+ IF valid$ = "THISISVALID" THEN\r
+ LPRINT USING u1$; account(assetIndex(a)).Title; CVD(IoBalance$)\r
+ assetTotal# = assetTotal# + CVD(IoBalance$)\r
+ END IF\r
+ CLOSE #1\r
+ a = a + 1\r
+ WEND\r
+ LPRINT u2$\r
+ LPRINT USING u4$; "Total assets"; assetTotal#\r
+ LPRINT\r
+ LPRINT\r
+ LPRINT USING u0$; "LIABILITIES:"\r
+ liabilityTotal# = 0\r
+ a = 1\r
+ WHILE a <= maxLiability\r
+ file$ = "money." + Cvit$(liabilityIndex(a))\r
+ OPEN file$ FOR RANDOM AS #1 LEN = 84\r
+ FIELD #1, 11 AS valid$, 5 AS IoMaxRecord$, 8 AS IoBalance$\r
+ GET #1, 1\r
+ IF valid$ = "THISISVALID" THEN\r
+ LPRINT USING u1$; account(liabilityIndex(a)).Title; CVD(IoBalance$)\r
+ liabilityTotal# = liabilityTotal# + CVD(IoBalance$)\r
+ END IF\r
+ CLOSE #1\r
+ a = a + 1\r
+ WEND\r
+ LPRINT u2$\r
+ LPRINT USING u4$; "Total liabilities"; liabilityTotal#\r
+ LPRINT\r
+\r
+ LPRINT\r
+ LPRINT u3$\r
+ LPRINT USING u4$; "NET WORTH"; assetTotal# - liabilityTotal#\r
+ LCenter "-------------------------------------------"\r
+ LPRINT : LPRINT : LPRINT\r
+ END IF\r
+ ON ERROR GOTO 0\r
+ END IF\r
+ RETURN\r
+END SUB\r
+\r
+'PrintHelpLine:\r
+' Prints help text on the bottom row in the proper color\r
+SUB PrintHelpLine (help$)\r
+ COLOR colors(5, ColorPref), colors(4, ColorPref)\r
+ LOCATE 25, 1\r
+ PRINT SPACE$(80);\r
+ Center 25, help$\r
+END SUB\r
+\r
+'SaveState:\r
+' Save color preference and account information to "MONEY.DAT" data file.\r
+SUB SaveState\r
+ OPEN "money.dat" FOR OUTPUT AS #2\r
+ PRINT #2, ColorPref\r
+ \r
+ FOR a = 1 TO 19\r
+ PRINT #2, account(a).Title\r
+ PRINT #2, account(a).AType\r
+ PRINT #2, account(a).Desc\r
+ NEXT a\r
+ \r
+ CLOSE #2\r
+END SUB\r
+\r
+'ScrollDown:\r
+' Call the assembly program to scroll the screen down\r
+SUB ScrollDown\r
+ DEF SEG = VARSEG(ScrollDownAsm(1))\r
+ CALL Absolute(VARPTR(ScrollDownAsm(1)))\r
+ DEF SEG\r
+END SUB\r
+\r
+'ScrollUp:\r
+' Calls the assembly program to scroll the screen up\r
+SUB ScrollUp\r
+ DEF SEG = VARSEG(ScrollUpAsm(1))\r
+ CALL Absolute(VARPTR(ScrollUpAsm(1)))\r
+ DEF SEG\r
+END SUB\r
+\r
+'SparklePause:\r
+' Creates flashing border for intro screen\r
+SUB SparklePause\r
+\r
+ COLOR 4, 0\r
+ a$ = "* * * * * * * * * * * * * * * * * "\r
+ WHILE INKEY$ <> "": WEND 'Clear keyboard buffer\r
+\r
+ WHILE INKEY$ = ""\r
+ FOR a = 1 TO 5\r
+ LOCATE 1, 1 'print horizontal sparkles\r
+ PRINT MID$(a$, a, 80);\r
+ LOCATE 22, 1\r
+ PRINT MID$(a$, 6 - a, 80);\r
+\r
+ FOR b = 2 TO 21 'Print Vertical sparkles\r
+ c = (a + b) MOD 5\r
+ IF c = 1 THEN\r
+ LOCATE b, 80\r
+ PRINT "*";\r
+ LOCATE 23 - b, 1\r
+ PRINT "*";\r
+ ELSE\r
+ LOCATE b, 80\r
+ PRINT " ";\r
+ LOCATE 23 - b, 1\r
+ PRINT " ";\r
+ END IF\r
+ NEXT b\r
+ NEXT a\r
+ WEND\r
+END SUB\r
+\r
+'TransactionSummary:\r
+' Print transaction summary to line printer\r
+SUB TransactionSummary (item)\r
+ FancyCls colors(2, ColorPref), colors(1, ColorPref)\r
+ PrintHelpLine ""\r
+ Box 8, 20, 14, 62\r
+ Center 10, "Prepare printer on LPT1 for report"\r
+ Center 12, "Hit <Enter> to print, or <Esc> to abort"\r
+\r
+ DO: Kbd$ = INKEY$: LOOP WHILE Kbd$ <> CHR$(13) AND Kbd$ <> CHR$(27)\r
+\r
+ IF Kbd$ = CHR$(13) THEN\r
+ Box 8, 20, 14, 62\r
+ Center 11, "Printing report..."\r
+ PrintErr = FALSE\r
+ ON ERROR GOTO ErrorTrap ' test if printer is connected\r
+ LPRINT\r
+ IF PrintErr = FALSE THEN\r
+ PRINT\r
+ LPRINT : LPRINT : LPRINT : LPRINT : LPRINT\r
+ LCenter "Q B a s i c"\r
+ LCenter "M O N E Y M A N A G E R"\r
+ LPRINT : LPRINT\r
+ LCenter "Transaction summary: " + Trim$(account(item).Title)\r
+ LCenter DATE$\r
+ LPRINT\r
+ u5$ = "--------|------|------------------------|----------|----------|--------------"\r
+ LPRINT u5$\r
+ LPRINT " Date | Ref# | Description | Increase | Decrease | Balance "\r
+ LPRINT u5$\r
+ u0$ = "\ \|\ \|\ \|"\r
+ u2$ = "###,###.##"\r
+ u3$ = "###,###,###.##"\r
+ u4$ = " "\r
+\r
+ file$ = "money." + Cvit$(item)\r
+ OPEN file$ FOR RANDOM AS #1 LEN = 84\r
+ FIELD #1, 8 AS IoDate$, 10 AS IoRef$, 50 AS IoDesc$, 8 AS IoFig1$, 8 AS IoFig2$\r
+ FIELD #1, 11 AS valid$, 5 AS IoMaxRecord$, 8 AS IoBalance$\r
+ GET #1, 1\r
+ IF valid$ = "THISISVALID" THEN\r
+ Balance# = 0\r
+ MaxRecord = VAL(IoMaxRecord$)\r
+ CurrRecord = 1\r
+ WHILE CurrRecord <= MaxRecord\r
+\r
+ GET #1, CurrRecord + 1\r
+ Fig1# = CVD(IoFig1$)\r
+ Fig2# = CVD(IoFig2$)\r
+\r
+ LPRINT USING u0$; IoDate$; IoRef$; IoDesc$;\r
+ IF Fig2# = 0 AND Fig1# = 0 THEN\r
+ LPRINT USING u4$ + "|" + u4$ + "|" + u3$; Balance#\r
+ ELSEIF Fig2# = 0 THEN\r
+ Balance# = Balance# + Fig1#\r
+ LPRINT USING u2$ + "|" + u4$ + "|" + u3$; Fig1#; Balance#\r
+ ELSE\r
+ Balance# = Balance# - Fig2#\r
+ LPRINT USING u4$ + "|" + u2$ + "|" + u3$; Fig2#; Balance#\r
+ END IF\r
+ CurrRecord = CurrRecord + 1\r
+ WEND\r
+ LPRINT u5$\r
+ LPRINT : LPRINT\r
+ END IF\r
+ ON ERROR GOTO 0\r
+ END IF\r
+ CLOSE\r
+ END IF\r
+END SUB\r
+\r
+'Trin$:\r
+' Remove null and spaces from the end of a string.\r
+FUNCTION Trim$ (X$)\r
+\r
+ IF X$ = "" THEN\r
+ Trim$ = ""\r
+ ELSE\r
+ lastChar = 0\r
+ FOR a = 1 TO LEN(X$)\r
+ y$ = MID$(X$, a, 1)\r
+ IF y$ <> CHR$(0) AND y$ <> " " THEN\r
+ lastChar = a\r
+ END IF\r
+ NEXT a\r
+ Trim$ = LEFT$(X$, lastChar)\r
+ END IF\r
+ \r
+END FUNCTION\r
+\r
GIT.Harvie.CZ / mirrors / Programs.git / blobdiff