Check the Cash Register Receipt

[bplus]

Did you ever come home from store and wonder where all your money went?

You look at the receipt and the prices look OK, but wonder, "Did the register add the stuff up right?"

I did today, (again) so a made a little proggie to reassure myself the register is working right.
Ha! I trust a QB64 program more!

It seems to be working OK or all the adders are conspiring against me... :-))

Code: QB64: [Select]

1. _TITLE "Adding machine, use c to clear total, enter again to repeat an add, R to review tape" 'B+ 2019-08-20
2. REDIM tape(0) AS STRING
3.  
4. WHILE _KEYDOWN(27) = 0
5.     k$ = INKEY$
6.     IF LEN(k$) THEN
7.         IF INSTR("-.0123456789", k$) THEN build$ = build$ + k$: PRINT k$;
8.         IF ASC(k$) = 8 AND LEN(build$) THEN build$ = LEFT$(build$, LEN(build$) - 1): PRINT: PRINT build$;
9.         IF ASC(k$) = 13 THEN
10.             IF build$ = "" AND lastBuild$ <> "" THEN
11.                 r = r + 1
12.                 total = total + VAL(lastBuild$)
13.                 LOCATE , 1: PRINT lastBuild$;
14.                 LOCATE , 30: PRINT total, r
15.                 s$ = SPACE$(60)
16.                 MID$(s$, 1, LEN(lastBuild$)) = lastBuild$
17.                 st$ = STR$(total)
18.                 MID$(s$, 30, LEN(st$)) = st$
19.                 st$ = STR$(r)
20.                 MID$(s$, 45, LEN(st$)) = st$
21.                 sAppend tape(), s$
22.             ELSE
23.                 r = 1
24.                 total = total + VAL(build$)
25.                 LOCATE , 30: PRINT total
26.                 s$ = SPACE$(60)
27.                 MID$(s$, 1, LEN(build$)) = build$
28.                 st$ = STR$(total)
29.                 MID$(s$, 30, LEN(st$)) = st$
30.                 sAppend tape(), s$
31.                 lastBuild$ = build$
32.                 build$ = ""
33.             END IF
34.         END IF
35.         IF UCASE$(k$) = "C" THEN
36.             CLS: total = 0: build$ = ""
37.             st$ = STRING$(60, "-")
38.             sAppend tape(), st$
39.         END IF
40.         IF UCASE$(k$) = "R" THEN
41.             _KEYCLEAR
42.             show tape()
43.             CLS
44.             LOCATE , 1: PRINT "Current total: ";
45.             LOCATE , 30: PRINT total
46.         END IF
47.     END IF
48.     _LIMIT 60
49. WEND
50.  
51. 'append to the string array the string item
52. SUB sAppend (arr() AS STRING, item AS STRING)
53.     REDIM _PRESERVE arr(LBOUND(arr) TO UBOUND(arr) + 1) AS STRING
54.     arr(UBOUND(arr)) = item
55. END SUB
56.  
57. SUB show (arr() AS STRING)
58.     DIM lb AS LONG, ub AS LONG, top AS LONG, i AS LONG, row AS LONG, prevrow AS LONG, n AS LONG
59.     lb = LBOUND(arr): ub = UBOUND(arr)
60.     IF ub - lb + 1 < 21 THEN top = ub ELSE top = lb + 19
61.     CLS: PRINT "press any key to quit scroller..."
62.     LOCATE 2, 1
63.     FOR i = lb TO top
64.         PRINT arr(i)
65.     NEXT
66.     DO
67.         IF ub - lb + 1 > 20 THEN
68.             DO WHILE _MOUSEINPUT
69.                 IF row >= lb THEN row = row + _MOUSEWHEEL ELSE row = lb 'prevent under scrolling
70.                 IF row > ub - 19 THEN row = ub - 19 'prevent over scrolling
71.                 IF prevrow <> row THEN 'look for a change in row value
72.                     IF row >= lb AND row <= ub - 19 THEN
73.                         CLS: PRINT "press any key to quit scroller..."
74.                         LOCATE 2, 1
75.                         FOR n = row TO row + 19
76.                             PRINT arr(n)
77.                         NEXT
78.                     END IF
79.                 END IF
80.                 prevrow = row 'store previous row value
81.             LOOP
82.         END IF
83.     LOOP UNTIL INKEY$ > ""
84. END SUB
85.  
86.  

R to Review the tape, to repeat items just press enter again, will get a repeat count with price and total.

Probably will work with checkbooks too.

[johnno56]

"Proggie"? Interesting. Do you pronounce "Newcastlle" as "new castle" or "new carstle"? Guess where I'm going with this... lol

[SierraKen]

Cool little adding proggie! LOL Johno "proggie" goes back to at least the 90's. Not sure where it started, probably California.

I just found out how it started... lol from hackers. Oh well...

https://www.urbandictionary.com/define.php?term=proggie

[bplus]

