From 04e68443040c7abad84d66477e98f93bed701760 Mon Sep 17 00:00:00 2001 From: Lars-Dominik Braun Date: Mon, 4 Feb 2019 13:09:03 +0100 Subject: Initial import --- app/schulis/2.2.1/src/0.listen.druckbearbeitung | 207 ++++++++++++++++++++++++ 1 file changed, 207 insertions(+) create mode 100644 app/schulis/2.2.1/src/0.listen.druckbearbeitung (limited to 'app/schulis/2.2.1/src/0.listen.druckbearbeitung') diff --git a/app/schulis/2.2.1/src/0.listen.druckbearbeitung b/app/schulis/2.2.1/src/0.listen.druckbearbeitung new file mode 100644 index 0000000..a7c47be --- /dev/null +++ b/app/schulis/2.2.1/src/0.listen.druckbearbeitung @@ -0,0 +1,207 @@ +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 + -- cgit v1.2.3