PACKET listendruckbearbeitungDEFINES einstellungderlistenausgabe, leseveraendertelisteneinstellung,einstellungdersonderlistenausgabe, leseveraendertesonderlisteneinstellung, einstellungderstartwertefueruebersichtsplaene, leseveraenderteuebersichtsplaneinstellung,lesenvorbereitendruck,seitedrucken, druckbreite,drucklaenge,initdruckkopf,druckvorbereiten,druckkopfschreiben, druckzeileschreiben,seitenwechsel,setzemitseitennummern,drucknachbereiten, drucknachbereitenohneausdrucken:LET niltext="",blank=" ",null=0, schulnameschluessel="Schulname",schulstrasseschluessel="Schulstraße", schulortschluessel="Schulort",seitennrtrenner="/",seitenwechselanweisung= "###page#",stdxeumel=2.54,stdyeumel=2.35,druckdateinamepre="liste.", dateilaenge=4073,seitenwechselzeilen=2,tatsdruckkopflaenge=7, eineueberschriftzeilen=1,zweiueberschriftenzeilen=2,ueberschriftenmaxzeilen=2 ,schreiben=FALSE ,lesen=TRUE ,schriftfeldnr=2,druckbreitefeldnr=3, drucklaengefeldnr=4,mindruckbreitefeldnr=4,startxfeldnr=5,startyfeldnr=6, startxfeldnruebplan=3,startyfeldnruebplan=4,maxdruckbreite=76,mindruckbreite= 60,mindrucklaenge=26,maxstartxy=10.0,textnull="0.0",realnull=0.0, eingabenichtsinnvoll=162,stackgroessedrucktupel=3,DRUCKKOPF =STRUCT (ROW tatsdruckkopflaengeTEXT zeile,BOOL zweiueberschriften);REAL VAR startx:= stdxeumel,starty:=stdyeumel,schreibflaeche;INT VAR druckzeilenbreite:=75, druckseitenlaenge:=60,testdruckzeilenbreite,testdruckseitenlaenge, anzahldrucktupel,bearbeitetedrucktupel,minbreitemitteilung;TEXT VAR teststartx,teststarty;BOOL VAR werteinordnung,mitseitennummern;INT VAR maxdateiseiten,schreibbaredrucklaenge,druckzeilennummer,druckseitennummer, druckdateinummer,zeilenzaehler;TEXT VAR schulname,schulstrasse,schulort, druckdateiname;DRUCKKOPF VAR druckkopf;FILE VAR druckdatei;INT PROC druckbreite:druckzeilenbreiteEND PROC druckbreite;PROC einstellungderlistenausgabe:LET maske="ms einstellung druck listen"; druckzeilenbreite:=75;standardstartproc(maske);standardmaskenfeld(schrifttyp, schriftfeldnr);standardmaskenfeld(text(druckzeilenbreite),druckbreitefeldnr); standardmaskenfeld(text(druckseitenlaenge),drucklaengefeldnr); standardmaskenfeld(text(startx),startxfeldnr);standardmaskenfeld(text(starty) ,startyfeldnr);standardnprocEND PROC einstellungderlistenausgabe;PROC einstellungdersonderlistenausgabe:LET maske= "ms einstellung druck anschreiben";minbreitemitteilung:=70;druckzeilenbreite :=75;standardstartproc(maske);standardmaskenfeld(schrifttyp,schriftfeldnr); standardmaskenfeld(text(druckzeilenbreite),druckbreitefeldnr); standardmaskenfeld(text(minbreitemitteilung),mindruckbreitefeldnr); standardmaskenfeld(text(startx),startxfeldnr);standardmaskenfeld(text(starty) ,startyfeldnr);standardnprocEND PROC einstellungdersonderlistenausgabe;PROC einstellungdersonderlistenausgabe(INT CONST anzzeichen):LET maske= "ms einstellung druck anschreiben";minbreitemitteilung:=anzzeichen; druckzeilenbreite:=anzzeichen;standardstartproc(maske);standardmaskenfeld( schrifttyp,schriftfeldnr);standardmaskenfeld(text(druckzeilenbreite), druckbreitefeldnr);standardmaskenfeld(text(minbreitemitteilung), mindruckbreitefeldnr);standardmaskenfeld(text(startx),startxfeldnr); standardmaskenfeld(text(starty),startyfeldnr);standardnprocEND PROC einstellungdersonderlistenausgabe;PROC einstellungderstartwertefueruebersichtsplaene:LET maske= "ms einstellung startwerte";standardstartproc(maske);standardmaskenfeld( schrifttyp,schriftfeldnr);standardmaskenfeld(text(startx),startxfeldnruebplan );standardmaskenfeld(text(starty),startyfeldnruebplan);standardnprocEND PROC einstellungderstartwertefueruebersichtsplaene;PROC leseveraenderteuebersichtsplaneinstellung:werteinordnung:=TRUE ;teststartx:= compress(standardmaskenfeld(startxfeldnruebplan));teststarty:=compress( standardmaskenfeld(startyfeldnruebplan));ueberpruefendergegebenenwerte;IF werteinordnungTHEN werteuebernehmen;IF fontexists(schrifttyp)THEN schreibflaeche:=(16.0-(real(teststartx)-stdxeumel));druckzeilenbreite:=(( xstepconversion(schreibflaeche))DIV (charpitch(font(schrifttyp)," ")))FI ;IF druckzeilenbreitemaxdruckbreiteTHEN druckzeilenbreite:=maxdruckbreiteFI ; enter(2)ELSE meldefehler;return(1)FI ;.ueberpruefendergegebenenwerte:IF ( teststartx<>textnullAND real(teststartx)=realnull)OR real(teststartx)> maxstartxyOR real(teststartx)textnullAND real(teststarty)= realnull)OR real(teststarty)>maxstartxyOR real(teststarty)textnullAND real(teststartx)=realnull)OR real(teststartx)> maxstartxyOR real(teststartx)textnullAND real(teststarty)=realnull )OR real(teststarty)>maxstartxyOR real(teststarty) textnullAND real(teststartx)=realnull)OR real(teststartx)>maxstartxyOR real( teststartx)textnullAND real(teststarty)=realnull)OR real(teststarty)> maxstartxyOR real(teststarty)0THEN einendatensatzlesen(PROC (INT CONST ,BOOL PROC )scanstacksucc,PROC multisucc, TRUE ,BOOL PROC pruefungspeziell);bearbeitetedrucktupel:=1ELSE setzebestandende(TRUE )FI END PROC lesenvorbereitendruck;PROC lesendruck( PROC (INT CONST ,BOOL PROC ,INT VAR )mitscanner,BOOL PROC pruefungspeziell): anzahldrucktupel:=stackgroessedrucktupel;eineseiteeinlesen(PROC (INT CONST , BOOL PROC ,INT VAR )mitscanner,PROC (INT CONST ,INT VAR )multisucc,TRUE , BOOL PROC pruefungspeziell,anzahldrucktupel);IF anzahldrucktupel>0THEN einendatensatzlesen(PROC (INT CONST ,BOOL PROC )scanstacksucc,PROC multisucc, TRUE ,BOOL PROC pruefungspeziell);bearbeitetedrucktupel:=1ELSE setzebestandende(TRUE )FI END PROC lesendruck;TEXT PROC tb:IF bestandende THEN "Bestandsende"ELSE "kein Ende"FI ENDPROC tb;PROC dummy(INT CONST i,INT VAR j):ENDPROC dummy;PROC dummy:ENDPROC dummy;PROC naechsteseiteeinlesen( BOOL PROC pruefungspeziell):lesendruck(PROC (INT CONST ,BOOL PROC ,INT VAR ) scansucc,BOOL PROC pruefungspeziell)ENDPROC naechsteseiteeinlesen;PROC seitedrucken(PROC (INT VAR )drucken,INT CONST zeilenzahl,maxsatzlaenge,BOOL PROC pruefespeziell):seitedrucken(PROC (INT VAR )drucken,zeilenzahl, maxsatzlaenge,PROC dummy,BOOL PROC pruefespeziell)ENDPROC seitedrucken;PROC seitedrucken(PROC (INT VAR )drucken,INT CONST zeilenzahl,maxsatzlaenge,PROC bestandendesimulierenbeimerkmalwechsel,BOOL PROC pruefespeziell): zeilenzaehler:=null;WHILE NOT bestandendeCAND (zeilenzaehler<=zeilenzahl- maxsatzlaenge)CAND pruefespeziellREP drucken(zeilenzaehler); naechstensatzlesen;#IF NOT bestandendeTHEN # bestandendesimulierenbeimerkmalwechsel#FI #PER .naechstensatzlesen:IF bearbeitetedrucktupel=anzahldrucktupelTHEN IF anzahldrucktupel<> stackgroessedrucktupelTHEN setzebestandende(TRUE )ELSE naechsteseiteeinlesen( BOOL PROC pruefespeziell)FI ELSE einendatensatzlesen(PROC (INT CONST ,BOOL PROC )scanstacksucc,PROC multisucc,TRUE ,BOOL PROC pruefespeziell); bearbeitetedrucktupelINCR 1FI .END PROC seitedrucken;INT PROC drucklaenge( INT CONST ueberschriftenzeilen):schreibbaredrucklaenge-druckkopflaenge( ueberschriftenzeilen).END PROC drucklaenge;INT PROC drucklaenge: schreibbaredrucklaenge.END PROC drucklaenge;PROC initdruckkopf:initdruckkopf( niltext,niltext).END PROC initdruckkopf;PROC initdruckkopf(TEXT CONST ueberschrift):initdruckkopf(ueberschrift,niltext).END PROC initdruckkopf; PROC initdruckkopf(TEXT CONST ueberschrift1,ueberschrift2):schulname:= schulkenndatum(schulnameschluessel);schulort:=schulkenndatum( schulortschluessel);druckkopf.zeile(1):=geblockt(schulname,date, druckzeilenbreite);IF (ueberschrift1=niltext)AND (ueberschrift2=niltext)THEN teilbriefkopfELSE teillistenkopfFI ;druckkopf.zeile(4):=ueberschrift1; druckkopf.zeile(5):=ueberschrift2;druckkopf.zeile(6):=niltext;druckkopf.zeile (7):=niltext;druckkopf.zweiueberschriften:=ueberschrift2<>niltext. teilbriefkopf:schulstrasse:=schulkenndatum(schulstrasseschluessel);druckkopf. zeile(2):=schulstrasse;druckkopf.zeile(3):=schulort.teillistenkopf:druckkopf. zeile(2):=schulort;druckkopf.zeile(3):=niltext.END PROC initdruckkopf;PROC druckvorbereiten:druckdateinummer:=0;druckseitennummer:=0;druckzeilennummer:= 0;dateieroeffnen(schreiben).END PROC druckvorbereiten;PROC druckkopfschreiben :INT VAR i;FOR iFROM 1UPTO druckkopflaengeREPEAT druckzeileschreiben( druckkopf.zeile[i])END REPEAT .END PROC druckkopfschreiben;PROC druckzeileschreiben(TEXT CONST inhalt):IF druckzeilennummer< schreibbaredrucklaengeTHEN put(druckdatei,inhalt);line(druckdatei); druckzeilennummerINCR 1END IF .END PROC druckzeileschreiben;PROC seitenwechsel:trageggfleerzeilenein;putline(druckdatei,seitenwechselanweisung );druckseitennummerINCR 1;druckzeilennummer:=0;ggffolgedateieroeffnen( schreiben).trageggfleerzeilenein:INT CONST fehlendezeilen:=max(0, druckseitenlaenge-druckzeilennummer-1);line(druckdatei,fehlendezeilen).END PROC seitenwechsel;PROC setzemitseitennummern(BOOL CONST ja):mitseitennummern :=ja.END PROC setzemitseitennummern;PROC drucknachbereiten:INT VAR i; ggfseitenwechsel;IF mitseitennummernTHEN seitennummerneintragenFI ;FOR iFROM 1UPTO druckdateinummerREPEAT druckdateiname:=druckdateinamepre+text(i); dateidruckenundloeschenEND REPEAT .ggfseitenwechsel:IF druckzeilennummer>0 THEN seitenwechselEND IF .dateidruckenundloeschen:print(druckdateiname); forget(druckdateiname,quiet).END PROC drucknachbereiten;PROC drucknachbereitenohneausdrucken:ggfseitenwechsel;IF mitseitennummernTHEN seitennummerneintragenFI .ggfseitenwechsel:IF druckzeilennummer>0THEN seitenwechselEND IF .END PROC drucknachbereitenohneausdrucken;PROC seitennummerneintragen:IF mehralseineseiteTHEN trageseitennummernindruckdateieinEND IF .mehralseineseite:druckseitennummer>1 .trageseitennummernindruckdateiein:INT CONST seiten:=druckseitennummer; druckdateinummer:=0;dateieroeffnen(lesen);FOR druckseitennummerFROM 1UPTO seitenREPEAT down(druckdatei,seitenwechselanweisung);trageseitennummerein; ggffolgedateieroeffnen(lesen)END REPEAT .trageseitennummerein:writerecord( druckdatei,seitennummer+seitenwechselanweisung);down(druckdatei).seitennummer :TEXT CONST seitennr:=nr;blanks+seitennr.nr:text(druckseitennummer)+ seitennrtrenner+text(seiten).blanks:(druckzeilenbreite-seitennrlaenge)*blank. seitennrlaenge:length(seitennr).END PROC seitennummerneintragen;PROC ggffolgedateieroeffnen(BOOL CONST lesen):IF druckseitennummerMOD maxdateiseiten=0THEN dateieroeffnen(lesen)END IF .END PROC ggffolgedateieroeffnen;PROC dateieroeffnen(BOOL CONST lesen):druckdateinummer INCR 1;druckdateiname:=druckdateinamepre+text(druckdateinummer);IF lesenTHEN lesedateieroeffnenELSE schreibdateieroeffnenEND IF .lesedateieroeffnen: druckdatei:=sequentialfile(modify,druckdateiname);down(druckdatei, seitenwechselanweisung).schreibdateieroeffnen:forget(druckdateiname,quiet); druckdatei:=sequentialfile(output,druckdateiname);maxdateiseiten:=dateilaenge DIV druckseitenlaenge;schreibbaredrucklaenge:=druckseitenlaenge;IF mitseitennummernTHEN schreibbaredrucklaenge:=schreibbaredrucklaenge- seitenwechselzeilenFI ;setzeanzahlderzeichenprozeile(druckzeilenbreite); schrift(schrifttyp);start(startx,starty);schreibesteuerzeichenzeile( druckdateiname);putline(druckdatei,seitenwechselanweisung).END PROC dateieroeffnen;INT PROC druckkopflaenge(INT CONST ueberschriftenzeilen):IF ueberschriftenzeilen>ueberschriftenmaxzeilenTHEN errorstop("max "+text( ueberschriftenmaxzeilen)+" Ueberschriften im Druckkopf");0ELSE tatsdruckkopflaenge-ueberschriftenmaxzeilen+ueberschriftenzeilenEND IF .END PROC druckkopflaenge;INT PROC druckkopflaenge:druckkopflaenge( ueberschriftenzeilen).ueberschriftenzeilen:IF druckkopf.zweiueberschriften THEN zweiueberschriftenzeilenELSE eineueberschriftzeilenEND IF .END PROC druckkopflaenge;END PACKET listendruckbearbeitung