home *** CD-ROM | disk | FTP | other *** search
/ T.C. 1,001 Programme der Spitzenklasse / T._C._1001_Programme_der_Spitzenklasse.iso / richter / 8607 / 8607.mhs / RICHTER.DTP / FBASIC / DEMO.BAS < prev    next >
BASIC Source File  |  1989-11-19  |  7KB  |  274 lines
  1.  
  2. Rectype Artrec
  3.   Recvar Artnummer$ 16
  4.   Recvar Bez1$ 30, Bez2$ 30
  5.   Recvar Lieferant$ 20
  6.   Recvar Preis 8:2
  7.   Recvar Bestand%
  8. Endrec
  9.  
  10. Rectype WEinrec
  11.   Recvar Artnummer$ 16
  12.   Recvar Bez$ 30
  13.   Recvar Zugang%
  14. Endrec
  15.  
  16. Rectype Kunden
  17.   Recvar Kundennr$ 4
  18.   Recvar Vorname$ 20, Name$ 20
  19.   Recvar Strasse$ 20, Ort$ 20
  20.   Recvar Rabatt%
  21. Endrec
  22.  
  23. Dim HMenu$(5)
  24. Dim anz$(20), arti$(20), Epreis(20)
  25. Record Artrec Artikelsatz
  26. Record WEinrec WEsatz
  27. Record Kunden Kusatz, kuinit
  28.  
  29. Subroutine Info(s$)
  30.   Colour 7,0
  31.   Leer$ = "                                        "
  32.   Locate 1,25 : Print Leer$;Leer$;
  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 Hauptmenu%
  40.   HMenu$(1) = " Fakturieren  Lagerverwaltung  Kundenverwaltung "
  41.   HMenu$(2) = " Rechnungen erstellen "
  42.   HMenu$(3) = " Artikelstamm, Wareneingang, Warenausgang "
  43.   HMenu$(4) = " Kundendaten bearbeiten"
  44.   HMenu$(5) = ""
  45.   Colour 7,0 : cls 176
  46.   Menu HMenu$,15,3        'Menu anzeigen
  47.   cls
  48.   Return lastkey%()       'und gedrueckte Taste zurueckgeben
  49. Endsub
  50.  
  51. Subroutine Gesamtpreis()
  52.   Local i%, G
  53.   G = 0.0
  54.   For i% = 1 To 20
  55.     G = G + Epreis(i%)
  56.   Endfor
  57.   Return G
  58. Endsub
  59.  
  60. Subroutine Ersetze(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 Faktdrucken
  70.   Local i%
  71.   Line Input #1,Zeile$
  72.   While Left$(zeile$,1) <> "#"
  73.     Gosub Ersetze(Zeile$,"&Date&",TimeDate$(3))
  74.     Gosub Ersetze(Zeile$,"&Name&",Kusatz.name$)
  75.     Gosub Ersetze(Zeile$,"&Vorname&",Kusatz.vorname$)
  76.     Gosub Ersetze(Zeile$,"&Strasse&",Kusatz.strasse$)
  77.     Gosub Ersetze(Zeile$,"&Ort&",Kusatz.ort$)
  78.     LPrint Zeile$
  79.     Line Input #1,Zeile$
  80.   Wend
  81.  
  82.   For i% = 1 To 20
  83.     If anz$(i%) = "" Then Break
  84.     Dbget #1,arti$(i%),Artikelsatz
  85.     LPrint anz$(i%);" ";arti$(i%),Artikelsatz.bez1$;
  86.     LPrint Using " ##,###.##";Artikelsatz.Preis;Epreis(i%)
  87.   Endfor
  88.   G = Gesamtpreis()
  89.   LPrint
  90.   LPrint "Gesamtpreis ";Using "##,###.##";G
  91.   LPrint "Ihr Rabatt  ",Kusatz.Rabatt%;"%"
  92.   G = G * (100-Kusatz.Rabatt%) / 100
  93.   LPrint "Zu zahlen   ";Using"##,###.##";G
  94.  
  95.   Line Input #1,Zeile$
  96.   While Left$(zeile$,1) <> "#"
  97.     LPrint Zeile$
  98.     Line Input #1,Zeile$
  99.   Wend
  100.   LPrint Chr$(12)
  101. Endsub
  102.  
  103. Subroutine Fakturierung()
  104.   Local i%, y%, ext$, file$
  105.   i% = 1 : y% = 1
  106.   Gosub Info("Formular auswählen")
  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, "kunden"
  112. A:
  113.   while 1
  114.     Gosub Info("? Übersicht")
  115.     Dialog "Kundennummer ",kunr$,4
  116.     If lastkey%() = 27 Then Goto End
  117.     If Left$(kunr$,1) <> "?" Then Break
  118.     Gosub Info("ESC=Ende PgUp PgDn")
  119.     Dbbrowse #2,"","4,16,16,16"
  120.   wend
  121.  
  122.   Dbget #2,kunr$,kusatz
  123.   If error%() Then
  124.      Gosub Info(" Kunden-Nr. unbekannt [Taste]") : Input taste%
  125.      Goto a
  126.   Endif
  127.  
  128.   Colour 3,0
  129.   Print "KUNDE: ";Kusatz.Kundennr$;" ";Kusatz.vorname$;" ";Kusatz.name$
  130.   Print : Print "Anz. Artikel"
  131.   Colour 7,0
  132.  
  133.   Gosub Info("ESC=Ende TAB")
  134.   Dbopen #1, "artikel"
  135.  
  136.   While 1
  137.     If i% = 1 Then
  138.       Dialog "",anz$(y%),3,1,y%+3
  139.       Locate 1,y%+3 : Print anz$(y%)
  140.     Else
  141.       Dialog "",arti$(y%),16,5,y%+3
  142.       Locate 5,y%+3 : Print arti$(y%)
  143.       Dbget #1,arti$(y%),Artikelsatz
  144.       If error%() = 0 Then
  145.          EPreis(y%) = Artikelsatz.Preis * Val%(anz$(y%))
  146.          Locate 25,y%+3
  147.          Print Artikelsatz.bez1$;
  148.          Print Using " ##,###.##";Artikelsatz.Preis;Epreis(y%)
  149.       Else
  150.          Epreis(y%) = 0.0
  151.       Endif
  152.     Endif
  153.     c% = lastkey%()
  154.     If c% = 27 Then Break
  155.  
  156.     If c% = 13 Then
  157.       If i% = 2 Then y% = y%+1
  158.       i% = 3-i%
  159.     Elseif c% = 200 Then
  160.       y% = y%-1
  161.     Elseif c% = 208 Then
  162.       y% = y%+1
  163.     Elseif c% = 9 Then
  164.       i% = 3-i%
  165.     Endif
  166.  
  167.     If i% < 1 Then i% = 1
  168.     If i% > 2 Then i% = 2
  169.     If y% < 1 Then y% = 1
  170.     If y% > 20 Then y% = 20
  171.   Wend
  172.   Gosub Faktdrucken()
  173.   Goto A
  174. End:
  175.   Close #1
  176.   Dbclose #1
  177.   Dbclose #2
  178. Endsub
  179.  
  180. Subroutine WEin()
  181.   s$ = "Wareneingang;(Artikelnummer);(Bezeichnung);Zugang;"
  182.   Dbopen #1,"artikel"
  183.   art$ = " "
  184.   while 1
  185.     Dialog "Artikelnummer: ",art$,16,24,2
  186.     If (lastkey%()) = 27 Or (art$ = "") Then Break
  187.     Dbget #1,Art$,Artikelsatz
  188.     If error%() <> 0 Then
  189.        Message "Datensatz existiert nicht|          OK"
  190.     Else
  191.        WEsatz.artnummer$ = Artikelsatz.artnummer$
  192.        WEsatz.bez$ = Artikelsatz.bez1$
  193.        WEsatz.zugang% = 0
  194.        Form WEsatz, s$
  195.        Artikelsatz.bestand% = Artikelsatz.bestand% + WEsatz.zugang%
  196.        Dbput #1, Artikelsatz
  197.     Endif
  198.   Wend
  199.   Dbclose #1
  200. Endsub
  201.  
  202. Subroutine Astamm()
  203.   s$ = "Artikelstamm;(Artikelnummer) ;Bezeichnung;;Lieferant;Preis;Bestand;"
  204.   Dbopen #1,"artikel"
  205.   Repeat
  206.     Locate 34,5 : Print "(+  -  ESC)"
  207.     Dialog "Artikelnummer: ",art$,16,24,2
  208.     If lastkey%() = 27 Then Break
  209.     Dbget #1,Art$,Artikelsatz
  210.     Form Artikelsatz, s$
  211.     Dbput #1,Artikelsatz
  212.   Until art$ = ""
  213.   Dbclose #1
  214. Endsub
  215.  
  216. Subroutine Lager
  217.   HMenu$(1) = " Artikelstamm  Wareneingang "
  218.   HMenu$(2) = ""
  219.   cls 176
  220.   Menu HMenu$,20,3        'Menu anzeigen
  221.   cls 176
  222.   if lastkey%() = 1 Then Gosub  Astamm()
  223.   if lastkey%() = 2 Then Gosub  WEin()
  224. Endsub
  225.  
  226. Subroutine Kunden()
  227.   s$ = "Kundenstamm;(Kundennummer) ;Name;;Strasse;Ort;Rabatt %;"
  228.   Dbopen #1,"kunden"
  229.   Repeat
  230.     Locate 30,5 : Print "(+ - nn* nn? ESC)"
  231.     While 1
  232.        Dialog "Kundennr.: ",key$,4,30,2
  233.        If lastkey%() = 27 Then Goto End
  234.        If Right$(key$,1) <> "?" Then Break
  235.        Locate 35,2
  236.        Print "Kundenstamm"
  237.        Dbbrowse #1,Left$(key$,len%(key$)-1),"4,16,16,16"
  238.        Cls
  239.     Wend
  240.     Dbget #1,key$,kusatz
  241.     err% = error%()
  242.     If Right$(key$,1) = "*" Then err% = 0
  243.     If err% = 0 Then
  244.        Form kusatz, s$
  245.        Dbput #1,kusatz
  246.     Else
  247.       Kusatz = NIL
  248.       Kusatz.kundennr$ = key$
  249.       Form kusatz, s$
  250.       mess$ = "Neuen Datensatz anlegen|    Ja    Nein"
  251.       Message Mess$
  252.       If lastkey%() = 1 Then Dbput #1,kusatz
  253.     Endif
  254.   Until key$ = ""
  255. End:
  256.   Dbclose #1
  257. Endsub
  258.  
  259. ' *** Hauptprogramm ***
  260. Anfang:
  261. Auswahl% = Hauptmenu%()    'Subroutine als Funktionsaufruf
  262.                            'gibt ausgew. Menupunkt zurueck
  263.  
  264. If Auswahl% = 0 Then
  265.    colour 7,0 : cls : Stop
  266. Elseif auswahl% = 1 Then
  267.    Gosub Fakturierung()
  268. Elseif auswahl% = 2 Then
  269.    Gosub Lager()
  270. Elseif auswahl% = 3 Then
  271.    Gosub Kunden()
  272. Endif
  273. Goto anfang
  274.