' *******************************
' *    Rechnung Amiga 1.00      *
' *  © 3.3.1994 by Henry König  *
' * Bornheide 71, 22549 Hamburg *
' *******************************
init                            !
init.rechnung
anschrift                       ! Absender vorbesetzen
anschluss
menueein
info
tagesdatum
start:
programmkopf
copyright                     ! Copyright ausgeben
' ON ERROR GOSUB fehler
ON MENU GOSUB menÜkontrolle
REPEAT
  SLEEP
UNTIL ende!
CLOSEW #1
CLOSES 1
END                             ! system
PROCEDURE abfragen
  anweisung(aw%)
  anweisung(18)
  CLR x%
  mausk%=0
  ay%=ay%(aw%)+5+LEN(aw$(aw%))
  ay%=ay%*8-16                  ! Rechtswert
  ax%=ax%(aw%)*8-12             ! Hochwert
  COLOR 2                       ! schwarz
  BOX ay%,ax%,ay%+64,ax%+14
  COLOR 4                       ! hellgrau
  LINE ay%+1,ax%+1,ay%+63,ax%+1
  LINE ay%,ax%+1,ay%,ax%+14
  WHILE mausk%<>2 AND x%<>13
    IF y$="J" THEN
      COLOR 2
      LOCATE ay%(aw%)+5+LEN(aw$(aw%)),ax%(aw%)
      textstil(7,3,6)           ! Invers
      PRINT " J ";
      textstil(0,1,0)           ! Invers aus
      PRINT " N ";
      y$="J"
    ELSE
      LOCATE ay%(aw%)+5+LEN(aw$(aw%)),ax%(aw%)
      textstil(0,1,0)           ! Invers aus
      PRINT " J ";
      textstil(7,3,6)           ! Invers
      PRINT " N ";
      y$="N"
    ENDIF
    taste
    IF x%=155                   ! Sondertaste
      x%=ASC(MID$(x$,2,1))      ! ASCII-Wert
      IF x%=63 THEN             ! Help-Taste?
        textstil(0,1,0)         ! Invers ausschalten
      ENDIF
    ENDIF
    IF UPPER$(x$)="J" THEN
      y$="J"
    ELSE IF UPPER$(x$)="N"
      y$="N"
    ENDIF
    IF mausy%=ax%(aw%) THEN     ! Abfragefeld (Zeile) angeklickt?
      IF mausx%-1>ay%(aw%)+3+LEN(aw$(aw%)) AND mausx%-1<ay%(aw%)+8+LEN(aw$(aw%)) THEN
        y$="J"
      ELSE IF mausx%-1>ay%(aw%)+7+LEN(aw$(aw%)) AND mausx%-1<ay%(aw%)+11+LEN(aw$(aw%))
        y$="N"
      ENDIF
    ELSE
      x1%=ASC(MID$(x$,2,1))-37
      IF x1%=30 THEN            ! Cursor rechts?
        y$="N"                  ! ja, dann nein gewahlt
      ELSE IF x1%=31            ! Cursor links?
        y$="J"                  ! ja, dann ja gewahlt
      ENDIF
    ENDIF
  WEND
  textstil(0,1,0)               ! Invers aus
  programmfuss
RETURN
PROCEDURE abfrage.ja
  y$="J"
  abfragen
RETURN
PROCEDURE abfrage.nein
  y$="N"
  abfragen
RETURN
PROCEDURE anweisung(aw%)
  PRINT AT(4,ax%(aw%));SPACE$(74) ! Zeile löschen
  PRINT AT(ay%(aw%),ax%(aw%));aw$(aw%) ! Anweisung ausgeben
RETURN
PROCEDURE beenden               ! Programm beenden
  ALERT 0,"Wollen Sie aufhören",1,"  Ja  | Nein ",wahl%
  ende!=(wahl%=1)
RETURN
PROCEDURE bildschirm            ! Bildschirm und Fenster öffnen
  OPENS 1,0,0,breite%,hoehe%,ebenen%,&H8000
  OPENW #1,0,0,breite%,hoehe%,&H18,&H1800,1
  farben.setzen                 ! Farbpalette setzen
  '  menueein
  '  LPOKE ADD(FindTask(0),184),WINDOW(1)! Requester auf GFA-Screen umlenken
RETURN
PROCEDURE copyright
  PRINT AT(10,31);"© 1993 (9.6.1993) by Henry König, Bornheide 71,  2000 Hamburg"
RETURN
PROCEDURE cursor.aus            ! Ersatz-Cursor ausschalten
  LOCATE spalte%+sp%,zeile%     ! Cursor positionieren
  textstil(0,1,0)               ! Invers ausschalten
  PRINT MID$(t$,sp%,1)          ! Zeichen ausgeben
RETURN
PROCEDURE daten                 ! Daten für Menüs und Anweisungen
  anweisungen:
  '
  DATA 31, 5,"Variable Anweisung",0
  DATA 28,12,"Soll eine bestehende Maske verwendet werden",1
  DATA 28,30,"Noch einen Artikel",2
  DATA 28,22,"Sind alle Angaben richtig",3
  DATA 31, 6,"Suchbegriffe eingeben und mit RETURN bestätigen. Weiter mit RETURN.",4
  DATA 31,24,"Steuerung mit den Cursor-Tasten",5
  DATA 2,  4,"G e b e n  S i e  d i e  E r s a t z w e r t e  e i n .",6
  DATA 28,25,"Mehrspaltig drucken",7
  DATA 28, 4,"Daten selektieren (Vorauswahl treffen)",8
  DATA 31, 4,"0 = Vorgabe, 1 = löschen, 2 = Addition, 3 = rechtsbündig, 4 = 1 u. 3",9
  DATA 31, 4,"Feldposition im Druck ändern. Reihenfolge eingeben. 0 = nicht Ausgeben.",10
  DATA 31,14,"Eingabefelder mit | markieren. Masken-Editor mit Esc beenden",11
  DATA 31,18,"Bitte ewas Geduld. Die Maske wird überprüft.",12
  DATA 28,20,"Fehler in der Maske. Korrigieren",13
  DATA 31, 4,"Dateneingabe oder Datenänderung können Sie nur mit der 'Esc'-Taste beenden.",14
  DATA 31, 4,"Index-(Sortier)Felder durch Ziffern (1 -)an und bestätigen die Eingabe mit Esc.",15
  DATA 31, 8,"Unterbrechung mit beliebiger Taste, Abbruch mit der « Esc-Taste » ",16
  DATA 31, 4,"Bei RETURN wird jedes Datenfeld übernommen, sonst wird selektiert.",17
  DATA 31, 4,"Anwahl = linke Maustaste, Cursor, Buchst. Start = rechte Maustaste, RETURN",18
  DATA 28,10,"Soll die Konfiguratiom gespeichert werden",19
  DATA 31, 4,"Bitte zutreffendes anwählen:",20
  DATA 28, 4,"Bitte Namen der Arbeits-Datei auswählen. Endung '.Daten' oder '.Maske'.",21
  DATA 28, 4,"Bitte den (Pfad)-Namen der  Z I E L - Datei auswählen oder eingeben.",22
  DATA 28, 4,"Haben Sie diese Anweisung verstanden",23
  DATA 28,20,"Datenfeld mehrfach gewählt. Korrigieren",24
  DATA 28,10,"Ausgabefelder (Reihenfolge) ändern oder unterdrücken",25
  DATA 28, 4,"Sie haben die Maske verändert. Datei neu organisieren",26
  DATA 31,10,"B i t t e  w ä h l e n  S i e  e i n e n  M e n ü p u n k t .",27
  DATA 31, 4,"Der interne Speicher ist voll. Datenerfassung ohne DATEN-IMPORT fortsetzen.",28
  DATA 28, 4,"Achtung es sind Vorgabeflags gesetzt. Vorgabe berücksichtigen",29
  DATA 31, 4,"= ersetzen, <> entfernen, < voranstellen, > anfügen, * Instring",30
  DATA 28,14,"Soll dieser Datensatz verändert werden",31
  DATA 22,20,"Übernommenen Datensatz ergänzen",32
  DATA 31, 4,"Ordner sind mit '*' gekennzeichet. Zum Ordnerwechsel nur einmal klicken.",33
  DATA 28, 4,"Auswertung in neue Datei (J), an vorhandene Datei anhängen (N)",34
  DATA 28, 4,"Druckzeile ist zu lang. Druckersteuerung durchs Programm",35
  DATA 28, 4,"Speichermangel. Zusätzliche Indexfelder entfernen",36
  DATA 28, 4,"Soll ein externes Datenfeld verwaltet werden.",37
  DATA 28, 4,"Soll ein Selektierprotokoll gedruckt werden.",38
  um2:
  DATA 47,28," = "
  DATA 52,28," <> "
  DATA 57,28," < "
  DATA 62,28," > "
  DATA 67,28," * "
  DATA 72,28," <>* "
  menue.daten:
  DATA " Projekt "
  DATA "+I Info "
  DATA "+O ---------------------     "
  DATA "+Q Programm beenden... "
  DATA ""
  DATA " Rechnung "
  DATA "+A schreiben...           "
  DATA "+B auf Bildschirm "
  DATA "+D drucken... "
  DATA ""
  DATA "*"
