turbobasic/1998/3RD-PA.RTY/QBASIC/MONEY.BAS

   1 '
   2 '                    Q B a s i c   M O N E Y   M A N A G E R
   3 '
   4 '                   Copyright (C) Microsoft Corporation 1990
   5 '
   6 ' The Money Manager is a personal finance manager that allows you
   7 ' to enter account transactions while tracking your account balances
   8 ' and net worth.
   9 '
  10 ' To run this program, press Shift+F5.
  11 '
  12 ' To exit QBasic, press Alt, F, X.
  13 '
  14 ' To get help on a BASIC keyword, move the cursor to the keyword and press
  15 ' F1 or click the right mouse button.
  16 '
  17
  18
  19 'Set default data type to integer for faster operation
  20 DEFINT A-Z
  21
  22 'Sub and function declarations
  23 DECLARE SUB TransactionSummary (item%)
  24 DECLARE SUB LCenter (text$)
  25 DECLARE SUB ScrollUp ()
  26 DECLARE SUB ScrollDown ()
  27 DECLARE SUB Initialize ()
  28 DECLARE SUB Intro ()
  29 DECLARE SUB SparklePause ()
  30 DECLARE SUB Center (row%, text$)
  31 DECLARE SUB FancyCls (dots%, Background%)
  32 DECLARE SUB LoadState ()
  33 DECLARE SUB SaveState ()
  34 DECLARE SUB MenuSystem ()
  35 DECLARE SUB MakeBackup ()
  36 DECLARE SUB RestoreBackup ()
  37 DECLARE SUB Box (Row1%, Col1%, Row2%, Col2%)
  38 DECLARE SUB NetWorthReport ()
  39 DECLARE SUB EditAccounts ()
  40 DECLARE SUB PrintHelpLine (help$)
  41 DECLARE SUB EditTrans (item%)
  42 DECLARE FUNCTION Cvdt$ (X#)
  43 DECLARE FUNCTION Cvst$ (X!)
  44 DECLARE FUNCTION Cvit$ (X%)
  45 DECLARE FUNCTION Menu% (CurrChoiceX%, MaxChoice%, choice$(), ItemRow%(), ItemCol%(), help$(), BarMode%)
  46 DECLARE FUNCTION GetString$ (row%, col%, start$, end$, Vis%, Max%)
  47 DECLARE FUNCTION Trim$ (X$)
  48
  49 'Constants
  50 CONST TRUE = -1
  51 CONST FALSE = NOT TRUE
  52
  53 'User-defined types
  54 TYPE AccountType
  55     Title        AS STRING * 20
  56     AType        AS STRING * 1
  57     Desc         AS STRING * 50
  58 END TYPE
  59
  60 TYPE Recordtype
  61     Date     AS STRING * 8
  62     Ref      AS STRING * 10
  63     Desc     AS STRING * 50
  64     Fig1     AS DOUBLE
  65     Fig2     AS DOUBLE
  66 END TYPE
  67
  68 'Global variables
  69 DIM SHARED account(1 TO 19)  AS AccountType     'Stores the 19 account titles
  70 DIM SHARED ColorPref                            'Color Preference
  71 DIM SHARED colors(0 TO 20, 1 TO 4)              'Different Colors
  72 DIM SHARED ScrollUpAsm(1 TO 7)                  'Assembly Language Routines
  73 DIM SHARED ScrollDownAsm(1 TO 7)
  74 DIM SHARED PrintErr AS INTEGER                  'Printer error flag
  75
  76     DEF SEG = 0                     ' Turn off CapLock, NumLock and ScrollLock
  77     KeyFlags = PEEK(1047)
  78     POKE 1047, &H0
  79     DEF SEG
  80
  81     'Open money manager data file.  If it does not exist in current directory,
  82     '  goto error handler to create and initialize it.
  83     ON ERROR GOTO ErrorTrap
  84     OPEN "money.dat" FOR INPUT AS #1
  85     CLOSE
  86     ON ERROR GOTO 0     'Reset error handler
  87
  88     Initialize          'Initialize program
  89     Intro               'Display introduction screen
  90     MenuSystem          'This is the main program
  91     COLOR 7, 0          'Clear screen and end
  92     CLS
  93
  94     DEF SEG = 0                     ' Restore CapLock, NumLock and ScrollLock states
  95     POKE 1047, KeyFlags
  96     DEF SEG
  97
  98     END
  99
 100 ' Error handler for program
 101 ' If data file not found, create and initialize a new one.
 102 ErrorTrap:
 103     SELECT CASE ERR
 104         ' If data file not found, create and initialize a new one.
 105         CASE 53
 106             CLOSE
 107             ColorPref = 1
 108             FOR a = 1 TO 19
 109                 account(a).Title = ""
 110                 account(a).AType = ""
 111                 account(a).Desc = ""
 112             NEXT a
 113             SaveState
 114             RESUME
 115         CASE 24, 25
 116             PrintErr = TRUE
 117             Box 8, 13, 14, 69
 118             Center 11, "Printer not responding ... Press Space to continue"
 119             WHILE INKEY$ <> "": WEND
 120             WHILE INKEY$ <> " ": WEND
 121             RESUME NEXT
 122         CASE ELSE
 123     END SELECT
 124     RESUME NEXT
 125
 126
 127 'The following data defines the color schemes available via the main menu.
 128 '
 129 '    scrn  dots  bar  back   title  shdow  choice  curs   cursbk  shdow
 130 DATA 0,    7,    15,  7,     0,     7,     0,      15,    0,      0
 131 DATA 1,    9,    12,  3,     0,     1,     15,     0,     7,      0
 132 DATA 3,    15,   13,  1,     14,    3,     15,     0,     7,      0
 133 DATA 7,    12,   15,  4,     14,    0,     15,     15,    1,      0
 134
 135 'The following data is actually a machine language program to
 136 'scroll the screen up or down very fast using a BIOS call.
 137 DATA &HB8,&H01,&H06,&HB9,&H01,&H04,&HBA,&H4E,&H16,&HB7,&H00,&HCD,&H10,&HCB
 138 DATA &HB8,&H01,&H07,&HB9,&H01,&H04,&HBA,&H4E,&H16,&HB7,&H00,&HCD,&H10,&HCB
 139
 140 'Box:
 141 '  Draw a box on the screen between the given coordinates.
 142 SUB Box (Row1, Col1, Row2, Col2) STATIC
 143
 144     BoxWidth = Col2 - Col1 + 1
 145
 146     LOCATE Row1, Col1
 147     PRINT "Ú"; STRING$(BoxWidth - 2, "Ä"); "¿";
 148
 149     FOR a = Row1 + 1 TO Row2 - 1
 150         LOCATE a, Col1
 151         PRINT "³"; SPACE$(BoxWidth - 2); "³";
 152     NEXT a
 153
 154     LOCATE Row2, Col1
 155     PRINT "À"; STRING$(BoxWidth - 2, "Ä"); "Ù";
 156
 157 END SUB
 158
 159 'Center:
 160 '  Center text on the given row.
 161 SUB Center (row, text$)
 162     LOCATE row, 41 - LEN(text$) / 2
 163     PRINT text$;
 164 END SUB
 165
 166 'Cvdt$:
 167 '  Convert a double precision number to a string WITHOUT a leading space.
 168 FUNCTION Cvdt$ (X#)
 169
 170     Cvdt$ = RIGHT$(STR$(X#), LEN(STR$(X#)) - 1)
 171
 172 END FUNCTION
 173
 174 'Cvit$:
 175 '  Convert an integer to a string WITHOUT a leading space.
 176 FUNCTION Cvit$ (X)
 177     Cvit$ = RIGHT$(STR$(X), LEN(STR$(X)) - 1)
 178 END FUNCTION
 179
 180 'Cvst$:
 181 '  Convert a single precision number to a string WITHOUT a leading space
 182 FUNCTION Cvst$ (X!)
 183     Cvst$ = RIGHT$(STR$(X!), LEN(STR$(X!)) - 1)
 184 END FUNCTION
 185
 186 'EditAccounts:
 187 '  This is the full-screen editor which allows you to change your account
 188 '  titles and descriptions
 189 SUB EditAccounts
 190
 191     'Information about each column
 192     REDIM help$(4), col(4), Vis(4), Max(4), edit$(19, 3)
 193
 194     'Draw the screen
 195     COLOR colors(7, ColorPref), colors(4, ColorPref)
 196     Box 2, 1, 24, 80
 197
 198     COLOR colors(5, ColorPref), colors(4, ColorPref)
 199     LOCATE 1, 1: PRINT SPACE$(80)
 200     LOCATE 1, 4: PRINT "Account Editor";
 201     COLOR colors(7, ColorPref), colors(4, ColorPref)
 202
 203     LOCATE 3, 2: PRINT "No³ Account Title      ³ Description                                      ³A/L"
 204     LOCATE 4, 2: PRINT "ÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄ"
 205                   u$ = "##³\                  \³\                                                \³ ! "
 206     FOR a = 5 TO 23
 207         LOCATE a, 2
 208         X = a - 4
 209         PRINT USING u$; X; account(X).Title; account(X).Desc; account(X).AType;
 210     NEXT a
 211
 212     'Initialize variables
 213     help$(1) = "  Account name                             | <F2=Save and Exit> <Escape=Abort>"
 214     help$(2) = "  Account description                      | <F2=Save and Exit> <Escape=Abort>"
 215     help$(3) = "  Account type (A = Asset, L = Liability)  | <F2=Save and Exit> <Escape=Abort>"
 216
 217     col(1) = 5: col(2) = 26: col(3) = 78
 218     Vis(1) = 20: Vis(2) = 50: Vis(3) = 1
 219     Max(1) = 20: Max(2) = 50: Max(3) = 1
 220
 221     FOR a = 1 TO 19
 222         edit$(a, 1) = account(a).Title
 223         edit$(a, 2) = account(a).Desc
 224         edit$(a, 3) = account(a).AType
 225     NEXT a
 226
 227     finished = FALSE
 228
 229     CurrRow = 1
 230     CurrCol = 1
 231     PrintHelpLine help$(CurrCol)
 232
 233     'Loop until F2 or <ESC> is pressed
 234     DO
 235         GOSUB EditAccountsShowCursor            'Show Cursor
 236         DO                                      'Wait for key
 237             Kbd$ = INKEY$
 238         LOOP UNTIL Kbd$ <> ""
 239
 240         IF Kbd$ >= " " AND Kbd$ < "~" THEN      'If legal, edit item
 241             GOSUB EditAccountsEditItem
 242         END IF
 243         GOSUB EditAccountsHideCursor            'Hide Cursor so it can move
 244                                                 'If it needs to
 245         SELECT CASE Kbd$
 246             CASE CHR$(0) + "H"                              'Up Arrow
 247                 CurrRow = (CurrRow + 17) MOD 19 + 1
 248             CASE CHR$(0) + "P"                              'Down Arrow
 249                 CurrRow = (CurrRow) MOD 19 + 1
 250             CASE CHR$(0) + "K", CHR$(0) + CHR$(15)          'Left or Shift+Tab
 251                 CurrCol = (CurrCol + 1) MOD 3 + 1
 252                 PrintHelpLine help$(CurrCol)
 253             CASE CHR$(0) + "M", CHR$(9)                     'Right or Tab
 254                 CurrCol = (CurrCol) MOD 3 + 1
 255                 PrintHelpLine help$(CurrCol)
 256             CASE CHR$(0) + "<"                              'F2
 257                 finished = TRUE
 258                 Save = TRUE
 259             CASE CHR$(27)                                   'Esc
 260                 finished = TRUE
 261                 Save = FALSE
 262             CASE CHR$(13)                                   'Return
 263             CASE ELSE
 264                 BEEP
 265         END SELECT
 266     LOOP UNTIL finished
 267
 268     IF Save THEN
 269         GOSUB EditAccountsSaveData
 270     END IF
 271
 272     EXIT SUB
 273
 274 EditAccountsShowCursor:
 275     COLOR colors(8, ColorPref), colors(9, ColorPref)
 276     LOCATE CurrRow + 4, col(CurrCol)
 277     PRINT LEFT$(edit$(CurrRow, CurrCol), Vis(CurrCol));
 278     RETURN
 279
 280 EditAccountsEditItem:
 281     COLOR colors(8, ColorPref), colors(9, ColorPref)
 282     ok = FALSE
 283     start$ = Kbd$
 284     DO
 285         Kbd$ = GetString$(CurrRow + 4, col(CurrCol), start$, end$, Vis(CurrCol), Max(CurrCol))
 286         edit$(CurrRow, CurrCol) = LEFT$(end$ + SPACE$(Max(CurrCol)), Max(CurrCol))
 287         start$ = ""
 288
 289         IF CurrCol = 3 THEN
 290             X$ = UCASE$(end$)
 291             IF X$ = "A" OR X$ = "L" OR X$ = "" OR X$ = " " THEN
 292                 ok = TRUE
 293                 IF X$ = "" THEN X$ = " "
 294                 edit$(CurrRow, CurrCol) = X$
 295             ELSE
 296                 BEEP
 297             END IF
 298         ELSE
 299             ok = TRUE
 300         END IF
 301
 302     LOOP UNTIL ok
 303     RETURN
 304
 305 EditAccountsHideCursor:
 306     COLOR colors(7, ColorPref), colors(4, ColorPref)
 307     LOCATE CurrRow + 4, col(CurrCol)
 308     PRINT LEFT$(edit$(CurrRow, CurrCol), Vis(CurrCol));
 309     RETURN
 310
 311
 312 EditAccountsSaveData:
 313     FOR a = 1 TO 19
 314         account(a).Title = edit$(a, 1)
 315         account(a).Desc = edit$(a, 2)
 316         account(a).AType = edit$(a, 3)
 317     NEXT a
 318     SaveState
 319     RETURN
 320
 321 END SUB
 322
 323 'EditTrans:
 324 '  This is the full-screen editor which allows you to enter and change
 325 '  transactions
 326 SUB EditTrans (item)
 327
 328     'Stores info about each column
 329     REDIM help$(6), col(6), Vis(6), Max(6), CurrString$(3), CurrFig#(5)
 330     'Array to keep the current balance at all the transactions
 331     REDIM Balance#(1000)
 332
 333     'Open random access file
 334     file$ = "money." + Cvit$(item)
 335     OPEN file$ FOR RANDOM AS #1 LEN = 84
 336     FIELD #1, 8 AS IoDate$, 10 AS IoRef$, 50 AS IoDesc$, 8 AS IoFig1$, 8 AS IoFig2$
 337     FIELD #1, 11 AS valid$, 5 AS IoMaxRecord$, 8 AS IoBalance$
 338
 339     'Initialize variables
 340     CurrString$(1) = ""
 341     CurrString$(2) = ""
 342     CurrString$(3) = ""
 343     CurrFig#(4) = 0
 344     CurrFig#(5) = 0
 345
 346     GET #1, 1
 347     IF valid$ <> "THISISVALID" THEN
 348         LSET IoDate$ = ""
 349         LSET IoRef$ = ""
 350         LSET IoDesc$ = ""
 351         LSET IoFig1$ = MKD$(0)
 352         LSET IoFig2$ = MKD$(0)
 353         PUT #1, 2
 354         LSET valid$ = "THISISVALID"
 355         LSET IoMaxRecord$ = "1"
 356         LSET IoBalance$ = MKD$(0)
 357         PUT #1, 1
 358     END IF
 359
 360     MaxRecord = VAL(IoMaxRecord$)
 361
 362     Balance#(0) = 0
 363     a = 1
 364     WHILE a <= MaxRecord
 365         GET #1, a + 1
 366         Balance#(a) = Balance#(a - 1) + CVD(IoFig1$) - CVD(IoFig2$)
 367         a = a + 1
 368     WEND
 369     GOSUB EditTransWriteBalance
 370
 371     help$(1) = "Date of transaction (mm/dd/yy) "
 372     help$(2) = "Transaction reference number   "
 373     help$(3) = "Transaction description        "
 374     help$(4) = "Increase asset or debt value   "
 375     help$(5) = "Decrease asset or debt value   "
 376
 377     col(1) = 2
 378     col(2) = 11
 379     col(3) = 18
 380     col(4) = 44
 381     col(5) = 55
 382
 383     Vis(1) = 8
 384     Vis(2) = 6
 385     Vis(3) = 25
 386     Vis(4) = 10
 387     Vis(5) = 10
 388
 389     Max(1) = 8
 390     Max(2) = 6
 391     Max(3) = 25
 392     Max(4) = 10
 393     Max(5) = 10
 394
 395
 396     'Draw Screen
 397     COLOR colors(7, ColorPref), colors(4, ColorPref)
 398     Box 2, 1, 24, 80
 399
 400     COLOR colors(5, ColorPref), colors(4, ColorPref)
 401     LOCATE 1, 1: PRINT SPACE$(80);
 402     LOCATE 1, 4: PRINT "Transaction Editor: " + Trim$(account(item).Title);
 403
 404     COLOR colors(7, ColorPref), colors(4, ColorPref)
 405     LOCATE 3, 2: PRINT "  Date  ³ Ref# ³ Description             ³ Increase ³ Decrease ³   Balance    "
 406     LOCATE 4, 2: PRINT "ÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄÄ"
 407
 408      u$ = "\      \³\    \³\                       \³"
 409     u1$ = "        ³      ³                         ³          ³          ³              "
 410     u1x$ = "ßßßßßßßß³ßßßßßß³ßßßßßßßßßßßßßßßßßßßßßßßßß³ßßßßßßßßßß³ßßßßßßßßßß³ßßßßßßßßßßßßßß"
 411     u2$ = "###,###.##"
 412     u3$ = "###,###,###.##"
 413     u4$ = "          "
 414
 415     CurrTopline = 1
 416     GOSUB EditTransPrintWholeScreen
 417
 418     CurrRow = 1
 419     CurrCol = 1
 420     PrintHelpLine help$(CurrCol) + "|  <F2=Save and Exit> <F9=Insert> <F10=Delete>"
 421
 422     GOSUB EditTransGetLine
 423
 424     finished = FALSE
 425
 426
 427     'Loop until <F2> is pressed
 428     DO
 429         GOSUB EditTransShowCursor                   'Show Cursor, Wait for key
 430         DO: Kbd$ = INKEY$: LOOP UNTIL Kbd$ <> ""
 431         GOSUB EditTransHideCursor
 432
 433         IF Kbd$ >= " " AND Kbd$ < "~" OR Kbd$ = CHR$(8) THEN        'If legal key, edit item
 434             GOSUB EditTransEditItem
 435         END IF
 436
 437         SELECT CASE Kbd$                            'Handle Special keys
 438             CASE CHR$(0) + "H"                      'up arrow
 439                 GOSUB EditTransMoveUp
 440             CASE CHR$(0) + "P"                      'Down arrow
 441                 GOSUB EditTransMoveDown
 442             CASE CHR$(0) + "K", CHR$(0) + CHR$(15)  'Left Arrow,BackTab
 443                 CurrCol = (CurrCol + 3) MOD 5 + 1
 444                 PrintHelpLine help$(CurrCol) + "|  <F2=Save and Exit> <F9=Insert> <F10=Delete>"
 445             CASE CHR$(0) + "M", CHR$(9)             'Right Arrow,Tab
 446                 CurrCol = (CurrCol) MOD 5 + 1
 447                 PrintHelpLine help$(CurrCol) + "|  <F2=Save and Exit> <F9=Insert> <F10=Delete>"
 448             CASE CHR$(0) + "G"                      'Home
 449                 CurrCol = 1
 450             CASE CHR$(0) + "O"                      'End
 451                 CurrCol = 5
 452             CASE CHR$(0) + "I"                      'Page Up
 453                 CurrRow = 1
 454                 CurrTopline = CurrTopline - 19
 455                 IF CurrTopline < 1 THEN
 456                     CurrTopline = 1
 457                 END IF
 458                 GOSUB EditTransPrintWholeScreen
 459                 GOSUB EditTransGetLine
 460             CASE CHR$(0) + "Q"                      'Page Down
 461                 CurrRow = 1
 462                 CurrTopline = CurrTopline + 19
 463                 IF CurrTopline > MaxRecord THEN
 464                     CurrTopline = MaxRecord
 465                 END IF
 466                 GOSUB EditTransPrintWholeScreen
 467                 GOSUB EditTransGetLine
 468             CASE CHR$(0) + "<"                      'F2
 469                 finished = TRUE
 470             CASE CHR$(0) + "C"                      'F9
 471                 GOSUB EditTransAddRecord
 472             CASE CHR$(0) + "D"                      'F10
 473                 GOSUB EditTransDeleteRecord
 474             CASE CHR$(13)                           'Enter
 475             CASE ELSE
 476                BEEP
 477         END SELECT
 478     LOOP UNTIL finished
 479
 480     CLOSE
 481
 482     EXIT SUB
 483
 484
 485 EditTransShowCursor:
 486     COLOR colors(8, ColorPref), colors(9, ColorPref)
 487     LOCATE CurrRow + 4, col(CurrCol)
 488     SELECT CASE CurrCol
 489         CASE 1, 2, 3
 490             PRINT LEFT$(CurrString$(CurrCol), Vis(CurrCol));
 491         CASE 4
 492             IF CurrFig#(4) <> 0 THEN
 493                 PRINT USING u2$; CurrFig#(4);
 494             ELSE
 495                 PRINT SPACE$(Vis(CurrCol));
 496             END IF
 497         CASE 5
 498             IF CurrFig#(5) <> 0 THEN
 499                 PRINT USING u2$; CurrFig#(5);
 500             ELSE
 501                 PRINT SPACE$(Vis(CurrCol));
 502             END IF
 503     END SELECT
 504     RETURN
 505
 506
 507 EditTransHideCursor:
 508     COLOR colors(7, ColorPref), colors(4, ColorPref)
 509     LOCATE CurrRow + 4, col(CurrCol)
 510     SELECT CASE CurrCol
 511         CASE 1, 2, 3
 512             PRINT LEFT$(CurrString$(CurrCol), Vis(CurrCol));
 513         CASE 4
 514             IF CurrFig#(4) <> 0 THEN
 515                 PRINT USING u2$; CurrFig#(4);
 516             ELSE
 517                 PRINT SPACE$(Vis(CurrCol));
 518             END IF
 519         CASE 5
 520             IF CurrFig#(5) <> 0 THEN
 521                 PRINT USING u2$; CurrFig#(5);
 522             ELSE
 523                 PRINT SPACE$(Vis(CurrCol));
 524             END IF
 525     END SELECT
 526     RETURN
 527
 528
 529 EditTransEditItem:
 530
 531     CurrRecord = CurrTopline + CurrRow - 1
 532     COLOR colors(8, ColorPref), colors(9, ColorPref)
 533
 534     SELECT CASE CurrCol
 535         CASE 1, 2, 3
 536             Kbd$ = GetString$(CurrRow + 4, col(CurrCol), Kbd$, new$, Vis(CurrCol), Max(CurrCol))
 537             CurrString$(CurrCol) = new$
 538             GOSUB EditTransPutLine
 539             GOSUB EditTransGetLine
 540         CASE 4
 541             start$ = Kbd$
 542             DO
 543                 Kbd$ = GetString$(CurrRow + 4, col(4), start$, new$, Vis(4), Max(4))
 544                 new4# = VAL(new$)
 545                 start$ = ""
 546             LOOP WHILE new4# >= 999999.99# OR new4# < 0
 547
 548             a = CurrRecord
 549             WHILE a <= MaxRecord
 550                 Balance#(a) = Balance#(a) + new4# - CurrFig#(4) + CurrFig#(5)
 551                 a = a + 1
 552             WEND
 553             CurrFig#(4) = new4#
 554             CurrFig#(5) = 0
 555             GOSUB EditTransPutLine
 556             GOSUB EditTransGetLine
 557             GOSUB EditTransPrintBalances
 558             GOSUB EditTransWriteBalance
 559         CASE 5
 560             start$ = Kbd$
 561             DO
 562                 Kbd$ = GetString$(CurrRow + 4, col(5), start$, new$, Vis(5), Max(5))
 563                 new5# = VAL(new$)
 564                 start$ = ""
 565             LOOP WHILE new5# >= 999999.99# OR new5# < 0
 566
 567             a = CurrRecord
 568             WHILE a <= MaxRecord
 569                 Balance#(a) = Balance#(a) - new5# + CurrFig#(5) - CurrFig#(4)
 570                 a = a + 1
 571             WEND
 572             CurrFig#(4) = 0
 573             CurrFig#(5) = new5#
 574             GOSUB EditTransPutLine
 575             GOSUB EditTransGetLine
 576             GOSUB EditTransPrintBalances
 577             GOSUB EditTransWriteBalance
 578         CASE ELSE
 579     END SELECT
 580     GOSUB EditTransPrintLine
 581     RETURN
 582
 583 EditTransMoveUp:
 584     IF CurrRow = 1 THEN
 585         IF CurrTopline = 1 THEN
 586             BEEP
 587         ELSE
 588             ScrollDown
 589             CurrTopline = CurrTopline - 1
 590             GOSUB EditTransGetLine
 591             GOSUB EditTransPrintLine
 592         END IF
 593     ELSE
 594         CurrRow = CurrRow - 1
 595         GOSUB EditTransGetLine
 596     END IF
 597     RETURN
 598
 599 EditTransMoveDown:
 600     IF (CurrRow + CurrTopline - 1) >= MaxRecord THEN
 601         BEEP
 602     ELSE
 603         IF CurrRow = 19 THEN
 604             ScrollUp
 605             CurrTopline = CurrTopline + 1
 606             GOSUB EditTransGetLine
 607             GOSUB EditTransPrintLine
 608         ELSE
 609             CurrRow = CurrRow + 1
 610             GOSUB EditTransGetLine
 611         END IF
 612     END IF
 613     RETURN
 614
 615 EditTransPrintLine:
 616     COLOR colors(7, ColorPref), colors(4, ColorPref)
 617     CurrRecord = CurrTopline + CurrRow - 1
 618     LOCATE CurrRow + 4, 2
 619     IF CurrRecord = MaxRecord + 1 THEN
 620         PRINT u1x$;
 621     ELSEIF CurrRecord > MaxRecord THEN
 622         PRINT u1$;
 623     ELSE
 624         PRINT USING u$; CurrString$(1); CurrString$(2); CurrString$(3);
 625         IF CurrFig#(4) = 0 AND CurrFig#(5) = 0 THEN
 626             PRINT USING u4$ + "³" + u4$ + "³" + u3$; Balance#(CurrRecord)
 627         ELSEIF CurrFig#(5) = 0 THEN
 628             PRINT USING u2$ + "³" + u4$ + "³" + u3$; CurrFig#(4); Balance#(CurrRecord)
 629         ELSE
 630             PRINT USING u4$ + "³" + u2$ + "³" + u3$; CurrFig#(5); Balance#(CurrRecord)
 631         END IF
 632     END IF
 633     RETURN
 634
 635 EditTransPrintBalances:
 636     COLOR colors(7, ColorPref), colors(4, ColorPref)
 637     FOR a = 1 TO 19
 638         CurrRecord = CurrTopline + a - 1
 639         IF CurrRecord <= MaxRecord THEN
 640             LOCATE 4 + a, 66
 641             PRINT USING u3$; Balance#(CurrTopline + a - 1);
 642         END IF
 643     NEXT a
 644     RETURN
 645
 646 EditTransDeleteRecord:
 647     IF MaxRecord = 1 THEN
 648         BEEP
 649     ELSE
 650         CurrRecord = CurrTopline + CurrRow - 1
 651         MaxRecord = MaxRecord - 1
 652         a = CurrRecord
 653         WHILE a <= MaxRecord
 654             GET #1, a + 2
 655             PUT #1, a + 1
 656             Balance#(a) = Balance#(a + 1) - CurrFig#(4) + CurrFig#(5)
 657             a = a + 1
 658         WEND
 659
 660         LSET valid$ = "THISISVALID"
 661         LSET IoMaxRecord$ = Cvit$(MaxRecord)
 662         PUT #1, 1
 663         GOSUB EditTransPrintWholeScreen
 664         CurrRecord = CurrTopline + CurrRow - 1
 665         IF CurrRecord > MaxRecord THEN
 666             GOSUB EditTransMoveUp
 667         END IF
 668         GOSUB EditTransGetLine
 669         GOSUB EditTransWriteBalance
 670     END IF
 671     RETURN
 672
 673 EditTransAddRecord:
 674     CurrRecord = CurrTopline + CurrRow - 1
 675     a = MaxRecord
 676     WHILE a > CurrRecord
 677         GET #1, a + 1
 678         PUT #1, a + 2
 679         Balance#(a + 1) = Balance#(a)
 680         a = a - 1
 681     WEND
 682     Balance#(CurrRecord + 1) = Balance#(CurrRecord)
 683     MaxRecord = MaxRecord + 1
 684     LSET IoDate$ = ""
 685     LSET IoRef$ = ""
 686     LSET IoDesc$ = ""
 687     LSET IoFig1$ = MKD$(0)
 688     LSET IoFig2$ = MKD$(0)
 689     PUT #1, CurrRecord + 2
 690
 691     LSET valid$ = "THISISVALID"
 692     LSET IoMaxRecord$ = Cvit$(MaxRecord)
 693     PUT #1, 1
 694     GOSUB EditTransPrintWholeScreen
 695     GOSUB EditTransGetLine
 696     RETURN
 697
 698 EditTransPrintWholeScreen:
 699     temp = CurrRow
 700     FOR CurrRow = 1 TO 19
 701         CurrRecord = CurrTopline + CurrRow - 1
 702         IF CurrRecord <= MaxRecord THEN
 703             GOSUB EditTransGetLine
 704         END IF
 705         GOSUB EditTransPrintLine
 706     NEXT CurrRow
 707     CurrRow = temp
 708     RETURN
 709
 710 EditTransWriteBalance:
 711     GET #1, 1
 712     LSET IoBalance$ = MKD$(Balance#(MaxRecord))
 713     PUT #1, 1
 714     RETURN
 715
 716 EditTransPutLine:
 717     CurrRecord = CurrTopline + CurrRow - 1
 718     LSET IoDate$ = CurrString$(1)
 719     LSET IoRef$ = CurrString$(2)
 720     LSET IoDesc$ = CurrString$(3)
 721     LSET IoFig1$ = MKD$(CurrFig#(4))
 722     LSET IoFig2$ = MKD$(CurrFig#(5))
 723     PUT #1, CurrRecord + 1
 724     RETURN
 725
 726 EditTransGetLine:
 727     CurrRecord = CurrTopline + CurrRow - 1
 728     GET #1, CurrRecord + 1
 729     CurrString$(1) = IoDate$
 730     CurrString$(2) = IoRef$
 731     CurrString$(3) = IoDesc$
 732     CurrFig#(4) = CVD(IoFig1$)
 733     CurrFig#(5) = CVD(IoFig2$)
 734     RETURN
 735 END SUB
 736
 737 'FancyCls:
 738 '  Clears screen in the right color, and draws nice dots.
 739 SUB FancyCls (dots, Background)
 740
 741     VIEW PRINT 2 TO 24
 742     COLOR dots, Background
 743     CLS 2
 744
 745     FOR a = 95 TO 1820 STEP 45
 746         row = a / 80 + 1
 747         col = a MOD 80 + 1
 748         LOCATE row, col
 749         PRINT CHR$(250);
 750     NEXT a
 751
 752     VIEW PRINT
 753
 754 END SUB
 755
 756 'GetString$:
 757 '  Given a row and col, and an initial string, edit a string
 758 '  VIS is the length of the visible field of entry
 759 '  MAX is the maximum number of characters allowed in the string
 760 FUNCTION GetString$ (row, col, start$, end$, Vis, Max)
 761     curr$ = Trim$(LEFT$(start$, Max))
 762     IF curr$ = CHR$(8) THEN curr$ = ""
 763
 764     LOCATE , , 1
 765
 766     finished = FALSE
 767     DO
 768         GOSUB GetStringShowText
 769         GOSUB GetStringGetKey
 770
 771         IF LEN(Kbd$) > 1 THEN
 772             finished = TRUE
 773             GetString$ = Kbd$
 774         ELSE
 775             SELECT CASE Kbd$
 776                 CASE CHR$(13), CHR$(27), CHR$(9)
 777                     finished = TRUE
 778                     GetString$ = Kbd$
 779
 780                 CASE CHR$(8)
 781                     IF curr$ <> "" THEN
 782                         curr$ = LEFT$(curr$, LEN(curr$) - 1)
 783                     END IF
 784
 785                 CASE " " TO "}"
 786                     IF LEN(curr$) < Max THEN
 787                         curr$ = curr$ + Kbd$
 788                     ELSE
 789                         BEEP
 790                     END IF
 791
 792                 CASE ELSE
 793                     BEEP
 794             END SELECT
 795         END IF
 796
 797     LOOP UNTIL finished
 798
 799     end$ = curr$
 800     LOCATE , , 0
 801     EXIT FUNCTION
 802
 803
 804 GetStringShowText:
 805     LOCATE row, col
 806     IF LEN(curr$) > Vis THEN
 807         PRINT RIGHT$(curr$, Vis);
 808     ELSE
 809         PRINT curr$; SPACE$(Vis - LEN(curr$));
 810         LOCATE row, col + LEN(curr$)
 811     END IF
 812     RETURN
 813
 814 GetStringGetKey:
 815     Kbd$ = ""
 816     WHILE Kbd$ = ""
 817         Kbd$ = INKEY$
 818     WEND
 819     RETURN
 820 END FUNCTION
 821
 822 'Initialize:
 823 '  Read colors in and set up assembly routines
 824 SUB Initialize
 825
 826     WIDTH , 25
 827     VIEW PRINT
 828
 829     FOR ColorSet = 1 TO 4
 830         FOR X = 1 TO 10
 831             READ colors(X, ColorSet)
 832         NEXT X
 833     NEXT ColorSet
 834
 835     LoadState
 836
 837     P = VARPTR(ScrollUpAsm(1))
 838     DEF SEG = VARSEG(ScrollUpAsm(1))
 839     FOR I = 0 TO 13
 840        READ J
 841        POKE (P + I), J
 842     NEXT I
 843
 844     P = VARPTR(ScrollDownAsm(1))
 845     DEF SEG = VARSEG(ScrollDownAsm(1))
 846     FOR I = 0 TO 13
 847        READ J
 848        POKE (P + I), J
 849     NEXT I
 850
 851     DEF SEG
 852
 853 END SUB
 854
 855 'Intro:
 856 '  Display introduction screen.
 857 SUB Intro
 858     SCREEN 0
 859     WIDTH 80, 25
 860     COLOR 7, 0
 861     CLS
 862
 863     Center 4, "Q B a s i c"
 864     COLOR 15
 865     Center 5, "Ü     Ü ÜÜÜÜ Ü   Ü ÜÜÜÜ Ü   Ü      Ü     Ü ÜÜÜÜ Ü   Ü ÜÜÜÜ ÜÜÜÜÜ ÜÜÜÜ ÜÜÜÜÜ"
 866     Center 6, "ÛßÜ ÜßÛ Û  Û ÛÜ  Û Û    ÛÜÜÜÛ      ÛßÜ ÜßÛ Û  Û ÛÜ  Û Û  Û Û     Û    Û   Û"
 867     Center 7, "Û  ß  Û Û  Û Û ßÜÛ Ûßßß   Û        Û  ß  Û ÛßßÛ Û ßÜÛ ÛßßÛ Û ßßÛ Ûßßß ÛßÛßß"
 868     Center 8, "Û     Û ÛÜÜÛ Û   Û ÛÜÜÜ   Û        Û     Û Û  Û Û   Û Û  Û ÛÜÜÜÛ ÛÜÜÜ Û  ßÜ"
 869     COLOR 7
 870     Center 11, "A Personal Finance Manager written in"
 871     Center 12, "MS-DOS QBasic"
 872     Center 24, "Press any key to continue"
 873
 874     SparklePause
 875 END SUB
 876
 877 'LCenter:
 878 '  Center TEXT$ on the line printer
 879 SUB LCenter (text$)
 880     LPRINT TAB(41 - LEN(text$) / 2); text$
 881 END SUB
 882
 883 'LoadState:
 884 '  Load color preferences and account info from MONEY.DAT
 885 SUB LoadState
 886
 887     OPEN "money.dat" FOR INPUT AS #1
 888     INPUT #1, ColorPref
 889
 890     FOR a = 1 TO 19
 891         LINE INPUT #1, account(a).Title
 892         LINE INPUT #1, account(a).AType
 893         LINE INPUT #1, account(a).Desc
 894     NEXT a
 895
 896     CLOSE
 897
 898 END SUB
 899
 900 'Menu:
 901 '  Handles Menu Selection for a single menu (either sub menu, or menu bar)
 902 '  currChoiceX  :  Number of current choice
 903 '  maxChoice    :  Number of choices in the list
 904 '  choice$()    :  Array with the text of the choices
 905 '  itemRow()    :  Array with the row of the choices
 906 '  itemCol()    :  Array with the col of the choices
 907 '  help$()      :  Array with the help text for each choice
 908 '  barMode      :  Boolean:  TRUE = menu bar style, FALSE = drop down style
 909 '
 910 '  Returns the number of the choice that was made by changing currChoiceX
 911 '  and returns the scan code of the key that was pressed to exit
 912 '
 913 FUNCTION Menu (CurrChoiceX, MaxChoice, choice$(), ItemRow(), ItemCol(), help$(), BarMode)
 914
 915     currChoice = CurrChoiceX
 916
 917     'if in bar mode, color in menu bar, else color box/shadow
 918     'bar mode means you are currently in the menu bar, not a sub menu
 919     IF BarMode THEN
 920         COLOR colors(7, ColorPref), colors(4, ColorPref)
 921         LOCATE 1, 1
 922         PRINT SPACE$(80);
 923     ELSE
 924         FancyCls colors(2, ColorPref), colors(1, ColorPref)
 925         COLOR colors(7, ColorPref), colors(4, ColorPref)
 926         Box ItemRow(1) - 1, ItemCol(1) - 1, ItemRow(MaxChoice) + 1, ItemCol(1) + LEN(choice$(1)) + 1
 927
 928         COLOR colors(10, ColorPref), colors(6, ColorPref)
 929         FOR a = 1 TO MaxChoice + 1
 930             LOCATE ItemRow(1) + a - 1, ItemCol(1) + LEN(choice$(1)) + 2
 931             PRINT CHR$(178); CHR$(178);
 932         NEXT a
 933         LOCATE ItemRow(MaxChoice) + 2, ItemCol(MaxChoice) + 2
 934         PRINT STRING$(LEN(choice$(MaxChoice)) + 2, 178);
 935     END IF
 936
 937     'print the choices
 938     COLOR colors(7, ColorPref), colors(4, ColorPref)
 939     FOR a = 1 TO MaxChoice
 940         LOCATE ItemRow(a), ItemCol(a)
 941         PRINT choice$(a);
 942     NEXT a
 943
 944     finished = FALSE
 945
 946     WHILE NOT finished
 947
 948         GOSUB MenuShowCursor
 949         GOSUB MenuGetKey
 950         GOSUB MenuHideCursor
 951
 952         SELECT CASE Kbd$
 953             CASE CHR$(0) + "H": GOSUB MenuUp
 954             CASE CHR$(0) + "P": GOSUB MenuDown
 955             CASE CHR$(0) + "K": GOSUB MenuLeft
 956             CASE CHR$(0) + "M": GOSUB MenuRight
 957             CASE CHR$(13): GOSUB MenuEnter
 958             CASE CHR$(27): GOSUB MenuEscape
 959             CASE ELSE:  BEEP
 960         END SELECT
 961     WEND
 962
 963     Menu = currChoice
 964
 965     EXIT FUNCTION
 966
 967
 968 MenuEnter:
 969     finished = TRUE
 970     RETURN
 971
 972 MenuEscape:
 973     currChoice = 0
 974     finished = TRUE
 975     RETURN
 976
 977 MenuUp:
 978     IF BarMode THEN
 979         BEEP
 980     ELSE
 981         currChoice = (currChoice + MaxChoice - 2) MOD MaxChoice + 1
 982     END IF
 983     RETURN
 984
 985 MenuLeft:
 986     IF BarMode THEN
 987         currChoice = (currChoice + MaxChoice - 2) MOD MaxChoice + 1
 988     ELSE
 989         currChoice = -2
 990         finished = TRUE
 991     END IF
 992     RETURN
 993
 994 MenuRight:
 995     IF BarMode THEN
 996         currChoice = (currChoice) MOD MaxChoice + 1
 997     ELSE
 998         currChoice = -3
 999         finished = TRUE
1000     END IF
1001     RETURN
1002
1003 MenuDown:
1004     IF BarMode THEN
1005         finished = TRUE
1006     ELSE
1007         currChoice = (currChoice) MOD MaxChoice + 1
1008     END IF
1009     RETURN
1010
1011 MenuShowCursor:
1012     COLOR colors(8, ColorPref), colors(9, ColorPref)
1013     LOCATE ItemRow(currChoice), ItemCol(currChoice)
1014     PRINT choice$(currChoice);
1015     PrintHelpLine help$(currChoice)
1016     RETURN
1017
1018 MenuGetKey:
1019     Kbd$ = ""
1020     WHILE Kbd$ = ""
1021         Kbd$ = INKEY$
1022     WEND
1023     RETURN
1024
1025 MenuHideCursor:
1026     COLOR colors(7, ColorPref), colors(4, ColorPref)
1027     LOCATE ItemRow(currChoice), ItemCol(currChoice)
1028     PRINT choice$(currChoice);
1029     RETURN
1030
1031
1032 END FUNCTION
1033
1034 'MenuSystem:
1035 '  Main routine that controls the program.  Uses the MENU function
1036 '  to implement menu system and calls the appropriate function to handle
1037 '  the user's selection
1038 SUB MenuSystem
1039
1040     DIM choice$(20), menuRow(20), menuCol(20), help$(20)
1041     LOCATE , , 0
1042     choice = 1
1043     finished = FALSE
1044
1045     WHILE NOT finished
1046         GOSUB MenuSystemMain
1047
1048         subchoice = -1
1049         WHILE subchoice < 0
1050             SELECT CASE choice
1051                 CASE 1: GOSUB MenuSystemFile
1052                 CASE 2: GOSUB MenuSystemEdit
1053                 CASE 3: GOSUB MenuSystemAccount
1054                 CASE 4: GOSUB MenuSystemReport
1055                 CASE 5: GOSUB MenuSystemColors
1056             END SELECT
1057             FancyCls colors(2, ColorPref), colors(1, ColorPref)
1058
1059             SELECT CASE subchoice
1060                 CASE -2: choice = (choice + 3) MOD 5 + 1
1061                 CASE -3: choice = (choice) MOD 5 + 1
1062             END SELECT
1063         WEND
1064     WEND
1065     EXIT SUB
1066
1067
1068 MenuSystemMain:
1069     FancyCls colors(2, ColorPref), colors(1, ColorPref)
1070     COLOR colors(7, ColorPref), colors(4, ColorPref)
1071     Box 9, 19, 14, 61
1072     Center 11, "Use arrow keys to navigate menu system"
1073     Center 12, "Press Enter to select a menu item"
1074
1075     choice$(1) = " File "
1076     choice$(2) = " Accounts "
1077     choice$(3) = " Transactions "
1078     choice$(4) = " Reports "
1079     choice$(5) = " Colors "
1080
1081     menuRow(1) = 1: menuCol(1) = 2
1082     menuRow(2) = 1: menuCol(2) = 8
1083     menuRow(3) = 1: menuCol(3) = 18
1084     menuRow(4) = 1: menuCol(4) = 32
1085     menuRow(5) = 1: menuCol(5) = 41
1086
1087     help$(1) = "Exit the Money Manager"
1088     help$(2) = "Add/edit/delete accounts"
1089     help$(3) = "Add/edit/delete account transactions"
1090     help$(4) = "View and print reports"
1091     help$(5) = "Set screen colors"
1092
1093     DO
1094         NewChoice = Menu((choice), 5, choice$(), menuRow(), menuCol(), help$(), TRUE)
1095     LOOP WHILE NewChoice = 0
1096     choice = NewChoice
1097     RETURN
1098
1099 MenuSystemFile:
1100     choice$(1) = " Exit           "
1101
1102     menuRow(1) = 3: menuCol(1) = 2
1103
1104     help$(1) = "Exit the Money Manager"
1105
1106     subchoice = Menu(1, 1, choice$(), menuRow(), menuCol(), help$(), FALSE)
1107
1108     SELECT CASE subchoice
1109         CASE 1: finished = TRUE
1110         CASE ELSE
1111     END SELECT
1112     RETURN
1113
1114
1115 MenuSystemEdit:
1116     choice$(1) = " Edit Account Titles "
1117
1118     menuRow(1) = 3: menuCol(1) = 8
1119
1120     help$(1) = "Add/edit/delete accounts"
1121
1122     subchoice = Menu(1, 1, choice$(), menuRow(), menuCol(), help$(), FALSE)
1123
1124     SELECT CASE subchoice
1125         CASE 1: EditAccounts
1126         CASE ELSE
1127     END SELECT
1128     RETURN
1129
1130
1131 MenuSystemAccount:
1132
1133     FOR a = 1 TO 19
1134         IF Trim$(account(a).Title) = "" THEN
1135             choice$(a) = RIGHT$(STR$(a), 2) + ". ------------------- "
1136         ELSE
1137             choice$(a) = RIGHT$(STR$(a), 2) + ". " + account(a).Title
1138         END IF
1139         menuRow(a) = a + 2
1140         menuCol(a) = 19
1141         help$(a) = RTRIM$(account(a).Desc)
1142     NEXT a
1143
1144     subchoice = Menu(1, 19, choice$(), menuRow(), menuCol(), help$(), FALSE)
1145
1146     IF subchoice > 0 THEN
1147         EditTrans (subchoice)
1148     END IF
1149     RETURN
1150
1151
1152 MenuSystemReport:
1153     choice$(1) = " Net Worth Report       "
1154     menuRow(1) = 3: menuCol(1) = 32
1155     help$(1) = "View and print net worth report"
1156
1157     FOR a = 1 TO 19
1158         IF Trim$(account(a).Title) = "" THEN
1159             choice$(a + 1) = RIGHT$(STR$(a), 2) + ". ------------------- "
1160         ELSE
1161             choice$(a + 1) = RIGHT$(STR$(a), 2) + ". " + account(a).Title
1162         END IF
1163         menuRow(a + 1) = a + 3
1164         menuCol(a + 1) = 32
1165         help$(a + 1) = "Print " + RTRIM$(account(a).Title) + " transaction summary"
1166     NEXT a
1167
1168     subchoice = Menu(1, 20, choice$(), menuRow(), menuCol(), help$(), FALSE)
1169
1170     SELECT CASE subchoice
1171         CASE 1
1172             NetWorthReport
1173         CASE 2 TO 20
1174             TransactionSummary (subchoice - 1)
1175         CASE ELSE
1176     END SELECT
1177     RETURN
1178
1179 MenuSystemColors:
1180     choice$(1) = " Monochrome Scheme "
1181     choice$(2) = " Cyan/Blue Scheme  "
1182     choice$(3) = " Blue/Cyan Scheme  "
1183     choice$(4) = " Red/Grey Scheme   "
1184
1185     menuRow(1) = 3: menuCol(1) = 41
1186     menuRow(2) = 4: menuCol(2) = 41
1187     menuRow(3) = 5: menuCol(3) = 41
1188     menuRow(4) = 6: menuCol(4) = 41
1189
1190     help$(1) = "Color scheme for monochrome and LCD displays"
1191     help$(2) = "Color scheme featuring cyan"
1192     help$(3) = "Color scheme featuring blue"
1193     help$(4) = "Color scheme featuring red"
1194
1195     subchoice = Menu(1, 4, choice$(), menuRow(), menuCol(), help$(), FALSE)
1196
1197     SELECT CASE subchoice
1198         CASE 1 TO 4
1199             ColorPref = subchoice
1200             SaveState
1201         CASE ELSE
1202     END SELECT
1203     RETURN
1204
1205
1206 END SUB
1207
1208 'NetWorthReport:
1209 '  Prints net worth report to screen and printer
1210 SUB NetWorthReport
1211     DIM assetIndex(19), liabilityIndex(19)
1212
1213     maxAsset = 0
1214     maxLiability = 0
1215
1216     FOR a = 1 TO 19
1217         IF account(a).AType = "A" THEN
1218             maxAsset = maxAsset + 1
1219             assetIndex(maxAsset) = a
1220         ELSEIF account(a).AType = "L" THEN
1221             maxLiability = maxLiability + 1
1222             liabilityIndex(maxLiability) = a
1223         END IF
1224     NEXT a
1225
1226     'Loop until <F2> is pressed
1227     finished = FALSE
1228     DO
1229         u1$ = "\                  \$$###,###,###.##"
1230         u2$ = "\               \+$$#,###,###,###.##"
1231
1232         COLOR colors(5, ColorPref), colors(4, ColorPref)
1233         LOCATE 1, 1: PRINT SPACE$(80);
1234         LOCATE 1, 4: PRINT "Net Worth Report: " + DATE$;
1235         PrintHelpLine "<F2=Exit>    <F3=Print Report>"
1236
1237         COLOR colors(7, ColorPref), colors(4, ColorPref)
1238         Box 2, 1, 24, 40
1239         Box 2, 41, 24, 80
1240
1241         LOCATE 2, 16: PRINT " ASSETS "
1242         assetTotal# = 0
1243         a = 1
1244         count1 = 1
1245         WHILE a <= maxAsset
1246             file$ = "money." + Cvit$(assetIndex(a))
1247             OPEN file$ FOR RANDOM AS #1 LEN = 84
1248             FIELD #1, 11 AS valid$, 5 AS IoMaxRecord$, 8 AS IoBalance$
1249             GET #1, 1
1250             IF valid$ = "THISISVALID" THEN
1251                 LOCATE 2 + count1, 3: PRINT USING u1$; account(assetIndex(a)).Title; CVD(IoBalance$)
1252                 assetTotal# = assetTotal# + CVD(IoBalance$)
1253                 count1 = count1 + 1
1254             END IF
1255             CLOSE
1256             a = a + 1
1257         WEND
1258
1259         LOCATE 2, 55: PRINT " LIABILITIES "
1260         liabilityTotal# = 0
1261         a = 1
1262         count2 = 1
1263         WHILE a <= maxLiability
1264             file$ = "money." + Cvit$(liabilityIndex(a))
1265             OPEN file$ FOR RANDOM AS #1 LEN = 84
1266             FIELD #1, 11 AS valid$, 5 AS IoMaxRecord$, 8 AS IoBalance$
1267             GET #1, 1
1268             IF valid$ = "THISISVALID" THEN
1269                 LOCATE 2 + count2, 43: PRINT USING u1$; account(liabilityIndex(a)).Title; CVD(IoBalance$)
1270                 liabilityTotal# = liabilityTotal# + CVD(IoBalance$)
1271                 count2 = count2 + 1
1272             END IF
1273             CLOSE
1274             a = a + 1
1275         WEND
1276         IF count2 > count1 THEN count1 = count2
1277         LOCATE 2 + count1, 25: PRINT "--------------"
1278         LOCATE 2 + count1, 65: PRINT "--------------"
1279         LOCATE 3 + count1, 3: PRINT USING u2$; "Total assets"; assetTotal#;
1280         LOCATE 3 + count1, 43: PRINT USING u2$; "Total liabilities"; liabilityTotal#
1281
1282         COLOR colors(5, ColorPref), colors(4, ColorPref)
1283         LOCATE 1, 43: PRINT USING u2$; "    NET WORTH:"; assetTotal# - liabilityTotal#
1284
1285         DO: Kbd$ = INKEY$: LOOP UNTIL Kbd$ <> ""
1286
1287         SELECT CASE Kbd$                            'Handle Special keys
1288             CASE CHR$(0) + "<"                      'F2
1289                 finished = TRUE
1290             CASE CHR$(0) + "="                      'F3
1291                GOSUB NetWorthReportPrint
1292             CASE ELSE
1293                BEEP
1294         END SELECT
1295     LOOP UNTIL finished
1296     EXIT SUB
1297
1298 NetWorthReportPrint:
1299     PrintHelpLine ""
1300
1301     Box 8, 20, 14, 62
1302     Center 10, "Prepare printer on LPT1 for report"
1303     Center 12, "Hit <Enter> to print, or <Esc> to abort"
1304
1305     DO: Kbd$ = INKEY$: LOOP WHILE Kbd$ <> CHR$(13) AND Kbd$ <> CHR$(27)
1306
1307     IF Kbd$ = CHR$(13) THEN
1308         Box 8, 20, 14, 62
1309         Center 11, "Printing report..."
1310         u0$ = "                     \                  \ "
1311         u1$ = "                        \                 \ $$###,###,###.##"
1312         u2$ = "                                              --------------"
1313         u3$ = "                                               ============="
1314         u4$ = "                        \               \+$$#,###,###,###.##"
1315         PrintErr = FALSE
1316         ON ERROR GOTO ErrorTrap                 ' test if printer is connected
1317         LPRINT
1318         IF PrintErr = FALSE THEN
1319             LPRINT : LPRINT : LPRINT : LPRINT : LPRINT
1320             LCenter "Q B a s i c"
1321             LCenter "M O N E Y   M A N A G E R"
1322             LPRINT : LPRINT
1323             LCenter "NET WORTH REPORT:  " + DATE$
1324             LCenter "-------------------------------------------"
1325             LPRINT USING u0$; "ASSETS:"
1326             assetTotal# = 0
1327             a = 1
1328             WHILE a <= maxAsset
1329                 file$ = "money." + Cvit$(assetIndex(a))
1330                 OPEN file$ FOR RANDOM AS #1 LEN = 84
1331                 FIELD #1, 11 AS valid$, 5 AS IoMaxRecord$, 8 AS IoBalance$
1332                 GET #1, 1
1333                 IF valid$ = "THISISVALID" THEN
1334                     LPRINT USING u1$; account(assetIndex(a)).Title; CVD(IoBalance$)
1335                     assetTotal# = assetTotal# + CVD(IoBalance$)
1336                 END IF
1337                 CLOSE #1
1338                 a = a + 1
1339             WEND
1340             LPRINT u2$
1341             LPRINT USING u4$; "Total assets"; assetTotal#
1342             LPRINT
1343             LPRINT
1344             LPRINT USING u0$; "LIABILITIES:"
1345             liabilityTotal# = 0
1346             a = 1
1347             WHILE a <= maxLiability
1348                 file$ = "money." + Cvit$(liabilityIndex(a))
1349                 OPEN file$ FOR RANDOM AS #1 LEN = 84
1350                 FIELD #1, 11 AS valid$, 5 AS IoMaxRecord$, 8 AS IoBalance$
1351                 GET #1, 1
1352                 IF valid$ = "THISISVALID" THEN
1353                     LPRINT USING u1$; account(liabilityIndex(a)).Title; CVD(IoBalance$)
1354                     liabilityTotal# = liabilityTotal# + CVD(IoBalance$)
1355                 END IF
1356                 CLOSE #1
1357                 a = a + 1
1358             WEND
1359             LPRINT u2$
1360             LPRINT USING u4$; "Total liabilities"; liabilityTotal#
1361             LPRINT
1362
1363             LPRINT
1364             LPRINT u3$
1365             LPRINT USING u4$; "NET WORTH"; assetTotal# - liabilityTotal#
1366             LCenter "-------------------------------------------"
1367             LPRINT : LPRINT : LPRINT
1368         END IF
1369         ON ERROR GOTO 0
1370     END IF
1371     RETURN
1372 END SUB
1373
1374 'PrintHelpLine:
1375 '  Prints help text on the bottom row in the proper color
1376 SUB PrintHelpLine (help$)
1377     COLOR colors(5, ColorPref), colors(4, ColorPref)
1378     LOCATE 25, 1
1379     PRINT SPACE$(80);
1380     Center 25, help$
1381 END SUB
1382
1383 'SaveState:
1384 '  Save color preference and account information to "MONEY.DAT" data file.
1385 SUB SaveState
1386     OPEN "money.dat" FOR OUTPUT AS #2
1387     PRINT #2, ColorPref
1388
1389     FOR a = 1 TO 19
1390         PRINT #2, account(a).Title
1391         PRINT #2, account(a).AType
1392         PRINT #2, account(a).Desc
1393     NEXT a
1394
1395     CLOSE #2
1396 END SUB
1397
1398 'ScrollDown:
1399 '  Call the assembly program to scroll the screen down
1400 SUB ScrollDown
1401     DEF SEG = VARSEG(ScrollDownAsm(1))
1402     CALL Absolute(VARPTR(ScrollDownAsm(1)))
1403     DEF SEG
1404 END SUB
1405
1406 'ScrollUp:
1407 '  Calls the assembly program to scroll the screen up
1408 SUB ScrollUp
1409     DEF SEG = VARSEG(ScrollUpAsm(1))
1410     CALL Absolute(VARPTR(ScrollUpAsm(1)))
1411     DEF SEG
1412 END SUB
1413
1414 'SparklePause:
1415 '  Creates flashing border for intro screen
1416 SUB SparklePause
1417
1418     COLOR 4, 0
1419     a$ = "*    *    *    *    *    *    *    *    *    *    *    *    *    *    *    *    *    "
1420     WHILE INKEY$ <> "": WEND 'Clear keyboard buffer
1421
1422     WHILE INKEY$ = ""
1423         FOR a = 1 TO 5
1424             LOCATE 1, 1                             'print horizontal sparkles
1425             PRINT MID$(a$, a, 80);
1426             LOCATE 22, 1
1427             PRINT MID$(a$, 6 - a, 80);
1428
1429             FOR b = 2 TO 21                         'Print Vertical sparkles
1430                 c = (a + b) MOD 5
1431                 IF c = 1 THEN
1432                     LOCATE b, 80
1433                     PRINT "*";
1434                     LOCATE 23 - b, 1
1435                     PRINT "*";
1436                 ELSE
1437                     LOCATE b, 80
1438                     PRINT " ";
1439                     LOCATE 23 - b, 1
1440                     PRINT " ";
1441                 END IF
1442             NEXT b
1443         NEXT a
1444     WEND
1445 END SUB
1446
1447 'TransactionSummary:
1448 '  Print transaction summary to line printer
1449 SUB TransactionSummary (item)
1450     FancyCls colors(2, ColorPref), colors(1, ColorPref)
1451     PrintHelpLine ""
1452     Box 8, 20, 14, 62
1453     Center 10, "Prepare printer on LPT1 for report"
1454     Center 12, "Hit <Enter> to print, or <Esc> to abort"
1455
1456     DO: Kbd$ = INKEY$: LOOP WHILE Kbd$ <> CHR$(13) AND Kbd$ <> CHR$(27)
1457
1458     IF Kbd$ = CHR$(13) THEN
1459         Box 8, 20, 14, 62
1460         Center 11, "Printing report..."
1461         PrintErr = FALSE
1462         ON ERROR GOTO ErrorTrap                 ' test if printer is connected
1463         LPRINT
1464         IF PrintErr = FALSE THEN
1465             PRINT
1466             LPRINT : LPRINT : LPRINT : LPRINT : LPRINT
1467             LCenter "Q B a s i c"
1468             LCenter "M O N E Y   M A N A G E R"
1469             LPRINT : LPRINT
1470             LCenter "Transaction summary: " + Trim$(account(item).Title)
1471             LCenter DATE$
1472             LPRINT
1473             u5$ = "--------|------|------------------------|----------|----------|--------------"
1474             LPRINT u5$
1475             LPRINT "  Date  | Ref# | Description            | Increase | Decrease |  Balance   "
1476             LPRINT u5$
1477              u0$ = "\      \|\    \|\                      \|"
1478             u2$ = "###,###.##"
1479             u3$ = "###,###,###.##"
1480             u4$ = "          "
1481
1482             file$ = "money." + Cvit$(item)
1483             OPEN file$ FOR RANDOM AS #1 LEN = 84
1484             FIELD #1, 8 AS IoDate$, 10 AS IoRef$, 50 AS IoDesc$, 8 AS IoFig1$, 8 AS IoFig2$
1485             FIELD #1, 11 AS valid$, 5 AS IoMaxRecord$, 8 AS IoBalance$
1486             GET #1, 1
1487             IF valid$ = "THISISVALID" THEN
1488                 Balance# = 0
1489                 MaxRecord = VAL(IoMaxRecord$)
1490                 CurrRecord = 1
1491                 WHILE CurrRecord <= MaxRecord
1492
1493                     GET #1, CurrRecord + 1
1494                     Fig1# = CVD(IoFig1$)
1495                     Fig2# = CVD(IoFig2$)
1496
1497                     LPRINT USING u0$; IoDate$; IoRef$; IoDesc$;
1498                     IF Fig2# = 0 AND Fig1# = 0 THEN
1499                         LPRINT USING u4$ + "|" + u4$ + "|" + u3$; Balance#
1500                     ELSEIF Fig2# = 0 THEN
1501                         Balance# = Balance# + Fig1#
1502                         LPRINT USING u2$ + "|" + u4$ + "|" + u3$; Fig1#; Balance#
1503                     ELSE
1504                         Balance# = Balance# - Fig2#
1505                         LPRINT USING u4$ + "|" + u2$ + "|" + u3$; Fig2#; Balance#
1506                     END IF
1507                     CurrRecord = CurrRecord + 1
1508                 WEND
1509                 LPRINT u5$
1510                 LPRINT : LPRINT
1511             END IF
1512             ON ERROR GOTO 0
1513         END IF
1514         CLOSE
1515     END IF
1516 END SUB
1517
1518 'Trin$:
1519 '  Remove null and spaces from the end of a string.
1520 FUNCTION Trim$ (X$)
1521
1522     IF X$ = "" THEN
1523         Trim$ = ""
1524     ELSE
1525         lastChar = 0
1526         FOR a = 1 TO LEN(X$)
1527             y$ = MID$(X$, a, 1)
1528             IF y$ <> CHR$(0) AND y$ <> " " THEN
1529                 lastChar = a
1530             END IF
1531         NEXT a
1532         Trim$ = LEFT$(X$, lastChar)
1533     END IF
1534
1535 END FUNCTION
1536