diff options
Diffstat (limited to 'app/baisy/2.2.1-schulis/src/isp.maskendesign')
-rw-r--r-- | app/baisy/2.2.1-schulis/src/isp.maskendesign | 302 |
1 files changed, 302 insertions, 0 deletions
diff --git a/app/baisy/2.2.1-schulis/src/isp.maskendesign b/app/baisy/2.2.1-schulis/src/isp.maskendesign new file mode 100644 index 0000000..a90acca --- /dev/null +++ b/app/baisy/2.2.1-schulis/src/isp.maskendesign @@ -0,0 +1,302 @@ +PACKET maskendesignDEFINES maskstart,aktuellendesignnamenlesen,maskgenstart, +holestandardvorgaben,maskenattributespeichern,einlesenderattribute, +generieremaske,zeigegeneriertemaske,formularentwerfen,formularspeichern, +felderentwerfen,felddefinitionenspeichern,maskenformularzeigen, +definitionsnamenlesen,gesuchtesfeldanzeigen,feldloeschen,feldspeichern, +feldnichtspeichern,feldmalen,feldaufneuenschirmmalen,feldattributesetzen, +holeattribute,listeallermasken,loescheneinermaske,kopierenaendern, +zweitennamenlesen,kopiereneinermaske,druckeneinermaske,neuernamefuereinemaske +:LET standardanfang=2;LET z="Liste aller Masken";LET nummernmaske= +"mb maskenfeldnummern",id="mb maskenbearbeitung1",zusatz= +"mb maskenbearbeitung2",mgmatrix="mb maskgenmatrix",mg="mb maskengenerator", +b1="mb maskenfeldattribute";LET dru=49;LET maxfeldnr=200;LET praefixs= +"Formular für: ",praefixf="form.";TEXT VAR symbalphag:="#",symbalphau:="&", +symbankreuz:="^",symbgeheim:="'",symbmeldung:="%",symbfortsetzunga:="<", +symbfortsetzunge:=">",symbpseudoblank:="!",unterlegungalpha:="_", +unterlegungankreuz:="_",unterlegunggeheim:="_",unterlegungmeldung:="=", +anzeigeankreuz:="x",anzeigegeheim:="-";TEXT VAR symbolischemaske:="";TEXT +VAR formulardatei:="";TEXT VAR maskenname:="",zweitername:="";INT VAR +feldname:=standardanfang,loeschfeld;BOOL VAR da;#DBMASKE VAR dbm;nil(dbm);# +TEXT VAR eingangsname;TAG VAR maske;;TAG VAR aktuellemaske;INT VAR +aktuelleposition;TEXT VAR logtextergaenzung;PROC maskstart: +frageentwicklernachmaskennamen(id);aktuellendesignnamenlesenEND PROC +maskstart;PROC frageentwicklernachmaskennamen(TEXT CONST start):eingangsname +:=start;standardstartproc(start)END PROC frageentwicklernachmaskennamen;PROC +aktuellendesignnamenlesen:standardmaskenfeld(maskenname,2);standardnproc; +maskenname:=standardmaskenfeld(2);init(feld)END PROC +aktuellendesignnamenlesen;PROC maskgenstart:zeigemaske;holestandardvorgaben;. +zeigemaske:frageentwicklernachmaskennamen(mg).END PROC maskgenstart;PROC +holestandardvorgaben:standardmaskenfeld("",1);standardmaskenfeld(maskenname,2 +);standardmaskenfeld(unterlegungalpha,3);standardmaskenfeld(symbalphag,4); +standardmaskenfeld(symbalphau,5);standardmaskenfeld(symbankreuz,6); +standardmaskenfeld(unterlegungankreuz,7);standardmaskenfeld(anzeigeankreuz,8) +;standardmaskenfeld(symbgeheim,9);standardmaskenfeld(unterlegunggeheim,10); +standardmaskenfeld(anzeigegeheim,11);standardmaskenfeld(symbmeldung,12); +standardmaskenfeld(unterlegungmeldung,13);standardmaskenfeld(symbfortsetzunga +,14);standardmaskenfeld(symbfortsetzunge,15);standardmaskenfeld( +symbpseudoblank,16);standardnproc;maskenname:=standardmaskenfeld(2); +unterlegungalpha:=standardmaskenfeld(3);symbalphag:=standardmaskenfeld(4); +symbalphau:=standardmaskenfeld(5);symbankreuz:=standardmaskenfeld(6); +unterlegungankreuz:=standardmaskenfeld(7);anzeigeankreuz:=standardmaskenfeld( +8);symbgeheim:=standardmaskenfeld(9);unterlegunggeheim:=standardmaskenfeld(10 +);anzeigegeheim:=standardmaskenfeld(11);symbmeldung:=standardmaskenfeld(12); +unterlegungmeldung:=standardmaskenfeld(13);symbfortsetzunga:= +standardmaskenfeld(14);symbfortsetzunge:=standardmaskenfeld(15); +symbpseudoblank:=standardmaskenfeld(16);trans(symbpseudoblank+ +symbfortsetzunga+symbfortsetzunge);.END PROC holestandardvorgaben;PROC +formularentwerfen(INT CONST nummerderauskunft):IF maskenname=""THEN +keineeingabe;return(1)ELSE setzedateinamen;IF NOT exists(symbolischemaske) +THEN IF NOT maskedaTHEN logtextergaenzung:="eingefügt";neuELSE +logtextergaenzung:="geändert";aendernFI ;FI ;formularzeigen(nummerderauskunft +)FI .keineeingabe:aktuelleposition:=standardanfang;standardmeldung(26,""). +setzedateinamen:symbolischemaske:=praefixs+maskenname;formulardatei:=praefixf ++maskenname.maskeda:maskegibtes(maskenname).neu:init(feld); +erzeugeleeresymbolischemaske(maskenname).aendern:erzeugesymbolischemaske( +maskenname).END PROC formularentwerfen;PROC formularzeigen(INT CONST +nummerderauskunft):page;sagderauskunftwasaufdemeingangsschirmstand;editiere( +symbolischemaske,"a",FALSE ).sagderauskunftwasaufdemeingangsschirmstand:TEXT +VAR eingangsinfo:="";eingangsinfoCAT infozeile("geschützt",symbalphag); +eingangsinfoCAT infozeile("ungeschützt",symbalphau);eingangsinfoCAT infozeile +("Ankreuzfeld",symbankreuz);eingangsinfoCAT infozeile("sonst. Geheimfeld", +symbgeheim);eingangsinfoCAT infozeile("Meldungsfeld",symbmeldung); +eingangsinfoCAT infozeile("Beginn Fortsetzung",symbfortsetzunga);eingangsinfo +CAT infozeile("Ende Fortsetzung",symbfortsetzunge);eingangsinfoCAT infozeile( +"Überdeckungszeichen",symbpseudoblank);eingangsinfoCAT auskunftstextende; +ergaenzeauskunft(eingangsinfo,nummerderauskunft).END PROC formularzeigen; +PROC generieremaske:erzeugemaske(maskenname);page;show(maske); +zeigegeneriertemaskeEND PROC generieremaske;PROC zeigegeneriertemaske:INT +VAR feldind,maxfeld:=min(fields(maske),maxfeldnr);ROW maxfeldnrTEXT VAR +maskenfeld;INT VAR einstieg:=maxfeldnr;FOR feldindFROM 1UPTO maxfeldREP IF +fieldexists(maske,feldind)THEN maskenfeld(feldind):="";put(maske,"",feldind); +cursor(maske,feldind);out(text(feldind));IF (NOT protected(maske,feldind)) +CAND (feldind<einstieg)THEN einstieg:=feldindFI ;FI PER ;IF einstieg>maxfeld +THEN einstieg:=standardanfangFI ;get(maske,maskenfeld,einstieg)END PROC +zeigegeneriertemaske;ROW maxfeldnrTEXT VAR feld;INT VAR maxfeld;PROC +maskenattributesetzen:maskenholen;formularzeigen;attributezeigen; +einlesenderattribute.maskenholen:initmaske(aktuellemaske,mgmatrix). +formularzeigen:page;standardkopfmaskeausgeben(text(vergleichsknoten));show( +aktuellemaske).attributezeigen:INT VAR i;INT VAR maxfields:=fields( +aktuellemaske);feld(1):="";TEXT VAR hellername:=""+maskenname+" ";feld(2):= +hellername+(length(aktuellemaske,2)-length(hellername))*" ";INT VAR zaehler:= +3;FOR iFROM 2UPTO min(fields(maske),maxfeldnr-1)REP IF (fieldexists(maske,i)) +THEN IF feld(zaehler)=""THEN feld(zaehler):=text(i,3)+text(auskunftsnr(maske, +i),5)+text(symbolicname(maske,i),3)FI ;zaehlerINCR 1FI PER ;FOR iFROM 1UPTO +zaehler-1REP IF fieldexists(aktuellemaske,i)THEN put(aktuellemaske,feld(i),i) +FI PER ;FOR iFROM zaehlerUPTO maxfieldsREP protect(aktuellemaske,i,TRUE )PER +;maxfeld:=zaehler-1;aktuelleposition:=3.END PROC maskenattributesetzen;PROC +einlesenderattribute:get(aktuellemaske,feld,aktuelleposition)END PROC +einlesenderattribute;PROC maskenattributespeichern:INT VAR i;IF NOT +maskengeneratorTHEN gibtestag;IF NOT daTHEN meldezuerstformular;LEAVE +maskenattributespeichernFI ;FOR iFROM 1UPTO maxfeldnrREP feld(i):=""PER ;FI ; +maskenattributesetzen;FOR iFROM 3UPTO maxfeldREP INT VAR feldnr:=int(subtext( +feld(i),1,3));auskunftsnr(maske,feldnr,int(subtext(feld(i),4,8))); +symbolicname(maske,feldnr,int(subtext(feld(i),9,11)))PER .maskengenerator: +eingangsname=mg.meldezuerstformular:standardmeldung(32,"");return(1).END +PROC maskenattributespeichern;PROC formularspeichern(INT CONST zurueck): +schreibemaske(maske,maskenname);logbucheintrag(logtextergaenzung);IF exists( +formulardatei)THEN forget(formulardatei,quiet)FI ;return(zurueck); +frageentwicklernachmaskennamen(eingangsname);meldespeicherung. +meldespeicherung:standardmeldung(27,"").END PROC formularspeichern;PROC +felderentwerfen:gibtestag;IF daTHEN initialisiereELSE meldezuerstformularFI . +initialisiere:feldname:=standardanfang;maskenformularzeigen; +definitionsnamenlesen.meldezuerstformular:standardmeldung(32,"");return(1). +END PROC felderentwerfen;PROC gibtestag:initmaske(maske,maskenname);da:= +maskegibtes(maskenname)END PROC gibtestag;PROC felddefinitionenspeichern: +schreibemaske(maske,maskenname);return(2);frageentwicklernachmaskennamen(id); +meldespeicherung;.meldespeicherung:standardmeldung(28,"").END PROC +felddefinitionenspeichern;PROC maskenformularzeigen: +maskezuderfelderstelltwerdensollzeigen;entwicklernachfeldnamenfragen. +maskezuderfelderstelltwerdensollzeigen:page;show(maske).END PROC +maskenformularzeigen;PROC entwicklernachfeldnamenfragen:aktuelleposition:= +standardanfang;initmaske(aktuellemaske,nummernmaske);show(aktuellemaske).END +PROC entwicklernachfeldnamenfragen;PROC definitionsnamenlesen:TEXT VAR f:= +text(feldname);ROW maxfeldnrTEXT VAR feld;init(feld);feld(2):=f;loeschfeld:= +feldname;putget(aktuellemaske,feld,aktuelleposition);feldname:=int(feld( +aktuelleposition));loeschemeldung(aktuellemaske);END PROC +definitionsnamenlesen;PROC gesuchtesfeldanzeigen:IF NOT fieldexists(maske, +feldname)THEN meldefalschenummer;loeschenELSE TEXT CONST pointer:=(length( +maske,feldname))*"?";loeschen;put(maske,pointer,feldname);meldegesuchtesfeld +FI ;return(1).meldegesuchtesfeld:melde(aktuellemaske,10).loeschen:put(maske, +"",loeschfeld).END PROC gesuchtesfeldanzeigen;PROC meldefalschenummer:melde( +aktuellemaske,9).END PROC meldefalschenummer;LET null="�";TEXT VAR xrow,yrow, +lrow,trow;BOOL VAR a,b,c,d,e;INT VAR sym,aus;TEXT VAR geheimzeichen;PROC +feldloeschen:INT VAR x,y;IF fieldexists(maske,feldname)THEN clearfield(maske, +feldname);put(maske,"",loeschfeld);getcursor(x,y);cursor(1,y);out(formline( +maske,y));melde(aktuellemaske,42)ELSE meldefalschenummerFI ;return(1)END +PROC feldloeschen;PROC feldmalen:xrow:="";yrow:=" ";lrow:="";trow:="";IF +menuedraussenTHEN reorganizescreenFI ;designfield(maske,feldname,xrow,yrow, +lrow,trow)END PROC feldmalen;PROC feldaufneuenschirmmalen:reorganizescreen; +designfield(maske,feldname,xrow,yrow,lrow,trow)END PROC +feldaufneuenschirmmalen;PROC feldattributesetzen:INT VAR gz;fieldinfos(maske, +feldname,gz,a,b,c,d,e);geheimzeichen:=code(gz);baisymaskeholen;sym:= +symbolicname(maske,feldname);aus:=auskunftsnr(maske,feldname);show( +aktuellemaske);holeattribute;END PROC feldattributesetzen;PROC +baisymaskeholen:initmaske(aktuellemaske,b1)END PROC baisymaskeholen;PROC +holeattribute:ROW maxfeldnrTEXT VAR feld;init(feld);IF bTHEN feld(2):="X"FI ; +IF cTHEN feld(3):=geheimzeichenFI ;feld(4):=text(sym);putget(aktuellemaske, +feld,aktuelleposition);b:=feld(2)<>"";c:=feld(3)<>"";geheimzeichen:=feld(3); +sym:=int(feld(4))END PROC holeattribute;PROC feldspeichern:definefield(maske, +xrow,yrow,lrow,trow,sym,aus,feldname,geheimzeichen,null);setfieldinfos(maske, +feldname,a,b,c);maskenformularzeigen;meldevorlaeufiguebernommen;return(3). +meldevorlaeufiguebernommen:melde(aktuellemaske,41).END PROC feldspeichern; +PROC feldnichtspeichern(INT CONST schritte):maskenformularzeigen;return( +schritte)END PROC feldnichtspeichern;PROC listeallermasken: +meldezusammenstellung;listen.listen:listezusammenstellen;zeigendermaskenliste +.meldezusammenstellung:store(FALSE );standardmeldung(7,"");store(TRUE ). +listezusammenstellen:maskenliste(z).END PROC listeallermasken;PROC +zeigendermaskenliste:page;editiere(z)END PROC zeigendermaskenliste;PROC +loescheneinermaske:IF maskenname=""THEN keineeingabe;return(1)ELSE IF +maskegibtes(maskenname)THEN loeschemaske(maskenname);logbucheintrag( +"gelöscht");meldeloeschungELSE maskegibtesnichtFI ;return(1)FI . +maskegibtesnicht:standardmeldung(8,"").meldeloeschung:standardmeldung(33,""). +keineeingabe:standardmeldung(26,"").END PROC loescheneinermaske;PROC +kopierenaendern:maskekopierenoderaendern;IF NOT daTHEN maskegibtesnichtFI . +maskegibtesnicht:standardmeldung(8,"");return(1).END PROC kopierenaendern; +PROC maskekopierenoderaendern:IF NOT maskegibtes(maskenname)THEN da:=FALSE +ELSE da:=TRUE ;frageentwicklernachmaske;zweitennamenlesenFI . +frageentwicklernachmaske:aktuelleposition:=standardanfang;initmaske( +aktuellemaske,zusatz);zweitername:="";show(aktuellemaske).END PROC +maskekopierenoderaendern;PROC zweitennamenlesen:ROW maxfeldnrTEXT VAR feld; +init(feld);feld(2):=zweitername;putget(aktuellemaske,feld,aktuelleposition); +zweitername:=feld(2);loeschemeldung(aktuellemaske).END PROC zweitennamenlesen +;PROC kopiereneinermaske:IF maskegibtes(zweitername)THEN da:=TRUE ;return(1) +ELSE maskekopieren(maskenname,zweitername);da:=FALSE FI ;IF daTHEN gibtsschon +ELSE return(2);frageentwicklernachmaskennamen(id);meldekopierungFI . +gibtsschon:melde(aktuellemaske,31).meldekopierung:melde(aktuellemaske,29). +END PROC kopiereneinermaske;PROC neuernamefuereinemaske:IF maskegibtes( +zweitername)THEN da:=TRUE ;return(1)ELSE maskeumbenennen(maskenname, +zweitername);da:=FALSE ;FI ;IF daTHEN gibtsschonELSE return(2); +frageentwicklernachmaskennamen(id);meldeumbenennungFI .gibtsschon:melde( +aktuellemaske,31).meldeumbenennung:melde(aktuellemaske,30).END PROC +neuernamefuereinemaske;PROC druckeneinermaske:BOOL VAR maskeda;TAG VAR t;IF +maskenname=""THEN keineeingabe;return(1)ELSE maskeda:=maskegibtes(t, +maskenname);IF maskedaTHEN meldedrucken;fuehredurchELSE maskegibtesnichtFI ; +return(1)FI .maskegibtesnicht:standardmeldung(8,"").keineeingabe: +standardmeldung(26,"").meldedrucken:standardmeldung(dru,"").fuehredurch: +kopfindatei;formularindatei;feldinformationenindatei;drucken.kopfindatei:LET +temp="temporäre Druckdatei";FILE VAR f:=sequentialfile(output,temp);putline(f +,"Name der Maske: "+maskenname);putline(f,"Stand: "+date+" "+ +timeofday);line(f,2).drucken:print(temp);forget(temp,quiet).formularindatei: +INT VAR fz:=min(fields(t),maxfeldnr);IF fz>0THEN INT VAR i;FOR iFROM 1UPTO fz +REP IF fieldexists(t,i)THEN fill(t,text(i),i)FI PER FI ;tTO f. +feldinformationenindatei:line(f,2);IF fz>0THEN ueberschrift;FOR iFROM 1UPTO +fzREP IF fieldexists(t,i)THEN tabellenzeileFI PER FI .ueberschrift:putline(f, +"Nr...Länge...geschützt....geheim.....Symbol.....Auskunftsnr...."). +tabellenzeile:INT VAR gz;BOOL VAR a,b,c,d,e;fieldinfos(t,i,gz,a,b,c,d,e); +TEXT VAR geheim:=code(gz);INT VAR sym:=0,aus:=0;sym:=symbolicname(t,i);aus:= +auskunftsnr(t,i);put(f,text(text(i),4));put(f,text(text(length(t,i)),7));IF b +THEN put(f,text("X",13))ELSE put(f,13*" ")FI ;IF cTHEN put(f,text(geheim,11)) +ELSE put(f,11*" ")FI ;IF sym<>0THEN put(f,text(text(sym),10))ELSE put(f,10* +" ")FI ;IF aus<>0THEN put(f,text(aus))FI ;line(f,1).END PROC +druckeneinermaske;PROC schreibemaske(TAG VAR ta,TEXT CONST t):setzemaske(ta); +maskespeichern(t)END PROC schreibemaske;PROC loeschemaske(TEXT CONST t): +maskeloeschen(t)END PROC loeschemaske;BOOL PROC maskegibtes(TAG VAR t,TEXT +CONST name):initmaske(t,name);maskegibtes(name)END PROC maskegibtes;PROC +erzeugeleeresymbolischemaske(TEXT CONST maskenname):oeffneausgabedatei; +schreibemarkierungenindatei.oeffneausgabedatei:TEXT CONST dateiname:=praefixs ++maskenname;forget(dateiname,quiet);FILE VAR f:=sequentialfile(output, +dateiname).schreibemarkierungenindatei:dreileerzeilen;grundlinie; +vieleleerzeilen;endlinie.dreileerzeilen:INT VAR i;FOR iFROM 1UPTO 3REP +putline(f,"")PER .grundlinie:putline(f,78*unterlegungmeldung).vieleleerzeilen +:FOR iFROM 1UPTO 18REP putline(f,"")PER .endlinie:putline(f,3* +unterlegungmeldung+72*symbmeldung+3*unterlegungmeldung).END PROC +erzeugeleeresymbolischemaske;PROC erzeugesymbolischemaske(TEXT CONST +maskenname):holeformular;oeffneausgabedatei;setzesymbole; +zeigesymbolischemaske.holeformular:INT VAR i;INT CONST maxmaskenfeld:= +maxfeldnr-1;initmaske(maske,maskenname);FOR iFROM 2UPTO maxmaskenfeldREP IF +fieldexists(maske,i)THEN feld(i+1):=text(i,3)+text(auskunftsnr(maske,i),5)+ +text(symbolicname(maske,i),3)ELSE feld(i+1):=""FI PER .oeffneausgabedatei: +TEXT CONST dateiname:=praefixs+maskenname;forget(dateiname,quiet);FILE VAR f +:=sequentialfile(output,dateiname).zeigesymbolischemaske:maskeTO f. +setzesymbole:erstesfeld;REP symbolisierefeld;naechstesfeldUNTIL letztesfeld +PER ;abschluss.erstesfeld:INT VAR aktfeld:=firstfield(maske),zeilennr:=1;INT +VAR altesfeld:=aktfeld;INT VAR zeilenpointer:=1.naechstesfeld:altesfeld:= +aktfeld;aktfeld:=nextfield(maske,aktfeld).letztesfeld:aktfeld<0. +symbolisierefeld:setzezeile;pruefeobfortsetzung;uebernehmenbiszudiesemfeld; +holeinformationenueberdasfeld;fuelledasfeldmitdensymbolen. +fuelledasfeldmitdensymbolen:TEXT VAR alteszeichen;IF aktfeld=1THEN fill(maske +,length(maske,1)*symbmeldung,aktfeld);alteszeichen:=symbmeldungELSE IF +geschuetztTHEN fill(maske,laenge*symbalphag,aktfeld);alteszeichen:=symbalphag +ELSE IF geheimTHEN IF laenge=1THEN IF code(gz)=anzeigeankreuzTHEN fill(maske, +symbankreuz,aktfeld);alteszeichen:=symbankreuzELSE fill(maske,symbgeheim, +aktfeld);alteszeichen:=symbgeheimFI ELSE fill(maske,laenge*symbgeheim,aktfeld +);alteszeichen:=symbgeheimFI ELSE fill(maske,laenge*symbalphau,aktfeld); +alteszeichen:=symbalphauFI FI FI .holeinformationenueberdasfeld:INT VAR gz,x, +y,laenge:=length(maske,aktfeld);BOOL VAR a,geschuetzt,geheim,d,e;fieldinfos( +maske,aktfeld,gz,a,geschuetzt,geheim,d,e);.setzezeile:woliegtdasfeld; +allevorhergehendenzeilen.woliegtdasfeld:cursor(maske,aktfeld);getcursor(x,y). +allevorhergehendenzeilen:IF y>zeilennrTHEN INT VAR xalt:=x;x:=length(formline +(maske,zeilennr))+1;pruefeobfortsetzung;uebernehmenbiszudiesemfeld;x:=xalt; +zeilenpointer:=1;zeileaktualisierenFI .zeileaktualisieren:zeilennr:=y;. +abschluss:y:=ysize(maske)+1;allevorhergehendenzeilen.schoneinfeldinderzeile: +zeilenpointer<>1.pruefeobfortsetzung:BOOL VAR fortsetzung:= +schoneinfeldinderzeileCAND (pos(subtext(formline(maske,zeilennr), +zeilenpointer,x-1),alteszeichen,laenge+1)>0).uebernehmenbiszudiesemfeld:IF +fortsetzungTHEN fill(maske,symbfortsetzunga+((length(maske,altesfeld)-2)* +alteszeichen)+symbfortsetzunge,altesfeld)FI ;zeilenpointer:=x.END PROC +erzeugesymbolischemaske;PROC feldanfang(INT VAR fa,TEXT CONST zeile):INT +CONST zeilenlaenge:=length(zeile);WHILE NOT issymbol(subtext(zeile,fa,fa)) +REP faINCR 1UNTIL NOT inzeilePER .inzeile:NOT (fa>zeilenlaenge).END PROC +feldanfang;BOOL PROC issymbol(TEXT CONST s):TEXT VAR symb:=s;symbol(symb); +symb<>""END PROC issymbol;PROC symbol(TEXT VAR s):IF NOT ((s=symbalphag)OR (s +=symbalphau)OR (s=symbankreuz)OR (s=symbgeheim)OR (s=symbmeldung)OR (s= +symbfortsetzunga)OR (s=symbfortsetzunge))THEN s:=""FI END PROC symbol;PROC +felddefinition(INT VAR fa,TEXT VAR zeile,INT VAR feldnr,INT CONST znr):IF +feldmitteilfeldernTHEN teilfelderELSE einfachesfeldFI ;setzefeld. +feldmitteilfeldern:subtext(zeile,fa,fa)=symbfortsetzunga.teilfelder: +geschuetzt:=FALSE ;geheim:=FALSE ;xkoord:="";ykoord:="";laengen:=""; +geheimzeichen:=code(0);TEXT VAR gesamtunterlegung:=unterlegungalpha;BOOL VAR +gesamtgeschuetzt:=TRUE ,gesamtgeheim:=FALSE ;teilfeldbearbeitung;unterlegung +:=gesamtunterlegung;geschuetzt:=gesamtgeschuetzt;geheim:=gesamtgeheim. +teilfeldbearbeitung:REP efeld(zeile,fa,unterlegung,xkoord,ykoord,laengen, +geschuetzt,geheim,geheimzeichen,znr);IF (unterlegung=symbfortsetzunge)COR ( +unterlegung="")THEN LEAVE teilfeldbearbeitungELIF unterlegung<>""THEN +gesamtunterlegung:=unterlegung;gesamtgeschuetzt:=geschuetzt;gesamtgeheim:= +geheimFI ;faINCR 1;feldanfang(fa,zeile);PER .einfachesfeld:TEXT VAR +unterlegung;BOOL VAR geschuetzt:=FALSE ,geheim:=FALSE ;TEXT VAR xkoord:="", +ykoord:="",laengen:="",geheimzeichen:=code(0);efeld(zeile,fa,unterlegung, +xkoord,ykoord,laengen,geschuetzt,geheim,geheimzeichen,znr);.setzefeld:INT +VAR fnr;IF meldungsfeldTHEN fnr:=1;geschuetzt:=TRUE ELSE fnr:=feldnr;feldnr +INCR 1FI ;definefield(maske,xkoord,ykoord,laengen,code(0),0,0,fnr, +geheimzeichen,code(0));setfieldinfos(maske,fnr,FALSE ,geschuetzt,geheim); +ersetzedurchunterlegung(zeile,xkoord,laengen,unterlegung).meldungsfeld: +subtext(zeile,fa,fa)=symbmeldung.END PROC felddefinition;PROC +ersetzedurchunterlegung(TEXT VAR zeile,TEXT CONST xkoord,laengen,unterlegung) +:INT VAR eintragszahl:=length(xkoord),ind;FOR indFROM 1UPTO eintragszahlREP +ersetzungPER .ersetzung:INT VAR fstart,flaenge;fstart:=code(subtext(xkoord, +ind,ind));flaenge:=code(subtext(laengen,ind,ind));replace(zeile,fstart, +flaenge*unterlegung);.END PROC ersetzedurchunterlegung;PROC efeld(TEXT CONST +zeile,INT VAR fa,TEXT VAR unterlegung,xkoord,ykoord,laengen,BOOL VAR +geschuetzt,geheim,TEXT VAR geheimzeichen,INT CONST znr):INT VAR poszeile:=fa; +IF issymbol(subtext(zeile,poszeile,poszeile))THEN WHILE issymbol(subtext( +zeile,poszeile+1,poszeile+1))REP poszeileINCR 1PER ;xkoordCAT code(fa);ykoord +CAT code(znr);laengenCAT code(poszeile-fa+1);fa:=poszeile;FI ;TEXT CONST s:= +subtext(zeile,fa,fa);IF s=symbalphagTHEN geschuetzt:=TRUE ;unterlegung:= +unterlegungalphaELIF s=symbalphauTHEN geschuetzt:=FALSE ;unterlegung:= +unterlegungalphaELIF s=symbankreuzTHEN geheim:=TRUE ;unterlegung:= +unterlegungankreuz;geheimzeichen:=anzeigeankreuzELIF s=symbgeheimTHEN geheim +:=TRUE ;unterlegung:=unterlegunggeheim;geheimzeichen:=anzeigegeheimELIF s= +symbmeldungTHEN unterlegung:=unterlegungmeldungELIF s=symbfortsetzungeTHEN +unterlegung:=symbfortsetzungeELSE unterlegung:=""FI END PROC efeld;PROC +erzeugemaske(TEXT CONST maskenname):oeffnedatei; +generieremaskeausformulardatei;uebertrageformular;.oeffnedatei:forget( +formulardatei,quiet);copy(symbolischemaske,formulardatei);FILE VAR datei:= +sequentialfile(modify,formulardatei).uebertrageformular:input(datei);dateiTO +maske;forget(formulardatei,quiet).generieremaskeausformulardatei: +holeerstezeile;REP generierefelderdieserzeile;schreibeformularzeile; +holenaechstezeileUNTIL dateiendePER .holeerstezeile:ananfang;lesezeile. +holenaechstezeile:einsweiter;lesezeile.dateiende:eof(datei).einsweiter:down( +datei,1).ananfang:nil(maske);TEXT VAR zeile:="";toline(datei,1);INT VAR +feldnr:=2.lesezeile:readrecord(datei,zeile).schreibeformularzeile:writerecord +(datei,zeile).generierefelderdieserzeile:startezeile;REP +findefeldspezifikation;definierenaechstesfeldPER .startezeile:INT VAR fa:=1. +findefeldspezifikation:feldanfang(fa,zeile);IF fa>length(zeile)THEN LEAVE +generierefelderdieserzeileFI ;.definierenaechstesfeld:felddefinition(fa,zeile +,feldnr,lineno(datei));faINCR 1.END PROC erzeugemaske;TEXT PROC infozeile( +TEXT CONST t,s):auskunftstextende+t+" = "+sEND PROC infozeile;PROC init(ROW +maxfeldnrTEXT VAR feld):INT VAR i;FOR iFROM 1UPTO maxfeldnrREP feld(i):="" +PER END PROC init;PROC logbucheintrag(TEXT CONST logergaenzung):TEXT VAR +eintrag:="Maske ";eintragCAT maskenname;eintragCAT " ";eintragCAT +logergaenzung;logeintrag(eintrag)END PROC logbucheintrag;END PACKET +maskendesign + |