RETURN
PROCEDURE eingabe(sp%,zeile%,spalte%,lg%,t$)
  undo1$=t$                     ! Eingabe sichern
  eingabe0:
  PRINT AT(spalte%+1,zeile%);t$ ! String auf Bildschirm
  eingabe1:
  IF sp%<1 THEN                 ! Spalte < 1
    sp%=1                       ! ja, dann Spalte = 1
  ELSE IF sp%>lg%               ! Spalte > Stringlaenge
    sp%=lg%                     ! ja, dann Spalte = Stringlaenge
  ENDIF
  LOCATE spalte%+sp%,zeile%     ! Cursor positionieren
  textstil(7,3,6)               ! Invers an
  PRINT MID$(t$,sp%,1)          ! Zeichen ausgeben
  textstil(0,1,0)               ! Invers aus
  taste                         ! Zeichen von Tastatur holen
  IF mausy%>0 THEN              ! mit Maus positioniert
    cursor.aus                  ! Ersatz-Cursor aus
    IF (cf% AND mausy%<>zeile%) OR (cf% AND mausx%<spalte%) OR (cf% AND mausx%>spalte%+lg%) THEN
      GOTO eingabe.ende         ! ja, dann Ende
    ELSE
      sp%=mausx%-spalte%        ! Spaltenposition = Mausspalte-Spalte
    ENDIF
  ENDIF
  IF cf%=1 THEN                 ! Datenfeld links/rechts
    IF x%=12 OR x%=18 OR x%=20 OR x%=22 THEN      !
      GOTO eingabe.ende
    ENDIF
  ENDIF
  IF x%=13 OR x%=27 THEN        ! Abbbruch durch Esc oder RETURN?
    GOTO eingabe.ende
  ELSE IF x%=155                ! Sondertasten
    cursor.aus                  ! Ersatz-Cursor ausschalten
    x%=ASC(MID$(x$,2,1))        ! ASCII-Wert merken
    IF x%=32 THEN               ! Shift-Cursor gedrückt?
      x%=ASC(MID$(x$,3,1))      ! ja, dann nächsten ASCII-Wert
      IF x%=64 THEN             ! Shift-Cursor-rechts?
        x%=22                   ! ja, dann Ersatzwert übergeben
      ELSE IF x%=65             ! Shift-Cursor-links?
        x%=20                   ! ja, dann Ersatz-Wert übergeben
      ENDIF
      GOTO eingabe.ende         ! und abbrechen
    ENDIF
    IF x%=65 AND cf%=1 OR x%=66 AND cf%=1 THEN ! Abbbruch
      GOTO eingabe.ende
    ENDIF
    IF x%=63 THEN               ! HELP-Taste
      hilfe                     ! Hilfsbildschirm einblenden
    ELSE IF x%=67               ! Cursor rechts
      INC sp%                   ! ja, dann Spalte +1
    ELSE IF x%=68               ! Cursor links
      DEC sp%                   ! ja, dann Spalte -1
    ELSE IF x%=90               ! TAB links
      sp%=sp%-8                 ! Spalte -8
    ENDIF
  ELSE IF x%=127                !   Delete
    t$=LEFT$(t$,sp%-1)+MID$(t$,sp%+1,lg%-sp%)+" " ! Zeichen löschen
  ELSE IF x%<32 OR x%>127 AND x%<160  ! Steuerzeichen?
    cursor.aus
    IF x%=8 AND sp%>1 THEN      ! Backspace
      t$=LEFT$(t$,sp%-2)+MID$(t$,sp%,lg%-sp%+1)+" " ! Leerzeichen einfügen
      sp%=sp%-1                 ! Spalte -1
    ELSE IF x%=4                ! Ctrl-d = Wort löschen
      WHILE MID$(t$,sp%,1)<>" " AND sp%>1
        DEC sp%                 ! kein Space, dann Startposition minus 1
      WEND
      spe%=sp%+1                ! Startposition and Enposition übergeben
      WHILE MID$(t$,spe%,1)<>" " AND spe%<lg%
        INC spe%                ! kein Space, dann Enposition plus 1
      WEND
      IF sp%>1 AND sp%<lg% THEN !
        INC sp%
      ENDIF
      IF spe%<lg% THEN
        INC spe%
      ENDIF
      wort$=MID$(t$,sp%,spe%-sp%) ! Wort merken
      t$=LEFT$(t$,sp%-1)+MID$(t$,spe%)+SPACE$(spe%-sp%) ! String zusammensetzen
    ELSE IF x%=5                ! Crtl-e = Wort einfügen
      IF sp%=1 THEN             ! Feldanfang?
        x$=wort$+MID$(t$,sp%)   !
      ELSE
        x$=LEFT$(t$,sp%-1)+wort$+MID$(t$,sp%)
      ENDIF
      t$=LEFT$(x$+SPACE$(lg%),lg%) ! Text auf Sollänge bringen
    ELSE IF x%=9                ! TAB rechts
      sp%=sp%+8                 ! ja, dann Spalte +8
    ELSE IF x%=11               ! Crtl-k
      hard.copy
    ELSE IF x%=16               ! Crtl-p
      auto.ins%=NOT auto.ins% ! ja, dann Insertflag ändern
      CLR x%                    ! Steuerzeichen löschen
      insert.anzeige            !
    ELSE IF x%=21               ! Ctrl-u = Feld einfügen
      t$=LEFT$(undo$+SPACE$(lg%),lg%) ! Text aus Puffer auf Sollänge bringen
    ELSE IF x%=25               ! Ctrl-y = Feld löschen
      undo$=t$                  ! Text zwischenspeichern
      t$=SPACE$(lg%)            ! String löschen
      sp%=1                     ! Spalte = 1
    ENDIF
  ELSE                          ! gültiges ASCII-Zeichen übernehmen
    IF auto.ins% THEN        ! Einfügemodus eingeschaltet?
      t$=LEFT$(t$,sp%-1)+x$+MID$(t$,sp%,lg%-sp%) ! ja, dann Zeichen einfügen
    ELSE                        ! Überschreibmodus
      MID$(t$,sp%,1)=x$         ! Zeichen überschreiben
    ENDIF
    INC sp%                     ! Spalte +1
  ENDIF
  GOTO eingabe0
  eingabe.ende:
  cursor.aus                    ! Ersatz-Cursor ausschalten
  IF vf.flag%=1 THEN
    prÜfe.vorgabe
    IF vflag%=0 THEN
      PRINT AT(2,28);"In diesem Feld wollen Sie  Z i f f e r n  eingegeben. Weiter mit Taste."
      t$=undo1$                 ! alten Wert zurückholen
      taste
      PRINT AT(4,28);SPACE$(75) ! Anweisung ausblenden
      GOTO eingabe0
    ENDIF
  ENDIF
  tx$=t$                        ! Rückgabestring an die aufrufende Procedure
  sp1%=sp%
