home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Club Amiga de Montreal - CAM
/
CAM_CD_1.iso
/
files
/
371.lha
/
CheckMate_v2.0
/
CheckMate.BAS
< prev
next >
Wrap
BASIC Source File
|
1990-05-05
|
16KB
|
855 lines
CLEAR ,30000&
BREAK ON
MENU ON
ON BREAK GOSUB Ender
ON ERROR GOTO ErrorFix
ON MENU GOSUB MenuCheck
DEFDBL bal
DEF FNround(e)=INT(e*100+.5)/100
DIM SHARED amnt(300),type$(300),num(300),dt$(300),des$(300),X9(12)
fs$= "\ \ \ \ ###### $$###,###.## \ \"
tf$="ACCOUNT NUMBER: \ \ Date: \ \ Balance: $$#,###,###.##"
path$=""
bal=0:c=1:account$=""
s$=STRING$(80," ")
t$=STRING$(19," ")+"CheckMATE - ©1989 Control Point Software"
t1$=" TYPE DATE NUMBER AMOUNT DESCRIPTION"
t2$="--------- -------- ------ ------------ -----------------------------------"
ach$=""
SCREEN 1,640,200,3,2
WINDOW 2,t$,(0,0)-(631,186),16,1
WINDOW OUTPUT 2
WINDOW CLOSE 1
PALETTE 0,0,0,0
PALETTE 1,.72,.72,.72
PALETTE 2,.4,.5,1
PALETTE 3,.93,.2,0
PALETTE 4,0,.93,.87
PALETTE 5,1,.13,.93
OPEN "S:CB.Config" FOR INPUT AS #1
INPUT #1,path$
CLOSE 1
MENU 1,0,1,"Information"
MENU 1,1,1,"Set Path "
MENU 1,2,1,"About "
Main:
WHILE 0=0
CLS
COLOR 1
PRINT STRING$(19," ")STRING$(40,"~")
COLOR 2
PRINT
PRINT
PRINT TAB(10)"Account #: ";
COLOR 3
PRINT account$;
PRINT TAB(45);
COLOR 2
PRINT "Balance: ";
COLOR 3
PRINT USING"$$#,###,###.##";bal
COLOR 4
LOCATE 7,10
PRINT"1. Change Account Number"
LOCATE 8,10
PRINT"2. Change Current Balance"
LOCATE 9,10
PRINT"3. Enter Deposit"
LOCATE 10,10
PRINT"4. Enter Withdrawl"
LOCATE 11,10
PRINT"5. Display Transactions"
LOCATE 7,45
PRINT"6. Print Transactions"
LOCATE 8,45
PRINT"7. Modify Transaction"
LOCATE 9,45
PRINT"8. Balance Account"
LOCATE 10,45
PRINT"9. Print Check History"
LOCATE 11,45
PRINT"Q. Quit"
LOCATE 15,1
PRINT "Choice:_";:x$=""
WINDOW OUTPUT 2
WHILE x$=""
x$=INKEY$
SLEEP
IF sp=1 THEN x$="*"
WEND
IF x$="*" AND sp=1 THEN sp=0
PRINT CHR$(8);x$
x=VAL(x$)
IF UCASE$(x$)="Q" THEN Ender:
ON x GOSUB NewNum,ChBal,Dep,With,Display,PrintOut,EditIt,Balance,ChkHist
WEND
1 :
NewNum:
GOSUB WriteFile:
CLS
can=0
WHILE can=0
PRINT :PRINT "Account Number:";
LINE INPUT account$
gs$=account$
GOSUB NumOnly
account$=rs$
CLOSE 1
ff=0
OPEN path$+account$ FOR INPUT AS #1
IF ff=1 THEN
PRINT "New Account [Y/N]:";
na$=""
WHILE na$=""
na$=INKEY$
SLEEP
WEND
IF UCASE$(na$)="Y" THEN
bal=0
can=1
CLOSE 1
ELSE
can=0
END IF
ELSE
CLOSE 1
GOSUB ReadFile
can=1
END IF
WEND
RETURN
2 :
ChBal:
CLS
PRINT :INPUT "New Balance:";bal$
gs$=bal$
GOSUB NumOnly
bal=FNround(VAL(rs$))
RETURN
3 :
Dep:
tran$="Deposit"
GOSUB DisplayScreen:
bal=bal+amnt(c)
type$(c)="Deposit"
c=c+1
RETURN
4 :
With:
tran$="Withdrawl"
GOSUB DisplayScreen:
bal=bal-amnt(c)
type$(c)="Withdrawl"
c=c+1
RETURN
5 :
Display:
CLS
PRINT t1$
PRINT t2$
FOR i=1 TO c-1
PRINT USING fs$;type$(i),dt$(i),num(i),amnt(i),des$(i)
IF i/18 = INT(i/18) THEN
PRINT
PRINT "Press any key for next page...":ak$=""
WHILE ak$=""
ak$=INKEY$
SLEEP
WEND
CLS
PRINT t1$
PRINT t2$
END IF
NEXT
PRINT
PRINT "Press any key to continue...":ak$=""
WHILE ak$=""
ak$=INKEY$
SLEEP
WEND
RETURN
6 :
PrintOut:
CLS
PRINT
COLOR 5
PRINT "Align paper and press any key..."
ak$=""
WHILE ak$=""
ak$=INKEY$
SLEEP
WEND
PRINT
COLOR 3
PRINT "Please Wait..."
COLOR 1
LPRINT SPACE$(15)"* CheckMate v2.0 (c)1989 Sam Reynolds, Control Point Services *"
LPRINT ach$
LPRINT USING tf$;account$,DATE$,bal
LPRINT
LPRINT t1$
LPRINT t2$
FOR i=1 TO c-1
LPRINT USING fs$;type$(i),dt$(i),num(i),amnt(i),des$(i)
IF i/55 = INT(i/55) THEN
LPRINT CHR$(12);
LPRINT SPACE$(15)"* CheckMate v2.0 (c)1989 Sam Reynolds, Control Point Services *"
LPRINT ach$
LPRINT USING tf$;account$,DATE$,bal
LPRINT
LPRINT t1$
LPRINT t2$
END IF
NEXT
LPRINT CHR$(12);
RETURN
7 :
EditIt:
CLS
INPUT "Amount";amnt$
gs$=amnt$
GOSUB NumOnly
ckamt=FNround(VAL(rs$))
INPUT "Number";num$
gs$=num$
GOSUB NumOnly
num=VAL(rs$)
n=1:cts=1
WHILE cts=1
tff=0
FOR i=n TO c-1
IF ckamt=amnt(i) THEN
IF num(i)=num THEN tff=1:n=i:i=c-1
END IF
NEXT
IF tff=1 THEN
PRINT :PRINT :PRINT
PRINT t1$
PRINT t2$
PRINT USING fs$;type$(n),dt$(n),num(n),amnt(n),des$(n)
PRINT
PRINT
PRINT "Correct [Y/N]:_";:ak$=""
WHILE ak$=""
ak$=INKEY$
SLEEP
WEND
PRINT ak$
IF UCASE$(ak$)="Y" THEN
cts=0
PRINT "Delete or Change it [D/C]:_";:ak$=""
WHILE ak$=""
ak$=INKEY$
SLEEP
WEND
PRINT ak$
IF UCASE$(ak$)="D" THEN
IF LEFT$(type$(n),1)="W" THEN
bal=bal+amnt(n)
ELSE
bal=bal-amnt(n)
END IF
FOR i=n TO c-2
type$(i)=type$(i+1)
num(i)=num(i+1)
dt$(i)=dt$(i+1)
amnt(i)=amnt(i+1)
des$(i)=des$(i+1)
NEXT
c=c-1:ff=0
ELSE
cc=c
c=n
IF LEFT$(type$(n),1)="W" THEN
bal=bal+amnt(n)
GOSUB With
ELSE
bal=bal-amnt(n)
GOSUB Dep
END IF
c=cc:ff=0
END IF
ELSE
n=n+1
END IF
ELSE
cts=0
PRINT
PRINT "Not found..."
PRINT
PRINT "Press any key to continue..."
ak$=""
WHILE ak$=""
ak$=INKEY$
SLEEP
WEND
END IF
WEND
RETURN
8 :
Balance:
CLS
PRINT
LINE INPUT "Please enter your ending balance from your bank statement:";ebal$
gs$=ebal$
GOSUB NumOnly
ebal=FNround(VAL(rs$))
IF bal=ebal THEN
PRINT
COLOR 5
PRINT"Congrats!!!!!!!"
PRINT
COLOR 3
PRINT"You Balance!!!!"
PRINT
COLOR 1
PRINT "Press any key to continue..."
ak$=""
WHILE ak$=""
ak$=INKEY$
SLEEP
WEND
PRINT "Please Wait..."
OPEN path$+account$ FOR OUTPUT AS #1
PRINT#1,bal
CLOSE 1
'********** To Check History Start **********
OPEN path$+account$+".HST" FOR APPEND AS #1
FOR i=1 TO c
PRINT#1,type$(i)
PRINT#1,num(i)
PRINT#1,dt$(i)
PRINT#1,amnt(i)
PRINT#1,des$(i)
NEXT i
CLOSE 1
'********** To Check History End **********
c=1
ELSE
OPEN path$+account$+".HST" FOR APPEND AS #1
i=1
WHILE i<>c
CLS
COLOR 1
PRINT t1$
PRINT t2$
COLOR 2
PRINT USING fs$;type$(i),dt$(i),num(i),amnt(i),des$(i)
PRINT
PRINT
COLOR 5
PRINT "Is this on your statement [Y/N]:";
COLOR 7
os$=""
WHILE os$=""
os$=INKEY$
SLEEP
WEND
PRINT os$:PRINT
IF UCASE$(os$)="Y" THEN
'********** To Check History Start **********
PRINT#1,type$(i)
PRINT#1,num(i)
PRINT#1,dt$(i)
PRINT#1,amnt(i)
PRINT#1,des$(i)
FOR j=i TO c-2
type$(j)=type$(j+1)
num(j)=num(j+1)
dt$(j)=dt$(j+1)
amnt(j)=amnt(j+1)
des$(j)=des$(j+1)
NEXT
c=c-1
'********** To Check History End **********
ELSE
IF LEFT$(type$(i),1)="W" THEN
ebal=ebal-amnt(i)
ELSE
ebal=ebal+amnt(i)
END IF
IF UCASE$(os$)<>"Y" THEN i=i+1
END IF
WEND
CLOSE 1
IF bal=ebal THEN
PRINT
COLOR 5
PRINT"Congrats!!!!!!!"
PRINT
COLOR 3
PRINT"You Balance!!!!"
PRINT
COLOR 1
PRINT "Press any key to continue..."
ak$=""
WHILE ak$=""
ak$=INKEY$
SLEEP
WEND
ELSE
PRINT
COLOR 3
PRINT"Sorry..."
PRINT
COLOR 5
PRINT "You dont balance..."
PRINT
COLOR 1
PRINT "If there are transactions on your statement that were not
PRINT "listed above enter (OR correct) them AND try again..."
PRINT
COLOR 7
PRINT "Press any key to continue..."
ak$=""
WHILE ak$=""
ak$=INKEY$
SLEEP
WEND
END IF
PRINT "Please Wait..."
GOSUB WriteFile
END IF
RETURN
10
ChkHist:
GOSUB WriteFile
CLS
PRINT
COLOR 3
PRINT "Please Wait..."
COLOR 1
OPEN path$+account$+".HST" FOR INPUT AS #1
c=1
WHILE NOT EOF(1)
LINE INPUT#1,type$(c)
INPUT#1,num(c)
LINE INPUT#1,dt$(c)
INPUT#1,amnt
amnt(c)=FNround(amnt)
LINE INPUT#1,des$(c)
c=c+1
WEND
CLOSE 1
ach$=SPACE$(29)+"*** A c c o u n t H i s t o r y ***"
GOSUB PrintOut
ach$=""
GOSUB ReadFile
RETURN
Ender:
CLS
GOSUB WriteFile
QuickEnd:
WINDOW CLOSE 2
SCREEN CLOSE 1
WINDOW 1
ON MENU GOSUB 0
ON BREAK GOSUB 0
MENU RESET
END
'--------------------------------------------------------
'----- Subroutines Past Here! -----
'--------------------------------------------------------
NumOnly:
rs$=""
FOR i=1 TO LEN(gs$)
ch$=MID$(gs$,i,1):ch=ASC(ch$)
IF ch=>48 AND ch<=57 OR ch=46 THEN rs$=rs$+ch$
NEXT
RETURN
ErrorFix:
IF ERR=53 AND ERL=1 THEN
ff=1
RESUME NEXT
END IF
IF ERL=9 THEN
pnff=1
RESUME NEXT
END IF
PRINT "ERROR #:"ERR"
PRINT :PRINT "Press any key..."
ak$=""
WHILE ak$=""
ak$=INKEY$
SLEEP
WEND
GOTO QuickEnd
ReadFile:
PRINT :PRINT :PRINT "Please Wait..."
OPEN path$+account$ FOR INPUT AS #1
c=1
INPUT#1,bal
WHILE NOT EOF(1)
LINE INPUT#1,type$(c)
INPUT#1,num(c)
LINE INPUT#1,dt$(c)
INPUT#1,amnt
amnt(c)=FNround(amnt)
LINE INPUT#1,des$(c)
c=c+1
WEND
CLOSE 1
RETURN
WriteFile:
IF account$<>"" THEN
GOSUB SortFile
PRINT:PRINT:PRINT" Writing File..."
OPEN path$+account$ FOR OUTPUT AS #1
PRINT#1,FNround(bal)
IF c>1 THEN
FOR i=1 TO c-1
PRINT#1,type$(i)
PRINT#1,num(i)
PRINT#1,dt$(i)
PRINT#1,FNround(amnt(i))
PRINT#1,des$(i)
NEXT
END IF
CLOSE 1
END IF
RETURN
SortFile:
PRINT :PRINT :PRINT " Please Wait... Sorting..."
FOR i=1 TO c-1
FOR j=1 TO i
IF num(j) > num(i) THEN
SWAP type$(i),type$(j)
SWAP num(i),num(j)
SWAP dt$(i),dt$(j)
SWAP amnt(i),amnt(j)
SWAP des$(i),des$(j)
END IF
NEXT j
NEXT i
FOR i=1 TO c-1
FOR j=1 TO i
IF num(i) = num(j) THEN
IF dt$(j) > dt$(i) THEN
SWAP type$(i),type$(j)
SWAP num(i),num(j)
SWAP dt$(i),dt$(j)
SWAP amnt(i),amnt(j)
SWAP des$(i),des$(j)
END IF
END IF
NEXT j
NEXT i
FOR i=1 TO c-1
FOR j=1 TO i
IF num(i) = num(j) THEN
IF dt$(i) = dt$(j) THEN
IF amnt(j)>amnt(i) THEN
SWAP type$(i),type$(j)
SWAP num(i),num(j)
SWAP dt$(i),dt$(j)
SWAP amnt(i),amnt(j)
SWAP des$(i),des$(j)
END IF
END IF
END IF
NEXT j
NEXT i
RETURN
FindDate:
'************************************
'* Find Days Since Start of Century *
'* Given X$=DATE, Return X=DAYS *
'************************************
GOSUB SetDays
IF LEN(x$)<1 THEN GOTO ExitError
FOR X1=1 TO LEN(x$):'REPLACE SPACES WITH /'s
IF MID$(x$,X1,1)=" " THEN MID$(x$,X1,1)="/"
IF MID$(x$,X1,1)="." THEN MID$(x$,X1,1)="/"
IF MID$(x$,X1,1)="-" THEN MID$(x$,X1,1)="/"
NEXT X1
'------------------Get Month
GOSUB GetMDY
X1=x
IF X1>12 THEN GOTO ExitError
'------------------Get Day
GOSUB GetMDY
IF x<1 OR x>X9(X1) THEN GOTO ExitError: 'DAY ERR
X2=x
'------------------Get Year
GOSUB GetMDY
x=x*365.25
IF (x-INT(x))<>0 AND X1<3 THEN x=x+1
x=INT(x)-1+X2
FOR X2=0 TO (X1-1)
x=x+X9(X2)
NEXT X2
FindGreg:
'***************************************************
'* Find Greg Date Corresponding to Days in Century *
'* Given X=Days, Return X$=DATE, X1=YYMMDD *
'***************************************************
GOSUB SetDays: 'BUILD DATE TABLE
'----------------------------- Determine Year
X1=INT(100*x/36525&)
X1=INT(X1*1000+.5)/1000
'----------------------------- Determine Days in Year
X2=x-INT(X1*365.25)
IF ((X1/4)-INT(X1/4))=0 OR X2>59 THEN X2=X2+1
'----------------------------- Determine Month
FOR X3=1 TO 12
IF X9(X3)>=X2 THEN xx=X3:X3=12:GOTO Finish
X2=X2-X9(X3)
Finish:
NEXT X3
X3=xx
x$=RIGHT$(STR$(X3),2)+"/"
x$=x$+RIGHT$(STR$(X2),2)+"/"
x$=x$+RIGHT$(STR$(X1),2)
FOR i=1 TO LEN(x$)
IF MID$(x$,i,1)=" " THEN
MID$(x$,i,1)="0"
END IF
NEXT i
X1=10000*X1+100*X3+X2
D9$="SUNDAY MONDAY TUESDAY WEDNESDAYTHURSDAY FRIDAY SATURDAY "
D9=(x/7)-INT(x/7)
D9$=MID$(D9$,INT(D9*7+.5)*9+1,9)
RETURN
'====================================================================
GetMDY:
FLAG=1
WHILE FLAG=1
x=0:Y=Y+1
IF Y<=LEN(x$) THEN
xx=ASC(MID$(x$,Y,1))
IF xx=>48 AND xx<=57 THEN
x=VAL(CHR$(xx))
Y=Y+1
FLAG=0
END IF
ELSE
FLAG=0
END IF
WEND
IF Y<=LEN(x$) THEN
xx=ASC(MID$(x$,Y,1))
IF xx=>48 AND xx<=57 THEN
x=VAL(CHR$(xx))+10*x
END IF
END IF
RETURN
SetDays:
'DIM X9(12)
Y=0:X9(1)=31:X9(2)=29:X9(3)=31:X9(4)=30:X9(5)=31:X9(6)=30:X9(7)=31:X9(8)=31:X9(9)=30:X9(10)=31:X9(11)=30:X9(12)=31
RETURN
ExitError:
x=-1
RETURN
DisplayScreen:
ok$="N"
WHILE UCASE$(ok$)="N"
CLS
COLOR 4
PRINT "=======> ";
COLOR 2
PRINT tran$;
COLOR 4
PRINT " <======="
PRINT
PRINT
LOCATE 4,1
LINE INPUT "Amount: ";amnt$
gs$=amnt$
GOSUB NumOnly
amnt(c)=FNround(VAL(rs$))
LINE INPUT "Number: ";num$
gs$=num$
GOSUB NumOnly
num(c)=VAL(rs$)
des$(c)=STRING$(40,"*")
WHILE LEN(des$(c))>35
LINE INPUT "Description (35 CHARS MAX): ";des$(c)
WEND
dt$(c)=LEFT$(DATE$,6)+RIGHT$(DATE$,2)
x=-1
WHILE x=-1
LOCATE 7,1
LINE INPUT "Date: ";x$
IF x$="" THEN x$=dt$(c)
GOSUB FindDate
WEND
dt$(c)=x$
LOCATE 7,7:PRINT dt$(c)
LOCATE 12,1
PRINT"Okay [Y/N]:_";
ok$=""
WHILE ok$=""
ok$=INKEY$
SLEEP
WEND
WEND
RETURN
MenuCheck:
dummy=MENU(0)
ON MENU(1) GOSUB SetPath,About
RETURN
9 :
SetPath:
pnff=1
CLS
WHILE pnff<>0
pnff=0
WINDOW OUTPUT 2
COLOR 4
PRINT
PRINT "Please enter the DRIVE:Path where Account info will be stored:"
WINDOW OUTPUT 2
COLOR 3
LINE INPUT path$
ck$=RIGHT$(path$,1)
IF ck$<>"/" AND ck$<>":" THEN path$=path$+"/"
OPEN path$+"!" FOR OUTPUT AS #5
CLOSE 5
IF pnff<>0 THEN
WINDOW OUTPUT 2
COLOR 2
PRINT "Invalid Drive/Path... Try Again..."
PRINT
ELSE
KILL path$+"!"
OPEN "S:CB.Config" FOR OUTPUT AS #3
PRINT#3,path$
CLOSE 3
END IF
WEND
sp=1
RETURN
About:
WINDOW 3,"",(39,20)-(598,160),18,1
WINDOW OUTPUT 3
COLOR 5
PRINT SPC(28)"CheckMate v2.0"
COLOR 4
PRINT SPC(21)"©1990 Control Point Services"
PRINT
COLOR 1
PRINT SPC(21)"This Program is ";
COLOR 3
PRINT "SHAREWARE";
COLOR 1
PRINT "..."
PRINT SPC(16)"If you like it, use it, don't like it,"
PRINT PTAB(156)"or just have a comment, write to:"
PRINT
COLOR 2
PRINT SPC(29)"Sam Reynolds"
PRINT SPC(24)"Control Point Services"
PRINT SPC(27)"1651 Bradford NE"
PRINT SPC(23)"Grand Rapids, MI 49503"
PRINT
COLOR 1
PRINT PTAB(52)"(Send $10 to the above address to become a ";
COLOR 3
PRINT "registered";
COLOR 1
PRINT " user."
PRINT SPC(9)"Registered users recieve upgrade notices and notices"
PRINT SPC(17)"of new programs when they come out!)"
PRINT
PRINT PTAB(212)"[CLICK TO CONTINUE]";
dummy=MOUSE(0)
WHILE MOUSE(0)=0
SLEEP
WEND
WINDOW OUTPUT 2
WINDOW CLOSE 3
RETURN