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