RETURN
PROCEDURE farben.setzen
  SETCOLOR 0,5,5,5              ! grau statt blau
  SETCOLOR 1,15,15,15           ! weiß bleibt
  SETCOLOR 2,0,0,0              ! schwarz erhalten
  SETCOLOR 3,15,5,0             ! rot bleibt
  SETCOLOR 4,10,10,10           ! hellgrau inverse Farbe im Filerequester
  SETCOLOR 5,15,15,0            ! gelb
  SETCOLOR 6,0,0,0              ! schwarz = Inverse Farbe im Filerequester
RETURN
PROCEDURE fehler.anzeigen(f$)
  programmfuss
  PCOLOR 3,0
  PRINT AT(4,31);"Fehler-Nr.: ";
  PCOLOR 1,0
  PRINT ERR;"  ";
  PCOLOR 3,0
  PRINT f$
  PCOLOR 1,0
  CLOSE
  GOSUB tastendruck
RETURN
PROCEDURE fehler
  fehler.anzeigen(" gemäß Handbuch: ")
  RESUME start
RETURN
PROCEDURE info                  ! Info übers Programm ausgeben
  programmkopf
  PCOLOR 5,0
  PRINT AT(1,5);"Rechnung Amiga V. 1.01";
  PCOLOR 1,0
  PRINT " ist ein einfaches Programm um Rechnungen zu schreiben"
  PRINT AT(1,7);"und zu drucken."
  PCOLOR 3,0
  IF pwd%=0 THEN                ! Paßwort erforderlich
    PRINT AT(1,24);"Dieses Programm darf nur mit meinem  s c h r i f t l i c h e m  Einverständnis"
    PRINT "verbreitet werden! Diese Version ist für: ";
    PCOLOR 5,0
    PRINT pd$;"."
  ELSE IF pwd%=1                ! kein Paßwort erforderlich
    PRINT AT(1,25);"Registrierte Version von: ";
    PCOLOR 5,0
    PRINT anwender$;"."
  ELSE IF pwd%=2                ! Low Cost Version
    PRINT AT(30,25);"Seriennummer: ";
    PCOLOR 5,0
    PRINT anwender$
  ENDIF
  PCOLOR 1,0
  copyright                     ! Copyright ausgeben
  tastendruck
RETURN
PROCEDURE init                  ! Programm initialisieren
  max%=200
  breite%=640                   ! Screenbreite
  hoehe%=256                    ! Screenhöhe
  ebenen%=3                     ! 3 Bitplanes
  at%=38                        ! Anzahl der Anweisungen
  sz%=4                         ! Startzeile der Bildschirmausgabe
  ez%=21                        ! Zeilenanzahl der Bildschirmmaske
  fz%=21                        ! Anz. Datenfelder
  iconx%=120                    ! Iconify-Position
  init.variable                 ! Variable initialisieren
  bildschirm                    ! Bildschirm und Fenster öffnen
  RESTORE anweisungen
  FOR j%=0 TO at%
    READ ax%(j%),ay%(j%),aw$(j%),dummy%
  NEXT j%
RETURN
PROCEDURE init.rechnung
  l$="                    "
  us$="10.2"
  x=50
  DIM m(x),ep(x),gp(x)
  DIM m$(x),bn$(x),a1$(x),ar$(x),f1$(x),f2$(x)
RETURN
PROCEDURE init.variable
  DIM pfad$(3),d$(3)            ! Pfadnamen und Dateinamen
  DIM menue$(50)                ! Anzahl der Menüs
  DIM geraete$(100)             ! Anzahl der möglichen Geräte
  DIM strgadget%(3)
  DIM file$(max%)
  DIM ax%(at%),ay%(at%),aw$(at%)
RETURN
PROCEDURE menueein              ! Menüs einschalten
  MENU KILL
  RESTORE menue.daten
  FOR menue%=0 TO 50
    READ x$
    EXIT IF x$="*"
    menue$(menue%)=x$
  NEXT menue%
  DEC menue%                    !
  menue$(menue%+6)=""
  menue$(menue%+7)=""
  MENU menue$()
RETURN
PROCEDURE menÜkontrolle         ! Hauptmenü
  mn%=MENU(0)                   ! Menüpunkt
  SELECT mn%
  CASE 1
    info
  CASE 2
    splitten
  CASE 3
    beenden
  CASE 6
    schreiben
  CASE 7
    lesen
  CASE 8
    drucken
  ENDSELECT
  programmkopf
  copyright                     ! Copyright ausgeben
RETURN
PROCEDURE programmfuss          ! Anweisungsboxen zeichnen
  COLOR 2                       ! schwarz
  PBOX 1,208,639,254            ! schwarze Box
  COLOR 0,0                     ! grau
  PBOX 6,(27*8)-5,633,(28*8)+4  ! 1. graue Box
  PBOX 6,(29*8)+2,633,251       ! 2. graue Box
  zeichne.schalter(5,209,633,230,1)! 1. Schalter
  zeichne.schalter(5,233,633,253,0)! 2. Schalter
RETURN
PROCEDURE programmfuss1         ! Anweisungsbox ausblenden
  COLOR 0,0                     ! grau
  PBOX 6,(27*8)-5,633,(28*8)+4  ! 1. graue Box
  zeichne.schalter(5,209,633,230,1)! 1. Schalter
RETURN
PROCEDURE programmkopf
  CLS                           ! Bildschirm löschen
  COLOR 2                       ! schwarz
  PBOX 1,1,639,21               ! Box zeichnen
  COLOR 0                       ! grau
  PBOX 4,3,636,19               ! Box zeichnen
  zeichne.schalter(1,1,639,21,1)
  PCOLOR 5,0                    ! gelbe Schrift
  PRINT AT(19,2);"R e c h n u n g  A m i g a   Version 1.01"
  PCOLOR 1,0                    ! weiße Schrift
  programmfuss
