home *** CD-ROM | disk | FTP | other *** search
/ Shareware Overload / ShartewareOverload.cdr / progm / franz.zip / DEMO.BAS < prev    next >
BASIC Source File  |  1989-11-24  |  7KB  |  275 lines
  1.  
  2. Rectype Artrec
  3.   Recvar Artnumber$ 16
  4.   Recvar Name1$ 30, Name2$ 30
  5.   Recvar Supplier$ 20
  6.   Recvar Price 8:2
  7.   Recvar Stock%
  8. Endrec
  9.  
  10. Rectype Inrec
  11.   Recvar Artnumber$ 16
  12.   Recvar Name$ 30
  13.   Recvar Increment%
  14. Endrec
  15.  
  16. Rectype Customer
  17.   Recvar Cusnr$ 4
  18.   Recvar Fname$ 20, Name$ 20
  19.   Recvar Street$ 20, City$ 20
  20.   Recvar Discount%
  21. Endrec
  22.  
  23. Dim HMenu$(5)
  24. Dim anz$(20), arti$(20), Price(20)
  25. Record Artrec Artrecord
  26. Record Inrec Inrecord
  27. Record Customer Cusrec, Cusinit
  28.  
  29. Subroutine Info(s$)
  30.   Colour 7,0
  31.   Blank$ = "                                        "
  32.   Locate 1,25 : Print Blank$;Blank$;
  33.   Locate 40-len%(s$)/2,25
  34.   Colour 7,1 : Print s$;
  35.   Colour 7,0
  36.   Locate 1,1
  37. Endsub
  38.  
  39. Subroutine Mainmenu%
  40.   HMenu$(1) = " Accounts   Stock    Customers "
  41.   HMenu$(2) = " Make and Print Account "
  42.   HMenu$(3) = " Maintain Articles "
  43.   HMenu$(4) = " Maintain Customers "
  44.   HMenu$(5) = ""
  45.   Colour 7,0 : cls 176
  46.   Menu HMenu$,22,3        'show menu
  47.   cls
  48.   Return lastkey%()       'and return users choice
  49. Endsub
  50.  
  51. Subroutine Sum()
  52.   Local i%, G
  53.   G = 0.0
  54.   For i% = 1 To 20
  55.     G = G + Price(i%)
  56.   Endfor
  57.   Return G
  58. Endsub
  59.  
  60. Subroutine Replace(var z$, alt$, neu$)
  61.    Local i%, G
  62.    i% = Instr%(z$,alt$)
  63.    if i% Then
  64.       Delete$ z$,i%,len%(alt$)
  65.       Insert$ z$,i%,neu$
  66.    Endif
  67. Endsub
  68.  
  69. Subroutine PrintAcc
  70.   Local i%
  71.   Line Input #1,Line$
  72.   While Left$(Line$,1) <> "#"
  73.     Gosub Replace(Line$,"&Date&",TimeDate$(3))
  74.     Gosub Replace(Line$,"&Name&",Cusrec.Name$)
  75.     Gosub Replace(Line$,"&Fname&",Cusrec.Fname$)
  76.     Gosub Replace(Line$,"&Street&",Cusrec.Street$)
  77.     Gosub Replace(Line$,"&City&",Cusrec.City$)
  78.     LPrint Line$
  79.     Line Input #1,Line$
  80.   Wend
  81.  
  82.   For i% = 1 To 20
  83.     If anz$(i%) = "" Then Break
  84.     Dbget #1,arti$(i%),Artrecord
  85.     LPrint anz$(i%);" ";arti$(i%),Artrecord.Name1$;
  86.     LPrint Using " ##,###.##";Artrecord.Price;Price(i%)
  87.   Endfor
  88.   G = Sum()
  89.   LPrint
  90.   LPrint "Sum       ";Using "##,###.##";G
  91.   LPrint "Discount  ";Cusrec.Discount%;"%"
  92.   G = G * (100-Cusrec.Discount%) / 100
  93.   LPrint "To Pay    ";Using"##,###.##";G
  94.  
  95.   Line Input #1,Line$
  96.   While Left$(Line$,1) <> "#"
  97.     LPrint Line$
  98.     Line Input #1,Line$
  99.   Wend
  100.   LPrint Chr$(12)
  101. Endsub
  102.  
  103. Subroutine Account()
  104.   Local i%, y%, ext$, file$
  105.   i% = 1 : y% = 1
  106.   Gosub Info("Choose Form")
  107.   ext$ = "txt" : file$="fakt"
  108.   Files "",ext$,file$
  109.   If lastkey%() = 27 Then Return 0.0
  110.   Open "I",#1,file$+"."+ext$
  111.   Dbopen #2, "Customer"
  112. A:
  113.   while 1
  114.     Gosub Info("? Survey")
  115.     Dialog "Custumer# ",Cunr$,4
  116.     If lastkey%() = 27 Then Goto End
  117.     If Left$(kunr$,1) <> "?" Then Break
  118.     Gosub Info("ESC=End PgUp PgDn")
  119.     Dbbrowse #2,"","4,16,16,16"
  120.   wend
  121.  
  122.   Dbget #2,Cunr$,Cusrec
  123.   If error%() Then
  124.      Gosub Info(" Unknown Customer# [Key]") : Input taste%
  125.      Goto a
  126.   Endif
  127.  
  128.   Colour 3,0
  129.   Print "CUSTOMER: ";Cusrec.Cusnr$;" ";Cusrec.Fname$;" ";Cusrec.Name$
  130.   Print : Print "Quty Article";
  131.   Locate 25,3 : Print "Description                         a$        Price"
  132.   Colour 7,0
  133.  
  134.   Gosub Info("ESC=End TAB")
  135.   Dbopen #1, "article"
  136.  
  137.   While 1
  138.     If i% = 1 Then
  139.       Dialog "",anz$(y%),3,1,y%+3
  140.       Locate 1,y%+3 : Print anz$(y%)
  141.     Else
  142.       Dialog "",arti$(y%),16,5,y%+3
  143.       Locate 5,y%+3 : Print arti$(y%)
  144.       Dbget #1,arti$(y%),Artrecord
  145.       If error%() = 0 Then
  146.          Price(y%) = Artrecord.Price * Val%(anz$(y%))
  147.          Locate 25,y%+3
  148.          Print Artrecord.Name1$;
  149.          Print Using " ##,###.##";Artrecord.Price;Price(y%)
  150.       Else
  151.          Price(y%) = 0.0
  152.       Endif
  153.     Endif
  154.     c% = lastkey%()
  155.     If c% = 27 Then Break
  156.  
  157.     If c% = 13 Then
  158.       If i% = 2 Then y% = y%+1
  159.       i% = 3-i%
  160.     Elseif c% = 200 Then
  161.       y% = y%-1
  162.     Elseif c% = 208 Then
  163.       y% = y%+1
  164.     Elseif c% = 9 Then
  165.       i% = 3-i%
  166.     Endif
  167.  
  168.     If i% < 1 Then i% = 1
  169.     If i% > 2 Then i% = 2
  170.     If y% < 1 Then y% = 1
  171.     If y% > 20 Then y% = 20
  172.   Wend
  173.   Gosub PrintAcc()
  174.   Goto A
  175. End:
  176.   Close #1
  177.   Dbclose #1
  178.   Dbclose #2
  179. Endsub
  180.  
  181. Subroutine Increment()
  182.   s$ = "Stock-Increment;(Articelnumber);(Articelname);Increment;"
  183.   Dbopen #1,"articel"
  184.   art$ = " "
  185.   while 1
  186.     Dialog "Articelnumber: ",art$,16,24,2
  187.     If (lastkey%()) = 27 Or (art$ = "") Then Break
  188.     Dbget #1,Art$,Artrecord
  189.     If error%() <> 0 Then
  190.        Message "Unknown Article#|       OK"
  191.     Else
  192.        Inrecord.artnumber$ = Artrecord.artnumber$
  193.        Inrecord.Name$ = Artrecord.Name1$
  194.        Inrecord.Increment% = 0
  195.        Form Inrecord, s$
  196.        Artrecord.Stock% = Artrecord.Stock% + Inrecord.Increment%
  197.        Dbput #1, Artrecord
  198.     Endif
  199.   Wend
  200.   Dbclose #1
  201. Endsub
  202.  
  203. Subroutine ArticleData()
  204.   s$ = "Article-Data;(Articelnumber) ;Name;;Supplier;Price;Stock;"
  205.   Dbopen #1,"article"
  206.   Repeat
  207.     Locate 34,5 : Print "(+  -  ESC)"
  208.     Dialog "Articelnumber: ",art$,16,24,2
  209.     If lastkey%() = 27 Then Break
  210.     Dbget #1,Art$,Artrecord
  211.     Form Artrecord, s$
  212.     Dbput #1,Artrecord
  213.   Until art$ = ""
  214.   Dbclose #1
  215. Endsub
  216.  
  217. Subroutine Article
  218.   HMenu$(1) = " Article-Data  Increment "
  219.   HMenu$(2) = ""
  220.   cls 176
  221.   Menu HMenu$,20,3
  222.   cls 176
  223.   if lastkey%() = 1 Then Gosub ArticleData()
  224.   if lastkey%() = 2 Then Gosub Increment()
  225. Endsub
  226.  
  227. Subroutine Customer()
  228.   s$ = "Customer-Data;(Customer#) ;Name;;Street;City;Discount %;"
  229.   Dbopen #1,"Customer"
  230.   Repeat
  231.     Locate 30,5 : Print "(+ - nn* nn? ESC)"
  232.     While 1
  233.        Dialog "Customer#: ",key$,4,30,2
  234.        If lastkey%() = 27 Then Goto End
  235.        If Right$(key$,1) <> "?" Then Break
  236.        Locate 35,2
  237.        Print "Customers"
  238.        Dbbrowse #1,Left$(key$,len%(key$)-1),"4,16,16,16"
  239.        Cls
  240.     Wend
  241.     Dbget #1,key$,Cusrec
  242.     err% = error%()
  243.     If Right$(key$,1) = "*" Then err% = 0
  244.     If err% = 0 Then
  245.        Form Cusrec, s$
  246.        Dbput #1,Cusrec
  247.     Else
  248.       Cusrec = NIL
  249.       Cusrec.Cusnr$ = key$
  250.       Form Cusrec, s$
  251.       mess$ = "Create New Record?|   Yes    No"
  252.       Message Mess$
  253.       If lastkey%() = 1 Then Dbput #1,Cusrec
  254.     Endif
  255.   Until key$ = ""
  256. End:
  257.   Dbclose #1
  258. Endsub
  259.  
  260. ' *** Mainprogramm ***
  261. Start:
  262. Choice% = Mainmenu%()    'Subroutine as Funktion
  263.                          'Returns Users Choice
  264.  
  265. If Choice% = 0 Then
  266.    colour 7,0 : cls : Stop
  267. Elseif Choice% = 1 Then
  268.    Gosub Account()
  269. Elseif Choice% = 2 Then
  270.    Gosub Article()
  271. Elseif Choice% = 3 Then
  272.    Gosub Customer()
  273. Endif
  274. Goto Start
  275.