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/1.listen.gebu | 125 ++++++++++++++++++++++++++++++++++++ 1 file changed, 125 insertions(+) create mode 100644 app/schulis/2.2.1/src/1.listen.gebu (limited to 'app/schulis/2.2.1/src/1.listen.gebu') diff --git a/app/schulis/2.2.1/src/1.listen.gebu b/app/schulis/2.2.1/src/1.listen.gebu new file mode 100644 index 0000000..a025331 --- /dev/null +++ b/app/schulis/2.2.1/src/1.listen.gebu @@ -0,0 +1,125 @@ +PACKET geburtslistenDEFINES gebulispezielleteile:LET niltext="",blank=" ", +mittestrich="-",null=0,komma=",",ueberschriftenzeilen=2,klas="Klasse",name= +"Name, Rufname",gebtag="Geburtstag",spalte1breite=7,spalte3breite=12, +anzspaltentrenner=2,ausgkopflaenge=2,ausgfeldlaenge=1,AUSGFELD =ROW +ausgfeldlaengeTEXT ,AUSGKOPF =ROW ausgkopflaengeTEXT ,gebulieingangsmaske= +"ms liste gebjahr eingang",gebulianfpos=2,mnrbearbeitetwird=100;INT CONST +spalte2bildbreite:=bildbreite-anzspaltentrenner-spalte1breite-spalte3breite; +INT VAR spalte2druckbreite,druckzeilenzahl,bildanf,eingabestatus, +aktuelleindexnr;TEXT VAR gebjahreingang,schuelername,schuelerrufname, +schuelernamenszus,schuelergebdat,klasse,alteklasse,druckstrich,bearbeitetwird +,startjahr,startgeschl;TEXT CONST bildstrich:=bildbreite*mittestrich; +AUSGFELD VAR ausgfeld;AUSGKOPF VAR ausgkopf;BOOL VAR weibl,maennl, +ersteraufbildschirm,klassegeaendert:=FALSE ;#DBMASKE VAR sortiertnachgebjahr, +sortiertnachgebjahrgeschl,sortiertnachklassename;#BOOL PROC multistopstatus: +BOOL VAR b:=wert(fnrsustatuss)="ls";setzebestandende(NOT b);bENDPROC +multistopstatus;BOOL PROC multistopdrucken:BOOL VAR b:=multistopmitdbstatus( +FALSE );setzebestandende(NOT b);bENDPROC multistopdrucken;BOOL PROC +multistopmitdbstatusdrucken:BOOL VAR b:=multistopmitdbstatus(TRUE ); +setzebestandende(NOT b);bENDPROC multistopmitdbstatusdrucken;BOOL PROC +multistop:multistopmitdbstatus(FALSE )ENDPROC multistop;BOOL PROC +multistopmitdbstatus:multistopmitdbstatus(TRUE )ENDPROC multistopmitdbstatus; +BOOL PROC multistopmitdbstatus(BOOL CONST mitdbstatus):BOOL VAR b:=FALSE ;IF +wert(fnrsustatuss)="ls"THEN IF startgeschl<>""THEN IF wert(fnrsugeschlechts)= +startgeschlTHEN b:=(subtext(wert(fnrsugebdatums),7,8)=gebjahreingang)ELSE b:= +FALSE FI ELSE b:=(subtext(wert(fnrsugebdatums),7,8)=gebjahreingang);IF +mitdbstatusTHEN b:=bCAND (dbstatus=ok)FI FI ;FI ;bEND PROC +multistopmitdbstatus;PROC gebulispezielleteile(INT CONST nr):SELECT nrOF +CASE 1:gebulidialogvorbereitenCASE 2:gebulieingabenrichtigCASE 3: +gebulilistenvorbereitenCASE 4:gebulidruckvorbereitenCASE 5:gebuliseitedrucken +CASE 6:gebulibildschirmvorbereitenCASE 7:gebuliseitezeigenENDSELECT .END +PROC gebulispezielleteile;PROC gebulidialogvorbereiten:setzeanfangswerte( +gebulieingangsmaske,gebulianfpos)END PROC gebulidialogvorbereiten;PROC +gebulieingabenrichtig:LET fnrgebjahr=2,fnrmaennlich=3,fnrweiblich=4, +fnrausgdrucker=5,fnrausgbild=6;standardpruefe(2,fnrgebjahr,null,null,niltext, +eingabestatus);IF eingabestatus<>0THEN infeld(eingabestatus);setzeeingabetest +(FALSE )ELSE waspruefen;wohinpruefen;IF eingabestatus<>0THEN infeld( +eingabestatus);setzeeingabetest(FALSE )ELSE setzegeburtsjahr; +setzeausgabedrucker(standardmaskenfeld(fnrausgbild)=niltext);setzeeingabetest +(TRUE )FI FI .waspruefen:weibl:=(standardmaskenfeld(fnrmaennlich)=niltext) +AND (standardmaskenfeld(fnrweiblich)<>niltext);maennl:=(standardmaskenfeld( +fnrweiblich)=niltext)AND (standardmaskenfeld(fnrmaennlich)<>niltext). +wohinpruefen:standardpruefe(5,fnrausgdrucker,fnrausgbild,null,niltext, +eingabestatus).setzegeburtsjahr:gebjahreingang:=standardmaskenfeld(fnrgebjahr +);IF int(gebjahreingang)<10THEN gebjahreingang:=text(null)+text(int( +gebjahreingang))FI .END PROC gebulieingabenrichtig;PROC +gebulilistenvorbereiten:#bestanderstellen(PROC +bestandgeburtsjahrgaengeerstellen).#BOOL VAR b:=FALSE ;startjahr:="01.01."+ +gebjahreingang;setzescanendewert("01.01."+text(int(gebjahreingang)+1)); +setzescanstartwert(startjahr);IF weiblTHEN startgeschl:="w";ELIF maennlTHEN +startgeschl:="m";ELSE startgeschl:="";FI ;IF startgeschl=""THEN +aktuelleindexnr:=ixsustatgebELSE aktuelleindexnr:=ixsustatgeschlgeb;FI ; +inittupel(dnrschueler);initobli(14);parsenooffields(19);setzeidentiwert(""); +putdatumwert(fnrsugebdatums,startjahr);putwert(fnrsugeschlechts,startgeschl); +putwert(fnrsustatuss,"ls");dbstatus(ok);objektlistestarten(aktuelleindexnr,"" +,fnrsugebdatums,TRUE ,b);setzebestandende(NOT multistopmitdbstatus)END PROC +gebulilistenvorbereiten;PROC gebulibildschirmvorbereiten:LET fnrausganf=2, +gebuliueberschriftneu="Schülerliste Geburtsjahrgang 19";INT VAR i; +standardkopfmaskeaktualisieren(gebuliueberschriftneu+gebjahreingang); +initspalten;setzespaltenbreite(spalte1breite);setzespaltenbreite( +spalte2bildbreite);setzespaltenbreite(spalte3breite);initausgabekopf( +bildstrich);bildanf:=fnrausganf;FOR iFROM 1UPTO ausgkopflaengeREPEAT ausgkopf +(i)IN bildanf;bildanfINCR 1END REPEAT ;klasse:=niltext;# +setzenderhilfsgroessenfuersblaettern(min(bildblocklaenge,maxblocklaenge), +bildsatzzahl);#setzebildanfangsposition(bildanf).END PROC +gebulibildschirmvorbereiten;PROC gebuliseitezeigen:ersteraufbildschirm:=TRUE +;blaettern(PROC (INT CONST )schuelerzeigen,aktion,TRUE ,TRUE ,BOOL PROC +multistop).END PROC gebuliseitezeigen;PROC schuelerzeigen(INT CONST x): +schuelerholen1;schuelerholen2;IF ersteraufbildschirmTHEN klassegeaendert:= +TRUE ;ersteraufbildschirm:=FALSE FI ;schueleraufbereiten; +schueleraufbildschirm.END PROC schuelerzeigen;PROC schueleraufbildschirm:INT +VAR i;FOR iFROM 1UPTO ausgfeldlaengeREPEAT ausgfeld(i)IN ausgabepos; +erhoeheausgabeposumeinsEND REPEAT .END PROC schueleraufbildschirm;PROC +gebulidruckvorbereiten:LET uebteil1="Liste der im Jahr 19",uebteil2= +" geborenen ",uebteil31="weiblichen ",uebteil32="männlichen ",uebteil4= +"Schüler";TEXT VAR ueberschrift;klasse:=niltext;druckvorbereiten; +variablenfuerdrucksetzen;ueberschriftvorbereitendruck;initdruckkopf( +ueberschrift);initspalten;setzespaltenbreite(spalte1breite); +setzespaltenbreite(spalte2druckbreite);setzespaltenbreite(spalte3breite); +initausgabekopf(druckstrich);holemeldungen;#putwert(dateinr(primdatid( +aktuelleindexnr))+1,"");putwert(fnrsugebdatums,"01.01."+gebjahreingang); +dbstatus(ok);#inittupel(dnrschueler);putwert(fnrsustatuss,"ls"); +aktuelleindexnr:=ixsustatjgstzug;BOOL VAR b;objektlistestarten( +aktuelleindexnr,"",fnrsusgrpzugtut,TRUE ,b);lesenvorbereitendruck(PROC (INT +CONST ,BOOL PROC ,INT VAR )scanforward,#BOOL PROC multistopmitdbstatusdrucken +#BOOL PROC multistopstatus).variablenfuerdrucksetzen:druckstrich:=druckbreite +*mittestrich;spalte2druckbreite:=druckbreite-anzspaltentrenner-spalte1breite- +spalte3breite;druckzeilenzahl:=drucklaenge(ueberschriftenzeilen)- +ausgkopflaenge.ueberschriftvorbereitendruck:ueberschrift:=uebteil1+ +gebjahreingang+uebteil2;IF weiblTHEN ueberschrift:=ueberschrift+uebteil31 +ELSE IF maennlTHEN ueberschrift:=ueberschrift+uebteil32FI ;FI ;ueberschrift:= +ueberschrift+uebteil4.holemeldungen:meldungstext(mnrbearbeitetwird, +bearbeitetwird).END PROC gebulidruckvorbereiten;PROC gebuliseitedrucken: +gebuliueberschriftdrucken;seitedrucken(PROC (INT VAR )schuelerdrucken, +druckzeilenzahl,ausgfeldlaenge,#BOOL PROC multistopdrucken#BOOL PROC +multistopstatus);seitenwechsel.END PROC gebuliseitedrucken;PROC +gebuliueberschriftdrucken:INT VAR i;druckkopfschreiben;FOR iFROM 1UPTO +ausgkopflaengeREPEAT druckzeileschreiben(ausgkopf(i))END REPEAT .END PROC +gebuliueberschriftdrucken;PROC schuelerdrucken(INT VAR zeilenzaehler):LET +markiert="#";schuelerholen1;evtleave;schuelerholen2;ggflmeldungklasse;IF +zeilenzaehler=nullTHEN klassegeaendert:=TRUE FI ;IF klassegeaendertTHEN +leerzeileindruckdateiFI ;schueleraufbereiten;zeilenzaehlerINCR ausgfeldlaenge +;schuelerindruckdatei.evtleave:IF jahrstimmtnichtCOR geschlechtstimmtnicht +THEN LEAVE schuelerdruckenFI .jahrstimmtnicht:subtext(wert(fnrsugebdatums),7, +8)<>gebjahreingang.geschlechtstimmtnicht:startgeschl<>""CAND wert( +fnrsugeschlechts)<>startgeschl.ggflmeldungklasse:IF klassegeaendertTHEN +meldungklasseFI .meldungklasse:standardmeldung(bearbeitetwird,klasse+markiert +).leerzeileindruckdatei:ausgfeld(1):=text(blank,druckbreite); +druckzeileschreiben(ausgfeld(1));zeilenzaehlerINCR 1.END PROC schuelerdrucken +;PROC schuelerindruckdatei:INT VAR i;FOR iFROM 1UPTO ausgfeldlaengeREPEAT +druckzeileschreiben(ausgfeld(i))END REPEAT .END PROC schuelerindruckdatei; +PROC initausgabekopf(TEXT CONST strich):spaltenweise(klas);spaltenweise(name) +;spaltenweise(gebtag);ausgkopf(1):=zeile;ausgkopf(2):=strich;END PROC +initausgabekopf;PROC schuelerholen1:schuelergebdat:=wert(fnrsugebdatums); +schuelername:=wert(fnrsufamnames);schuelerrufname:=wert(fnrsurufnames); +schuelernamenszus:=wert(fnrsunamenszusatzs);#alteklasse:=klasse;klasse:=wert( +fnrsusgrpjgst)+blank+wert(fnrsusgrpzugtut);klassegeaendert:=alteklasse<> +klasse.#END PROC schuelerholen1;PROC schuelerholen2:alteklasse:=klasse;klasse +:=wert(fnrsusgrpjgst)+blank+wert(fnrsusgrpzugtut);klassegeaendert:=alteklasse +<>klasse.END PROC schuelerholen2;PROC schueleraufbereiten: +schreibeklassenamegebdat.schreibeklassenamegebdat:IF klassegeaendertTHEN +spaltenweise(klasse)ELSE spaltenweise(blank)FI ;spaltenweise( +schuelernameaufber);spaltenweise(schuelergebdat);ausgfeld(1):=zeile. +schuelernameaufber:schuelername+komma+blank+schuelerrufname+blank+ +schuelernamenszus.END PROC schueleraufbereiten;END PACKET geburtslisten; + -- cgit v1.2.3