RETURN
PROCEDURE progname              ! Programmnamen abfragen und auf <> prüfen
  PRINT AT(14,28);"Pfad für die Speicherung der Proceduren eingeben."
  PRINT AT(14,31);"Ein beliebiger Dateiname  m u ß  eingegeben werden."
  REPEAT
    d$(x2%)=""                  ! Zielname löschen (wegen Abbruch)
    IF pfad$(x2%)="" THEN
      pfad$(x2%)=pfad$(0)
    ENDIF
    programmname                ! Programmnamen abfragen
  UNTIL d$(x2%)<>d$(0)          ! Dateinamen <>, dann RETURN
  PRINT AT(4,28);SPACE$(74);
RETURN
PROCEDURE programmname
  pfad$=pfad$(x2%)              ! Pfad übergeben für Fileselect
  filerequester("Datei auswählen","  OK",pfad$,file$)
  dateiname$=rdatei$
  pfad$=rpfad$
  IF dateiname$="" THEN
    abbruch%=1                  ! Abbruchflag setzen
  ENDIF
  pfad$(x2%)=pfad$              ! Pfad sichern für nächstes Fileselect
  d$(x2%)=dateiname$
RETURN
PROCEDURE tagesdatum
  programmkopf
  PRINT AT(20,10);"Tagesdatum: "
  eingabe(1,10,33,10,DATE$)
  datum$=tx$
RETURN
PROCEDURE taste                 ! ein Zeichen von der Tastatur holen
  CLR x%                        ! Steuerzeichen löschen
  CLR mausk%
  CLR mausx%                    ! Mausspalte löschen
  CLR mausy%                    ! Mauszeile löschen
  WHILE x%=0 AND MOUSEK=0
    x$=INKEY$                   ! Zeichen von Tastatur
    x%=ASC(x$)                  ! ASCII-Wert für Auswertung
  WEND
  IF MOUSEK<>0 THEN             ! linke Maustaste
    mausx%=INT(MOUSEX/8)+1      ! ja, dann Spalte = mausx
    mausy%=INT(MOUSEY/8)+1      ! Zeile = mausy
    mausk%=MOUSEK               ! Maustaste
  ENDIF
RETURN
PROCEDURE tastendruck
  PRINT AT(4,28);SPACE$(74);
  PCOLOR 5,0
  PRINT AT(18,28);" Weiter mit beliebiger Taste oder Mausklick."
  GOSUB taste
  PCOLOR 1,0
  PRINT AT(4,28);SPACE$(74)
RETURN
PROCEDURE textstil(stil%,vfarbe%,hfarbe%)
  par$=STR$(stil%)+";"+STR$(30+vfarbe%)+";"+STR$(40+hfarbe%)
  PRINT CHR$(&H9B);par$;CHR$(&H6D);
RETURN
' *********
PROCEDURE filerequester(titel$,ok$,pfad$,file$)
  x&=-1                                 ! senkrecht zentrieren
  y&=-1                                 ! waagerecht zentrieren
  IF pfad$="" THEN
    '    path$=DIR$(0)
    path$="RAM:"
  ELSE
    IF EXIST(pfad$) THEN
      path$=pfad$                           ! Pfad merken
    ELSE
      path$="RAM:"
    ENDIF
  ENDIF
  CLR rek%                              ! rememberKey
  rk%=V:rek%                            ! Zeiger auf rememberKey
  IF geraetez%>10 THEN                  ! mehr als 10 Geräte vorhanden?
    rbreite&=448                        ! ja, dann Boxbreite 448 Pixel
  ELSE                                  ! max. 10 Geräte
    rbreite&=348                        ! Boxbreite 348 Pixel
  ENDIF
  rhoehe&=190                           ! Boxhöhe
  IF x&=-1 THEN
    x&=(640-rbreite&)/2                 ! Box in der Breite zentrieren
  ENDIF
  IF y&=-1 THEN
    y&=(234-rhoehe&)/2                  ! Box in der Höhe zentrieren
  ENDIF
  OPENW #9,x&,y&,rbreite&,rhoehe&,96,2048+4096,1
  COLOR 2                               ! schwarz
  BOX 1,1,rbreite&-1,rhoehe&-1          ! Dateibox
  COLOR 4                               ! grau
  BOX 4,2,rbreite&-4,rhoehe&-2          ! Rahmen in der Box
  COLOR 0
  zeichne.auswahlbox            ! Dateiauswahlbox zeichnen
  zeichne.schalter(13*8-4,5,342,22,1)   ! Anweisungsbox zeichnen
  COLOR 5,0
  TEXT 14*8,16,titel$                   ! Anweisung ausgeben
  FOR x|=1 TO 10
    gadget(x|,18,21+x|*10,2+22*8+2+4,10)
  NEXT x|
  COLOR 1,0
  strgadget(x|,23,22+(x|+1)*10,301,9,50,path$) ! Path-Gadget 11
  INC x|
  strgadget(x|,23,28+(x|+1)*10,301,9,50,"")    ! File-Gadget 12
  INC x|
  gadget(x|,18,31+(x|+1)*10,70,12)      ! OK-Gadget 13
  zeichne.schalter(8,(21+(x|+1)*10)+6,96,(21+(x|+1)*10)+26,0)
  INC x|
  gadget(x|,rbreite&-88,31+x|*10,70,12) ! Cancel-Gadget 14
  zeichne.schalter(rbreite&-96,21+x|*10+6,rbreite&-8,21+x|*10+26,0)
  INC x|
  gadget(x|,18,8,55,10)                 ! Parent-Gadget 15
  zeichne.schalter(8,4,80,22,0)
  INC x|
  COLOR 3,0
  TEXT 22,16,"PARENT"
  TEXT 22,20+x|*10,ok$                  ! OK-Gadget
  TEXT rbreite&-78,20+x|*10,"ABBRUCH"
  geraeteschalter                       ! Geräteschalter zeichnen
  zeichne.schalter(200,23,240,137,0)    ! Proportionalgadget umrahmen
  erstellen(path$)                      ! Pfad erstellen und anzeigen
  propgadget(x|,214,30,15,101)          ! Proportionalgadget 16
  CLR roll%                             ! Scrollflag löschen
  uport%=LPEEK(WINDOW(9)+86)            ! Zeiger auf Intui-Message
  CLR ok%                               ! OK-Flag löschen
  WHILE ok%=0                           !
    ausgabe(roll%)
    DO
      CLR imsg%                         ! letzte Nachricht löschen
      imsg%=GetMsg(uport%)              ! auf Nachricht warten
    LOOP UNTIL imsg%<>0
    IF LONG{imsg%+20}=32 OR LONG{imsg%+20}=64
      userid&=DPEEK(LPEEK(imsg%+28)+38)
    ENDIF
    ~ReplyMsg(imsg%)                    ! Nachricht an Task zurückgeben
    '
    SELECT userid&
    CASE 1 TO 10                        ! Filefenster
      IF LEFT$(file$(userid&+roll%),1)="*" AND filez%<>0 THEN
        path$=path$+MID$(file$(userid&+roll%),2,LEN(file$(userid&+roll%))-1)+"/"
        erstellen(MID$(path$,0,LEN(path$)-1))
        CLR roll%
        CARD{pginfo%+4}=0
        ~OnGadget(pgadget%,WINDOW(9),0) ! Gadget einschaltem
        ausgabe(roll%)                  ! Datei oder Ordner anzeigen
        refresh(pathadr%,MID$(path$,0,LEN(path$)))
      ELSE IF filez%<>0                 ! Datei
        IF x%=userid&+roll% THEN        ! Doppelklick
          rpfad$=CHAR{LONG{LONG{pathadr%+34}}}
          rdatei$=CHAR{LONG{LONG{fileadr%+34}}}
          ok%=1                         ! Auswahl abbrechen
        ENDIF
        refresh(fileadr%,file$(userid&+roll%))
      ENDIF
    CASE 11                             ! Pfad-Gadget
      path$=CHAR{LONG{LONG{pathadr%+34}}}
      erstellen(MID$(path$,0,LEN(path$)))
    CASE 12 TO 13                       ! File- und OK-Gadget
      rpfad$=CHAR{LONG{LONG{pathadr%+34}}}
      rdatei$=CHAR{LONG{LONG{fileadr%+34}}}
      ok%=1                             ! Auswahl abbrechen
    CASE 14                             ! Cancel-Gadget
      rpfad$=""                         ! Rückgabepfad löschen
      rdatei$=""                        ! Rückgabedateiname löschen
      ok%=1                             ! Auswahl abbrechen
    CASE 15                             ! Parent-Gadget
      IF INSTR(path$,"/",0)
        anz|=RINSTR(path$,"/",LEN(path$))
        IF anz|<>0 THEN
          path$=MID$(path$,0,anz|)
          erstellen(MID$(path$,0,LEN(path$)-1))
        ELSE
          path$=LEFT$(path$,INSTR(path$,":",0))
          erstellen(MID$(path$,0,LEN(path$)))
        ENDIF
        CLR roll%
        CARD{pginfo%+4}=0
        ~OnGadget(pgadget%,WINDOW(9),0) ! Gadget einschaltem
        ausgabe(roll%)
        refresh(pathadr%,MID$(path$,0,LEN(path$)))
      ENDIF
    CASE 16                             ! Proportionalgadget
      oldroll%=roll%
      weiter!=FALSE
      IF CARD{pginfo%}>255 THEN
        DO
          rollen
          IF roll%<>oldroll% THEN
            ausgabe(roll%)
          ENDIF
          oldroll%=roll%
          imsg%=GetMsg(uport%)
          IF LONG{imsg%+20}=64
            ~ReplyMsg(imsg%)
            weiter!=TRUE
          ENDIF
        LOOP UNTIL CARD{pginfo%}<255 OR weiter!=TRUE
      ELSE
        rollen
      ENDIF
    CASE 17 TO 37               ! Devicegadgets
      zeichne.auswahlbox        ! Dateiauswahlbox löschen und zeichnen
      path$=geraete$(userid&-17+1)+":"
      refresh(pathadr%,MID$(path$,0,LEN(path$)))
      erstellen(path$)
      CLR roll%
      ausgabe(roll%)
      refresh(pathadr%,MID$(path$,0,LEN(path$)))
    ENDSELECT
  WEND
  CLOSEW #9
  IF rpfad$<>"" THEN            ! Pfad vorhanden?
    v%=INSTR(rpfad$,":")        ! Doppelpunkt für Gerätename
    v1%=LEN(rpfad$)
    IF v1%>v% AND RIGHT$(rpfad$,1)<>"/" THEN
      rpfad$=rpfad$+"/"
    ENDIF
  ENDIF
