home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Shareware Overload
/
ShartewareOverload.cdr
/
progm
/
franz.zip
/
DEMO.BAS
< prev
next >
Wrap
BASIC Source File
|
1989-11-24
|
7KB
|
275 lines
Rectype Artrec
Recvar Artnumber$ 16
Recvar Name1$ 30, Name2$ 30
Recvar Supplier$ 20
Recvar Price 8:2
Recvar Stock%
Endrec
Rectype Inrec
Recvar Artnumber$ 16
Recvar Name$ 30
Recvar Increment%
Endrec
Rectype Customer
Recvar Cusnr$ 4
Recvar Fname$ 20, Name$ 20
Recvar Street$ 20, City$ 20
Recvar Discount%
Endrec
Dim HMenu$(5)
Dim anz$(20), arti$(20), Price(20)
Record Artrec Artrecord
Record Inrec Inrecord
Record Customer Cusrec, Cusinit
Subroutine Info(s$)
Colour 7,0
Blank$ = " "
Locate 1,25 : Print Blank$;Blank$;
Locate 40-len%(s$)/2,25
Colour 7,1 : Print s$;
Colour 7,0
Locate 1,1
Endsub
Subroutine Mainmenu%
HMenu$(1) = " Accounts Stock Customers "
HMenu$(2) = " Make and Print Account "
HMenu$(3) = " Maintain Articles "
HMenu$(4) = " Maintain Customers "
HMenu$(5) = ""
Colour 7,0 : cls 176
Menu HMenu$,22,3 'show menu
cls
Return lastkey%() 'and return users choice
Endsub
Subroutine Sum()
Local i%, G
G = 0.0
For i% = 1 To 20
G = G + Price(i%)
Endfor
Return G
Endsub
Subroutine Replace(var z$, alt$, neu$)
Local i%, G
i% = Instr%(z$,alt$)
if i% Then
Delete$ z$,i%,len%(alt$)
Insert$ z$,i%,neu$
Endif
Endsub
Subroutine PrintAcc
Local i%
Line Input #1,Line$
While Left$(Line$,1) <> "#"
Gosub Replace(Line$,"&Date&",TimeDate$(3))
Gosub Replace(Line$,"&Name&",Cusrec.Name$)
Gosub Replace(Line$,"&Fname&",Cusrec.Fname$)
Gosub Replace(Line$,"&Street&",Cusrec.Street$)
Gosub Replace(Line$,"&City&",Cusrec.City$)
LPrint Line$
Line Input #1,Line$
Wend
For i% = 1 To 20
If anz$(i%) = "" Then Break
Dbget #1,arti$(i%),Artrecord
LPrint anz$(i%);" ";arti$(i%),Artrecord.Name1$;
LPrint Using " ##,###.##";Artrecord.Price;Price(i%)
Endfor
G = Sum()
LPrint
LPrint "Sum ";Using "##,###.##";G
LPrint "Discount ";Cusrec.Discount%;"%"
G = G * (100-Cusrec.Discount%) / 100
LPrint "To Pay ";Using"##,###.##";G
Line Input #1,Line$
While Left$(Line$,1) <> "#"
LPrint Line$
Line Input #1,Line$
Wend
LPrint Chr$(12)
Endsub
Subroutine Account()
Local i%, y%, ext$, file$
i% = 1 : y% = 1
Gosub Info("Choose Form")
ext$ = "txt" : file$="fakt"
Files "",ext$,file$
If lastkey%() = 27 Then Return 0.0
Open "I",#1,file$+"."+ext$
Dbopen #2, "Customer"
A:
while 1
Gosub Info("? Survey")
Dialog "Custumer# ",Cunr$,4
If lastkey%() = 27 Then Goto End
If Left$(kunr$,1) <> "?" Then Break
Gosub Info("ESC=End PgUp PgDn")
Dbbrowse #2,"","4,16,16,16"
wend
Dbget #2,Cunr$,Cusrec
If error%() Then
Gosub Info(" Unknown Customer# [Key]") : Input taste%
Goto a
Endif
Colour 3,0
Print "CUSTOMER: ";Cusrec.Cusnr$;" ";Cusrec.Fname$;" ";Cusrec.Name$
Print : Print "Quty Article";
Locate 25,3 : Print "Description a$ Price"
Colour 7,0
Gosub Info("ESC=End TAB")
Dbopen #1, "article"
While 1
If i% = 1 Then
Dialog "",anz$(y%),3,1,y%+3
Locate 1,y%+3 : Print anz$(y%)
Else
Dialog "",arti$(y%),16,5,y%+3
Locate 5,y%+3 : Print arti$(y%)
Dbget #1,arti$(y%),Artrecord
If error%() = 0 Then
Price(y%) = Artrecord.Price * Val%(anz$(y%))
Locate 25,y%+3
Print Artrecord.Name1$;
Print Using " ##,###.##";Artrecord.Price;Price(y%)
Else
Price(y%) = 0.0
Endif
Endif
c% = lastkey%()
If c% = 27 Then Break
If c% = 13 Then
If i% = 2 Then y% = y%+1
i% = 3-i%
Elseif c% = 200 Then
y% = y%-1
Elseif c% = 208 Then
y% = y%+1
Elseif c% = 9 Then
i% = 3-i%
Endif
If i% < 1 Then i% = 1
If i% > 2 Then i% = 2
If y% < 1 Then y% = 1
If y% > 20 Then y% = 20
Wend
Gosub PrintAcc()
Goto A
End:
Close #1
Dbclose #1
Dbclose #2
Endsub
Subroutine Increment()
s$ = "Stock-Increment;(Articelnumber);(Articelname);Increment;"
Dbopen #1,"articel"
art$ = " "
while 1
Dialog "Articelnumber: ",art$,16,24,2
If (lastkey%()) = 27 Or (art$ = "") Then Break
Dbget #1,Art$,Artrecord
If error%() <> 0 Then
Message "Unknown Article#| OK"
Else
Inrecord.artnumber$ = Artrecord.artnumber$
Inrecord.Name$ = Artrecord.Name1$
Inrecord.Increment% = 0
Form Inrecord, s$
Artrecord.Stock% = Artrecord.Stock% + Inrecord.Increment%
Dbput #1, Artrecord
Endif
Wend
Dbclose #1
Endsub
Subroutine ArticleData()
s$ = "Article-Data;(Articelnumber) ;Name;;Supplier;Price;Stock;"
Dbopen #1,"article"
Repeat
Locate 34,5 : Print "(+ - ESC)"
Dialog "Articelnumber: ",art$,16,24,2
If lastkey%() = 27 Then Break
Dbget #1,Art$,Artrecord
Form Artrecord, s$
Dbput #1,Artrecord
Until art$ = ""
Dbclose #1
Endsub
Subroutine Article
HMenu$(1) = " Article-Data Increment "
HMenu$(2) = ""
cls 176
Menu HMenu$,20,3
cls 176
if lastkey%() = 1 Then Gosub ArticleData()
if lastkey%() = 2 Then Gosub Increment()
Endsub
Subroutine Customer()
s$ = "Customer-Data;(Customer#) ;Name;;Street;City;Discount %;"
Dbopen #1,"Customer"
Repeat
Locate 30,5 : Print "(+ - nn* nn? ESC)"
While 1
Dialog "Customer#: ",key$,4,30,2
If lastkey%() = 27 Then Goto End
If Right$(key$,1) <> "?" Then Break
Locate 35,2
Print "Customers"
Dbbrowse #1,Left$(key$,len%(key$)-1),"4,16,16,16"
Cls
Wend
Dbget #1,key$,Cusrec
err% = error%()
If Right$(key$,1) = "*" Then err% = 0
If err% = 0 Then
Form Cusrec, s$
Dbput #1,Cusrec
Else
Cusrec = NIL
Cusrec.Cusnr$ = key$
Form Cusrec, s$
mess$ = "Create New Record?| Yes No"
Message Mess$
If lastkey%() = 1 Then Dbput #1,Cusrec
Endif
Until key$ = ""
End:
Dbclose #1
Endsub
' *** Mainprogramm ***
Start:
Choice% = Mainmenu%() 'Subroutine as Funktion
'Returns Users Choice
If Choice% = 0 Then
colour 7,0 : cls : Stop
Elseif Choice% = 1 Then
Gosub Account()
Elseif Choice% = 2 Then
Gosub Article()
Elseif Choice% = 3 Then
Gosub Customer()
Endif
Goto Start