QB 4.5 Money Manager

[vxlancin]

Does anyone remember the sample source code program "Qbasic Money Manager" that came with QB4.5?

I have adapted it for other uses changing it slightly. It only stores 19 account. Does anyone know how to extend that to 50 or 100?

Thanks

[Clippy]

For those interested in "Money.Bas", download it from QbasicStation.com in Member's Files. It is in the QB45.zip download in Sub's and Functions area.

Ted

[vxlancin]

I have the actual program already but was wondering how to change it for more than the set 19 accounts?

[Ninkazu]

19 was pretty baked into that program, but I changed it to have MAXREPORT accounts and reports (add a const where TRUE and FALSE are defined)

Here are the changes to FUNCTION Menu (don't forget to change its declaration to have DisplayChoice%)

Code:

FUNCTION Menu (CurrChoiceX, DisplayChoice, MaxChoice, choice$(), ItemRow(), ItemCol(), help$(), BarMode)
   
    currChoice = CurrChoiceX
    scrollBegin = 1 ' To show more than 19 menu items, we have to scroll

    GOSUB MenuPrintChoices

    finished = FALSE

    WHILE NOT finished
       
        GOSUB MenuShowCursor
        GOSUB MenuGetKey
        GOSUB MenuHideCursor

        SELECT CASE Kbd$
            CASE CHR$(0) + "H": GOSUB MenuUp
            CASE CHR$(0) + "P": GOSUB MenuDown
            CASE CHR$(0) + "K": GOSUB MenuLeft
            CASE CHR$(0) + "M": GOSUB MenuRight
            CASE CHR$(13): GOSUB MenuEnter
            CASE CHR$(27): GOSUB MenuEscape
            CASE ELSE:  BEEP
        END SELECT
    WEND

    Menu = currChoice

    EXIT FUNCTION


MenuEnter:
    finished = TRUE
    RETURN

MenuEscape:
    currChoice = 0
    finished = TRUE
    RETURN

MenuUp:
    IF BarMode THEN
        BEEP
    ELSE
        currChoice = (currChoice + MaxChoice - 2) MOD MaxChoice + 1
        IF currChoice < scrollBegin THEN scrollBegin = currChoice
        IF currChoice - DisplayChoice > scrollBegin THEN scrollBegin = currChoice - DisplayChoice + 1
    END IF
    RETURN

MenuLeft:
    IF BarMode THEN
        currChoice = (currChoice + MaxChoice - 2) MOD MaxChoice + 1
    ELSE
        currChoice = -2
        finished = TRUE
    END IF
    RETURN

MenuRight:
    IF BarMode THEN
        currChoice = (currChoice) MOD MaxChoice + 1
    ELSE
        currChoice = -3
        finished = TRUE
    END IF
    RETURN

MenuDown:
    IF BarMode THEN
        finished = TRUE
    ELSE
        currChoice = (currChoice) MOD MaxChoice + 1
        IF currChoice - scrollBegin >= DisplayChoice THEN scrollBegin = scrollBegin MOD MaxChoice + 1
        IF currChoice < scrollBegin THEN scrollBegin = 1
    END IF
    RETURN

MenuShowCursor:
    GOSUB MenuPrintChoices
    COLOR colors(8, ColorPref), colors(9, ColorPref)
    LOCATE ItemRow(currChoice - scrollBegin + 1), ItemCol(currChoice - scrollBegin + 1)
    PRINT choice$(currChoice);
    PrintHelpLine help$(currChoice)
    RETURN

MenuGetKey:
    Kbd$ = ""
    WHILE Kbd$ = ""
        Kbd$ = INKEY$
    WEND
    RETURN

MenuHideCursor:
    COLOR colors(7, ColorPref), colors(4, ColorPref)
    LOCATE ItemRow(currChoice - scrollBegin + 1), ItemCol(currChoice - scrollBegin + 1)
    PRINT choice$(currChoice);
    RETURN

MenuPrintChoices:
    'if in bar mode, color in menu bar, else color box/shadow
    'bar mode means you are currently in the menu bar, not a sub menu
    IF BarMode THEN
        COLOR colors(7, ColorPref), colors(4, ColorPref)
        LOCATE 1, 1
        PRINT SPACE$(80);
    ELSE
        FancyCls colors(2, ColorPref), colors(1, ColorPref)
        COLOR colors(7, ColorPref), colors(4, ColorPref)
        Box ItemRow(1) - 1, ItemCol(1) - 1, ItemRow(DisplayChoice) + 1, ItemCol(1) + LEN(choice$(1)) + 1
       
        COLOR colors(10, ColorPref), colors(6, ColorPref)
        FOR a = 1 TO DisplayChoice + 1
            LOCATE ItemRow(1) + a - 1, ItemCol(1) + LEN(choice$(1)) + 2
            PRINT CHR$(178); CHR$(178);
        NEXT a
        LOCATE ItemRow(DisplayChoice) + 2, ItemCol(DisplayChoice) + 2
        PRINT STRING$(LEN(choice$(DisplayChoice + scrollBegin - 1)) + 2, 178);
    END IF
   
    'print the choices
    COLOR colors(7, ColorPref), colors(4, ColorPref)
    FOR a = 1 TO DisplayChoice
        LOCATE ItemRow(a), ItemCol(a)
        PRINT choice$(a + scrollBegin - 1);
    NEXT a
    RETURN


END FUNCTION

MenuSystem required a few tweaks too, and instead of posting the diff, here's the whole thing

Code:

SUB MenuSystem

    DIM choice$(MAXREPORT + 1), menuRow(MAXREPORT + 1), menuCol(MAXREPORT + 1), help$(MAXREPORT + 1)
    LOCATE , , 0
    choice = 1
    finished = FALSE

    WHILE NOT finished
        GOSUB MenuSystemMain

        subchoice = -1
        WHILE subchoice < 0
            SELECT CASE choice
                CASE 1: GOSUB MenuSystemFile
                CASE 2: GOSUB MenuSystemEdit
                CASE 3: GOSUB MenuSystemAccount
                CASE 4: GOSUB MenuSystemReport
                CASE 5: GOSUB MenuSystemColors
            END SELECT
            FancyCls colors(2, ColorPref), colors(1, ColorPref)

            SELECT CASE subchoice
                CASE -2: choice = (choice + 3) MOD 5 + 1
                CASE -3: choice = (choice) MOD 5 + 1
            END SELECT
        WEND
    WEND
    EXIT SUB


MenuSystemMain:
    FancyCls colors(2, ColorPref), colors(1, ColorPref)
    COLOR colors(7, ColorPref), colors(4, ColorPref)
    Box 9, 19, 14, 61
    Center 11, "Use arrow keys to navigate menu system"
    Center 12, "Press Enter to select a menu item"

    choice$(1) = " File "
    choice$(2) = " Accounts "
    choice$(3) = " Transactions "
    choice$(4) = " Reports "
    choice$(5) = " Colors "

    menuRow(1) = 1: menuCol(1) = 2
    menuRow(2) = 1: menuCol(2) = 8
    menuRow(3) = 1: menuCol(3) = 18
    menuRow(4) = 1: menuCol(4) = 32
    menuRow(5) = 1: menuCol(5) = 41
   
    help$(1) = "Exit the Money Manager"
    help$(2) = "Add/edit/delete accounts"
    help$(3) = "Add/edit/delete account transactions"
    help$(4) = "View and print reports"
    help$(5) = "Set screen colors"
   
    DO
        NewChoice = Menu((choice), 5, 5, choice$(), menuRow(), menuCol(), help$(), TRUE)
    LOOP WHILE NewChoice = 0
    choice = NewChoice
    RETURN

MenuSystemFile:
    choice$(1) = " Exit           "

    menuRow(1) = 3: menuCol(1) = 2

    help$(1) = "Exit the Money Manager"

    subchoice = Menu(1, 1, 1, choice$(), menuRow(), menuCol(), help$(), FALSE)

    SELECT CASE subchoice
        CASE 1: finished = TRUE
        CASE ELSE
    END SELECT
    RETURN


MenuSystemEdit:
    choice$(1) = " Edit Account Titles "

    menuRow(1) = 3: menuCol(1) = 8
   
    help$(1) = "Add/edit/delete accounts"

    subchoice = Menu(1, 1, 1, choice$(), menuRow(), menuCol(), help$(), FALSE)

    SELECT CASE subchoice
        CASE 1: EditAccounts
        CASE ELSE
    END SELECT
    RETURN


MenuSystemAccount:

    FOR a = 1 TO 19
        IF Trim$(account(a).Title) = "" THEN
            choice$(a) = RIGHT$(STR$(a), 2) + ". ------------------- "
        ELSE
            choice$(a) = RIGHT$(STR$(a), 2) + ". " + account(a).Title
        END IF
        menuRow(a) = a + 2
        menuCol(a) = 19
        help$(a) = RTRIM$(account(a).Desc)
    NEXT a

    subchoice = Menu(1, 19, 19, choice$(), menuRow(), menuCol(), help$(), FALSE)

    IF subchoice > 0 THEN
        EditTrans (subchoice)
    END IF
    RETURN


MenuSystemReport:
    choice$(1) = " Net Worth Report       "
    menuRow(1) = 3: menuCol(1) = 32
    help$(1) = "View and print net worth report"

    FOR a = 1 TO MAXREPORT
        IF Trim$(account(a).Title) = "" THEN
            choice$(a + 1) = RIGHT$(STR$(a), 2) + ". ------------------- "
        ELSE
            choice$(a + 1) = RIGHT$(STR$(a), 2) + ". " + account(a).Title
        END IF
        menuRow(a + 1) = a + 3
        menuCol(a + 1) = 32
        help$(a + 1) = "Print " + RTRIM$(account(a).Title) + " transaction summary"
    NEXT a

    subchoice = Menu(1, 20, MAXREPORT, choice$(), menuRow(), menuCol(), help$(), FALSE)

    SELECT CASE subchoice
        CASE 1
            NetWorthReport
        CASE 2 TO 20
            TransactionSummary (subchoice - 1)
        CASE ELSE
    END SELECT
    RETURN

MenuSystemColors:
    choice$(1) = " Monochrome Scheme "
    choice$(2) = " Cyan/Blue Scheme  "
    choice$(3) = " Blue/Cyan Scheme  "
    choice$(4) = " Red/Grey Scheme   "

    menuRow(1) = 3: menuCol(1) = 41
    menuRow(2) = 4: menuCol(2) = 41
    menuRow(3) = 5: menuCol(3) = 41
    menuRow(4) = 6: menuCol(4) = 41

    help$(1) = "Color scheme for monochrome and LCD displays"
    help$(2) = "Color scheme featuring cyan"
    help$(3) = "Color scheme featuring blue"
    help$(4) = "Color scheme featuring red"

    subchoice = Menu(1, 4, 4, choice$(), menuRow(), menuCol(), help$(), FALSE)

    SELECT CASE subchoice
        CASE 1 TO 4
            ColorPref = subchoice
            SaveState
        CASE ELSE
    END SELECT
    RETURN


END SUB

EditAccounts needed a few changes to allow more reports than the screen can display too

Code:

SUB EditAccounts

    'Information about each column
    REDIM help$(4), col(4), Vis(4), Max(4), edit$(MAXREPORT, 3)

    'Draw the screen
    COLOR colors(7, ColorPref), colors(4, ColorPref)
    Box 2, 1, 24, 80

    COLOR colors(5, ColorPref), colors(4, ColorPref)
    LOCATE 1, 1: PRINT SPACE$(80)
    LOCATE 1, 4: PRINT "Account Editor";
    COLOR colors(7, ColorPref), colors(4, ColorPref)

    LOCATE 3, 2: PRINT "No� Account Title      � Description                                      �A/L"
    LOCATE 4, 2: PRINT "������������������������������������������������������������������������������"
                  u$ = "##�\                  \�\                                                \� ! "

    'Initialize variables
    help$(1) = "  Account name                             | <F2=Save and Exit> <Escape=Abort>"
    help$(2) = "  Account description                      | <F2=Save and Exit> <Escape=Abort>"
    help$(3) = "  Account type (A = Asset, L = Liability)  | <F2=Save and Exit> <Escape=Abort>"
                       
    col(1) = 5: col(2) = 26: col(3) = 78
    Vis(1) = 20: Vis(2) = 50: Vis(3) = 1
    Max(1) = 20: Max(2) = 50: Max(3) = 1
    scrollBegin = 1

    FOR a = 1 TO MAXREPORT
        edit$(a, 1) = account(a).Title
        edit$(a, 2) = account(a).Desc
        edit$(a, 3) = account(a).AType
    NEXT a

    finished = FALSE

    CurrRow = 1
    CurrCol = 1
    PrintHelpLine help$(CurrCol)

    'Loop until F2 or <ESC> is pressed
    DO
        FOR a = 5 TO 23
            LOCATE a, 2
            X = scrollBegin + a - 5
            PRINT USING u$; X; edit$(X, 1); edit$(X, 2); edit$(X, 3);
        NEXT a
        GOSUB EditAccountsShowCursor            'Show Cursor
        DO                                      'Wait for key
            Kbd$ = INKEY$
        LOOP UNTIL Kbd$ <> ""

        IF Kbd$ >= " " AND Kbd$ < "~" THEN      'If legal, edit item
            GOSUB EditAccountsEditItem
        END IF
        GOSUB EditAccountsHideCursor            'Hide Cursor so it can move
                                                'If it needs to
        SELECT CASE Kbd$
            CASE CHR$(0) + "H"                              'Up Arrow
                CurrRow = (CurrRow + MAXREPORT - 2) MOD MAXREPORT + 1
                IF CurrRow < scrollBegin THEN scrollBegin = CurrRow
                IF CurrRow - 19 > scrollBegin THEN scrollBegin = CurrRow - 18
            CASE CHR$(0) + "P"                              'Down Arrow
                CurrRow = (CurrRow) MOD MAXREPORT + 1
                IF CurrRow - scrollBegin >= 19 THEN scrollBegin = scrollBegin MOD MAXREPORT + 1
                IF CurrRow < scrollBegin THEN scrollBegin = 1
            CASE CHR$(0) + "K", CHR$(0) + CHR$(15)          'Left or Shift+Tab
                CurrCol = (CurrCol + 1) MOD 3 + 1
                PrintHelpLine help$(CurrCol)
            CASE CHR$(0) + "M", CHR$(9)                     'Right or Tab
                CurrCol = (CurrCol) MOD 3 + 1
                PrintHelpLine help$(CurrCol)
            CASE CHR$(0) + "<"                              'F2
                finished = TRUE
                Save = TRUE
            CASE CHR$(27)                                   'Esc
                finished = TRUE
                Save = FALSE
            CASE CHR$(13)                                   'Return
            CASE ELSE
                BEEP
        END SELECT
    LOOP UNTIL finished

    IF Save THEN
        GOSUB EditAccountsSaveData
    END IF

    EXIT SUB

EditAccountsShowCursor:
    COLOR colors(8, ColorPref), colors(9, ColorPref)
    LOCATE CurrRow - scrollBegin + 5, col(CurrCol)
    PRINT LEFT$(edit$(CurrRow, CurrCol), Vis(CurrCol));
    RETURN

EditAccountsEditItem:
    COLOR colors(8, ColorPref), colors(9, ColorPref)
    ok = FALSE
    start$ = Kbd$
    DO
        Kbd$ = GetString$(CurrRow - scrollBegin + 5, col(CurrCol), start$, end$, Vis(CurrCol), Max(CurrCol))
        edit$(CurrRow, CurrCol) = LEFT$(end$ + SPACE$(Max(CurrCol)), Max(CurrCol))
        start$ = ""

        IF CurrCol = 3 THEN
            X$ = UCASE$(end$)
            IF X$ = "A" OR X$ = "L" OR X$ = "" OR X$ = " " THEN
                ok = TRUE
                IF X$ = "" THEN X$ = " "
                edit$(CurrRow, CurrCol) = X$
            ELSE
                BEEP
            END IF
        ELSE
            ok = TRUE
        END IF
       
    LOOP UNTIL ok
    RETURN

EditAccountsHideCursor:
    COLOR colors(7, ColorPref), colors(4, ColorPref)
    LOCATE CurrRow - scrollBegin + 5, col(CurrCol)
    PRINT LEFT$(edit$(CurrRow, CurrCol), Vis(CurrCol));
    RETURN


EditAccountsSaveData:
    FOR a = 1 TO MAXREPORT
        account(a).Title = edit$(a, 1)
        account(a).Desc = edit$(a, 2)
        account(a).AType = edit$(a, 3)
    NEXT a
    SaveState
    RETURN

END SUB

And then SaveState/LoadState needs to just modify 19 to MAXREPORT, along with the dimensioning of accounts and the for loop in ErrorTrap

I didn't change the transactions code. If you need more than 19 there, just follow the scheme of these changes.

[vxlancin]

Thanks thats exactly what i'm looking for. One thing - the reports menu scrolls up and down but not the transaction one. Any ideas?

[Ninkazu]

Well, considering that you've modified the program to fit your needs elsewhere, I know that you understand the science of programming. As my last sentence stated, I didn't touch the transactions code, but I believe you would be able to handle it yourself, learning from my changes. Consider it a learning experience.

::EDIT::
I took a look and it was a two line change, so what the hell.

(Label in MenuSystem)

Code:

MenuSystemAccount:

    FOR a = 1 TO MAXREPORT
        IF Trim$(account(a).Title) = "" THEN
            choice$(a) = RIGHT$(STR$(a), 2) + ". ------------------- "
        ELSE
            choice$(a) = RIGHT$(STR$(a), 2) + ". " + account(a).Title
        END IF
        menuRow(a) = a + 2
        menuCol(a) = 19
        help$(a) = RTRIM$(account(a).Desc)
    NEXT a

    subchoice = Menu(1, 20, MAXREPORT, choice$(), menuRow(), menuCol(), help$(), FALSE)

    IF subchoice > 0 THEN
        EditTrans (subchoice)
    END IF
    RETURN

::EDIT 2::
Also, I found that the subchoice bounds checking in the label following should be from 2 to MAXREPORT+1 instead of 20. That should take care of all the bugs.

[vxlancin]

Thanks very much this has helped a lot

Cheers

[Ninkazu]

No problem. I was getting bored watching hulu all day. ProjectEuler is a bore (maybe difficult for scriptkiddies, but I'm 4 months away from a math degree), and programming games is too much work for an afternoon, so your question helped me out.

[vxlancin]

Hi
I have one more bug that i really cant work out why its doing it. When I access the reports and scroll down there is only 98 accounts available but have set MAXREPORT as 99. In the accounts part there is 99 and there is also 99 in transactions but not reports. Any ideas why?

[Ninkazu]

Since the choice(1) is being set specifically for reports, the menu limit of MAXREPORT is wrong. Line 136 of SUB MenuSystem should have MAXREPORT+1 instead.