RETURN
PROCEDURE erstellen(path$)
  lpath$=path$+CHR$(0)
  CLR filez%                    ! Dateizähler löschen
  filelock%=Lock(V:lpath$,-2)
  IF filelock%=0 THEN           ! kein Lock
    filez%=-1                   ! Dateizähler löschen
  ELSE
    IF adr%=0 THEN
      adr%=AllocRemember(rk%,300,65537)     ! CHIP-RAM anfordern
    ENDIF
    nochfiles|=1
    e%=Examine(filelock%,adr%)
    WHILE nochfiles|            ! noch Dateien u. kein Mausknopf gedrückt
      e%=ExNext(filelock%,adr%)
      IF e%<>0 THEN
        sign%=SGN(LPEEK(adr%+4))
        adr2%=adr%+8
        file$=""
        file$=LEFT$(CHAR{adr2%},32)
        IF filez%<max% THEN
          INC filez%            ! Dateizähler plus 1
          IF sign%=1 THEN
            file$(filez%)="*"+file$ ! Ordner
          ELSE
            file$(filez%)=file$ ! Dateien
          ENDIF
        ENDIF
      ELSE
        CLR nochfiles|
      ENDIF
    WEND
    IF filez%>0 THEN            ! Dateien oder Ordner vorhanden
      QSORT file$(),filez%+1    ! ja, dann sortieren
    ENDIF
    IF filez%<=10 THEN
      CARD{pginfo%+8}=65535     ! VertBody
      div%=65535
    ELSE
      CARD{pginfo%+8}=65535/(filez%-10) ! VertBody
      div%=65535/(filez%-10)
    ENDIF
  ENDIF
  IF filelock%>0 THEN           ! Lock vorhanden
    ~UnLock(filelock%)          ! ja, dann wieder freigeben
  ENDIF
RETURN
PROCEDURE gadget(x|,x&,y&,breite&,hoehe&)
  bgadget%=AllocRemember(rk%,50,65537)
  CARD{bgadget%+4}=x&           ! linke Ecke
  CARD{bgadget%+6}=y&           ! obere Ecke
  CARD{bgadget%+8}=breite&      ! Breite
  CARD{bgadget%+10}=hoehe&      ! Höhe
  CARD{bgadget%+12}=3           ! Gadget wird nicht verändert
  CARD{bgadget%+14}=1           ! Gadget wird sofort aktiv
  CARD{bgadget%+16}=1           ! Gadgettyp, 1 = Boolean
  CARD{bgadget%+38}=x|          ! Gadget-ID
  ~AddGadget(WINDOW(9),bgadget%,-1)
  ~OnGadget(bgadget%,WINDOW(9),0) ! Gadget einschalten