hmm... now you have me wondering where I picked up that term, probably from an Italian MASM developer and lover of Basic.

Being close to Cleveland, I suppose I should be telling you guys of perogies but I never had any, but with bacon I'll try anything. :)

[bplus]

Update: Now done with Long Integers for cents and using dollars$ function to display with decimal.
Oh yeah, I put the Input line at the bottom and your "paper" tape is above and will show your last 20 lines.

Now, no more the crazy stuff the default Single adds or subtracts from a number.

Instructions (some in the title):
"q" enter to quit (or just use the normal way).
"r" enter lets you read / review the paper tape simulation, scrollable with mouse wheel.
"c" enter lets you clear the screen, tape and running total
just enter allows you to add (or subtract if negative) the last amount entered.
So just enter positive and negative numbers for a running total to check receipt or balance checking account.

Code: QB64: [Select]

1. _Title "Adding machine, use c to clear total, enter again to repeat an add, R to review tape" 'B+ 2019-08-20
2. ' 2022-04-04 overhaul with input Cents (no decimal)
3.  
4. ReDim tape(0) As String
5. Dim test$
6. Dim As Long total, amt, quit, row, start, i
7. row = 0
8.  
9. Do
10.     Locate 25, 1: Input "Enter Cents Amount (no decimal), q to quit "; test$
11.     If test$ = "q" Then
12.         quit = -1
13.     ElseIf test$ = "c" Then
14.         Cls: total = 0
15.         row = 0
16.         ReDim tape(0) As String
17.     ElseIf test$ = "r" Then
18.         _KeyClear
19.         show tape()
20.         GoSub AndDisplay
21.     ElseIf allNumber%(test$) Then
22.         View Print 1 To 21
23.         amt = Val(test$)
24.         GoSub addAndDisplay
25.     ElseIf test$ = "" Then ' just enter then repeat last amt
26.         GoSub addAndDisplay
27.     End If
28.     _Limit 60
29. Loop Until quit
30. End
31.  
32. addAndDisplay:
33. total = total + amt
34. s$ = dollars$(amt) + Space$(20 - Len(dollars$(amt)) - Len(dollars$(total))) + dollars$(total)
35. sAppend tape(), s$
36. row = row + 1
37. AndDisplay:
38. If row > 20 Then start = row - 20 Else start = 1
39. Cls
40. For i = start To row
41.     Print tape(i)
42. Next
43. Return
44.  
45. Function dollars$ (cents As Long)
46.     s$ = _Trim$(Str$(cents))
47.     If Left$(s$, 1) = "-" Then sign$ = "-": s$ = Mid$(s$, 2) Else sign$ = ""
48.     If Len(s$) = 1 Then
49.         s$ = sign$ + "0.0" + s$
50.     ElseIf Len(s$) = 2 Then
51.         s$ = sign$ + "0." + s$
52.     Else
53.         s$ = sign$ + Mid$(s$, 1, Len(s$) - 2) + "." + Mid$(s$, Len(s$) - 1)
54.     End If
55.     dollars$ = s$
56. End Function
57.  
58. Function allNumber% (s$)
59.     If Len(s$) = 0 Then Exit Function
60.     For i = 1 To Len(s$)
61.         If InStr("-1234567890", Mid$(s$, i, 1)) <= 0 Then Exit Function 'done return 0
62.     Next
63.     allNumber% = -1
64. End Function
65.  
66. 'append to the string array the string item
67. Sub sAppend (arr() As String, item As String)
68.     ReDim _Preserve arr(LBound(arr) To UBound(arr) + 1) As String
69.     arr(UBound(arr)) = item
70. End Sub
71.  
72. Sub show (arr() As String)
73.     Dim lb As Long, ub As Long, top As Long, i As Long, row As Long, prevrow As Long, n As Long
74.     lb = LBound(arr): ub = UBound(arr)
75.     If ub - lb + 1 < 21 Then top = ub Else top = lb + 19
76.     Cls: Print "press any key to quit scroller..."
77.     Locate 2, 1
78.     For i = lb To top
79.         Print arr(i)
80.     Next
81.     Do
82.         If ub - lb + 1 > 20 Then
83.             Do While _MouseInput
84.                 If row >= lb Then row = row + _MouseWheel Else row = lb 'prevent under scrolling
85.                 If row > ub - 19 Then row = ub - 19 'prevent over scrolling
86.                 If prevrow <> row Then 'look for a change in row value
87.                     If row >= lb And row <= ub - 19 Then
88.                         Cls: Print "press any key to quit Review of tape..."
89.                         Locate 2, 1
90.                         For n = row To row + 19
91.                             Print arr(n)
92.                         Next
93.                     End If
94.                 End If
95.                 prevrow = row 'store previous row value
96.             Loop
97.         End If
98.     Loop Until InKey$ > ""
99. End Sub
100.  
101.  
102.  

PS If Long fits 10 years of seconds then that's how many cents the Total may add to before it's limit fails.