app/schulis/2.2.1/src/0.listen.druckbearbeitung

Raw file
Back to index

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 
druckzeilenbreite<mindruckbreiteTHEN druckzeilenbreite:=mindruckbreiteELIF 
druckzeilenbreite>maxdruckbreiteTHEN druckzeilenbreite:=maxdruckbreiteFI ;
enter(2)ELSE meldefehler;return(1)FI ;.ueberpruefendergegebenenwerte:IF (
teststartx<>textnullAND real(teststartx)=realnull)OR real(teststartx)>
maxstartxyOR real(teststartx)<realnullTHEN infeld(startxfeldnruebplan);
werteinordnung:=FALSE ELSE IF (teststarty<>textnullAND real(teststarty)=
realnull)OR real(teststarty)>maxstartxyOR real(teststarty)<realnullTHEN 
infeld(startyfeldnruebplan);werteinordnung:=FALSE ELSE werteinordnung:=TRUE 
FI ;FI .werteuebernehmen:setzeschuliszeichensatz(standardmaskenfeld(
schriftfeldnr));startx:=real(teststartx);starty:=real(teststarty).meldefehler
:standardmeldung(eingabenichtsinnvoll,niltext).END PROC 
leseveraenderteuebersichtsplaneinstellung;PROC 
leseveraendertelisteneinstellung:werteinordnung:=TRUE ;testdruckzeilenbreite
:=int(standardmaskenfeld(druckbreitefeldnr));testdruckseitenlaenge:=int(
standardmaskenfeld(drucklaengefeldnr));teststartx:=compress(
standardmaskenfeld(startxfeldnr));teststarty:=compress(standardmaskenfeld(
startyfeldnr));ueberpruefendergegebenenwerte;IF werteinordnungTHEN 
werteuebernehmen;enter(2)ELSE meldefehler;return(1)FI .
ueberpruefendergegebenenwerte:IF testdruckzeilenbreite<mindruckbreiteTHEN 
infeld(druckbreitefeldnr);werteinordnung:=FALSE ELIF testdruckseitenlaenge<
mindrucklaengeTHEN infeld(drucklaengefeldnr);werteinordnung:=FALSE ELIF (
teststartx<>textnullAND real(teststartx)=realnull)OR real(teststartx)>
maxstartxyOR real(teststartx)<realnullTHEN infeld(startxfeldnr);
werteinordnung:=FALSE ELIF (teststarty<>textnullAND real(teststarty)=realnull
)OR real(teststarty)>maxstartxyOR real(teststarty)<realnullTHEN infeld(
startyfeldnr);werteinordnung:=FALSE ELSE werteinordnung:=TRUE FI .
werteuebernehmen:setzeschuliszeichensatz(standardmaskenfeld(schriftfeldnr));
druckzeilenbreite:=testdruckzeilenbreite;druckseitenlaenge:=
testdruckseitenlaenge;maxdateiseiten:=dateilaengeDIV druckseitenlaenge;
schreibbaredrucklaenge:=druckseitenlaenge-seitenwechselzeilen;startx:=real(
teststartx);starty:=real(teststarty).meldefehler:standardmeldung(
eingabenichtsinnvoll,niltext).END PROC leseveraendertelisteneinstellung;PROC 
leseveraendertesonderlisteneinstellung:werteinordnung:=TRUE ;
testdruckzeilenbreite:=int(standardmaskenfeld(druckbreitefeldnr));teststartx
:=compress(standardmaskenfeld(startxfeldnr));teststarty:=compress(
standardmaskenfeld(startyfeldnr));ueberpruefendergegebenenwerte;IF 
werteinordnungTHEN werteuebernehmen;enter(2)ELSE meldefehler;return(1)FI .
ueberpruefendergegebenenwerte:IF testdruckzeilenbreite<minbreitemitteilung
THEN infeld(druckbreitefeldnr);werteinordnung:=FALSE ELIF (teststartx<>
textnullAND real(teststartx)=realnull)OR real(teststartx)>maxstartxyOR real(
teststartx)<realnullTHEN infeld(startxfeldnr);werteinordnung:=FALSE ELIF (
teststarty<>textnullAND real(teststarty)=realnull)OR real(teststarty)>
maxstartxyOR real(teststarty)<realnullTHEN infeld(startyfeldnr);
werteinordnung:=FALSE ELSE werteinordnung:=TRUE FI .werteuebernehmen:
setzeschuliszeichensatz(standardmaskenfeld(schriftfeldnr));druckzeilenbreite
:=testdruckzeilenbreite;startx:=real(teststartx);starty:=real(teststarty).
meldefehler:standardmeldung(eingabenichtsinnvoll,niltext).END PROC 
leseveraendertesonderlisteneinstellung;PROC lesenvorbereitendruck(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 )multisearchforward,
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 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