RETURN
PROCEDURE strgadget(x|,x&,y&,breite&,hoehe&,maxz&,default$)
  COLOR 1
  BOX x&-6,y&-4,x&+breite&+8,y&+hoehe&  ! Stringgadget einrahmen
  BOX x&-5,y&-4,x&+breite&+9,y&+hoehe&  ! Stringgadget einrahmen
  COLOR 2
  BOX x&-4,y&-3,x&+breite&+10,y&+hoehe&+1       ! Stringgadget einrahmen
  BOX x&-3,y&-3,x&+breite&+11,y&+hoehe&+1       ! Stringgadget einrahmen
  strbuffer%=AllocRemember(rk%,maxz&,65537)
  stringundo%=AllocRemember(rk%,maxz&,65537)
  stringinfo%=AllocRemember(rk%,40,65537)
  strgadget%=AllocRemember(rk%,50,65537)
  FOR i=1 TO LEN(default$)
    BYTE{strbuffer%+(i-1)}=ASC(MID$(default$,i,1))
  NEXT i
  BYTE{strbuffer%+i}=0
  LONG{stringinfo%+0}=strbuffer%        ! Buffer
  LONG{stringinfo%+4}=stringundo%       ! UndoBuffer
  CARD{stringinfo%+8}=0                 ! Buffer Position
  CARD{stringinfo%+10}=maxz&            ! Maximale Zeichenanzahl
  CARD{stringinfo%+12}=0                ! DispPos
  CARD{strgadget%+4}=x&                 ! linke Ecke
  CARD{strgadget%+6}=y&                 ! obere Ecke
  CARD{strgadget%+8}=breite&+8          ! Breite
  CARD{strgadget%+10}=hoehe&            ! Höhe
  CARD{strgadget%+14}=1                 ! Activation RELVERIFY STRINGCENTER
  CARD{strgadget%+16}=4                 ! Gadgettype STRGADGET
  LONG{strgadget%+18}=0                 ! Gadget Render Zeiger
  LONG{strgadget%+34}=stringinfo%       ! SpecialInfo für Stringgadget
  CARD{strgadget%+38}=x|                ! GadgetID
  ~AddGadget(WINDOW(9),strgadget%,-1)
  ~OnGadget(strgadget%,WINDOW(9),0)
  IF x|=11
    pathadr%=strgadget%
  ELSE IF x|=12
    fileadr%=strgadget%
  ENDIF
RETURN
PROCEDURE propgadget(x|,x&,y&,breite&,hoehe&)
  render%=AllocRemember(rk%,100,65537)
  pginfo%=AllocRemember(rk%,30,65537)
  pgadget%=AllocRemember(rk%,50,65537)
  CARD{pginfo%}=5               ! Flags  AUTOKNOB FREEVERT
  CARD{pginfo%+4}=0             ! VertPot hier werden Werte ausgelesen
  IF filez%<=10 THEN
    CARD{pginfo%+8}=65535       ! VertBody
    div%=65535
  ELSE
    CARD{pginfo%+8}=65535/(filez%-10) ! VertBody
    div%=65535/(filez%-10)
  ENDIF
  CARD{pgadget%+4}=x&           ! linke Ecke
  CARD{pgadget%+6}=y&           ! obere Ecke
  CARD{pgadget%+8}=breite&      ! Breite
  CARD{pgadget%+10}=hoehe&      ! Hoehe
  CARD{pgadget%+12}=3           ! Flags GADGHNONE
  CARD{pgadget%+14}=3           ! Activation RELVERIFY GADGIMMEDIATE
  CARD{pgadget%+16}=3           ! GadgetType PROPORTIONALGADGET
  LONG{pgadget%+18}=render%     ! Gadget Render
  LONG{pgadget%+34}=pginfo%     ! SpecialInfo
  CARD{pgadget%+38}=x|          ! GadgetID User defined
  '
  gad%=AddGadget(WINDOW(9),pgadget%,-1)! Gadget in Liste eintragen
  ~OnGadget(pgadget%,WINDOW(9),0)  ! Gadget einschaltem
RETURN
PROCEDURE refresh(gadget%,aus$)
  FOR i=0 TO LEN(aus$)
    BYTE{LONG{LONG{gadget%+34}}+(i-1)}=ASC(MID$(aus$,i,1))
  NEXT i
  BYTE{LONG{LONG{gadget%+34}}+i-1}=0
  ~OnGadget(gadget%,WINDOW(9),0)! Gadget einschalten
  x%=userid&+roll%              ! Zeiger auf Dateinamen merken
RETURN
PROCEDURE ausgabe(roll%)        ! Requesteranzeige scrollen
  IF roll%+10<=filez% OR filez%<=10 THEN
    COLOR 0,colrando|
    PBOX 18,29,18+22*8+2+4,25+10*10+6
    COLOR 1,0
    IF filez%>10 THEN           ! mehr als 10 Dateien
      zz%=10
    ELSE
      zz%=filez%
    ENDIF
    FOR x|=1 TO zz%             !
      IF LEFT$(file$(x|+roll%),1)="*" THEN
        COLOR 3,0               ! Ordner in rot ausgeben
        TEXT 20,28+x|*10,MID$(file$(x|+roll%),1,22)
      ELSE
        COLOR 1,0               ! Dateien in weiß ausgeben
        TEXT 20,28+x|*10,MID$(file$(x|+roll%),1,22)
      ENDIF
    NEXT x|
  ENDIF
RETURN
PROCEDURE rollen
  IF filez%>10 THEN
    roll%=INT(CARD{pginfo%+4}/div%)     ! Vertpot auslesen von Gadget 1
  ENDIF
RETURN
PROCEDURE anschluss             ! alle angeschlossenen Geräte anzeigen
  root%=LPEEK(_DosBase+34)      ! Zeiger auf das Root-Device
  info%=LPEEK(root%+24)*4
  devinfo%=LPEEK(info%+4)*4
  texte%=LPEEK(devinfo%+40)*4
  type&=PEEK(devinfo%+7)
  CLR geraetez%
  WHILE devinfo%<>0             !
    x$=""
    lg%=PEEK(texte%)            ! Textlänge
    FOR j%=1 TO lg%
      x$=x$+CHR$(PEEK(texte%+j%))! Gerätenamen zusammensetzen
    NEXT j%
    IF type&=0 OR type&=2       ! interner/externer Gerätename
      IF x$="PRT" OR x$="PAR" OR x$="SER" OR x$="CON" OR x$="NEWCON" OR x$="RAW" THEN
        ' Standardgeräte ausblenden
      ELSE
        IF x$="PIPE" OR x$="AUX" OR x$="SPEAK" THEN
          ' Standardgeräte ausblenden
        ELSE
          INC geraetez%         ! Gerätezähler plus 1
          geraete$(geraetez%)=x$! internen Gerätenamen merken
        ENDIF
      ENDIF
    ENDIF
    devinfo%=LPEEK(devinfo%)*4
    texte%=LPEEK(devinfo%+40)*4
    type&=PEEK(devinfo%+7)
  WEND
  INC geraetez%
  geraete$(geraetez%)="SYS"     ! Systemgerät
  IF geraetez%>20 THEN          ! mehr als 20 angeschlossene Geräte
    geraetez%=20                ! ja, dann auf 20 begrenzen
  ENDIF
  QSORT geraete$(),geraetez%+1
  CLR j%
  WHILE j%<geraetez%            ! doppelte Geräte ausblenden
    INC j%
    IF geraete$(j%)=geraete$(j%+1) THEN
      DELETE geraete$(j%)
      DEC geraetez%
    ENDIF
  WEND
RETURN
PROCEDURE geraeteschalter       ! Geräte ausgeben
  xx|=x|                        !
  zeichne.schalter(234,23,342,137,1)     ! Dateiauswahlbox zeichnen
  IF geraetez%>10 THEN
    zeichne.schalter(334,23,442,137,1)     ! Dateiauswahlbox zeichnen
  ENDIF
  COLOR 5,0
  FOR j%=1 TO geraetez%
    INC xx|                     !
    IF j%<=10 THEN
      gadget(xx|,238,19+(xx|-16)*10,98,12)
      TEXT 246,19+(xx|-16)*10+9,LEFT$(geraete$(j%),10)
    ELSE
      gadget(xx|,338,19+(xx|-16)*10-100,98,12)
      TEXT 346,19+(xx|-16)*10+9-100,LEFT$(geraete$(j%),10)
    ENDIF
  NEXT j%
