+- QB64 Phoenix Edition (https://qb64phoenix.com/forum)
+-- Forum: QB64 Rising (https://qb64phoenix.com/forum/forumdisplay.php?fid=1)
+--- Forum: Code and Stuff (https://qb64phoenix.com/forum/forumdisplay.php?fid=3)
+---- Forum: Help Me! (https://qb64phoenix.com/forum/forumdisplay.php?fid=10)
+---- Thread: program crashes about 20% of the time (/showthread.php?tid=1301)
program crashes about 20% of the time - billythebull - 12-18-2022
PITABLE.txt (Size: 44.47 KB / Downloads: 50)
This program crashes about 20% of the time. Any help appreciated.Code: (Select All)
'_FullScreen
Version$ = "Beta Version 0.31"
$ExeIcon:'ultpizza.ico'
_Icon
_Title "ULTIMATE PIZZA POS - POINT OF SALE" + " " + Version$ + " " + "© 2006-2016 MasterSoft LLC. All Rights Reserved."
_ScreenMove _Middle
Do '**********************************************************************************************************
1
K$ = "frank"
result$ = _InputBox$("ULTIMATE PIZZA POS PASSWORD", "You must enter your password to run this program. If you forgot your password please see management", "")
'_ScreenMove _Middle
'If result$ = "" Then
'_MessageBox "ENTER PASSWORD", "Password Field can not be empty", "error"
'GoTo 1
'Else
If UCase$(result$) = UCase$(K$) Then
Exit Do
'Shell _DontWait "C:\Users\Bradley\Desktop\qb64pe_\ULTPIZZA-COUPONS.exe"
ElseIf result$ = "" Then
System
Else
_NotifyPopup "ERROR", "INCORRECT PASSWORD ENTERED", "warning"
GoTo 1
End If
Loop
'**********************************************************************************************************
_FullScreen
'_MOUSEHIDE
'**************************************************************************************************************
'********************************************** Shared Variables **********************************************
'**************************************************************************************************************
Const CTRL = 100306
Const ALT = 100308
Const F12 = 34304
Dim Shared useprinter
Dim Shared HF
Common Shared BK1
Dim Shared CN
Dim Shared ENDER
Dim Shared printstring3$
Dim Shared fontpath$
Dim Shared phone$
Dim Shared Back$
Dim Shared chkno
Dim Shared PRICE
Dim Shared VOIDS
Dim Shared REFUNDS
Dim Shared COUPCNT$
Dim Shared TOTALSALESCNT$
Dim Shared TOTALSALESCNT
Dim Shared COUPON
Dim Shared COUPCNT
Dim Shared code
Dim Shared Styper$
Dim Shared typer$
Dim Shared SALESTYPE$
Dim Shared taxrate
Dim Shared RECEIPT$
Dim Shared PP$
Dim Shared mask$
Dim Shared line1
Dim Shared row
Dim Shared page
Dim Shared M$
Dim Shared tax
Dim Shared DELCNT
Dim Shared VOIDCOUPDOLLARS
Dim Shared subtotal As _Integer64
ReDim Shared RECEIPT$(1100, 2)
Dim Shared DESCRIPTION$
Dim Shared total As _Integer64
Dim Shared ZSUBTOTAL As _Float
Dim Shared ZTAX As _Float
Dim Shared ZTOTAL As _Float
Dim Shared XSUBTOTAL As _Float
Dim Shared XTAX As _Float
Dim Shared XTOTAL As _Float
Dim Shared XCOUPON As _Float
Dim Shared del As _Integer64
Dim Shared TABLE$(540, 6, 1), PRICE$(4) ' FORMAT$(5), X(5)
Common Shared DESCRIPTION$(), PRICE(), LINES, OFFSET, INSTRUCT$(), F1, delivery, DELTIME, PICKTIME
Common Shared NAME1$, NAME$, STREET1$, STREET$, CITY1$, CITY$, FKEY(), opencode$
Common Shared PHONE1$, PHONE2$, LASTRECORD$, BK, USEMENU, MENU$(), MENULABEL$()
'**************************************************************************************************************
'**************************************** Turn on Screen Resizing *********************************************
'**************************************************************************************************************
$Resize:On
_Resize , _Smooth
'**************************************************************************************************************
'********************************************* Set Font Path **************************************************
'**************************************************************************************************************
fontpath$ = Environ$("SYSTEMROOT") + "\fonts\cour.ttf"
printstring3$ = " " + "###"
'**************************************************************************************************************
'********************************************* Screen Settings ************************************************
'**************************************************************************************************************
DeskTop& = _ScreenImage ' *** Capture the Desktop image
DT_Width& = _Width(DeskTop&) - 27 ' *** Get the Desktop Width
DT_Height& = _Height(DeskTop&) ' *** Get the Desktop Height
MainScreen~& = _NewImage(DT_Width&, DT_Height&, 32) '1600, 900, 32)
Screen MainScreen~&
_ScreenMove (DT_Width& - _Width(MainScreen~&)) / 2, (DT_Height& - _Height(MainScreen~&)) / 2
_FullScreen
'**************************************************************************************************************
'**************************************** Set Title and Load Splash screen ************************************
'**************************************************************************************************************
i& = _LoadImage("pizzasplash.jpg", 32)
_Icon i&
Screen i&
Sleep 10
Rem $DYNAMIC
Screen 0, 0, 0, 0: Cls
Dim MENU$(1): MENU$(0) = "MENU1": MENU$(1) = "MENU2"
Dim INSTRUCT$(7), FKEY(20, 2), MENULABEL$(20)
Call BEGINNING
'**************************************************************************************************************
'****************************** Open and Read table.dat and load arrays into memory ***************************
'**************************************************************************************************************
Sub MENUCHOICE
Screen 0, 0, 23, 23
View Print 1 To 25
If CsrLin <> 25 Then Print Else flag = 1
If CsrLin = 25 And flag = 1 Then Locate 25, 1:
font& = _LoadFont(fontpath$, 20, "MONOSPACE,BOLD")
_Font font&
Color 14, 1
Print Chr$(201) + String$(78, Chr$(205)) + Chr$(187)
For a = 1 To 2
Print Chr$(186) + String$(78, Chr$(255)) + Chr$(186)
Next a
Print Chr$(204) + String$(50, Chr$(205)) + Chr$(209) + String$(27, Chr$(205)) + Chr$(185)
For a = 1 To 19
Print Chr$(186) + String$(50, Chr$(255)) + Chr$(179) + String$(27, Chr$(255)) + Chr$(186)
Next a
Print Chr$(200) + String$(50, Chr$(205)) + Chr$(207) + String$(27, Chr$(205)) + Chr$(188)
Color 15, 12
Locate 2, 14: Print " P I Z Z A O P T I O N S "
Locate 3, 14: Print " M A I N M E N U "
Color 15, 5
Locate 21, 5: Print "** PLEASE SEE DESCRIPTION TO THE RIGHT **"
Color 15, 13
Locate 6, 5: Print "PRESS THE F KEY or HIGHLIGHT SELECTION FROM"
Locate 7, 5: Print "BELOW USING" + " " + Chr$(24) + Chr$(25) + " AND PRESS ENTER TO SELECT. "
Color 15, 11
For a = 8 To 20
Locate a, 5: Print String$(43, Chr$(255)) ' menu header
Next a
Start:
Option Base 1
Dim MenuItem(8) As String * 30 'define the menu item array
Dim ChooseItem As Integer ' currently chossen menu item
Dim XMenuPosn As Integer 'controls menu x positions
Dim YMenuPosn As Integer 'controls menu y position
Dim Count As Integer
Dim EndMenu As Integer
' menu items
MenuItem$(1) = "F1 - Z READING REPORT "
MenuItem$(2) = "F2 - X READING REPORT "
MenuItem$(3) = "F3 - VOID/REPRINT CHK "
MenuItem$(4) = "F4 - CHECK TICKET STATUS "
MenuItem$(5) = "F5 - RING UP A SALE "
MenuItem$(6) = "F6 - RTN TO MAIN SCREEN "
MenuItem$(7) = "F7 - EXIT PIZZA PROGRAM "
MenuItem$(8) = "F8 - STOCK TABLE SETTINGS"
ChooseItem = 1 'Starting point of highlighted menu item
XMenuPosn = 26 'X starting point of menu
YMenuPosn = 10 'Y starting point of menu
GoSub DrawMenu
Do
Cmmnd$ = (InKey$)
If Len(Cmmnd$) = 2 Then Cmmnd$ = Right$(Cmmnd$, 1)
If Cmmnd$ = "8" Or Cmmnd$ = Chr$(72) Then GoSub MoveUp
If Cmmnd$ = "2" Or Cmmnd$ = Chr$(80) Then GoSub MoveDown
If Cmmnd$ = "7" Or Cmmnd$ = Chr$(71) Then ChooseItem = 1
If Cmmnd$ = "1" Or Cmmnd$ = Chr$(79) Then ChooseItem = UBound(MenuItem)
If Cmmnd$ = Chr$(13) Then EndMenu = 1
If Cmmnd$ = Chr$(59) Or Cmmnd$ = Chr$(30) Then
ChooseItem = 1
'EndMenu = 1
End If
If Cmmnd$ = Chr$(60) Or Cmmnd$ = Chr$(19) Then
ChooseItem = 2
'EndMenu = 1
End If
If Cmmnd$ = Chr$(61) Or Cmmnd$ = Chr$(50) Then
ChooseItem = 3
'EndMenu = 1
End If
If Cmmnd$ = Chr$(62) Or Cmmnd$ = Chr$(31) Then
ChooseItem = 4
'EndMenu = 1
End If
If Cmmnd$ = Chr$(63) Or Cmmnd$ = Chr$(25) Then
ChooseItem = 5
'EndMenu = 1
End If
If Cmmnd$ = Chr$(64) Or Cmmnd$ = Chr$(32) Then
ChooseItem = 6
'EndMenu = 1
End If
If Cmmnd$ = Chr$(65) Or Cmmnd$ = Chr$(16) Then
ChooseItem = 7
EndMenu = 1
End If
If Cmmnd$ = Chr$(66) Or Cmmnd$ = Chr$(16) Then
ChooseItem = 8
End If
If ChooseItem = 1 Then
Color 15, 1
GoSub ClearSidePanel
Locate 6, 53: Print "This Option Displays The "
Locate 7, 53: Print "Sales Information Over "
Locate 8, 53: Print "The Life Of The Register "
Locate 9, 53: Print "And Can Not Be Cleared. "
Locate 12, 53: Print "Options Include: "
Locate 14, 53: Print "Print Data To the Screen "
Locate 16, 53: Print "Print Z-Report On Printer "
Color 15, 3
ElseIf ChooseItem = 2 Then
Color 15, 1
GoSub ClearSidePanel
Locate 6, 53: Print "Display The X-Report Screen"
Locate 7, 53: Print "And Gives You A Quick snap-"
Locate 8, 53: Print "Shot Of Cash Drawer Sales "
Locate 10, 53: Print "Options Include: "
Locate 12, 53: Print "Display report on-screen "
Locate 14, 53: Print "Print without Clearing Sale"
Locate 15, 53: Print "Data File To Zero"
Locate 17, 53: Print "Print X-Report and Clear "
Locate 18, 53: Print "All Sales Data To Zero. "
Color 15, 3
ElseIf ChooseItem = 3 Then
Color 15, 1
GoSub ClearSidePanel
Locate 10, 53: Print " Void/Reprint Options: "
Locate 12, 53: Print " Void A Sale "
Locate 14, 53: Print " Reprint A Check "
Color 15, 3
ElseIf ChooseItem = 4 Then
Color 15, 1
GoSub ClearSidePanel
Locate 12, 53: Print " Allows you to check the "
Locate 13, 53: Print " Status of a order ticket "
Locate 14, 53: Print " Open, Closed, or Voided "
Color 15, 3
ElseIf ChooseItem = 5 Then
Color 15, 1
GoSub ClearSidePanel
Locate 12, 53: Print " Allows you to ring up a "
Locate 13, 53: Print " Customers order when they "
Locate 14, 53: Print " come to pick it up "
Color 15, 3
ElseIf ChooseItem = 6 Then
Color 15, 1
GoSub ClearSidePanel
Locate 12, 53: Print "Exits Program Execution and"
Locate 13, 53: Print "Returns Control Over To The"
Locate 14, 53: Print "Main Program Order Screen. "
Color 15, 3
ElseIf ChooseItem = 7 Then
Color 15, 1
GoSub ClearSidePanel
Locate 12, 53: Print "Exits Program Execution and"
Locate 13, 53: Print "Returns Control Over To The"
Locate 14, 53: Print "Operating System "
Color 15, 3
End If
If Len(Cmmnd$) = 2 Then Cmmnd$ = Right$(Cmmnd$, 1)
GoSub DrawMenu
Loop Until EndMenu = 1
If ChooseItem = 1 Then Call GET_ZREPORT
If ChooseItem = 2 Then Call GET_XREPORT
If ChooseItem = 3 Then Call VOID
If ChooseItem = 4 Then Call CHKSTATUS
If ChooseItem = 5 Then F1 = 0: Call RINGSALE
If ChooseItem = 6 Then MAIN
If ChooseItem = 7 Then System
If ChooseItem = 8 Then Run "NEWSTOCK21"
MAIN
Exit Sub
ClearSidePanel:
_Limit (10)
For xx = 5 To 22
Locate xx, 53: Print " "
Next xx
Return
DrawMenu:
Locate YMenuPosn, XMenuPosn
For Counts = 1 To UBound(MenuItem$)
If Counts = ChooseItem Then Color 6 Else Color 15
Locate , 14: Print MenuItem$(Counts)
Locate CsrLin, XMenuPosn
Next Counts
Return
MoveUp:
If ChooseItem = 1 Then
ChooseItem = UBound(MenuItem$)
Else
ChooseItem = ChooseItem - 1
End If
Return
MoveDown:
If ChooseItem = UBound(MenuItem$) Then
ChooseItem = 1
Else
ChooseItem = ChooseItem + 1
End If
Return
exit1:
System
End Sub
Sub BEGINNING
PP$ = "##,###.##"
a = 1100
ReDim DESCRIPTION$(a), PRICE(a) ', FKEY(20, 1)
Open "R", 1, "PITABLE.DB", 60
Field #1, 24 As DESCRIBE$, 1 As CODE$
For a = 1 To 4: Field #1, 26 + (a - 1) * 6 As A$, 6 As PRICE$(a): Next
Field #1, 50 As A$, 2 As MENU$: Field #1, 60 As AA$
For a = 1 To 360
Get 1, a
TABLE$(a, 0, 0) = DESCRIBE$: TABLE$(a, 1, 0) = CODE$
For B = 1 To 4: TABLE$(a, B + 1, 0) = PRICE$(B): Next B
TABLE$(a, 6, 0) = MENU$
Next a
For a = 1 To 360
Get 1, a + 360
TABLE$(a, 0, 1) = DESCRIBE$: TABLE$(a, 1, 1) = CODE$
For B = 1 To 4: TABLE$(a, B + 1, 1) = PRICE$(B): Next B
TABLE$(a, 6, 1) = MENU$
Next a
F$ = ""
Get 1, 721
For B = 0 To 2: For a = 1 To 20: FKEY(a, B) = Sgn(Asc(Mid$(AA$, a + B * 20, 1))): Next a, B
For a = 1 To 20
Get 1, a + 721: B$ = A$
88 G = InStr(B$, Chr$(0)): If G > 0 Then Mid$(B$, G, 1) = " ": GoTo 88
B$ = LTrim$(RTrim$(B$))
B$ = Space$(12 - Len(B$) \ 2) + B$
MENULABEL$(a) = B$
Next a
opencode$ = ""
Get 1, 758: Q$ = Left$(A$, 6): For a = 1 To 6: opencode$ = opencode$ + Chr$(Asc(Mid$(A$, a, 1))): Next a
For a = 6 To 1 Step -1
If Mid$(opencode$, a, 1) <> Chr$(0) Then Exit For
Next
opencode$ = Left$(opencode$, a)
useprinter = Sgn(Asc(Mid$(A$, 7, 1))) + 1
Field #1, 9 As NULL$, 4 As T$: T& = CVL(T$): If T& < 0 Or T& > 99999 Then T& = 0
taxrate = T& / 100000
Field #1, 13 As NULL$, 4 As D$: D& = CVL(D$): If D& < 0 Or D& > 9999 Then D& = 0
delivery = D& / 100
Get 1, 759
Field #1, 4 As DELTIME1$, 4 As PICKTIME1$
DELTIME = CVL(DELTIME1$): If DELTIME < 0 Or DELTIME > 99 Then DELTIME = 0
PICKTIME = CVL(PICKTIME1$): If PICKTIME < 0 Or PICKTIME > 99 Then PICKTIME = 0
'pickup time and delivery time in record 759
Close 1
' ***************************************************************************
' *** Select Case to control main screen Destination ***
' ***************************************************************************
Call MAIN
1 A$ = "": While A$ = "": A$ = InKey$: Wend
PP$ = "##,###.##"
X = _KeyHit
If A$ = Chr$(9) Then Call SEEMENUS(A$)
If A$ = Chr$(43) Then Call PICKUP_DEL ' <===> Plus key press to display the Carry-Out Delivery menu
If A$ = Chr$(0) + Chr$(59) Then Call Fkey_main(1) ' <=========================> F1 key press
If A$ = Chr$(0) + Chr$(60) Then Call Fkey_main(2) ' <=========================> F2 key press
If A$ = Chr$(0) + Chr$(61) Then Call Fkey_main(3) ' <=========================> F3 key press
If A$ = Chr$(0) + Chr$(62) Then Call Fkey_main(4) ' <=========================> F4 key press
If A$ = Chr$(0) + Chr$(63) Then Call Fkey_main(5) ' <=========================> F5 key press
If A$ = Chr$(0) + Chr$(64) Then Call Fkey_main(6) ' <=========================> F6 key press
If A$ = Chr$(0) + Chr$(65) Then Call Fkey_main(7) ' <=========================> F7 key press
If A$ = Chr$(0) + Chr$(66) Then Call Fkey_main(8) ' <=========================> F8 key press
If A$ = Chr$(0) + Chr$(67) Then Call Fkey_main(9) ' <=========================> F9 key press
If A$ = Chr$(0) + Chr$(68) Then Call Fkey_main(10) ' <=========================> F10 key press
If A$ = Chr$(0) + Chr$(71) Then Call Fkey_main(13) ' <=========================> Home Key press <=============> PAGE 13 = Fkey_13A
If A$ = Chr$(0) + Chr$(79) Then Call Fkey_main(15) ' <=========================> END Key press <=============> PAGE 14 = Fkey_14A
If A$ = Chr$(0) + Chr$(82) Then Call Fkey_main(14) ' <=========================> INSERT Key press <===========> PAGE 15 = Fkey_15A
If A$ = Chr$(0) + Chr$(83) Then Call Fkey_main(16) ' <=========================> DELETE Key press <===========> PAGE 16 = Fkey_16A
If UCase$(A$) = "P" Then Call Fkey_main(17) ' <=========================> "P" Key press <===> PAGE 17 = Fkey_17A
If UCase$(A$) = "L" Then Call Fkey_main(18) ' <=========================> "L" Key press <===> PAGE 18 = Fkey_18A
If UCase$(A$) = "X" Then Call Fkey_main(19) ' <=========================> "X" Key press <===> PAGE 19 = Fkey_19A
If UCase$(A$) = "Z" Then Call Fkey_main(20) ' <=========================> "Z" Key press <===> PAGE 20 = Fkey_20A
If A$ = Chr$(0) + Chr$(133) Then Call Fkey_main(11) '<=========================> F11 key press
If A$ = Chr$(0) + Chr$(134) Then Call Fkey_main(12) '<=========================> F12 key press
If A$ = Chr$(0) + Chr$(111) Then Call CUSTINFO ' <=========================> ALT + F8 Combo key press
If A$ = Chr$(0) + Chr$(112) Then Call TYPEINSTRUCTIONS ' <=========================> ALT + F9 Combo key press
If UCase$(A$) = "R" And LINES > 0 Then ' <=========================> (R) or (r) key press
Call REMOVELINE(DESCRIPTION$(), PRICE(), DESCRIPTION$, PRICE, LINES, line1) ' to remove line from sale
End If
If A$ = Chr$(0) + Chr$(140) Then
Call MENUCHOICE
Call SCROLL(DESCRIPTION$(), PRICE(), LINES, UPDOWN, DESCRIPTION$, PRICE, OFFSET, line1)
End If
If A$ = Chr$(0) + Chr$(72) Then ' <=======> Up Arrow Key Press to scroll the main order screen up
UPDOWN = -1: Call SCROLL(DESCRIPTION$(), PRICE(), LINES, UPDOWN, DESCRIPTION$, PRICE, OFFSET, line1)
End If
If A$ = Chr$(0) + Chr$(80) Then ' <===> Down Arrow Key Press to scroll the main order screen down
UPDOWN = 1: Call SCROLL(DESCRIPTION$(), PRICE(), LINES, UPDOWN, DESCRIPTION$, PRICE, OFFSET, line1)
End If
If A$ = Chr$(0) + Chr$(118) Then System ' <===================> CTRL + Page Down Key Press to exit program
If _KeyDown(CTRL) And _KeyDown(F12) Then
Erase RECEIPT$
ReDim RECEIPT$(1100, 2)
Erase DESCRIPTION$
Erase PRICE
del = 0
LINES = 0
DESCRIPTION$ = ""
COUPON = 0
COUPCNT = 0
TOTALSALESCNT = 0
VOIDCOUPDOLLARS = 0
PRICE = 0
line1 = 0
subtotal = 0
tax = 0
total = 0
NAME1$ = ""
STREET1$ = ""
CITY1$ = ""
PHONE1$ = ""
typer$ = ""
ReDim INSTRUCT$(7)
Call BEGINNING
End If
GoTo 1
End Sub
'**************************************************************************************************************
'**************************************** Add Item to the order screen ****************************************
'**************************************************************************************************************
Sub ADDARRAY (RECEIPT$(), DESCRIPTION$, PRICE, line1)
If LTrim$(DESCRIPTION$) <> "" Then
line1 = line1 + 1
RECEIPT$(line1, 1) = DESCRIPTION$
RECEIPT$(line1, 2) = Str$(PRICE)
Else
End If
End Sub
'**************************************************************************************************************
'********************************* Get totals for items in the order screen ***********************************
'**************************************************************************************************************
Sub GETTOTALS
'taxrate = VAL(TABLE$(540, 2, 0)) / 100
subtotal = subtotal + PRICE
del = delivery * 100
tax = subtotal * taxrate
If typer$ = "DELIVERY" Then
total = subtotal + tax + del
Else
total = subtotal + tax: del = 0!
End If
PRICE = 0
DESCRIPTION$ = ""
End Sub
Sub Fkey_main (pages)
If FKEY(pages, 0) = 0 Then Exit Sub
Color 12, 15
PCopy 0, 1
Screen 0, 0, 1, 1
Color 0, 15
page = pages
row = 4
OFFSET2 = pages * 18 - 27
Call MENUS
Color 4: Locate 2, 53: Print MENULABEL$(pages)
Do
WW: CHOOSE$ = "": While CHOOSE$ = "": CHOOSE$ = InKey$: Wend
TablePointer = Asc(UCase$(CHOOSE$)) - 55
If Asc(CHOOSE$) = 27 Or Asc(CHOOSE$) = 9 Then DESCRIPTION$ = "": Exit Do
If TablePointer < 10 Or TablePointer > 27 Then GoTo WW
DESCRIPTION$ = Mid$(TABLE$(OFFSET2 + TablePointer, 0, USEMENU), 1, 24)
If FKEY(page, 2) = 1 Then
If TablePointer = 10 Or TablePointer = 11 Or TablePointer = 12 Or TablePointer = 13 Then code = Val(TABLE$(OFFSET2 + TablePointer, 1, USEMENU))
End If
PRICETEMP = Val(TABLE$(OFFSET2 + TablePointer, 2, USEMENU))
If code = 0 Then PRICE = Val(TABLE$(OFFSET2 + TablePointer, 2, USEMENU))
If code = 1 Then PRICE = Val(TABLE$(OFFSET2 + TablePointer, 2, USEMENU))
If code = 2 Then PRICE = Val(TABLE$(OFFSET2 + TablePointer, 3, USEMENU))
If code = 3 Then PRICE = Val(TABLE$(OFFSET2 + TablePointer, 4, USEMENU))
If code = 4 Then PRICE = Val(TABLE$(OFFSET2 + TablePointer, 5, USEMENU))
If PRICE < 0 Then COUPCNT = COUPCNT + 1
If PRICE < 0 Then COUPON = COUPON + PRICE
If PRICETEMP <> 0 And PRICE = 0 Then PRICE = PRICETEMP
Call SCROLL(DESCRIPTION$(), PRICE(), LINES, updown, DESCRIPTION$, PRICE, OFFSET, line1)
Call ADDARRAY(RECEIPT$(), DESCRIPTION$, PRICE, line1)
GETTOTALS
PRINTTOTAL: row = 4: Color 0, 15: Call MENUS: Locate 2, 56: Color 4: Print MENULABEL$(pages)
If FKEY(pages, 1) = 1 Then
Exit Do
End If
Loop
Screen 0, 0, 0, 0: Call PRINTTOTAL
If liner <> LINES Then
Call SCROLL(DESCRIPTION$(), PRICE(), LINES, updown, DESCRIPTION$, PRICE, OFFSET, line1)
If FKEY(pages, 1) = 1 Then
Call Fkey_sub(pages)
End If
End If
End Sub
Sub Fkey_sub (pages)
If FKEY(pages, 1) = 1 Then USEMENU = 1
Color 12, 15
PCopy 0, 1
Screen 0, 0, 1, 1
Color 0, 15
page = pages
row = 4
OFFSET2 = pages * 18 - 27
Call MENUS
Color 4: Locate 2, 56: Print MENULABEL$(pages)
Do
WW: CHOOSE$ = "": While CHOOSE$ = "": CHOOSE$ = InKey$: Wend
TablePointer = Asc(UCase$(CHOOSE$)) - 55
If Asc(CHOOSE$) = 27 Then DESCRIPTION$ = "": Exit Do
If TablePointer < 10 Or TablePointer > 27 Then GoTo WW
DESCRIPTION$ = Mid$(TABLE$(OFFSET2 + TablePointer, 0, USEMENU), 1, 24)
PRICETEMP = Val(TABLE$(OFFSET2 + TablePointer, 2, USEMENU))
If code = 0 Then PRICE = Val(TABLE$(OFFSET2 + TablePointer, 2, USEMENU))
If code = 1 Then PRICE = Val(TABLE$(OFFSET2 + TablePointer, 2, USEMENU))
If code = 2 Then PRICE = Val(TABLE$(OFFSET2 + TablePointer, 3, USEMENU))
If code = 3 Then PRICE = Val(TABLE$(OFFSET2 + TablePointer, 4, USEMENU))
If code = 4 Then PRICE = Val(TABLE$(OFFSET2 + TablePointer, 5, USEMENU))
If PRICETEMP <> 0 And PRICE = 0 Then PRICE = PRICETEMP
Call SCROLL(DESCRIPTION$(), PRICE(), LINES, updown, DESCRIPTION$, PRICE, OFFSET, line1)
Call ADDARRAY(RECEIPT$(), DESCRIPTION$, PRICE, line1)
GETTOTALS
PRINTTOTAL: row = 4: Color 0, 15: Call MENUS: Locate 2, 56: Color 4: Print MENULABEL$(pages)
Exit Do
Loop
USEMENU = USEMENU - USEMENU
Screen 0, 0, 0, 0: Call PRINTTOTAL
If liner <> LINES Then
Call SCROLL(DESCRIPTION$(), PRICE(), LINES, updown, DESCRIPTION$, PRICE, OFFSET, line1)
End If
End Sub
' ***************************************************************************
' *** Displays Main Order Screen ***
' ***************************************************************************
Rem $STATIC
Sub MAIN ()
Screen 0, 0, 0, 0
View Print 1 To 25
If CsrLin = 25 And flag = 1 Then Locate 25, 1:
If CsrLin <> 25 Then Print Else flag = 1
font& = _LoadFont(fontpath$, 20, "MONOSPACE,BOLD")
_Font font&
Color 15, 1
Print "ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍËÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»"
Print "º LINE DESCRIPTION PRICE º º"
Print "ÌÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ͹ º"
Print "º º º"
Print "º º º"
Print "º ÌÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ͹"
Print "º º Special Instructions º"
Print "º ÌÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ͹"
Print "º º º"
Print "º º º"
Print "º º º"
Print "º º º"
Print "º º º"
Print "º º º"
Print "º º º"
Print "º ÌÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ͹"
Print "º º º"
Print "º º º"
Print "º º º"
Print "º º º"
Print "º º º"
Print "ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÊÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ"
Color 12, 1
Print "[R] = REMOVE ITEM - [ALT] + [F9] = Instructions - [ALT + F12] = Menu Options "
'PRINT " [TAB] Show Menus "
Locate 24, 37: Print " "
If LTrim$(NAME1$ + STREET1$ + CITY1$ + PHONE1$) = "" Then
Color 10, 6
Locate 2, 54: Print " "
Locate 3, 54: Print "PRESS [ALT + F8] TO ENTER"
Locate 4, 54: Print " CUSTOMER INFORMATION "
Locate 5, 54: Print " "
Else
Color 15, 1: P$ = "\ \" '' : ' <-There are 25 spaces between the back slashes
Locate 2, 53: Print Using P$; NAME1$
Locate 3, 53: Print Using P$; STREET1$
Locate 4, 53: Print Using P$; CITY1$
Call PHONES(mask$, PHONE1$, 1, 53, 5, 15, 1, Back$)
End If
Color 14, 1
PRINTTOTAL
Locate 17, 53: Print " Subtotal =====> "
Locate 18, 53: Print " Tax =====> "
Locate 19, 53: Print " Del Fee =====> "
Locate 20, 71: Print "ÄÄÄÄÄÄÄÄÄ"
Locate 21, 53: Print "Total Due =====> "
End Sub
' ***************************************************************************
' *** Displays the menus to the screen ***
' ***************************************************************************
Sub MENUS
Locate 1, 52: Print Chr$(201) + String$(27, Chr$(205)) + Chr$(187)
Locate 2, 52: Print Chr$(186) + Spc(27) + Chr$(186)
Locate 3, 52: Print Chr$(204) + String$(27, Chr$(205)) + Chr$(185)
For a = page * 18 - 17 To page * 18
DESCRIPTION$ = Mid$(TABLE$(a, 0, USEMENU), 1, 24)
M$ = Left$(TABLE$(a, 6, USEMENU), 2)
If RTrim$(M$) <> "" Then
Locate row, 52: Print Chr$(186) + Spc(27) + Chr$(186)
Locate row, 53: row = row + 1
Color 1,: Print M$ + " ";: Color 0,: Print DESCRIPTION$
End If
Next a
Locate row, 52: Print Chr$(200) + String$(27, Chr$(205)) + Chr$(188)
'END
End Sub
Rem $DYNAMIC
' ***************************************************************************
' *** Displays the Customer information screen ***
' ***************************************************************************
Sub CUSTINFO
Screen 0, 0, 4, 4
Color 15, 1: Cls: PCopy 0, 4
Locate 1, 41: Print "ËÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»"
Locate 2, 41: Print "º º"
Locate 3, 41: Print "ÎÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ͹"
Locate 4, 41: Print "º º"
Locate 5, 41: Print "º º"
Locate 6, 41: Print "º º"
Locate 7, 41: Print "º º"
Locate 8, 41: Print "ÇÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄĶ"
Locate 9, 41: Print "º º"
Locate 10, 41: Print "º º"
Locate 11, 41: Print "º º"
Locate 12, 41: Print "ÈÍÍÍÍÍÍÍÍÍÍËÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ͹"
Locate 2, 51: Color 10,: Print "Customer Information"
GoSub SHOWED
If _FileExists("PIZZA.CST") Then Call OPENER: Get 1, 1: LASTRECORD = CVL(LASTRECORD$): Close 1
GoSub SHOWED
Locate 9, 42: Color 2: Print "[F1] = SEARCH [F2] = GET [F3] = SAVE"
Locate 10, 42: Print " [F4] = CLEAR [ESC] = QUIT "
Color 15, 1
Locate 4, 42: Print "Name: "; NAME1$
Locate 5, 42: Print "Address: "; STREET1$
Locate 6, 42: Print "City: "; CITY1$
Locate 7, 42: Print "Phone: ";
Call PHONES(mask$, PHONE1$, 1, 48, 7, 15, 1, Back$)
Do
FCOLOR = 14: BCOLOR = 5: NUMB = 0
I:
77
T = 0: X = 48: Y = 7
Call PHONES(mask$, PHONE1$, T, X, Y, 14, 5, Back$)
GoSub FUNCTIONS
If T = 72 Then 66
T = 0
44 X = 48: Y = 4: LENGTHS = 27: NUMB = 0
Call INPUTS(X, Y, FCOLOR, BCOLOR, LENGTHS, NUMB, NAME1$, KEYPRESS, 1)
If KEYPRESS = 72 Then 77
GoSub FUNCTIONS
If KEYPRESS <> 13 And KEYPRESS <> 80 Then 44
55 X = 50: Y = 5: LENGTHS = 27: NUMB = 0
Call INPUTS(X, Y, FCOLOR, BCOLOR, LENGTHS, NUMB, STREET1$, KEYPRESS, 1)
If KEYPRESS = 72 Then 44
GoSub FUNCTIONS
If KEYPRESS <> 13 And KEYPRESS <> 80 Then 55
66 X = 48: Y = 6: LENGTHS = 27: NUMB = 0
Call INPUTS(X, Y, FCOLOR, BCOLOR, LENGTHS, NUMB, CITY1$, KEYPRESS, 1)
If KEYPRESS = 72 Then 55
GoSub FUNCTIONS
If KEYPRESS <> 13 And KEYPRESS <> 80 Then 66
GoTo I
FUNCTIONS:
If KEYPRESS = 27 Or T = 27 Then Exit Do
If KEYPRESS = 59 Or T = 59 Then
PCopy 4, 6
Call CHOICEBOX
Locate 15, 10: Print "START SEARCH FROM HERE OR BEGINNING"
Locate 16, 10: Print "[H] [B] [ESC] = QUIT"
If Y = 4 Then SEARCH$ = LTrim$(RTrim$(UCase$(NAME1$)))
If Y = 5 Then SEARCH$ = LTrim$(RTrim$(UCase$(STREET1$)))
If Y = 6 Then SEARCH$ = LTrim$(RTrim$(UCase$(CITY1$)))
If Y = 7 Then SEARCH$ = LTrim$(RTrim$(UCase$(PHONE1$)))
FOUND = 0
WW3: Close 1
A$ = "": While A$ = "": A$ = UCase$(InKey$): Wend
If Asc(A$) = 27 Then Close 1: GoSub CLEARS: Return
If A$ <> "H" And A$ <> "B" Then GoTo WW3
If A$ = "H" Then START = RECORDNUMBER + 1 Else START = 1
Call OPENER
For a = START To LASTRECORD
Call GETTER(a)
RECORDNUMBER = a: GoSub SHOWED
If Y = 4 Then B = InStr(NAME1$, SEARCH$): If B Then FOUND = a: Exit For
If Y = 5 Then B = InStr(STREET1$, SEARCH$): If B Then FOUND = a: Exit For
If Y = 6 Then B = InStr(CITY1$, SEARCH$): If B Then FOUND = a: Exit For
If Y = 7 Then B = InStr(PHONE1$, SEARCH$): If B Then FOUND = a: Exit For
Next
If FOUND = 0 Then
RECORDNUMBER = 0
NAME1$ = "": STREET1$ = "": CITY1$ = "": PHONE1$ = "": GoSub SHOWED
Else
Call GETTER(FOUND)
RECORDNUMBER = FOUND: GoSub SHOWED
End If
GoTo WW3
End If
If KEYPRESS = 60 Or T = 60 Then
PCopy 4, 6
Call CHOICEBOX
Locate 15, 10: Print "ENTER THE RECORD NUMBER YOU WANT OR"
Locate 16, 10: Print "[PG UP] [PG DN] [ESC] = QUIT"
Call OPENER: N$ = ""
WW1: Call INPUTS(40, 16, FCOLOR, BCOLOR, 5, 1, N$, KEYPRESS, 1)
If KEYPRESS = 27 Then Close 1: GoSub CLEARS: Return
If KEYPRESS = 73 And RECORDNUMBER > 1 Then
RECORDNUMBER = RECORDNUMBER - 1: Call GETTER(RECORDNUMBER)
GoSub SHOWED: GoTo WW1
End If
If KEYPRESS = 81 And RECORDNUMBER < LASTRECORD Then
RECORDNUMBER = RECORDNUMBER + 1: Call GETTER(RECORDNUMBER)
GoSub SHOWED: GoTo WW1
End If
If KEYPRESS = 13 Then
N = Val(N$)
If N > 0 And N < LASTRECORD + 1 Then
RECORDNUMBER = N: Call GETTER(RECORDNUMBER)
GoSub SHOWED: N$ = "": GoTo WW1
End If
End If
GoTo WW1
End If
If KEYPRESS = 61 Or T = 61 Then
If RECORDNUMBER <> 0 Then
Call CHOICEBOX
PCopy 4, 6
Locate 15, 10: Print "SAVE AS CURRENT RECORD OR LAST RECORD"
Locate 16, 10: Print "[C] [L] [ESC] = QUIT "
WW: A$ = "": While A$ = "": A$ = UCase$(InKey$): Wend
If A$ = Chr$(27) Then GoSub CLEARS: Return
If A$ = "C" Then
Call OPENER: Call PUTTER(RECORDNUMBER): Close 1: GoSub CLEARS: Return
End If
If A$ <> "L" Then GoTo WW
End If
Call OPENER: LASTRECORD = LASTRECORD + 1: RECORDNUMBER = LASTRECORD
Call PUTTER(RECORDNUMBER): LSet LASTRECORD$ = MKL$(RECORDNUMBER): Put 1, 1
Close 1: GoSub CLEARS: GoSub SHOWED: Return
End If
If KEYPRESS = 62 Or T = 62 Then
RECORDNUMBER = 0
NAME1$ = "": STREET1$ = "": CITY1$ = "": PHONE1$ = "": GoSub SHOWED
End If
Return
CLEARS: For a = 18 To 19: Locate a, 5: Print Space$(40);: Next: Return
SHOWED: P$ = "\ \"
Locate 11, 42: Print "RECORD NUMBER: ";: Print Using "#####"; RECORDNUMBER;
Locate 4, 48: Print Using P$; NAME1$
Locate 5, 50: Print Using P$; STREET1$
Locate 6, 48: Print Using P$; CITY1$
Call PHONES(mask$, PHONE1$, 1, 48, 7, 15, 1, Back$)
Return
Loop
Screen 0, 0, 0, 0: Cls
Call MAIN
For a = 2 To 5: Locate a, 54: Print Space$(25): Next
Locate 2, 53: Print NAME1$
Locate 3, 53: Print STREET1$
Locate 4, 53: Print CITY1$
Locate 5, 53: Print Back$
Call SCROLL(DESCRIPTION$(), PRICE(), LINES, UPDOWN, DESCRIPTION$, PRICE, OFFSET, line1)
End Sub
' ***************************************************************************
' *** Retreve Customer information Record ***
' ***************************************************************************
Sub GETTER (RECORDNUMBER)
Get 1, RECORDNUMBER + 1
NAME1$ = NAME$: STREET1$ = STREET$: CITY1$ = CITY$: PHONE1$ = PHONE2$
End Sub
' ***************************************************************************
' *** Dale Harris' INPUTS SUB ***
' ***************************************************************************
Sub INPUTS (X, Y, FCOLOR, BCOLOR, LENGTHS, NUMB, INPUTER$, KEYPRESS, CAPS)
SC = Screen(Y, X, 1): FFCOLOR = Int(SC / 16): BBCOLOR = SC Mod 16: 'CURRENT COLOR
P = 1: INPUTER$ = Left$(INPUTER$ + Space$(LENGTHS), LENGTHS): GoSub SHOW
II: A$ = "": While A$ = "": A$ = InKey$: Wend: If CAPS Then A$ = UCase$(A$)
If Len(A$) = 1 Then
a = Asc(A$)
If NUMB And ((a > 31 And a < 48) Or a > 57) Then
If a > 31 Then GoTo II Else GoTo III
End If
If a > 31 And P <= LENGTHS Then
If INSERTS Then
INPUTER$ = Left$(Left$(INPUTER$, P - 1) + A$ + Mid$(INPUTER$, P, LENGTHS), LENGTHS)
P = P + 1: GoSub SHOW: GoTo II
Else
Mid$(INPUTER$, P, 1) = A$
P = P + 1: GoSub SHOW: GoTo II
End If
Else
If a > 31 And P <= LENGTHS Then
Mid$(INPUTER$, P, 1) = A$: P = P + 1
GoSub SHOW: GoTo II
Else
III: If a = 27 Or a = 13 Then GoTo LEAVE: '[ESC] [ENTER]
'[BACKSPACE]
If a = 8 And P > 1 Then
INPUTER$ = Left$(Left$(INPUTER$, P - 2) + Mid$(INPUTER$, P, LENGTHS) + " ", LENGTHS)
P = P - 1: GoSub SHOW
End If
End If
End If
End If
a = Asc(Right$(A$, 1))
If a = 71 Then P = 1: GoSub SHOW: '[HOME]
If a = 75 And P > 1 Then P = P - 1: GoSub SHOW: '[LEFT]
If a = 77 And P < LENGTHS Then P = P + 1: GoSub SHOW: '[RIGHT]
If a = 79 Then P = Len(RTrim$(INPUTER$)): GoSub SHOW: '[END]
If a = 82 Then INSERTS = Abs(INSERTS - 1): '[INSERT]
If a = 83 Then
'[DELETE]
INPUTER$ = Left$(Left$(INPUTER$, P - 1) + Mid$(INPUTER$, P + 1, LENGTHS) + " ", LENGTHS)
GoSub SHOW
End If
If a > 58 And a < 69 Then GoTo LEAVE: '[F?]
If a = 73 Or a = 81 Then GoTo LEAVE: '[PG UP] [PG DN]
If a = 72 Or a = 80 Then GoTo LEAVE: '[PG UP] [PG DN]
GoTo II
SHOW: If P < 1 Then P = 1
Color FCOLOR, BCOLOR
Locate Y, X: Print INPUTER$: Locate Y, X + P - 1
Return
LEAVE: KEYPRESS = a: CAPS = 0
Color BBCOLOR, FFCOLOR: Locate Y, X: Print INPUTER$
INPUTER$ = RTrim$(INPUTER$)
End Sub
' ***************************************************************************
' *** Opens The customer Database ***
' ***************************************************************************
Sub OPENER
Open "R", 1, "PIZZA.CST", 120
Field #1, 27 As NAME$, 27 As STREET$, 27 As CITY$, 15 As PHONE2$
Field #1, 4 As LASTRECORD$
End Sub
' ***************************************************************************
' *** Phone Sub Mask - Dale Harris ***
' ***************************************************************************
Sub PHONES (MASK$, PHONE$, T, X, Y, FCOLOR, BCOLOR, BACK$)
'T = 0=INPUT 1=DISPLAY ONLY 2=SEND BACK$ ONLY
SC = Screen(Y, X, 1): FFCOLOR = Int(SC / 16): BBCOLOR = SC Mod 16: 'CURRENT COLOR
MASK$ = "(###) ###-#### ex.#####": TT = T
For a = 1 To Len(MASK$): If Mid$(MASK$, a, 1) = "#" Then B = B + 1
Next: BW = 1
If BW Then Color FCOLOR, BCOLOR Else Color 0, 7
PHONE$ = Left$(PHONE$ + Space$(B), B): Locate , , 1, 7, 9
C = 1: GoSub DISPLAY: If T Then T = 0: GoTo ENDER
19 T# = Timer: A$ = ""
While A$ = "": A$ = InKey$: Wend
If Len(A$) = 2 Then E = Asc(Right$(A$, 1)) Else E = 0
If A$ = Chr$(27) Then T = 27: Locate , , , 7, 8: GoTo ENDER
If A$ = Chr$(9) Then T = 9: Locate , , , 8, 8: GoTo ENDER
If A$ = Chr$(13) Or E = 80 Then T = 80: Locate , , , 8, 8: GoTo ENDER
If E > 58 And E < 68 Then T = E:: Locate , , , 7, 8: GoTo ENDER
If E = 72 Then T = 72: Locate , , , 7, 8: GoTo ENDER
If E = 75 And C > 1 Then C = C - 1: INS = 0: Locate , , , 7, 8
If E = 77 And C < B Then C = C + 1: INS = 0: Locate , , , 7, 8
If E = 82 Then INS = Abs(INS - 1): If INS Then Locate , , , 5, 8 Else Locate , , , 7, 9
If E = 83 Then PHONE$ = Left$(PHONE$, C - 1) + Mid$(PHONE$, C + 1, B) + " "
If Asc(A$) = 8 And C > 1 Then PHONE$ = Left$(PHONE$, C - 2) + Mid$(PHONE$, C, B) + " ": C = C - 1
If E = 71 Then C = 1
If E = 79 Then
For C = B To 1 Step -1: If Mid$(PHONE$, C, 1) <> " " Then Exit For
Next: C = C + 1: If C > B Then C = B
End If
If InStr(" 0123456789", A$) Then
If INS Then
PHONE$ = Left$(Left$(PHONE$, C - 1) + A$ + Mid$(PHONE$, C, 50), B): C = C + 1
Else
Mid$(PHONE$, C, 1) = A$: C = C + 1: If C > B Then C = B
End If
End If
GoSub DISPLAY
GoTo 19
DISPLAY: BACK$ = ""
If T < 2 Then Locate Y, X
P = 0: PP = 1: P1 = 0
MASK$ = "(###) ###-#### ex.#####"
For a = 1 To Len(MASK$)
If Mid$(MASK$, a, 1) = "#" Then
P = P + 1: P1 = P1 + 1
If P <= Len(PHONE$) Then
BACK$ = BACK$ + Mid$(PHONE$, P, 1)
Else
BACK$ = BACK$ + " "
End If
Else
BACK$ = BACK$ + Mid$(MASK$, a, 1)
End If
If P1 < C Then PP = PP + 1
Next
If T < 2 Then Locate Y, X: Print BACK$;: Locate Y, X + PP - 1
Return
ENDER:
If TT <> 2 Then Color BBCOLOR, FFCOLOR: Locate Y, X: Print BACK$
End Sub
' ***************************************************************************
' *** Put Customer information into Database ***
' ***************************************************************************
Sub PUTTER (RECORDNUMBER)
LSet NAME$ = NAME1$: LSet STREET$ = STREET1$:
LSet CITY$ = CITY1$: LSet PHONE2$ = PHONE1$
Put 1, RECORDNUMBER + 1
End Sub
' ***************************************************************************
' *** Print totals to the order screen ***
' ***************************************************************************
Rem $STATIC
Sub PRINTTOTAL
Color 14, 1
Locate 17, 71: Print Using PP$; subtotal / 100
Locate 18, 71: Print Using PP$; tax / 100
Locate 19, 71: Print Using PP$; del / 100
Locate 21, 71: Print Using PP$; total / 100
End Sub
' ***************************************************************************
' *** Scroll the lines on the order screen ***
' ***************************************************************************
Rem $DYNAMIC
Sub SCROLL (DESCRIPTION$(), PRICE(), LINES, UPDOWN, DESCRIPTION$, PRICE, OFFSET, line1)
Color 15, 1
5 X = 2: Y = 3: 'UPPER LEFT CORNER OF SCROLL BOX
PRINTSTRING$ = "#### \ \ ####.## ": WIDTHS = Len(PRINTSTRING$)
printstring2$ = "#### \ \" + " ": WIDTHS = Len(printstring2$)
'THE WITH OF PRINTSTRING$ SETS THE WIDTH OF THE SCROLL BOX
HEIGHT = 18: 'NUMBER OF LINES IN THE SCROLL BOX
'LINES IS THE NUMBER OF THE BOTTOM LINE TO RECEIVE DATA IN THE SCROLL BOX
'OFFSET IS THE NUMER OF LINES BETWEEN THE BOTTOM LINE DISPLAYED AND "LINES"
'UPDOWN = EITHER +1 OR -1 TO MOVE THE TEXT EITHER UP OR DOWN 0 = NO MOVE
'DESCRIPTION$ IS THE NEW DESCRIPTION YOU WANT TO SEND TO THE SCROLL BOX
'PRICE IS THE NEW PRICE YOU WANT TO SEND TO THE SCROLL BOX
'DESCRIPTION$() HOLDS THE DESCRIPTIONS AND MUST BE RESET FOR A NEW SALE
'PRICE() HOLDS THE PRICES AND MUST BE RESET FOR A NEW SALE
If UPDOWN = 10 Then
ReDim PRICE$(1100), DESCRIPTION$(1100)
LINES = 0: UPDOWN = 0: DESCRIPTION$ = "": PRICE = 0: OFFSET = 0
End If
If RTrim$(DESCRIPTION$) <> "" Then
LINES = LINES + 1: DESCRIPTION$(LINES) = DESCRIPTION$: PRICE(LINES) = PRICE
End If
If UPDOWN <> 0 Then
OFFSET = OFFSET + UPDOWN * -1
If OFFSET = LINES * -1 Then OFFSET = OFFSET + 1
If OFFSET > 0 Then OFFSET = 0
End If
For a = 0 To HEIGHT - 1
B = a - HEIGHT + LINES + 1 + OFFSET
Locate a + Y + 1, X
If B < 1 Then
Print Spc(WIDTHS);
Else
If PRICE(B) = 0 Then
Print Using printstring2$; B; DESCRIPTION$(B);
Else
Print Using PRINTSTRING$; B; DESCRIPTION$(B); PRICE(B) / 100;
End If
End If
Next
End Sub
Sub PICKUP_DEL
Color 12, 15
PCopy 0, 1
Screen 0, 0, 1, 1
Color 0, 15
Locate 1, 52: Print Chr$(201) + String$(27, Chr$(205)) + Chr$(187)
Locate 2, 52: Print Chr$(186) + Spc(27) + Chr$(186)
Locate 3, 52: Print Chr$(204) + String$(27, Chr$(205)) + Chr$(185)
row = 4
'CALL MENUS
liner = LINES
Color 4: Locate 2, 56: Print " PRINT CHECK"
Color 12, 15: Color 0, 15
For linespace = 4 To 7
Locate linespace, 52: Print Chr$(186) + Spc(27) + Chr$(186)
Next linespace
Color 1, 15
Locate 4, 53: Print "A)"
Locate 5, 53: Print "B)"
Locate 6, 53: Print "C)"
Locate 7, 53: Print "D)"
Color 12, 15: Color 0, 15
Locate 4, 56: Print "PICK UP"
Locate 5, 56: Print "CARRY OUT"
Locate 6, 56: Print "DELIVERY"
Locate 7, 56: Print "OPEN TILL - NS"
Locate 8, 52: Print Chr$(200) + String$(27, Chr$(205)) + Chr$(188)
WERT: Do
choose$ = "": While choose$ = "": choose$ = UCase$(InKey$): Wend:
If Asc(choose$) = 27 Then Exit Do: Exit Sub
Select Case choose$
Case "A"
typer$ = " PICK UP "
Call PRINTRECEIPT(RECEIPT$(), DESCRIPTION$, PRICE, line1)
Case "B"
typer$ = "CARRY OUT"
Call PRINTRECEIPT(RECEIPT$(), DESCRIPTION$, PRICE, line1)
Case "C"
DESCRIPTION$ = ""
typer$ = "DELIVERY"
DELCNT = 1
Call ADDARRAY(RECEIPT$(), DESCRIPTION$, PRICE, line1)
Call SCROLL(DESCRIPTION$(), PRICE(), LINES, updown, DESCRIPTION$, PRICE, OFFSET, line1)
GETTOTALS
Call PRINTRECEIPT(RECEIPT$(), DESCRIPTION$, PRICE, line1)
Case Chr$(68), Chr$(100)
Open "lpt1" For Output As 2
Print #2, opencode$;
Close 2
Sound 696, 20
Exit Do
Case Else
GoTo WERT
End Select
Loop
Screen 0, 0, 0, 0
If liner = LINES Then DESCRIPTION$ = ""
Call SCROLL(DESCRIPTION$(), PRICE(), LINES, updown, DESCRIPTION$, PRICE, OFFSET, line1)
End Sub
Sub CHECKFORFILE
If Not _FileExists("checknofile\CHKNO.NO") Then FLAG = 1
Open "checknofile\CHKNO.NO" For Random As #3 Len = 1000
Field #3, 1000 As A$
If FLAG = 1 Then LSet A$ = String$(1000, ""): Put 3, 1
Close #3
End Sub
Sub RINGSALE
Screen 0, 0, 2, 2: BK = 0
Color 15, 1: Cls
'******************************************************************************************************************************
' THIS SECTION WAS ADDED TO KEEP FROM CREATING A BLANK CHKNO.NO FILE
'******************************************************************************************************************************
Call CHECKFORFILE
'******************************************************************************************************************************
' END ADDED SECTION
'******************************************************************************************************************************
Call CHECKOUT
FCOLOR = 14: BCOLOR = 5: DECIMAL$ = "000.00": X = 30: Y = 8
NUMBER = 0
Locate 13, 53: Print " Subtotal =====> "
Locate 14, 53: Print " Tax =====> "
Locate 15, 53: Print " Del Fee =====> "
Locate 16, 71: Print "ÄÄÄÄÄÄÄÄÄ"
Locate 17, 53: Print "Total Due =====> "
Color 1, 15
Call GETTER2(NAME1$, STREET1$, CITY1$, Back$, total$, tax$, subtotal$, Desc$, price$, CN, booboo, COUPON$)
If Styper$ = "D" Then DELCNT = 1 Else DELCNT = 0
If booboo = 1 Then booboo = 0: GoTo 78
For a = 2 To 5: Locate a, 54: Print Space$(25): Next
Locate 2, 53: Print NAME1$
Locate 3, 53: Print STREET1$
Locate 4, 53: Print CITY1$
Locate 5, 53: Print Back$
Locate 19, 53: Print " "
Locate 19, 53: Print "Amt Tendered: "
redo: Call NUMBERS(67, 19, FCOLOR, BCOLOR, DECIMAL$, NUMBER, KEYPRESS)
If KEYPRESS = 27 Then
Open "checknofile\CHKNO.NO" For Random As #3 Len = 1000
Field #3, 1000 As A$
Get 3, 1: B$ = A$: Mid$(B$, CN, 1) = "A": LSet A$ = B$: Put 3, 1: Close 3
GoTo 78
End If
If KEYPRESS = 59 Then
For a = 1 To LINES
DESCRIPTION$(a) = RECEIPT$(a, 1): PRICE(a) = Val(RECEIPT$(a, 2))
Next
If del <> 0 Then total = total - del: del = 0 '<== Deletes the Delivery Charge, if still a delivery when Choosen will add the del back on
Open "checknofile\CHKNO.NO" For Random As #3 Len = 1000
Field #3, 1000 As A$
Get 3, 1: B$ = A$: Mid$(B$, CN, 1) = "A": LSet A$ = B$: Put 3, 1: Close 3
BK = CN: BK1 = 1: F1 = 1
Exit Sub
End If
IF NUMBER < total THEN sound 554,20 : LOCATE 21, 53: COLOR 26,: _
PRINT "Tender less then Total Due": COLOR 15 ,: LOCATE 22,53: PRINT "RE-ENTER AMOUNT TENDERED": _
NUMBER = .00:SLEEP: LOCATE 21,53: PRINT " ": _
LOCATE 22,53: PRINT "ÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ": GOTO redo
If NUMBER = 0 Then
chgdue = 0
Else
chgdue = NUMBER - total
End If
Locate 21, 53: Print " "
Locate 21, 53: Print " Change Due: ";
TOTALSALESCNT = 1
'CALL BIG(chgdue)
Locate 21, 67: Print Using PP$; chgdue / 100
Color 15, 3
Locate 14, 3: Print "ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»"
Locate 15, 3: Print "º º"
Locate 16, 3: Print "ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ"
Locate 15, 3: Print Chr$(186) + Space$(23 - Len("PRESS ANY KEY TO RETURN TO MAIN SCREEN") / 2); "PRESS ANY KEY TO RETURN TO MAIN SCREEN"
Beep
Open "lpt1" For Output As 2
Print #2, opencode$;
Close 2
Color 15, 1
Open "checknofile\CHKNO.NO" For Random As #3 Len = 1000
Field #3, 1000 As A$
Get 3, 1: B$ = A$
Mid$(B$, CN, 1) = "B"
LSet A$ = B$
Put 3, 1
Close 3
CHKNO$ = LTrim$(Str$(CN)) + ".TRN"
Call SAVE_ZREPORT
Call SAVE_XREPORT
Sleep
78 subtotal = 0
NAME1$ = ""
STREET1$ = ""
CITY1$ = ""
PHONE1$ = ""
tax = 0
COUPCNT = 0
TOTALSALESCNT = 0
total = 0
del = 0
COUPON = 0
LINES = 0
line1 = 0
Call PRINTTOTAL
End Sub
Sub SAVER (name1$, street1$, City1$, back$, total$, tax$, subtotal$, Desc$, price$)
If BK = 0 Then
Call CHECKFORFILE
Open "checknofile\CHKNO.NO" For Random As #3 Len = 1000
Field #3, 1000 As A$
Get 3, 1: B$ = A$
'''FOR A = 1 TO 50: PRINT ASC(MID$(B$, A, 1));: NEXT
For a = 1 To 1000
N = Asc(Mid$(B$, a, 1))
If N <> 65 And N <> 66 And N <> 86 Then Mid$(B$, a, 1) = "A": Exit For
Next
LSet A$ = B$
Put 3, 1
Close 3
chkno = a
Else
chkno = BK: BK = 0
End If
If Not _DirExists("checknofile") Then
Shell _Hide ("mkdir checknofile")
End If
CHKNO$ = "checknofile\" + LTrim$(Str$(chkno)) + ".TRN"
Open CHKNO$ For Random As #3 Len = 80
Field #3, 80 As A$
FIELD #3, 4 AS subtotal$, 4 AS tax$, 4 AS DEL$, 4 AS total$, 4 AS LINE1$, 1 AS SALESTYPE$, 4 AS COUPON$, 2 AS COUPCNT$, 4 AS XVOIDCOUPDOLLARS$, _
2 as TOTALSALESCNT$, 8 as ORDERTIME$
LSet subtotal$ = MKL$(subtotal): LSet tax$ = MKL$(tax): LSet COUPON$ = MKL$(COUPON): LSet COUPCNT$ = MKI$(COUPCNT)
LSet XVOIDCOUPDOLLARS$ = MKL$(VOIDCOUPDOLLARS): LSet TOTALSALESCNT$ = MKI$(TOTALSALESCNT)
LSet DEL$ = MKL$(del): LSet total$ = MKL$(total): LSet LINE1$ = MKL$(line1): LSet SALESTYPE$ = LTrim$(typer$): RSet ORDERTIME$ = Right$(CLOCK$, 7)
Put 3, 1
LSet A$ = name1$: Put 3, 2
LSet A$ = street1$: Put 3, 3
LSet A$ = City1$: Put 3, 4
LSet A$ = back$: Put 3, 5
Field #3, 30 As Desc$, 10 As price$
For a = 1 To line1
LSet Desc$ = RECEIPT$(a, 1): LSet price$ = RECEIPT$(a, 2)
Put 3, a + 5
Next a
For a = 1 To 7: LSet A$ = INSTRUCT$(a): Put 3: Next a
Close 3
End Sub
Sub CHKSTATUS
Screen 0, 0, 22, 22
Color 15, 1: Cls
Locate 7, 25: Print "Choose Option to display...": Print
Locate 10, 30: Print "1. Open sales"
Locate 11, 30: Print "2. Completed sales"
Locate 12, 30: Print "3. Voided sales"
Locate 13, 30: Print "4. All sales"
Locate 14, 30: Print "5. Quit"
1 A$ = "": While A$ = "": A$ = InKey$: Wend
P = Val(A$): If P = 5 Then Exit Sub
If P = 0 Or P > 4 Then GoTo 1
If Not _FileExists("checknofile\CHKNO.NO") Then FLAG = 1
Open "checknofile\CHKNO.NO" For Random As #3 Len = 1000
Field #3, 1000 As A$
If FLAG = 1 Then LSet A$ = String$(1000, ""): Put 3, 1
Close #3
Open "checknofile\CHKNO.NO" For Random As #3 Len = 1000
Field #3, 1000 As A$
Get 3, 1: B$ = A$: Close 3
If _FileExists("OPENSCRL.DAT") Then Close #4: Kill "OPENSCRL.DAT"
Open "OPENSCRL.DAT" For Random As #4 Len = 80
Field #4, 80 As RECORD$
Field #4, 8 As TIMEORDER$, 1 As NULL$, 4 As COUNT$, 4 As NULL$, 28 As NAMER$, 25 As phone$, 5 As OPEN$
For A = 1 To 1000
If Mid$(B$, A, 1) = Chr$(15) Then Exit For
CK$ = Mid$(B$, A, 1)
If (P = 1 And CK$ = "A") Or (P = 2 And CK$ = "B") Or (P = 3 And CK$ = "V") Or P = 4 Then
CHKNO$ = LTrim$(Str$(A)) + ".TRN"
counter = counter + 1
Open "checknofile\" + CHKNO$ For Random As #3 Len = 80
Field #3, 80 As A$
FIELD #3, 4 AS subtotal$, 4 AS tax$, 4 AS DEL$, 4 AS total$, 4 AS LINE1$, 1 AS SALESTYPE$, 4 AS COUPON$, 2 AS COUPCNT$, 4 AS XVOIDCOUPDOLLARS$, _
2 as TOTALSALESCNT$, 8 as ORDERTIME$
Get #3, 1: LSet TIMEORDER$ = ORDERTIME$
Get 3, 2: NAME1$ = RTrim$(A$)
Get 3, 5: Back$ = RTrim$(A$)
NAME2$ = NAME1$
BACK1$ = Back$
Close #3
STATUS$ = "OPEN": If CK$ = "B" Then STATUS$ = "CLSD" Else If CK$ = "V" Then STATUS$ = "VOID"
RSet COUNT$ = LTrim$(RTrim$(Str$(A))): LSet NAMER$ = NAME1$: LSet phone$ = Back$: LSet OPEN$ = STATUS$
Print RECORD$
Put 4
End If
Next
Close
Open "OPENSCRL.DAT" For Random As #4 Len = 80
Field #4, 8 As TIMEORDER$, 1 As NULL$, 4 As COUNT$, 4 As NULL$, 28 As NAMER$, 25 As phone$, 5 As OPEN$
Field #4, 80 As RECORD$
RC = LOF(4) \ 80
Print RC
Color 15, 1:
Cls
Locate 4, 5: Print "Time In CHK # Customer Phone Status "
Locate 5, 4: Print "--------------------------------------------------------------------------"
5 X = 4: Y = 5: 'UPPER LEFT CORNER OF SCROLL BOX
WIDTHS = 74: ' WIDTH OF SCROLL BOX
HEIGHT = 18: 'NUMBER OF LINES IN THE SCROLL BOX
'LINES IS THE NUMBER OF THE BOTTOM LINE TO RECEIVE DATA IN THE SCROLL BOX
'OFFSET IS THE NUMER OF LINES BETWEEN THE BOTTOM LINE DISPLAYED AND "LINES"
OFFSET = 0
LINE6 = 1
6
For A = 0 To HEIGHT - 1
B = A + LINE6 + OFFSET
Locate A + Y + 1, X
Color 15, 1: If B = LINE6 Then Color 15, 3: TRN = Val(COUNT$)
If LINE6 < 0 Or LINE6 = 0 Then
Else
Get 4, B: Print Left$(RECORD$, WIDTHS);
Locate 1, 70: Print "LINE #"; Using "###"; LINE6
End If
Next
7 A$ = "": While A$ = "": A$ = InKey$: Wend
IN = Asc(A$):
If Len(A$) = 2 Then IN2 = Asc(Right$(A$, 1)) Else IN2 = 0
If IN2 = 72 Then
LINE6 = LINE6 - 1: If LINE6 = 0 Then LINE6 = 1
GoTo 6
End If
If IN2 = 80 Then
LINE6 = LINE6 + 1: If LINE6 > RC Then LINE6 = RC
GoTo 6
End If
If IN2 = 73 Then
LINE6 = LINE6 - HEIGHT: If LINE6 < 1 Then LINE6 = 1
GoTo 6
End If
If IN2 = 81 Then
LINE6 = LINE6 + HEIGHT: If LINE6 > RC Then LINE6 = RC
GoTo 6
End If
If IN2 = 71 Then
LINE6 = 1
GoTo 6
End If
If IN2 = 79 Then
LINE6 = RC
GoTo 6
End If
If IN = 27 Then Exit Sub
If IN = 13 Then Get 4, LINE6: TRN = Val(COUNT$): Locate 24, 1: Print TRN: Exit Sub
GoTo 7
End Sub
Sub GETTER2 (name1$, street1$, City1$, back$, total$, tax$, subtotal$, Desc$, price$, CN, booboo, COUPON$)
Color 15, 1
Locate 10, 53: Input "CHECK NUMBER"; CN
chkno = CN
CHKNO$ = "checknofile\" + LTrim$(Str$(chkno)) + ".TRN"
'CHKNO$ = LTRIM$(STR$(chkno)) + ".TRN"
If Not _FileExists(CHKNO$) Then
Color 15, 1
Locate 10: Print Space$(25 - Len("SORRY, I COULD NOT FIND A CHECK NUMBER " + CHKNO$) / 2); " I COULD NOT FIND A CHECK NUMBER " + CHKNO$
Locate 11: Print Space$(25 - Len("CHECK ALREADY PAID or CHECK DOES NOT EXIST") / 2); " CHECK PAID or CHECK DOESN'T EXIST"
Locate 15: Print Space$(25 - Len("PRESS ANY KEY TO CONTINUE") / 2); " PRESS ANY KEY TO CONTINUE"
Color 15, 1
Locate 10, 1: Print Chr$(186)
Locate 11, 1: Print Chr$(186)
Locate 15, 1: Print Chr$(186)
Sleep
booboo = 1: Exit Sub
End If
Open "checknofile\CHKNO.NO" For Random As #3 Len = 1000
Field #3, 1000 As A$
Get 3, 1: B$ = A$: Close 3
'''FOR A = 1 TO 50: PRINT ASC(MID$(B$, A, 1));: NEXT
If Mid$(B$, CN, 1) <> "A" Then
Color 15, 1
Locate 10: Print Space$(25 - Len("SORRY, I COULD NOT FIND A CHECK NUMBER " + CHKNO$) / 2); " I COULD NOT FIND A CHECK NUMBER " + CHKNO$
Locate 11: Print Space$(25 - Len("CHECK ALREADY PAID or CHECK DOES NOT EXIST") / 2); " CHECK PAID or CHECK DOESN'T EXIST"
Locate 15: Print Space$(25 - Len("PRESS ANY KEY TO CONTINUE") / 2); " PRESS ANY KEY TO CONTINUE"
Color 15, 1
Locate 10, 1: Print Chr$(186)
Locate 11, 1: Print Chr$(186)
Locate 15, 1: Print Chr$(186)
Sleep
booboo = 1: Exit Sub
End If
Open CHKNO$ For Random As #3 Len = 80
Field #3, 80 As A$
FIELD #3, 4 AS subtotal$, 4 AS tax$, 4 AS DEL$, 4 AS total$, 4 AS LINE1$, 1 AS SALESTYPE$, 4 AS COUPON$, 2 AS COUPCNT$, 4 AS VOIDCOUPDOLLARS$, _
2 as TOTALSALESCNT$
Get 3, 1
subtotal = CVL(subtotal$): tax = CVL(tax$): VOIDCOUPDOLLARS = CVL(VOIDCOUPDOLLARS$): TOTALSALESCNT = CVI(TOTALSALESCNT$)
del = CVL(DEL$): total = CVL(total$): line1 = CVL(LINE1$): COUPON = CVL(COUPON$): COUPCNT = CVI(COUPCNT$): Styper$ = SALESTYPE$
Get 3, 2: name1$ = RTrim$(A$)
Get 3, 3: street1$ = RTrim$(A$)
Get 3, 4: City1$ = RTrim$(A$)
Get 3, 5: back$ = RTrim$(A$)
Field #3, 30 As Desc$, 10 As price$
For a = 1 To line1
Get 3, a + 5
RECEIPT$(a, 1) = RTrim$(Desc$): RECEIPT$(a, 2) = RTrim$(price$)
Next a
For a = 1 To 7
Get 3
INSTRUCT$(a) = Left$(A$, 27)
88 I = InStr(INSTRUCT$(a), Chr$(0))
If I Then Mid$(INSTRUCT$(a), I, 1) = " ": GoTo 88
Next
Close 3
LINES = line1: GoSub SCROLLER
PP$ = "###.##"
Locate 13, 72: Print Using PP$; subtotal / 100
Locate 14, 72: Print Using PP$; tax / 100
Locate 15, 72: Print Using PP$; del / 100
Locate 17, 72: Print Using PP$; total / 100
LINES = line1: GoSub SCROLLER
If Len(A$) = 2 Then
a = Asc(Right$(A$, 1))
If a = 72 Then UPDOWN = -1: GoSub SCROLLER
If a = 80 Then UPDOWN = 1: GoSub SCROLLER
End If
Exit Sub
SCROLLER:
PRINTSTRING$ = "#### \ \ ####.## ": WIDTHS = Len(PRINTSTRING$)
printstring2$ = "#### \ \" + " ": WIDTHS = Len(printstring2$)
X = 2: Y = 3: HEIGHT = 18
If UPDOWN <> 0 Then
OFFSET = OFFSET + UPDOWN * -1
If OFFSET = LINES * -1 Then OFFSET = OFFSET + 1
If OFFSET > 0 Then OFFSET = 0
End If
For a = 0 To HEIGHT - 1
B = a - HEIGHT + LINES + 1 + OFFSET
Locate a + Y + 1, X
If B < 1 Then
Print Spc(WIDTHS);
Else
If Val(RECEIPT$(B, 2)) = 0 Then
Print Using printstring2$; B; RECEIPT$(B, 1);
Else
Print Using PRINTSTRING$; B; RECEIPT$(B, 1); Val(RECEIPT$(B, 2)) / 100;
End If
End If
Next
Return
End Sub
Sub PRINTHEAD (HF)
'FOR B = 0 TO 1: FOR a = 1 TO 8:
' GET 1, a + B * 8 + 721: HEADER$(B, a) = LEFT$(A$, 39):
'next a,b
ReDim HEAD$(2, 8)
Open "R", 10, "PITABLE.DB", 60
Field #10, 39 As A$
For B = 1 To 2
For a = 1 To 8
Get 10, a + (B - 1) * 8 + 741: H$ = A$
888 Q = InStr(H$, Chr$(0)): If Q Then Mid$(H$, Q, 1) = " ": GoTo 888 Else H$ = LTrim$(RTrim$(H$))
HEAD$(B, a) = Space$(19 - Len(H$) / 2) + H$
Next a
Next B
Close #10
For a = 8 To 1 Step -1
If RTrim$(HEAD$(HF, a)) <> "" Then Exit For
Next a
For B = 1 To a
26 NULL = InStr(HEAD$(HF, B), Chr$(0)): If NULL Then Mid$(HEAD$(HF, B), NULL, 1) = " ": GoTo 26
Print #2, RTrim$(HEAD$(HF, B))
Next B
Print #2, Chr$(29)
End Sub
Sub PRINTRECEIPT (RECEIPT$(), DESCRIPTION$, PRICE, line1)
Call SAVER(NAME1$, STREET1$, CITY1$, Back$, total$, tax$, subtotal$, Desc$, price$)
If useprinter = 1 Then Open "LPT1" For Output As #2
If useprinter = 2 Then Open "wlsdfkjn.dry" For Output As #2
If BK1 = 1 Then
REPRINT1$ = "*********************************"
REPRINT2$ = "*** REPRINT REPRINT REPRINT ***"
Print #2, Space$(20 - Len(REPRINT1$) / 2); REPRINT1$
Print #2, Space$(20 - Len(REPRINT2$) / 2); REPRINT2$
Print #2, Space$(20 - Len(REPRINT1$) / 2); REPRINT1$
For i = 1 To 2
Print #2, ""
Next i
BK1 = 0
End If
Call PRINTHEAD(1)
lined$ = "________________________________________"
Print #2, Space$(20 - Len(lined$) / 2); lined$
dateline$ = Date$ + Spc(9) + CLOCK$
Print #2, ""
Print #2, Space$(20 - Len(dateline$) / 2); dateline$
Print #2, ""
Print #2, Space$(20 - Len(DELCLOCK$) / 2); DELCLOCK$
Print #2, Space$(20 - Len(lined$) / 2); lined$
Print #2, ""
Print #2, NAME1$
Print #2, STREET1$
Print #2, CITY1$
Print #2, Back$
Print #2, Space$(20 - Len(lined$) / 2); lined$
Print #2, ""
Star$ = String$(40, "-")
Print #2, Chr$(29)
Print #2, Chr$(31); Space$(10 - Len(typer$) / 2); typer$
Print #2, Chr$(29)
Print #2, Space$(20 - Len(Star$) / 2); Star$
Print #2, ""
Print #2, ""
PP$ = "##,###.##"
PR$ = "\ \##,###.##"
For count = 1 To line1
If Val(RECEIPT$(count, 2)) = 0.00 Then
Print #2, RECEIPT$(count, 1)
Else
Print #2, Using PR$; RECEIPT$(count, 1); Val(RECEIPT$(count, 2)) / 100
End If
Next count
If typer$ = " PICK UP " Or typer$ = "CARRY OUT" Then
For i = 1 To 3
Print #2, ""
Next i
Print #2, Spc(21); "Subtotal "; Using PP$; subtotal / 100
Print #2, Spc(21); " Tax "; Using PP$; tax / 100
Print #2, Spc(32); "-------"
Print #2, Spc(21); " Total "; Using PP$; total / 100
Else
For i = 1 To 3
Print #2, ""
Next i
Print #2, Spc(21); "Subtotal "; Using PP$; subtotal / 100
Print #2, Spc(21); " Tax "; Using PP$; tax / 100
Print #2, Spc(21); "Delivery "; Using PP$; del / 100
Print #2, Spc(32); "-------"
Print #2, Spc(21); " Total "; Using PP$; total / 100
End If
Message2$ = "** GRATUITY NOT INCLUDED **"
CheckNumber$ = "Chk #"
For counter = 1 To 5
Print #2, ""
Next counter
KB$ = "INSTRUCTIONS"
XX3 = 0
For A = 1 To 7
If LTrim$(INSTRUCT$(A)) <> "" Then XX3 = 1: Exit For
Next A
If XX3 = 1 Then Print #2, Space$(20 - Len(KB$) / 2); KB$: Print #2, lined$
For A = 1 To 7
If LTrim$(INSTRUCT$(A)) <> "" Then Print #2, Space$(20 - Len(INSTRUCT$(A)) / 2); INSTRUCT$(A):
Next A
If XX3 = 1 Then Print #2, lined$
For A = 1 To 4
Print #2, ""
Next A
If typer$ = "DELIVERY" Then Print #2, Space$(20 - Len(Message2$) / 2); Message2$: Print #2, "": Print #2, ""
Call PRINTHEAD(2)
For counter = 1 To 5
Print #2, ""
Next counter
Print #2, Space$(16 - Len(chkno) / 2); CheckNumber$; " "; chkno
For counter = 1 To 5
Print #2, ""
Next counter
Call PRINTCOUPONS
For counter = 1 To 17
Print #2, " "
Next counter
Close #2
Erase RECEIPT$
ReDim RECEIPT$(1100, 2)
Erase DESCRIPTION$
Erase PRICE
del = 0
LINES = 0
DESCRIPTION$ = ""
COUPON = 0
COUPCNT = 0
TOTALSALESCNT = 0
VOIDCOUPDOLLARS = 0
PRICE = 0
line1 = 0
subtotal = 0
tax = 0
total = 0
NAME1$ = ""
STREET1$ = ""
CITY1$ = ""
PHONE1$ = ""
typer$ = ""
ReDim INSTRUCT$(7)
Call BEGINNING
End Sub
Sub REMOVELINE (DESCRIPTION$(), PRICE(), DESCRIPTION$, PRICE, LINES, line1)
Color 15,
Locate 1, 1: Print Chr$(201) + String$(35, Chr$(205)) + Chr$(203)
Locate 2, 1: Print Chr$(186)
Locate 2, 3: Color 15,: Print " Enter"
Locate 2, 10: Color 26,: Print "Line Number "
Locate 2, 22: Color 15,: Print "To Remove?" '
Locate 2, 37: Color 15,: Print Chr$(186)
Locate 3, 1: Print Chr$(204) + String$(35, Chr$(205)) + Chr$(202)
Color 15
Locate 2, 34: Input "", start
Color 15, 1
Locate 1, 1: Print "ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍË"
Locate 2, 1: Print "º LINE DESCRIPTION PRICE º"
Locate 3, 1: Print "ÌÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ͹"
REMOVEPRICE = Val(RECEIPT$(start, 2)): subtotal = subtotal - REMOVEPRICE
If REMOVEPRICE < 0 And CN > 0 Then
CHKNO$ = "checknofile\" + LTrim$(Str$(chkno)) + ".TRN"
'CHKNO$ = LTRIM$((STR$(CN))) + ".TRN"
Open CHKNO$ For Random As #3 Len = 80
Field #3, 80 As A$
Field #3, 4 As subtotal$, 4 As tax$, 4 As DEL$, 4 As total$, 4 As LINE1$, 1 As SALESTYPE$, 4 As COUPON$, 2 As COUPCNT$, 4 As VOIDCOUPDOLLARS$
Field #3, 4 As DELCNT$, 2 As TOTALSALESCNT$, 7 As ORDERTIME$
COUPON = COUPON - REMOVEPRICE
COUPCNT = COUPCNT - 1
LSet subtotal$ = MKL$(subtotal): LSet tax$ = MKL$(tax): LSet COUPON$ = MKL$(COUPON): LSet COUPCNT$ = MKI$(COUPCNT)
LSet XVOIDCOUPDOLLARS$ = MKL$(VOIDCOUPDOLLARS): LSet DELCNT$ = MKL$(DELCNT): LSet TOTALSALESCNT$ = MKI$(TOTALSALESCNT)
LSet DEL$ = MKL$(del): LSet total$ = MKL$(total): LSet LINE1$ = MKL$(line1): LSet SALESTYPE$ = LTrim$(typer$)
If Styper$ = "D" Then DELCNT = DELCNT - 1
TOTALSALESCNT = TOTALSALESCNT - 1
Put 3, 1
Close #3
End If
For a = start To LINES: For B = 0 To 2: RECEIPT$(a, B) = RECEIPT$(a + 1, B): Next B, a
For a = start To LINES: DESCRIPTION$(a) = DESCRIPTION$(a + 1): Next a
For a = start To LINES: PRICE(a) = PRICE(a + 1): Next a
LINES = LINES - 1
line1 = line1 - 1
Call GETTOTALS
Call PRINTTOTAL
Call SCROLL(DESCRIPTION$(), PRICE(), LINES, UPDOWN, DESCRIPTION$, PRICE, OFFSET, line1)
Exit Sub
End Sub
Function CLOCK$
hour$ = Left$(Time$, 2): H% = Val(hour$)
min$ = Mid$(Time$, 3, 3)
If H% >= 12 Then ampm$ = " PM" Else ampm$ = " AM"
If H% > 12 Then
If H% - 12 < 10 Then hour$ = Str$(H% - 12) Else hour$ = LTrim$(Str$(H% - 12))
ElseIf H% = 0 Then hour$ = "12" ' midnight hour
Else: If H% < 10 Then hour$ = Str$(H%) ' eliminate leading zeros
End If
CLOCK$ = "Time In: " + hour$ + min$ + ampm$
End Function
Function DELCLOCK$
Cls
temp$ = Time$
hour = Val(temp$)
min = Val(Mid$(temp$, 4, 2))
If typer$ = " PICK UP " Or typer$ = "CARRY OUT" Then gap = PICKTIME
If typer$ = "DELIVERY" Then gap = DELTIME
min = min + gap
If min > 59 Then min = min - 60: hour = hour + 1
If hour > 12 Then hour = hour - 12: M$ = "PM" Else M$ = "AM"
If hour = 12 Then If M$ = "AM" Then M$ = "PM" Else M$ = "AM"
If hour = 0 Then hour = 12: M$ = "AM"
If min < 10 Then x$ = "0" Else x$ = ""
DELCLOCK$ = "Target ETA: " + LTrim$(Str$(hour)) + ":" + x$ + LTrim$(Str$(min)) + M$
PickUPCLOCK$ = temp$
End Function
Sub CHOICEBOX
Screen 0, 0, 6, 6
Color 15, 1
Locate 14, 3: Print "ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»"
Locate 15, 3: Print "º º"
Locate 16, 3: Print "º º"
Locate 17, 3: Print "ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ"
End Sub
Sub CHECKOUT
Screen 0, 0, 19, 19
PCopy 0, 19
Color 15, 1
Locate 11, 52: Print "ÌÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ͹"
Locate 12, 52: Print "º º"
Locate 13, 52: Print "º º"
Locate 14, 52: Print "º º"
Locate 15, 52: Print "º º"
Locate 16, 52: Print "º º"
Locate 17, 52: Print "º º"
Locate 18, 52: Print "º º"
Locate 19, 52: Print "º º"
Locate 20, 52: Print "º º"
Locate 21, 52: Print "º º"
Locate 22, 52: Print "ÊÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ"
End Sub
Sub NUMBERS (X, Y, FCOLOR, BCOLOR, DECIMAL$, NUMBER, KEYPRESS)
SC = Screen(Y, X, 1): FFCOLOR = Int(SC / 16): BBCOLOR = SC Mod 16: 'CURRENT COLOR
DECIMAL = InStr(DECIMAL$, ".")
DIGITS = Len(DECIMAL$) - Sgn(DECIMAL)
GoSub SHOWS
NII: A$ = "": While A$ = "": A$ = InKey$: Wend
If Len(A$) = 1 Then
a = Asc(A$)
If a > 47 And a < 58 And NUMBER * 10 < 10 ^ DIGITS Then
NUMBER = NUMBER * 10 + Val(A$): GoSub SHOWS: GoTo NII
End If
NIII:
If a = 27 Or a = 13 Or a = 9 Then GoTo LEAVES: '[ESC] [ENTER] [TAB]
If a = 8 Then NUMBER = NUMBER \ 10: GoSub SHOWS: '[BACKSPACE]
End If
a = Asc(Right$(A$, 1))
If a = 75 Then NUMBER = NUMBER \ 10: GoSub SHOWS '[LEFT]
If a = 83 Then NUMBER = 0: GoSub SHOWS: '[DELETE]
If a > 58 And a < 69 Then GoTo LEAVES: '[F?]
If a = 73 Or a = 81 Then GoTo LEAVES: '[PG UP] [PG DN]
If a = 72 Or a = 80 Then GoTo LEAVES: '[UP] [DN]
GoTo NII
SHOWS:
N$ = Space$(DIGITS): RSet N$ = LTrim$(Str$(NUMBER))
If DECIMAL Then
N$ = Left$(N$, DECIMAL - 1) + "." + Mid$(N$, DECIMAL, 20)
If Mid$(N$, DECIMAL + 1, 1) = " " Then Mid$(N$, DECIMAL + 1, 1) = "0"
End If
If P < 1 Then P = 1
Color FCOLOR, BCOLOR
Locate Y, X: Print N$: Locate Y, X + DIGITS + Sgn(DECIMAL) - 1
Return
LEAVES: KEYPRESS = a
Color BBCOLOR, FFCOLOR: Locate Y, X: Print N$
End Sub
Sub GET_ZREPORT
_Delay 3
Cls
Screen 0, 0, 3, 3
PRINTSTRING$ = "##,###,###.##"
path$ = Environ$("LocalAppData") + "\WINDOWZ.Dll"
Open path$ For Random As #1 Len = 200
Field #1, 200 As A$
Get 1, 1
RANDOM$ = A$
'Get totals from file
ZSUBTOTAL = CVL(Mid$(RANDOM$, 56, 4)) / 100
ZTAX = CVL(Mid$(RANDOM$, 89, 4)) / 100
ZTOTAL = CVL(Mid$(RANDOM$, 122, 4)) / 100
ZVOIDS = CVL(Mid$(RANDOM$, 150, 4)) / 100
ZREFUNDS = CVL(Mid$(RANDOM$, 175, 4)) / 100
ZCOUPON = CVL(Mid$(RANDOM$, 180, 4)) / 100
ZDELIVERY = CVL(Mid$(RANDOM$, 190, 4)) / 100
'************************ REPORT FORMATTING ******************************
Color , 1
'BUILD BOX AROUND TOTAL DATA
Locate 4, 2: Print Chr$(201) + String$(76, Chr$(205)) + Chr$(187)
For i = 5 To 8
Locate i, 2: Print Chr$(186) + Spc(76) + Chr$(186)
Next i
Locate 9, 2: Print Chr$(200) + String$(76, Chr$(205)) + Chr$(188)
'END BOX BUILD
Color 15, 0
Locate 3, 27: Print "Z R E P O R T T O T A L S"
DATAS$ = "PRESS [F1] TO PRINT Z-REPORT"
Locate 18,: Print Space$(40 - Len(DATAS$) / 2); DATAS$
Color 15, 1
Locate 5, 56: Print "SUBTOTAL "; Using PRINTSTRING$; ZSUBTOTAL
Locate 6, 56: Print " TAX "; Using PRINTSTRING$; ZTAX
Locate 7, 56: Print "DELIVERY "; Using PRINTSTRING$; ZDELIVERY
Locate 8, 56: Print " TOTAL "; Using PRINTSTRING$; ZTOTAL
Locate 5, 8: Print " VOIDS "; Using PRINTSTRING$; ZVOIDS
Locate 6, 8: Print " REFUNDS "; Using PRINTSTRING$; ZREFUNDS
Locate 7, 8: Print " COUPONS "; Using PRINTSTRING$; ZCOUPON
Do Until A$ = Chr$(27)
_Limit (30)
A$ = InKey$
If A$ = Chr$(0) + Chr$(59) Then GoSub PRINTREPORTZ
Loop
Close #1
Exit Sub
PRINTREPORTZ:
If useprinter = 1 Then Open "LPT1" For Output As #2
If useprinter = 2 Then Open "wlsdfkjn.dry" For Output As #2
Call HEADER
Print #2, ""
Print #2, ""
Print #2, ""
REPORTHEAD$ = " TOTAL Z - READING REPORT "
lined$ = "================================="
Print #2, Space$(20 - Len(REPORTHEAD$) / 2); REPORTHEAD$
Print #2, Space$(20 - Len(lined$) / 2); lined$
Print #2, ""
Print #2, Spc(8) + " VOIDS"; Using "#,###,###.##"; ZVOIDS
Print #2, Spc(8) + " REFUNDS"; Using "#,###,###.##"; ZREFUNDS
Print #2, Spc(8) + " COUPONS"; Using "#,###,###.##"; ZCOUPON
Print #2, ""
Print #2, ""
Print #2, Spc(18) + "SUBTOTAL"; Using "#,###,###.##"; ZSUBTOTAL
Print #2, Spc(18) + " TAX"; Using "#,###,###.##"; ZTAX
Print #2, Spc(18) + "DELIVERY"; Using "#,###,###.##"; ZDELIVERY
Print #2, Spc(27) + "-----------"
Print #2, Spc(18) + " TOTAL"; Using "#,###,###.##"; ZTOTAL
For i = 1 To 4
Print #2, ""
Next i
Call PRINTHEAD(2)
For i = 1 To 20
Print #2, ""
Next
Close #2
Return
End Sub
Sub SAVE_ZREPORT
Randomize Timer
random$ = ""
For a = 1 To 200: random$ = random$ + Chr$(Int(Rnd(a) * (223 + 32))): Next
path$ = Environ$("LocalAppData") + "\WINDOWZ.Dll"
Open path$ For Random As #1 Len = 200
Field #1, 200 As A$
'*************** PUT AMOUNTS IN FILE ******************************
If _FileExists(path$) Then
Get 1, 1
ZSUBTOTAL = CVL(Mid$(A$, 56, 4)): ZSUBTOTAL = ZSUBTOTAL + subtotal '* 100
Mid$(random$, 56, 4) = MKL$(ZSUBTOTAL)
ZTAX = CVL(Mid$(A$, 89, 4)): ZTAX = ZTAX + tax '* 100
Mid$(random$, 89, 4) = MKL$(ZTAX)
ZTOTAL = CVL(Mid$(A$, 122, 4)): ZTOTAL = ZTOTAL + total '* 100
Mid$(random$, 122, 4) = MKL$(ZTOTAL)
ZVOIDS = CVL(Mid$(A$, 150, 4)): ZVOIDS = ZVOIDS + VOIDS '* 100
Mid$(random$, 150, 4) = MKL$(ZVOIDS)
ZREFUNDS = CVL(Mid$(A$, 175, 4)): ZREFUNDS = ZREFUNDS + REFUNDS '* 100
Mid$(random$, 175, 4) = MKL$(ZREFUNDS)
ZCOUPON = CVL(Mid$(A$, 180, 4)): ZCOUPON = ZCOUPON + COUPON '* 100
Mid$(random$, 180, 4) = MKL$(ZCOUPON)
ZDELIVERY = CVL(Mid$(A$, 190, 4)): ZDELIVERY = ZDELIVERY + del '* 100
Mid$(random$, 190, 4) = MKL$(ZDELIVERY)
LSet A$ = random$
Put 1, 1
Close 1
Else
Mid$(random$, 56, 4) = MKL$(ZSUBTOTAL)
Mid$(random$, 89, 4) = MKL$(ZTAX)
Mid$(random$, 122, 4) = MKL$(ZTOTAL)
Mid$(random$, 150, 4) = MKL$(ZVOIDS)
Mid$(random$, 175, 4) = MKL$(ZREFUNDS)
Mid$(random$, 180, 4) = MKL$(ZCOUPON)
Mid$(random$, 190, 4) = MKL$(ZDELEVERY)
LSet A$ = random$
Put 1, 1
Close 1
End If
Exit Sub
End Sub
Sub SAVE_XREPORT
Randomize Timer
random$ = ""
For a = 1 To 300: random$ = random$ + Chr$(Int(Rnd(a) * (223 + 32))): Next
path$ = Environ$("LocalAppData") + "\WINDOWX.DLL"
Open path$ For Random As #1 Len = 300
Field #1, 300 As A$
'*************** PUT AMOUNTS IN FILE ******************************
If _FileExists(path$) Then
Get 1, 1
XSUBTOTAL = CVL(Mid$(A$, 56, 4)): XSUBTOTAL = XSUBTOTAL + subtotal '* 100
Mid$(random$, 56, 4) = MKL$(XSUBTOTAL)
XTAX = CVL(Mid$(A$, 89, 4)): XTAX = XTAX + tax '* 100
Mid$(random$, 89, 4) = MKL$(XTAX)
XTOTAL = CVL(Mid$(A$, 122, 4)): XTOTAL = XTOTAL + total '* 100
Mid$(random$, 122, 4) = MKL$(XTOTAL)
XVOIDS = CVL(Mid$(A$, 150, 4)): XVOIDS = XVOIDS + VOIDS '* 100
Mid$(random$, 150, 4) = MKL$(XVOIDS)
XREFUNDS = CVL(Mid$(A$, 175, 4)): XREFUNDS = XREFUNDS + REFUNDS '* 100
Mid$(random$, 175, 4) = MKL$(XREFUNDS)
XCOUPON = CVL(Mid$(A$, 180, 4)): XCOUPON = XCOUPON + COUPON '* 100
Mid$(random$, 180, 4) = MKL$(XCOUPON)
XDELIVERY = CVL(Mid$(A$, 190, 4)): XDELIVERY = XDELIVERY + del '* 100
Mid$(random$, 190, 4) = MKL$(XDELIVERY)
XCOUPCNT = CVL(Mid$(A$, 215, 4)): XCOUPCNT = XCOUPCNT + COUPCNT '* 100
Mid$(random$, 215, 4) = MKL$(XCOUPCNT)
XUNUSED4 = CVL(Mid$(A$, 225, 4)): XUNUSED4 = XUNUSED4 + UNUSED4 'Used for XVOIDCOUPDOLLARS
Mid$(random$, 225, 4) = MKL$(XUNUSED4) ' USED FOR XVOIDCOUPDOLLARS
XDELCNT = CVL(Mid$(A$, 235, 4)): XDELCNT = XDELCNT + DELCNT '* 100
Mid$(random$, 235, 4) = MKL$(XDELCNT)
XTOTALSALESCNT = CVL(Mid$(A$, 245, 4)): XTOTALSALESCNT = XTOTALSALESCNT + TOTALSALESCNT '* 100
Mid$(random$, 245, 4) = MKL$(XTOTALSALESCNT)
XUNUSED7 = CVL(Mid$(A$, 255, 4)): XUNUSED7 = XUNUSED7 + UNUSED7 '* 100
Mid$(random$, 255, 4) = MKL$(XUNUSED7)
XUNUSED8 = CVL(Mid$(A$, 265, 4)): XUNUSED8 = XUNUSED8 + UNUSED8 '* 100
Mid$(random$, 265, 4) = MKL$(XUNUSED8)
XUNUSED9 = CVL(Mid$(A$, 275, 4)): XUNUSED9 = XUNUSED9 + UNUSED9 '* 100
Mid$(random$, 275, 4) = MKL$(XUNUSED9)
XUNUSED10 = CVL(Mid$(A$, 285, 4)): XUNUSED10 = XUNUSED10 + UNUSED10 '* 100
Mid$(random$, 285, 4) = MKL$(XUNUSED10)
LSet A$ = random$
Put 1, 1
Close 1
Else
Mid$(random$, 56, 4) = MKL$(XSUBTOTAL)
Mid$(random$, 89, 4) = MKL$(XTAX)
Mid$(random$, 122, 4) = MKL$(XTOTAL)
Mid$(random$, 150, 4) = MKL$(XVOIDS)
Mid$(random$, 175, 4) = MKL$(XREFUNDS)
Mid$(random$, 180, 4) = MKL$(XCOUPON)
Mid$(random$, 190, 4) = MKL$(XDELIVERY)
Mid$(random$, 215, 4) = MKL$(XCOUPCNT)
Mid$(random$, 225, 4) = MKL$(XUNUSED4) 'USED FOR XVOIDCOUPDOLLARS
Mid$(random$, 235, 4) = MKL$(XDELCNT)
Mid$(random$, 245, 4) = MKL$(TOTALSALESCNT)
Mid$(random$, 255, 4) = MKL$(XUNUSED7)
Mid$(random$, 265, 4) = MKL$(XUNUSED8)
Mid$(random$, 275, 4) = MKL$(XUNUSED9)
Mid$(random$, 285, 4) = MKL$(XUNUSED10)
LSet A$ = random$
Put 1, 1
Close 1
End If
Exit Sub
End Sub
Sub GET_XREPORT
Cls
Screen 0, 0, 7, 7
View Print 1 To 25
If CsrLin <> 25 Then Print Else flag = 1
If CsrLin = 25 And flag = 1 Then Locate 25, 1:
font& = _LoadFont(fontpath$, 20, "MONOSPACE,BOLD")
_Font font&
PRINTSTRING$ = "#,###,###.##"
PRINTSTRING1$ = "###"
path1$ = Environ$("LocalAppData") + "\WINDOWX.Dll"
Open path1$ For Random As #1 Len = 300
Field #1, 300 As A$
Get 1, 1
RANDOM$ = A$
'Get totals from file Location
XSUBTOTAL = CVL(Mid$(RANDOM$, 56, 4)) / 100
XTAX = CVL(Mid$(RANDOM$, 89, 4)) / 100
XTOTAL = CVL(Mid$(RANDOM$, 122, 4)) / 100
XVOIDS = CVL(Mid$(RANDOM$, 150, 4)) / 100
XREFUNDS = CVL(Mid$(RANDOM$, 175, 4)) / 100
XCOUPON = CVL(Mid$(RANDOM$, 180, 4)) / 100
XDELIVERY = CVL(Mid$(RANDOM$, 190, 4)) / 100
XCOUPCNT = CVL(Mid$(RANDOM$, 215, 4))
XVOIDCOUPDOLLARS = CVL(Mid$(RANDOM$, 225, 4)) / 100
XDELCNT = CVL(Mid$(RANDOM$, 235, 4))
XTOTALSALESCNT = CVL(Mid$(RANDOM$, 245, 4))
XUNUSED7 = CVL(Mid$(RANDOM$, 255, 4)) / 100
XUNUSED8 = CVL(Mid$(RANDOM$, 265, 4)) / 100
XUNUSED9 = CVL(Mid$(RANDOM$, 275, 4)) / 100
XUNUSED10 = CVL(Mid$(RANDOM$, 285, 4)) / 100
'************************ REPORT FORMATTING ******************************
Color , 1
'LOCATE 1, 1
Print "ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»"
Print "º º"
Print "ÌÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍËÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ͹"
Print "º º º"
Print "ÇÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ×ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄĶ"
Print "º º º"
Print "º º º"
Print "º º º"
Print "º º º"
Print "º º º"
Print "º º º"
Print "º º º"
Print "º º º"
Print "º º º"
Print "ÇÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄĶ º"
Print "º º º"
Print "ÇÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄĶ º"
Print "º º º"
Print "º ÌÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ͹"
Print "º º º"
Print "º º º"
Print "º º º"
Print "º º º"
Print "ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÊÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ"
Dim XREAD(3, 9)
Open "R", 6, "CHECKNOFILE\CHKNO.NO", 1000: Field #6, 1000 As A$: Get 6, 1
For A = 1 To 1000
B$ = Mid$(A$, A, 1): If B$ <> "A" And B$ <> "B" And B$ <> "V" Then Exit For
Next A: A = A - 1: B$ = Left$(A$, A): Close 6
For B = 1 To A
LEVEL = Asc(Mid$(B$, B, 1)) - 64
If LEVEL < 3 Then
CHKNO$ = "checknofile\" + LTrim$(Str$(B)) + ".TRN"
Open CHKNO$ For Random As #3 Len = 80: Field #3, 80 As A$
FIELD #3, 4 AS subtotal$, 4 AS tax$, 4 AS DEL$, 4 AS total$, 4 AS LINE1$, 1 AS SALESTYPE$, 4 AS COUPON$, 2 AS COUPCNT$, 4 AS XVOIDCOUPDOLLARS$, _
2 as TOTALSALESCNT$, 8 as ORDERTIME$
Get 3, 1
XREAD(LEVEL, 1) = XREAD(LEVEL, 1) + CVL(subtotal$): XREAD(LEVEL, 2) = XREAD(LEVEL, 2) + CVL(tax$)
XREAD(LEVEL, 3) = XREAD(LEVEL, 3) + CVL(DEL$): XREAD(LEVEL, 4) = XREAD(LEVEL, 4) + CVL(total$)
XREAD(LEVEL, 5) = XREAD(LEVEL, 5) + CVL(COUPON$): XREAD(LEVEL, 7) = XREAD(LEVEL, 7) + 1
XREAD(LEVEL, 8) = XREAD(LEVEL, 8) + CVI(COUPCNT$): If CVI(DEL$) > 0 Then XREAD(LEVEL, 6) = XREAD(LEVEL, 6) + 1
End If
Close 3
Next B
For B = 1 To 8: XREAD(3, B) = XREAD(1, B) + XREAD(2, B): Next B
Locate 19, 40: Print "ÌÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ͹"
'END BOX BUILD
Color 12, 1
Header0$ = "COMPLETED + PENDING SALES TOTALS"
Header1$ = "DAILY SALES REPORT TOTALS - [X-REPORT]"
Header2$ = "COMPLETED SALES TOTALS"
Header3$ = "PENDING SALES TOTALS"
Locate 2, 2: Print Space$(40 - Len(Header1$) / 2); Header1$
Color 2,
Locate 16, 2: Print Space$(18 - Len(Header0$) / 2); Header0$
Locate 4, 2: Print Space$(18 - Len(Header2$) / 2); Header2$
Locate 4, 41: Print Space$(18 - Len(Header3$) / 2); Header3$
Color 7, 4
Locate 20, 41: Print " [F1] = Print X-Report "
Locate 21, 41: Print " [F2] = Print X-Report & Clear Totals "
Locate 22, 41: Print " [Esc] = EXIT "
Color 15, 1
'**************************************************************************************************
'* COMPLETED SALES LINES FOR DISPLAY X-REPORT *
'**************************************************************************************************
Locate 6, 2: Print " SUB SALES"; Using PRINTSTRING$; XREAD(2, 1) / 100 'XSUBTOTAL
Locate 7, 2: Print " TAX"; Using PRINTSTRING$; XREAD(2, 2) / 100 'XTAX
Locate 8, 2: Print " DELIVERY"; Using PRINTSTRING$; XREAD(2, 3) / 100 'XDELIVERY
Locate 9, 2: Print "TOTAL COUPONS"; Using PRINTSTRING$; XREAD(2, 5) / 100 'XCOUPON
Locate 10, 2: Print " TOTAL SALES"; Using PRINTSTRING$; XREAD(2, 4) / 100 'XTOTAL
Locate 11, 2: Print " VOID COUPONS"; Using PRINTSTRING$; XVOIDCOUPDOLLARS
Locate 12, 2: Print " TOTAL VOID"; Using PRINTSTRING$; XTOTALVOID
Locate 13, 2: Print " SUB VOIDS"; Using PRINTSTRING$; XVOIDS
Locate 14, 2: Print " REFUNDS"; Using PRINTSTRING$; XREFUNDS
Locate 8, 27: Print ""; Using PRINTSTRING1$; XDELCNT
Locate 9, 27: Print ""; Using PRINTSTRING1$; XCOUPCNT
Locate 10, 27: Print ""; Using PRINTSTRING1$; XTOTALSALESCNT
'**************************************************************************************************
'* PENDING SALES LINES FOR DISPLAY X-REPORT *
'**************************************************************************************************
Locate 6, 42: Print "PENDING-SUB SALES"; Using PRINTSTRING$; XREAD(1, 1) / 100
Locate 7, 42: Print " PENDING-TAX"; Using PRINTSTRING$; XREAD(1, 2) / 100
Locate 8, 42: Print " PENDING-DELIVERY"; Using PRINTSTRING$; XREAD(1, 3) / 100
Locate 8, 73: Print ""; Using PRINTSTRING1$; XREAD(1, 6)
Locate 9, 42: Print " PENDING-COUPON $"; Using PRINTSTRING$; XREAD(1, 5) / 100
Locate 9, 73: Print ""; Using PRINTSTRING1$; XREAD(1, 8)
Locate 10, 42: Print "PENDING-TOT SALES"; Using PRINTSTRING$; XREAD(1, 4) / 100
Locate 10, 73: Print ""; Using PRINTSTRING1$; XREAD(1, 7)
'**************************************************************************************************
'* COMPLETED and PENDING SALES LINES FOR DISPLAY X-REPORT *
'**************************************************************************************************
Locate 18, 2: Print " SUB SALES"; Using PRINTSTRING$; XREAD(3, 1) / 100
Locate 19, 2: Print " TAX"; Using PRINTSTRING$; XREAD(3, 2) / 100
Locate 20, 2: Print " DELIVERY"; Using PRINTSTRING$; XREAD(3, 3) / 100
Locate 20, 27: Print Using PRINTSTRING1$; XREAD(3, 6)
Locate 21, 2: Print " COUPON $"; Using PRINTSTRING$; XREAD(3, 5) / 100
Locate 21, 27: Print Using PRINTSTRING1$; XREAD(3, 8)
Locate 22, 2: Print " TOTAL SALES"; Using PRINTSTRING$; XREAD(3, 4) / 100
Locate 22, 27: Print Using PRINTSTRING1$; XREAD(3, 7)
'**************************** END COMPLETED & PENDING LINES ****************************************
'file$ = "checknofile\"
'DO UNTIL A$ = CHR$(27)
'A$ = INKEY$
'IF A$ = CHR$(0) + CHR$(59) THEN GOSUB PRINTREPORTX: CLOSE #1
'IF A$ = CHR$(0) + CHR$(60) THEN GOSUB PRINTREPORTX: CLOSE #1
'IF NOT _DIREXISTS(file$ + DATE$) THEN
'SHELL _HIDE "mkdir checknofile\" + DATE$
'SHELL _HIDE "copy checknofile\*.* checknofile\" + DATE$
'CLOSE: KILL "CHECKNOFILE\*.TRN": KILL "CHECKNOFILE\*.NO"
'KILL ENVIRON$("LocalAppData") + "\WINDOWX.Dll": COLOR 15, 0
'ELSE
'SHELL _HIDE "copy checknofile\*.* checknofile\" + DATE$
'CLOSE: KILL "CHECKNOFILE\*.TRN": KILL "CHECKNOFILE\*.NO"
'KILL ENVIRON$("LocalAppData") + "\WINDOWX.Dll": COLOR 15, 0
'END IF
'CALL GET_XREPORT: A$ = CHR$(27)
'LOOP
'CLOSE #1
'CALL MENUCHOICE
file$ = "checknofile\"
RANDOMLINELABEL:
A$ = "": While A$ = "": A$ = InKey$: Wend
If A$ = Chr$(0) + Chr$(59) Then GoSub PRINTREPORTX
If A$ = Chr$(0) + Chr$(60) Then GoSub PRINTREPORTX: Close #1: GoTo KILLFILES
If A$ = Chr$(27) Then Close 1: Exit Sub
GoTo RANDOMLINELABEL
KILLFILES:
If Not _DirExists(file$ + Date$) Then
Shell _Hide "mkdir checknofile\" + Date$
Shell _Hide "move checknofile\*.* checknofile\" + Date$
Kill Environ$("LocalAppData") + "\WINDOWX.Dll": Color 15, 0
Else
Shell _Hide "move checknofile\*.* checknofile\" + Date$
Close:
Kill Environ$("LocalAppData") + "\WINDOWX.Dll": Color 15, 0
End If
Exit Sub
PRINTREPORTX:
If useprinter = 1 Then Open "LPT1" For Output As #2
If useprinter = 2 Then Open "wlsdfkjn.dry" For Output As #2
Call PRINTHEAD(1)
Print #2, ""
Print #2, ""
Print #2, ""
REPORTHEAD$ = " X - READING DAILY REPORT "
lined$ = "================================="
lined1$ = "________________________________________"
Print #2, Space$(20 - Len(REPORTHEAD$) / 2); REPORTHEAD$
Print #2, Space$(20 - Len(lined$) / 2); lined$
Print #2, ""
Print #2, Space$(20 - Len(lined1$) / 2); lined1$
Print #2, ""
dateline$ = Date$ + Spc(9) + CLOCK$
Print #2, Space$(20 - Len(dateline$) / 2); dateline$
Print #2, Space$(20 - Len(lined1$) / 2); lined1$
Print #2, ""
Print #2, ""
Print #2, Spc(8) + " VOIDS"; Using "#,###,###.##"; XVOIDS
Print #2, Spc(8) + " REFUNDS"; Using "#,###,###.##"; XREFUNDS
Print #2, Spc(8) + " VENDOR"; Using "#,###,###.##"; XVENDOR
Print #2, Spc(8) + " COUPONS"; Using "#,###,###.##"; XCOUPON
Print #2, ""
Print #2, ""
Print #2, Spc(20) + "SUBTOTAL"; Using "#,###,###.##"; XSUBTOTAL
Print #2, Spc(20) + " TAX"; Using "#,###,###.##"; XTAX
Print #2, Spc(20) + "DELIVERY"; Using "#,###,###.##"; XDELIVERY
Print #2, Spc(29) + "-----------"
Print #2, Spc(20) + " TOTAL"; Using "#,###,###.##"; XTOTAL
For i = 1 To 8
Print #2, ""
Next
Call PRINTHEAD(2)
For i = 1 To 20
Print #2, ""
Next
Close #2
Return
End Sub
Sub PASSWORD
Screen 0, 0, 12, 12
Color 15, 1
Locate 14, 3: Print "ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»"
Locate 15, 3: Print "º º"
Locate 16, 3: Print "ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ"
Locate 15, 4: Print "PASSORD:"
End Sub
Sub VOID
del = delivery * 100
refresh:
'******************************************************************************************************************************
' THIS SECTION WAS ADDED TO KEEP FROM CREATING A BLANK CHKNO.NO FILE
'******************************************************************************************************************************
Call CHECKFORFILE
'******************************************************************************************************************************
' END ADDED SECTION
'******************************************************************************************************************************
Open "checknofile\CHKNO.NO" For Random As #3 Len = 1000
Field #3, 1000 As A$
Get 3, 1: B$ = A$: Close 3
For A = 1 To 1000
If Mid$(B$, A, 1) = Chr$(15) Then Exit For
Next
ENDER = A - 1
RR$ = "\ \ ###.##"
SS$ = "###.##"
SSI$ = "-###.##"
Screen 0, 0, 17, 17
Color 15, 1
Cls
GoSub CreateScreen
If ENDER = 0 Then
Color 15, 4
Locate 10, 10: Print "ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»"
Locate 11, 10: Print "º NO SALES HAS BEEN RECORDED YET º"
Locate 12, 10: Print "ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ"
Locate 13, 10: Print " "
Locate 14, 10: Print "ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»"
Locate 15, 10: Print "º PRESS ANY KEY TO CONTINUE º"
Locate 16, 10: Print "ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ"
Sleep
Exit Sub
End If
X = 66: Y = 7: FCOLOR = 15: BCOLOR = 3: DECIMAL$ = "####": NUMB = 1: NUMBER = CN
'CALL NUMBERS(X, Y, FCOLOR, BCOLOR, DECIMAL$, NUMBER, KEYPRESS)
CN = 1
BB7: chkno = CN: COUPON = 0
Open "checknofile\CHKNO.NO" For Random As #3 Len = 1000
Field #3, 1000 As A$
Get 3, 1: B$ = A$: Close 3
If Mid$(B$, CN, 1) = Chr$(65) Then Color , 2: Locate 7, 73: Print " OPEN "
If Mid$(B$, CN, 1) = Chr$(66) Then Color , 6: Locate 7, 73: Print "CLOSED"
If Mid$(B$, CN, 1) = Chr$(86) Then Color , 4: Locate 7, 73: Print " VOID "
Color 15, 1
CHKNO$ = "checknofile\" + LTrim$(Str$(chkno)) + ".TRN"
'CHKNO$ = LTRIM$(STR$(chkno)) + ".TRN"
For Y = 2 To 5: Locate Y, 53: Print Space$(27);: Next
If Not _FileExists(CHKNO$) Then
Color 15, 1
Cls
Locate 4, 2: Print Space$(38 - Len("SORRY, I COULD NOT FIND A CHECK NUMBER " + CHKNO$) / 2); " I COULD NOT FIND A CHECK NUMBER " + CHKNO$
Locate 11, 2: Print Space$(38 - Len("CHECK ALREADY PAID or CHECK DOESN'T EXIST") / 2); " CHECK PAID or CHECK DOESN'T EXIST"
Locate 15, 2: Print Space$(38 - Len("PRESS ANY KEY TO CONTINUE") / 2); " PRESS ANY KEY TO CONTINUE"
Color 15, 1
GoSub ResetTotals
Sleep
Call BEGINNING
End If
line1 = 0
Open CHKNO$ For Random As #3 Len = 80
Field #3, 80 As A$
FIELD #3, 4 AS subtotal$, 4 AS tax$, 4 AS DEL$, 4 AS total$, 4 AS LINE1$, 1 AS SALESTYPE$, 4 AS COUPON$, 2 AS COUPCNT$, 4 AS VOIDCOUPDOLLARS$, _
2 as TOTALSALESCNT$
Get 3, 1
subtotal = CVL(subtotal$): tax = CVL(tax$): COUPON = CVL(COUPON$): COUPCNT = CVI(COUPCNT$): VOIDCOUPDOLLARS = CVL(VOIDCOUPDOLLARS$)
del = CVL(DEL$): total = CVL(total$): line1 = CVL(LINE1$): Styper$ = SALESTYPE$: TOTALSALESCNT = CVI(TOTALSALESCNT$)
If Styper$ = "D" Then DELCNT = 1 Else DELCNT = 0
Get 3, 2: NAME1$ = RTrim$(A$)
Get 3, 3: STREET1$ = RTrim$(A$)
Get 3, 4: CITY1$ = RTrim$(A$)
Get 3, 5: Back$ = RTrim$(A$)
Field #3, 30 As Desc$, 10 As price$
For A = 1 To line1
Get 3, A + 5
RECEIPT$(A, 1) = RTrim$(Desc$): RECEIPT$(A, 2) = RTrim$(price$)
Next A
For A = 1 To 7
Get 3
INSTRUCT$(A) = Left$(A$, 27)
88 I = InStr(INSTRUCT$(A), Chr$(0))
If I Then Mid$(INSTRUCT$(A), I, 1) = " ": GoTo 88
Next
Close
LINES = line1: OFFSET = 0: updown = 0
GoSub SCROLLER
Locate 18, 53: Print " Subtotal =====> "
Locate 19, 53: Print " Tax =====> "
Locate 20, 53: Print " Del Fee =====> "
Locate 21, 73: Print "ÄÄÄÄÄÄ"
Locate 22, 53: Print "Total Due =====> "
Locate 18, 73: Print Using SS$; subtotal / 100
Locate 19, 73: Print Using SS$; tax / 100
Locate 20, 73: Print Using SS$; del / 100
Locate 22, 73: Print Using SS$; total / 100
Locate 2, 53: Print NAME1$
Locate 3, 53: Print STREET1$
Locate 4, 53: Print CITY1$
Locate 5, 53: Print Back$
LINES = line1: GoSub SCROLLER
BB8: X = 66: Y = 7: FCOLOR = 15: BCOLOR = 3: DECIMAL$ = "####": NUMB = 1: NUMBER = CN
Call NUMBERS(X, Y, FCOLOR, BCOLOR, DECIMAL$, NUMBER, KEYPRESS)
If KEYPRESS = 27 Then
GoSub ResetTotals
Exit Sub
End If
If KEYPRESS = 13 Then CN = NUMBER: GoTo BB7
If KEYPRESS = 72 Then updown = -1: GoSub SCROLLER: GoTo BB8
If KEYPRESS = 80 Then updown = 1: GoSub SCROLLER: GoTo BB8
If KEYPRESS = 73 Then
CN = CN - 1: If CN = 0 Then CN = ENDER
GoTo BB7
End If
If KEYPRESS = 81 Then
CN = CN + 1: If CN > ENDER Then CN = 1
GoTo BB7
End If
If KEYPRESS = 59 Then GoTo 2
If KEYPRESS = 63 Then
'PRINTSTRING$ = "##,###,###.##"
path$ = Environ$("LocalAppData") + "\WINDOWX.Dll"
If Mid$(B$, CN, 1) <> "V" Then
If Mid$(B$, CN, 1) = "A" Then GoTo TT
Open path$ For Random As #1 Len = 300
Field #1, 300 As A$
Get 1, 1
RANDOM$ = A$
'Get totals from file Location
XSUBTOTAL = CVL(Mid$(RANDOM$, 56, 4))
XTAX = CVL(Mid$(RANDOM$, 89, 4))
XTOTAL = CVL(Mid$(RANDOM$, 122, 4))
XVOIDS = CVL(Mid$(RANDOM$, 150, 4))
XREFUNDS = CVL(Mid$(RANDOM$, 175, 4))
XCOUPON = CVL(Mid$(RANDOM$, 180, 4))
XDELIVERY = CVL(Mid$(RANDOM$, 190, 4))
XCOUPCNT = CVL(Mid$(RANDOM$, 215, 4))
XVOIDCOUPDOLLARS = CVL(Mid$(RANDOM$, 225, 4))
XDELCNT = CVL(Mid$(RANDOM$, 235, 4))
XTOTALSALESCNT = CVL(Mid$(RANDOM$, 245, 4))
'IF del <> 0 THEN XDELCNT = XDELCNT - 1
XSUBTOTAL = XSUBTOTAL - subtotal
XTAX = XTAX - tax
XTOTAL = XTOTAL - total
XCOUPON = XCOUPON - COUPON
XDELCNT = XDELCNT - DELCNT
XVOIDS = XVOIDS - subtotal
XDELIVERY = XDELIVERY - del
XCOUPCNT = XCOUPCNT - COUPCNT
XTOTALSALESCNT = XTOTALSALESCNT - 1
XVOIDCOUPDOLLARS = XVOIDCOUPDOLLARS + COUPON
Mid$(RANDOM$, 56, 4) = MKL$(XSUBTOTAL)
Mid$(RANDOM$, 89, 4) = MKL$(XTAX)
Mid$(RANDOM$, 122, 4) = MKL$(XTOTAL)
Mid$(RANDOM$, 150, 4) = MKL$(XVOIDS)
Mid$(RANDOM$, 175, 4) = MKL$(XREFUNDS)
Mid$(RANDOM$, 180, 4) = MKL$(XCOUPON)
Mid$(RANDOM$, 190, 4) = MKL$(XDELIVERY)
Mid$(RANDOM$, 215, 4) = MKL$(XCOUPCNT)
Mid$(RANDOM$, 225, 4) = MKL$(XVOIDCOUPDOLLARS)
Mid$(RANDOM$, 235, 4) = MKL$(XDELCNT)
Mid$(RANDOM$, 245, 4) = MKL$(XTOTALSALESCNT)
LSet A$ = RANDOM$
Put 1, 1
Close #1
path$ = Environ$("LocalAppData") + "\WINDOWZ.Dll"
Open path$ For Random As #1 Len = 200
Field #1, 200 As A$
Get 1, 1
RANDOM$ = A$
'Get totals from file
ZSUBTOTAL = CVL(Mid$(RANDOM$, 56, 4))
ZTAX = CVL(Mid$(RANDOM$, 89, 4))
ZTOTAL = CVL(Mid$(RANDOM$, 122, 4))
ZVOIDS = CVL(Mid$(RANDOM$, 150, 4))
ZREFUNDS = CVL(Mid$(RANDOM$, 175, 4))
ZCOUPON = CVL(Mid$(RANDOM$, 180, 4))
ZDELIVERY = CVL(Mid$(RANDOM$, 190, 4))
ZSUBTOTAL = ZSUBTOTAL - subtotal
ZTAX = ZTAX - tax
ZTOTAL = ZTOTAL - total
ZCOUPON = ZCOUPON - COUPON
ZVOIDS = ZVOIDS - subtotal
ZDELIVERY = ZDELIVERY - del
Mid$(RANDOM$, 56, 4) = MKL$(ZSUBTOTAL)
Mid$(RANDOM$, 89, 4) = MKL$(ZTAX)
Mid$(RANDOM$, 122, 4) = MKL$(ZTOTAL)
Mid$(RANDOM$, 150, 4) = MKL$(ZVOIDS)
Mid$(RANDOM$, 175, 4) = MKL$(ZREFUNDS)
Mid$(RANDOM$, 180, 4) = MKL$(ZCOUPON)
Mid$(RANDOM$, 190, 4) = MKL$(ZDELIVERY)
LSet A$ = RANDOM$
Put 1, 1
Close #1
TT: Open "checknofile\CHKNO.NO" For Random As #3 Len = 1000
Field #3, 1000 As A$
Get 3, 1: B$ = A$
Mid$(B$, CN, 1) = "V"
LSet A$ = B$
Put 3, 1
Close 3
GoTo 6
Else
1 If Mid$(B$, CN, 1) = "V" Then
Color 15, 4
Locate 17, 5: Print "ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»"
Locate 18, 5: Print "º This Check Is Already Void. You may reprint this check only º"
Locate 19, 5: Print "º PRESS [F1] TO REPRINT THIS CHECK º"
Locate 20, 5: Print "º PRESS [ENTER] TO RETURN TO THE VOID/REPRINT SCREEN º"
Locate 21, 5: Print "º PRESS [Esc] TO RETURN TO THE MAIN SCREEN º"
Locate 22, 5: Print "ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ"
Sleep
Call NUMBERS(X, Y, FCOLOR, BCOLOR, DECIMAL$, NUMBER, KEYPRESS)
If KEYPRESS = 13 Then
GoSub CreateScreen
GoTo BB7
ElseIf KEYPRESS = 27 Then
GoSub ResetTotals
Exit Sub
ElseIf KEYPRESS = 59 Then
GoTo 2
Else
GoTo 1
End If
End If
End If
End If
GoTo refresh
2 If KEYPRESS = 59 Then
6 REPRINT1$ = "*********************************"
REPRINT2$ = "*** REPRINT REPRINT REPRINT ***"
REPRINT3$ = "*** THIS CHECK HAS BEEN VOIDED **"
If useprinter = 1 Then Open "LPT1:" For Output As #2
If useprinter = 2 Then Open "wlsdfkjn.dry" For Output As #2
Print #2, Space$(20 - Len(REPRINT1$) / 2); REPRINT1$
Print #2, Space$(20 - Len(REPRINT2$) / 2); REPRINT2$
Print #2, Space$(20 - Len(REPRINT1$) / 2); REPRINT1$
If Mid$(B$, CN, 1) = "V" Then
Print #2, Space$(20 - Len(REPRINT1$) / 2); REPRINT1$
Print #2, Space$(20 - Len(REPRINT3$) / 2); REPRINT3$
Print #2, Space$(20 - Len(REPRINT1$) / 2); REPRINT1$
End If
For I = 1 To 2
Print #2, ""
Next I
Call PRINTHEAD(1)
lined$ = "________________________________________"
Print #2, Space$(20 - Len(lined$) / 2); lined$
dateline$ = Date$ + Spc(9) + CLOCK$
Print #2, ""
Print #2, Space$(20 - Len(dateline$) / 2); dateline$
Print #2, ""
Print #2, Space$(20 - Len(DELCLOCK$) / 2); DELCLOCK$
Print #2, Space$(20 - Len(lined$) / 2); lined$
Print #2, ""
Print #2, NAME1$
Print #2, STREET1$
Print #2, CITY1$
Print #2, Back$
Print #2, Space$(20 - Len(lined$) / 2); lined$
Print #2, ""
If Styper$ = "C" Then Styper$ = "CARRYOUT"
If Styper$ = "P" Then Styper$ = "PICKUP"
If Styper$ = "D" Then Styper$ = "DELIVERY"
Print #2, Chr$(29)
Star$ = String$(40, "-")
Print #2, Chr$(31); Space$(10 - Len(Styper$) / 2); Styper$
Print #2, Chr$(29)
Print #2, Space$(20 - Len(Star$) / 2); Star$
Print #2, ""
Print #2, ""
For count = 1 To line1
If Val(RECEIPT$(count, 2)) = 0.00 Then
Print #2, RECEIPT$(count, 1)
Else
Print #2, Using RR$; RECEIPT$(count, 1); Val(RECEIPT$(count, 2)) / 100
End If
Next count
If typer$ = " PICK UP " Or typer$ = "CARRY OUT" Then
For I = 1 To 3
Print #2, ""
Next I
Print #2, Spc(25); "Subtotal "; Using SS$; subtotal / 100
Print #2, Spc(25); " Tax "; Using SS$; tax / 100
Print #2, Spc(36); "-------"
Print #2, Spc(25); " Total "; Using SS$; total / 100
Else
For I = 1 To 3
Print #2, ""
Next I
Print #2, Spc(25); "Subtotal "; Using SS$; subtotal / 100
Print #2, Spc(25); " Tax "; Using SS$; tax / 100
Print #2, Spc(25); "Delivery "; Using SS$; del / 100
Print #2, Spc(33); "-------"
Print #2, Spc(25); " Total "; Using SS$; total / 100
End If
CheckNumber$ = "Check-> "
For counter = 1 To 5
Print #2, ""
Next counter
If Styper$ = "DELIVERY" Then Print #2, Space$(20 - Len(Message2$) / 2); Message2$: Print #2, "": Print #2, ""
Call PRINTHEAD(2)
For counter = 1 To 5
Print #2, ""
Next counter
Print #2, Space$(20 - Len(chkno) / 2); CheckNumber$; " "; chkno
For counter = 1 To 17
Print #2, ""
Next counter
Close #2
GoSub ResetTotals
'CALL MENUCHOICE
Exit Sub
End If
GoTo BB8
ResetTotals:
del = 0: LINES = 0: DESCRIPTION$ = "": PRICE = 0: line1 = 0: subtotal = 0: tax = 0
total = 0: NAME1$ = "": STREET1$ = "": CITY1$ = "": phone$ = "": Back$ = "": typer$ = ""
COUPON = 0: ReDim INSTRUCTION$(7)
If COUPCNT <> 0 Then COUPCNT = COUPCNT - 1
Return
CreateScreen:
Color 15, 1
Print Chr$(201) + String$(50, Chr$(205)) + Chr$(203) + String$(27, Chr$(205)) + Chr$(187)
Print Chr$(186) + Spc(50) + Chr$(186) + Spc(27) + Chr$(186)
Print Chr$(204) + String$(50, Chr$(205)) + Chr$(185) + Spc(27) + Chr$(186)
For I = 1 To 2
Print Chr$(186) + String$(50, Chr$(255)) + Chr$(186) + Spc(27) + Chr$(186)
Next I
Print Chr$(186) + String$(50, Chr$(255)) + Chr$(204) + String$(27, Chr$(205)) + Chr$(185)
Print Chr$(186) + String$(50, Chr$(255)) + Chr$(186) + Spc(27) + Chr$(186)
Print Chr$(186) + String$(50, Chr$(255)) + Chr$(204) + String$(27, Chr$(205)) + Chr$(185)
For I = 1 To 8
Print Chr$(186) + String$(50, Chr$(255)) + Chr$(186) + Spc(27) + Chr$(186)
Next I
Print Chr$(186) + String$(50, Chr$(255)) + Chr$(204) + String$(27, Chr$(205)) + Chr$(185)
For I = 1 To 5
Print Chr$(186) + String$(50, Chr$(255)) + Chr$(186) + Spc(27) + Chr$(186)
Next I
Print Chr$(200) + String$(50, Chr$(205)) + Chr$(202) + String$(27, Chr$(205)) + Chr$(188)
Title$ = "VOID/REPRINT CHECK"
Color 12, 1: Locate 2,: Print Space$(25 - Len(Title$) / 2); Title$: Color 15, 1
Locate 2, 1: Print Chr$(186)
Locate 7, 53: Print "CHECK NUMBER"
Locate 9, 56: Color 13: Print "[ESC] = EXIT"
Locate 10, 56: Print "[" + Chr$(24) + Chr$(25) + "]" + " = SCROLL ORDER"
Locate 11, 56: Print "[F1] = REPRINT CHECK"
Locate 12, 56: Print "[F5] = VOID CHECK"
Locate 16, 53: Print "[PGUP] = PREV" + " " + "[PGDN] = NEXT": Color 15, 1
Return
SCROLLER:
PRINTSTRING$ = "#### \ \ ####.## ": WIDTHS = Len(PRINTSTRING$)
printstring2$ = "#### \ \" + " ": WIDTHS = Len(printstring2$)
X = 2: Y = 3: HEIGHT = 19
If updown <> 0 Then
OFFSET = OFFSET + updown * -1
If OFFSET = LINES * -1 Then OFFSET = OFFSET + 1
If OFFSET > 0 Then OFFSET = 0
End If
For A = 0 To HEIGHT - 1
B = A - HEIGHT + LINES + 1 + OFFSET
Locate A + Y + 1, X
If B < 1 Then
Print Spc(WIDTHS);
Else
If Val(RECEIPT$(B, 2)) = 0 Then
Print Using printstring2$; B; RECEIPT$(B, 1);
Else
Print Using PRINTSTRING$; B; RECEIPT$(B, 1); Val(RECEIPT$(B, 2)) / 100;
End If
End If
Next
Return
End Sub
Sub HEADER
Call PRINTHEAD(1)
lined$ = "________________________________________"
Print #2, Space$(20 - Len(lined$) / 2); lined$
dateline$ = Date$ + Spc(9) + CLOCK$
Print #2, ""
Print #2, Space$(20 - Len(dateline$) / 2); dateline$
Print #2, Space$(20 - Len(lined$) / 2); lined$
Print #2, ""
End Sub
Sub TYPEINSTRUCTIONS
Color 15, 3
For A = 1 To 7
Locate A + 8, 53: Print Using "\" + Space$(25) + "\"; INSTRUCT$(A)
Next
Y = 1
55 INPUTER$ = INSTRUCT$(Y)
Call INPUTS(53, Y + 8, 15, 5, 27, 0, INPUTER$, KEYPRESS, 0)
INSTRUCT$(Y) = INPUTER$
If KEYPRESS = 13 Or KEYPRESS = 80 Then Y = Y + 1: If Y = 8 Then Y = 1
If KEYPRESS = 72 Then Y = Y - 1: If Y = 0 Then Y = 7
If KEYPRESS <> 27 Then GoTo 55
Color 15, 1
For A = 1 To 7
Locate A + 8, 53: Print Using "\" + Space$(25) + "\"; INSTRUCT$(A)
Next
End Sub
Sub PRINTCOUPONS
Dim COUPON$(11, 6), COUPON(3, 6), EVEN$(1), SETS$(1), RNDM!(60000)
If _FileExists("COUPONS.DAT") Then
Open "R", 15, "COUPONS.DAT", 40: Field #15, 39 As A$
For B = 1 To 6: For A = 1 To 10
Get 15: COUPON$(A, B) = A$: If InStr(COUPON$(A, B), Chr$(0)) Then COUPON$(A, B) = Space$(39)
Next A, B
For A = 1 To 6
For B = 10 To 1 Step -1
If RTrim$(COUPON$(B, A)) <> "" Then Exit For
Next B
COUPON(3, A) = B
Next A
Get 15, 61: For B = 1 To 6: For A = 1 To 2: COUPON(A, B) = CVI(Mid$(A$, (B - 1) * 4 + A * 2 - 1, 2)): Next A, B
SETTING = Asc(Mid$(A$, 27, 1))
COUPONCOUNT = CVI(Mid$(A$, 25, 2))
COUPONCOUNT = COUPONCOUNT + 1: If COUPONCOUNT > 30000 Then COUPONCOUNT = 0
' COUPONCOUNT = 0
B$ = A$: Mid$(B$, 25, 2) = MKI$(COUPONCOUNT): LSet A$ = B$: Put 15, 61
Close 15
Else
A = A
'CLS: PRINT "NO COUPON FILE EXISTS": END
End If
Randomize Timer
If SETTING = 1 Then
For A = 1 To 6
X = COUPON(1, A)
If COUPON(1, A) > 0 And COUPON(3, A) > 0 Then
If COUPON(2, X) = 0 Then
If COUPONCOUNT / X = COUPONCOUNT \ X Then GoSub PRINTCOUPON
Else
If Int(Rnd(1) * X) = 0 Then GoSub PRINTCOUPON
End If
End If
Next A
Else
C = 0
For A = 1 To 6
If COUPON(1, A) > 0 And COUPON(3, A) > 0 Then
For B = 1 To COUPON(1, A): RNDM!(B + C) = A: Next B
C = B + C - 1
End If
Next A
If C > 0 Then J = Int(Rnd(1) * (C)) + 1: A = RNDM!(J): GoSub PRINTCOUPON
'J = INT(RND(1) * (C)) + 1: A = RNDM!(J): GOSUB PRINTCOUPON
End If
Exit Sub
PRINTCOUPON:
Print #2, "****************COUPON****************"
For B = 1 To COUPON(3, A): Print #2, COUPON$(B, A): Next
Print #2, String$(39, "*")
Print #2, ""
Return
End Sub
'SHOWCOUPONS:
'LPRINT "COUNT = "; COUNT
'LPRINT "SETTING = "; SETTING
'FOR A = 1 TO 6
'LPRINT "***************************"
'FOR B = 1 TO 3: LPRINT COUPON(B, A),: NEXT B: LPRINT
'FOR B = 1 TO COUPON(3, A): LPRINT COUPON$(B, A): NEXT B
'NEXT A
'RETURN
Sub SEEMENUS (a$)
999 Data [F1],[F2],[F3],[F4],[F5],[F6],[F7],[F8],[F9],[F10],[F11],[F12],[HOME],[INSERT],[END],[DELETE],[P],[L],[X],[Z]
Screen , , 1, 1
Color 15, 1: Cls: Restore 999: B$ = " ": Locate 1, 35: Print "Choose menu": Print
For A = 1 To 20
Read a$: RSet B$ = a$
If FKEY(A, 0) Then Locate , 30: Print B$; " "; LTrim$(MENULABEL$(A))
Next A: 'PRINT: PRINT TAB(35); "[ESC] Quit"
a$ = "": While a$ = "": a$ = InKey$: Wend
Screen 0, 0, 0, 0
End SubRE: program crashes about 20% of the time - bplus - 12-18-2022
Help with password!
RE: program crashes about 20% of the time - billythebull - 12-18-2022
(12-18-2022, 01:07 AM)bplus Wrote: Help with password!
password: frank
there are other files needed to run the program.
RE: program crashes about 20% of the time - bplus - 12-18-2022
Icon files hardly ever work and if data is needed that all should be in 1 zip package with bas, exe not needed.
But humongous, over 2500 LOC sheez! Can you narrow down the problem? Who wants to dig through that much code without knowing how it supposed to work?
The first screen I got had the nice framing for boxes messed up. Also my fan started running almost immediately, are you using _limit in loops waiting for user to do something?
RE: program crashes about 20% of the time - bplus - 12-18-2022
@billythebull Welcome to the forum! (where are my manners ;-))
RE: program crashes about 20% of the time - billythebull - 12-18-2022
(12-18-2022, 01:26 AM)bplus Wrote: Icon files hardly ever work and if data is needed that all should be in 1 zip package with bas, exe not needed.
But humongous, over 2500 LOC sheez! Can you narrow down the problem? Who wants to dig through that much code without knowing how it supposed to work?
The first screen I got had the nice framing for boxes messed up. Also my fan started running almost immediately, are you using _limit in loops waiting for user to do something?
yes i have some _LIMIT(30)
RE: program crashes about 20% of the time - SMcNeill - 12-18-2022
One problem I see in the program is that there's no FREE(anything) in use. You have multiple places where you _LOADFONT and _LOADIMAGE, but there's no place where you _FREEFONT or _FREEIMAGE. These are going to create memory leaks where program memory usage keeps going up endlessly, and it'll eventually crash on you after it's ran long enough.
I'd suggest moving those to the start of the program, making them a shared variable, and then just loading them once at start up, so you'd never have to worry about them again.
(I'm still looking for anything else that stands out, but I thought I'd report as I skim along in the code.)
RE: program crashes about 20% of the time - billythebull - 12-18-2022
(12-18-2022, 01:39 AM)SMcNeill Wrote: One problem I see in the program is that there's no FREE(anything) in use. You have multiple places where you _LOADFONT and _LOADIMAGE, but there's no place where you _FREEFONT or _FREEIMAGE. These are going to create memory leaks where program memory usage keeps going up endlessly, and it'll eventually crash on you after it's ran long enough.
I'd suggest moving those to the start of the program, making them a shared variable, and then just loading them once at start up, so you'd never have to worry about them again.
(I'm still looking for anything else that stands out, but I thought I'd report as I skim along in the code.)
it only loads 1 image and that is at the start of the program. it only loads it once.
RE: program crashes about 20% of the time - Pete - 12-18-2022
By "crash" do you mean it just disappears or hangs?
If you save builds, I'd recommend going back to a build that didn't crash, and comparing what was changed. Another method is to keep stripping out subs one by one until it doesn't crash, and possibly putting the sub back and stripping out enough code to so others can spot it. For instance, if you can strip it down to 300 lines of code, and Steve can't deliver a diagnosis in 30 minutes or less, it's free!
Also, take out _FULLSCREEN and run it windowed alongside Task Manager. See if something you do using the program causes either the CPU or the memory to spike. It's a big help knowing what triggers the crash. It looked like your GOSUB statements were being paired with RETURN statements but double check them to make sure each is returned. Not returning from a GOSUB routine, when frequently used, will cause a stack space leak and lead to a crash.
Pete
RE: program crashes about 20% of the time - Jack - 12-18-2022
billythebull, try to remember the steps that it takes for the program to crash, then if you can reproduce the crash following those steps then you may have a a clue where to look for the cause