RETURN
PROCEDURE zeichne.schalter(sx1%,sy1%,sx2%,sy2%,an%)
  IF an% THEN
    schatten%=2
    licht%=4
  ELSE
    schatten%=4
    licht%=2
  ENDIF
  COLOR 2                          ! schwarz
  COLOR 0                          ! grau
  COLOR licht%                     ! hellgrau oder schwarz
  LINE sx1%+8,sy2%-4,sx2%-7,sy2%-4 ! untere Lichtlinien
  LINE sx2%-7,sy1%+5,sx2%-7,sy2%-4 ! rechte Lichtlinie
  COLOR schatten%                  ! schwarz oder hellgrau
  LINE sx1%+8,sy1%+4,sx2%-7,sy1%+4 ! obere Schatttenlinie
  LINE sx1%+8,sy1%+4,sx1%+8,sy2%-4 ! linke Schattenlinie
RETURN
PROCEDURE zeichne.auswahlbox    ! Dateiauswahlbox löschen und zeichnen
  COLOR 0,0
  PBOX 8,23,208,137                     ! Dateiauswahlbox löschen
  zeichne.schalter(8,23,208,137,1)     ! Dateiauswahlbox zeichnen
RETURN
REM ********************
PROCEDURE kunden.daten          ! Kundendaten abfragen
  y$="N"                        ! Eingangswert für die Schleife
  WHILE y$="N"
    programmkopf                ! Bildschirm löschen
    PRINT AT(1,5);"Datum:"
    eingabe(1,5,8,10,datum$)
    d$=tx$
    d=1
    k=1
    '  eingabe(1,10,33,10,datum$)
    PRINT AT(1,7);"Kunden-Nr.:"
    eingabe(1,7,15,8,LEFT$(k$+SPACE$(8),8))
    k$=tx$                      ! Eingabe übernehmen
    PRINT AT(1,9);"Kunden Name:"
    eingabe(1,9,15,20,LEFT$(kn$+SPACE$(20),20))
    kn$=tx$                     ! Eingabe übernehmen
    PRINT AT(1,11);"Strasse/Nr.:"
    eingabe(1,11,15,20,LEFT$(ks$+SPACE$(20),20))
    ks$=tx$                     ! Eingabe übernehmen
    PRINT AT(1,13);"PLZ/Ort:"   ! ;ko$
    eingabe(1,13,15,40,LEFT$(ko$+SPACE$(40),40))
    ko$=tx$                     ! Eingabe übernehmen
    PRINT AT(1,15);"Betreff:";b$
    eingabe(1,15,15,60,LEFT$(b$+SPACE$(60),60))
    b$=tx$                      ! Eingabe übernehmen
    PRINT AT(1,17);"Betreff-Nr.:";rn$
    eingabe(1,17,15,7,LEFT$(rn$+SPACE$(7),7))
    rn$=tx$                     ! Eingabe übernehmen
    k=2
    aw%=3
    abfrage.ja                  ! alle Eingaben richtig
  WEND
RETURN
PROCEDURE kunden.kosten         ! Zahlungsart und Kosten abfragen
  y$="N"                        ! Eingangswert für die Schleife
  WHILE y$="N"
    programmkopf                ! Bildschirm löschen
    zahlung:
    PRINT AT(1,5);"Zahlungsart:"
    eingabe(1,5,15,30,LEFT$(za$+SPACE$(30),30))
    za$=tx$                     ! Eingabe übernehmen
    PRINT AT(1,7);"MWST.in % :" ! mk$
    eingabe(1,7,15,2,LEFT$(mk$+SPACE$(2),2))
    mk$=tx$                     ! Mehrwertsteuer übergeben
    mw=VAL(mk$)
    PRINT AT(1,9);"Porto:"
    eingabe(1,9,15,5,LEFT$(pk$+SPACE$(5),5))
    pk$=tx$                     ! Portokosten übergeben
    po=VAL(pk$)
    uu=po
    p=1
    GOSUB formataus
    PRINT AT(1,11);"Verpackung:"!;vk$
    eingabe(1,11,15,5,LEFT$(vk$+SPACE$(5),5))
    vk$=tx$                     ! Verpackungkosten merken
    vp=VAL(vk$)
    uu=vp
    v=1
    GOSUB formataus
    PRINT AT(1,13);"Anrede:"      !;an$
    eingabe(1,13,15,20,LEFT$(an$+SPACE$(20),20))
    k=3
    aw%=3                       ! Ja/Nein-Abfrage
    abfrage.ja                  ! alle Eingaben richtig
  WEND
RETURN
PROCEDURE kunden.bestellung       ! Bestellungen für die Rechnung eingeben
  programmkopf                ! Bildschirm löschen
  z=0
  ly=0
  lx=0
  y$="J"                        ! Eingangswert für die Schleife
  PRINT AT(2,sz%+1);"Anz. Art.Nr. Artikelbezeichnung                  Einzelpreis Gesamtpreis"
  WHILE y$="J" AND z<20-sz%
    INC z                       ! Artikelzähler
    eingabe(1,sz%+2+z,1,4,LEFT$(m$(z)+SPACE$(4),4))
    m$(z)=tx$                   ! lfd. Warenmenge übergeben
    m(z)=VAL(m$(z))
    eingabe(1,sz%+2+z,6,6,LEFT$(bn$(z)+SPACE$(6),6))
    bn$(z)=tx$                  ! lfd. Artikelnummer übergeben
    eingabe(1,sz%+2+z,14,35,LEFT$(a1$(z)+SPACE$(35),35))
    a1$(z)=tx$                  ! lfd. Artikel übergeben
    ar$(z)=a1$(z)+LEFT$(l$,35-LEN(a1$(z)))
    eingabe(1,sz%+2+z,50,10,LEFT$(STR$(ep(z))+SPACE$(10),10))
    ep(z)=VAL(tx$)              ! Einzelpreis übergeben
    IF m(z)>1 THEN
      gp(z)=ep(z)*m(z)
    ELSE
      gp(z)=ep(z)
    ENDIF
    '    PRINT AT(61,sz%+2+z);gp(z)
    PRINT AT(61,sz%+2+z);USING "#######.##",gp(z)
    uu=ep(z)
    ly=ly+1
    f1=1
    GOSUB formataus
    uu=gp(z)
    lx=lx+1
    f2=1
    GOSUB formataus
    k=4
    aw%=2                       ! noch einen Artikel
    abfrage.ja                  ! alle Eingaben richtig
  WEND
RETURN
REM ********************
PROCEDURE schreiben
  kunden.daten                  ! Kundendaten abfragen
  kunden.kosten                 ! Zahlungsart und Kosten abfragen
  kunden.bestellung             ! Bestellungen eingeben
RETURN
PROCEDURE lesen                 ! Rechnung auf Bildschirm
  programmkopf
  PRINT AT(1,sz%);"Kunden Name :";kn$;SPC(2);"K-Nr:";k$
  PRINT
  PRINT "Rechungs-Datum: ";d$;SPC(10);
  PRINT b$;" Nr: ";rn$;SPC(10);"Zahlung: ";za$
  PRINT
  FOR a=1 TO lx
    sa=sa+gp(a)
  NEXT a
  sa=sa+vp
  uu=sa
  s1=1
  GOSUB formataus
  sx=sa/100*mw
  uu=sx
  m1=1
  GOSUB formataus
  gs=sa+sx+po
  uu=gs
  s2=1
  GOSUB formataus
  druck2                        ! Strich drucken
  PRINT "Menge  Art.Nr.   Artikel  ";SPC(16);"Einzelpreis     Gesamtpreis"
  druck2                        ! Strich drucken
  FOR a=1 TO lx
    PRINT m$;(a);SPC(3);bn$;(a);SPC(4);ar$;(a);
    PRINT f1$(a);" DM";f2$(a);" DM"
  NEXT a
  PRINT
  PRINT "  Verpackung :";vp$;" DM"
  PRINT
  PRINT "  Summe exkl.:";sa$;" DM"
  PRINT
  PRINT " ";mw;"% MWST. :";sx$;" DM"
  PRINT
  PRINT "  Porto      :";po$;" DM"
  sa=sa-sa
  gs=gs-gs
  PRINT
  PRINT "  Gesamtsumme:";gs$;" DM"
  PRINT TAB(13);"=================="
  tastendruck
RETURN
PROCEDURE drucken               ! Rechnung drucken
  OPEN "O",#1,"PRT:"
  PRINT #1,
  PRINT #1,CHR$(14)+CHR$(16);n$
  PRINT #1,CHR$(15)
  PRINT #1,ef$
  PRINT #1,sh$
  PRINT #1,o$
  PRINT #1,
  PRINT #1,
  PRINT #1,"Kundennr. : ";k$
  PRINT #1,
  PRINT #1,an$
  PRINT #1,
  PRINT #1,kn$
  PRINT #1,
  PRINT #1,ks$
  PRINT #1,ko$
  FOR cu=1 TO 3
    PRINT #1,CHR$(10)
  NEXT cu
  GOSUB druck1
  PRINT #1,CHR$(18);b$;
  PRINT #1,CHR$(18);"  Nr.";rn$;
  PRINT #1,CHR$(18);"     Zahlung :";
  PRINT #1,CHR$(18);za$;
  PRINT #1,CHR$(18);"  Datum:";d$
  GOSUB druck1
  PRINT #1,
  PRINT #1,
  PRINT #1,
  GOSUB druck1
  PRINT #1,CHR$(18);"  Menge  Art.Nr.   Artikel  ";SPC(16);"Einzelpreis     Gesamtpreis"
  GOSUB druck1
  PRINT #1,
  FOR a=1 TO lx
    PRINT #1,CHR$(18);TAB(3);m$;(a);SPC(3);bn$;(a);SPC(4);ar$;(a);
    PRINT #1,f1$(a);" DM";f2$(a);" DM"
  NEXT a
  PRINT #1,
  PRINT #1,
  PRINT #1,CHR$(18);"  Verpackung :";
  PRINT #1,vp$;" DM"
  PRINT #1,
  FOR a=1 TO lx
    sa=sa+gp(a)
  NEXT a
  sa=sa+vp
  uu=sa
  s1=1
  GOSUB formataus
  PRINT #1,CHR$(18);"  Summe exkl.:";
  PRINT #1,sa$;" DM"
  PRINT #1,
  sx=sa/100*mw
  uu=sx
  m1=1
  GOSUB formataus
  PRINT #1,CHR$(18);TAB(2);mw;"% MWST. :";
  PRINT #1,sx$;" DM"
  PRINT #1,
  gs=sa+sx+po
  uu=gs
  s2=1
  GOSUB formataus
  PRINT #1,CHR$(18);"  Porto      :";
  PRINT #1,po$;" DM"
  PRINT #1,
  sa=sa-sa
  gs=gs-gs
  PRINT #1,CHR$(18);"  Gesamtsumme:";
  PRINT #1,gs$;" DM"
  PRINT #1,CHR$(18);"  ============================"
  PRINT #1,CHR$(10)
  PRINT #1,CHR$(18);g$
  CLOSE #1
RETURN
PROCEDURE formataus
  up$=RIGHT$(us$,1)
  ul=INT(VAL(us$))
  IF up$<>"." THEN
    ur=VAL(up$)
    GOTO formataus1
  ENDIF
  ua$=STR$(SGN(uu)*INT(ABS(uu)))+"."
  ub$=""
  ul=ul+1
  GOTO formataus2
  formataus1:
  ul=INT(VAL(us$))
  uu$=STR$(SGN(uu)*(INT(ABS(uu)*10^ur+0.5))/10^ur)
  up=0
  FOR ui=1 TO LEN(uu$)
    IF MID$(uu$,ui,1)="." THEN
      up=ui
    ENDIF
  NEXT ui
  IF up=0 THEN
    up=ui
    uu$=uu$+"."
  ENDIF
  IF up<>2 THEN
    GOTO formataus3
  ENDIF
  uu$=LEFT$(uu$,1)+"0"+RIGHT$(uu$,LEN(uu$)-1)
  ul=ul-1
  ur=ur+1
  formataus3:
  ub$=MID$(uu$,up,LEN(uu$)+1)+"000000000"
  ub$=LEFT$(ub$,ur+1)
  ua$=LEFT$(uu$,up-1)
  formataus2:
  IF LEN(ua$)>ul THEN
    PRINT "us$ zu klein"
    STOP
  ENDIF
  formataus4:
  IF LEN(ua$)<ul THEN
    ua$=" "+ua$
    GOTO formataus4
  ENDIF
  IF p=1 THEN
    po$=ua$+ub$
    p=0
    GOTO sprung1
    '  RETURN
  ENDIF
  IF v=1 THEN
    vp$=ua$+ub$
    v=0
    GOTO sprung1
    ' RETURN
  ENDIF
  IF f1=1 THEN
    f1$(ly)=ua$+ub$
    f1=0
    GOTO sprung1
    ' RETURN
  ENDIF
  IF f2=1 THEN
    f2$(lx)=ua$+ub$
    f2=0
    GOTO sprung1
    ' RETURN
  ENDIF
  IF s1=1 THEN
    sa$=ua$+ub$
    s1=0
    GOTO sprung1
    ' RETURN
  ENDIF
  IF m1=1 THEN
    sx$=ua$+ub$
    m1=0
    GOTO sprung1
    ' RETURN
  ENDIF
  IF s2=1 THEN
    gs$=ua$+ub$
    s2=0
    GOTO sprung1
    ' RETURN
  ENDIF
  sprung1:
RETURN
PROCEDURE druck1
  FOR s=1 TO 75
    PRINT #1,CHR$(18);"-";
  NEXT s
  PRINT #1,
RETURN
PROCEDURE druck2
  PRINT STRING$(80,"-")         ! Strich drucken
  PRINT
RETURN
PROCEDURE anschrift             ! Absender vorbesetzen
  n$="Rechnung Rechner"
  ef$="Rechnung"
  sh$="Rechnungsstr.11"
  o$="1111 Rechnungsdorf"
RETURN
REM
k$=""
kn$=""
ks$=""
ko$=""
b$=""
rn$=""
za$=""
mk$=""
pk$=""
vk$=""
an$=""
m$(z)=""
bn$(z)=""
a1$(z)=""
REM