PACKETsimselmaskenDEFINES TAG,:=,nil,tagsankoppeln,formular,show,put,get,putget,leavingcode,fieldexists,cursor,fieldinfos,setfieldinfos:LETbeginmark="",endmark="",chop=1,chome=1,cvor=2,cfeldende=18,crueck=8,cfeldanf=20,choch=3,cfeldrueck=19,crunter=10,ctab=9,csettab=21,ceinf=11,caufbrech=22,causf=12,clearn=26,cfeldvor=13,cloeschende=24,cmark=16,cneu=17,cesc=27,cseiterueck=15,cseitevor=14;LETright="�",left="�",home="�";LETsimseltask="ls-MENUKARTEN",error=1110,sendetags=1120;INITFLAG VARinthistask:=FALSE;TEXT VARabc:="";INT VARi;FORiFROM33UPTO126REPabcCATcode(i);PER;FORiFROM214UPTO222REPabcCATcode(i);PER;abcCATcode(251);LEThoptasten="?aouAOUBb§</>(!)-k'= #",hopcodes="�äöüÄÖÜßßß[\]{|}k^~ \#";LETtaglines=24,maxfields=100;BOOL VARbeimletztenrausfallen:=FALSE;BOOL VARclosedbit,protectbit,darstbit,tabbit,leftbit,exitbit,rollbit,normal:=TRUE;INT VARworkint;PROCxoutsubtext(TEXT CONSTwas,INT CONSTvon,bis):out(subtext(was,von,bis))END PROCxoutsubtext;TYPE TAG=STRUCT(TEXTerstel,darst,diainfo,dbnam,ausknam,feld,x,y,len,tab,ROWtaglinesTEXTformblatt,INTxmax,ymax,xs,ys,dbp,ver,durchs,art);OP:=(TAG VARa,TAG CONSTb):CONCR(a):=CONCR(b)END OP:=;PROCnil(TAG VARt):t.formblatt:=ROWtaglinesTEXT:("","","","","","","","","","","","","","","","","","","","","","","","");t.xmax:=0;t.ymax:=0;t.xs:=1;t.ys:=1;t.dbp:=0;t.ver:=1;t.durchs:=0;t.art:=0;t.darst:="";t.erstel:="";t.diainfo:="";t.dbnam:="";t.ausknam:="";t.feld:="";t.x:="";t.y:="";t.tab:="";t.len:="";END PROCnil;BOOL PROCfieldexists(TAG CONSTa,INT CONSTfeldnr):(a.erstelVSUBfeldnr)>0END PROCfieldexists;PROCsetinfo(TEXT CONSTstring,INT CONSTpos):workint:=stringVSUBpos;IFworkint>0THENsetallvaluesELSEnormal:=TRUE FI.setallvalues:closedbit:=hbit;protectbit:=hbit;darstbit:=hbit;tabbit:=hbit;leftbit:=hbit;exitbit:=hbit;rollbit:=hbit;normal:=FALSE.hbit:workint:=workint*2;IFworkint>255THENworkintDECR256;TRUE ELSE FALSE FI.END PROCsetinfo;PROCfieldinfos(TAG CONSTt,INT CONSTfeld,INT VARgeheimcode,BOOL VARclosed,protected,secret,special,left):geheimcode:=code(t.darstSUBfeld);setinfo(t.diainfo,feld);IFnormalTHENclosed:=FALSE;protected:=FALSE;secret:=FALSE;special:=FALSE;left:=FALSE;ELSEclosed:=closedbit;protected:=protectbit;secret:=darstbit;special:=tabbit;left:=leftbit;FI END PROCfieldinfos;PROCsetfieldinfos(TAG VARt,INT CONSTfeld,BOOL CONSTclosed,protected,secret):INT VARcd:=(t.diainfoVSUBfeld)MOD32;IFsecretTHENcdINCR32FI;IFprotectedTHENcdINCR64FI;IFclosedTHENcdINCR128FI;replaceiac(t.diainfo,feld,code(cd))END PROCsetfieldinfos;INT VARafeld,ax,ay,al,ael,tlen,tout;PROCeput(TAG CONSTff,TEXT CONSTt,INT CONSTelfeld):eput(ff,t,elfeld,1)END PROCeput;PROCeput(TAG CONSTff,TEXT CONSTt,INT CONSTelfeld,INT CONSTabwo):zumerstenelementarfeld;WHILEnochgenugtextdaREPfuelleelementarfeld;elementarfeldweiterzaehlen;IFgehoertzumnaechstenfeldTHEN LEAVEeputFI;zumelementarfeld;PER;gibrestaus;REPelementarfeldweiterzaehlen;IFgehoertzumnaechstenfeldTHEN LEAVEeputFI;zumelementarfeld;gibhintergrundausPER.zumerstenelementarfeld:tlen:=LENGTHt;tout:=abwo-1;afeld:=ff.feldVSUBelfeld;ael:=elfeld;positionieren(ff).fuelleelementarfeld:xoutsubtext(t,tout+1,tout+al);toutINCRal.nochgenugtextda:tout+al<tlen.elementarfeldweiterzaehlen:aelINCR1.zumelementarfeld:positionieren(ff).gehoertzumnaechstenfeld:(ff.feldVSUBael)<>afeld.gibrestaus:xoutsubtext(t,tout+1,tlen);IFtout+al>tlenTHENxoutsubtext(grund,ax+tlen-tout,ax+al-1)FI.gibhintergrundaus:xoutsubtext(grund,ax,ax+al-1).grund:ff.formblatt(ay).END PROCeput;PROCpositionieren(TAG CONSTff):al:=ff.lenVSUBael;ax:=ff.xVSUBael;ay:=ff.yVSUBael;cursor(ax,ay).END PROCpositionieren;PROCcursor(TAG CONSTff,INT CONSTfeld):ael:=ff.erstelVSUBfeld;positionieren(ff)END PROCcursor;INT PROClength(TAG CONSTff,INT CONSTfeld):zumerstenelementarfeld;IFael<1THEN LEAVElengthWITH0FI;INT VARlen:=0;REPlenINCRfeldlaenge;zumnaechstenelementarfeld;UNTILgehoertzumnaechstenfeldPER;len.zumerstenelementarfeld:ael:=ff.erstelVSUBfeld.zumnaechstenelementarfeld:aelINCR1.gehoertzumnaechstenfeld:(ff.feldVSUBael)<>feld.feldlaenge:ff.lenVSUBael
.END PROClength;PROCshow(TAG CONSTff):INT VARi;out(home);out(ff.formblatt(1));FORiFROM2UPTOff.ymaxREPline;out(ff.formblatt(i))PER.END PROCshow;INT VARcharcode:=0,lastx,lasty;PROCtranslatecode:charcode:=code(char);SELECTcharcodeOF CASEchop:charcode:=chomeCASEcvor:charcode:=cfeldendeCASEcrueck:charcode:=cfeldanfCASEchoch:charcode:=cseiterueckCASEcrunter:charcode:=cseitevorCASEctab:charcode:=csettabCASEceinf:charcode:=caufbrechCASEcausf:charcode:=cloeschendeCASEcfeldvor:charcode:=cfeldrueckCASEcmark:charcode:=cneuCASEcesc:charcode:=clearnOTHERWISEcharcode:=pos(hoptasten,char);IFcharcode=0THEN IFischarTHEN FI ELSEchar:=hopcodesSUBcharcode;charcode:=code(char)FI END SELECT END PROCtranslatecode;TEXT VARchar;BOOL PROCischar:inchar(char);charcode:=code(char);IFcharcode>31THEN TRUE ELIFcharcode=chopTHENinchar(char);translatecode;charcode>31ELSE FALSE FI END PROCischar;INT VARaktbegin,aktfeld,aktline,aktlen,aktanf,aktel,wo;PROCsetfieldvalues(TAG CONSTta):aktlen:=ta.lenVSUBaktel;aktanf:=ta.xVSUBaktel;aktline:=ta.yVSUBaktelEND PROCsetfieldvalues;INT VARnextfeld,nextel,nextwo,nextbegin;PROCsetlasteditvalues:preset:=TRUE END PROCsetlasteditvalues;PROCsetneweditvalues:aktfeld:=nextfeld;aktbegin:=nextbegin;aktel:=nextel;wo:=nextwo;preset:=TRUE END PROCsetneweditvalues;BOOL VARpreset:=FALSE;PROCsearchfield(TAG CONSTt,INT CONSTx,y,BOOL VARerfolg):erfolg:=FALSE;nextel:=0;REPsucheelementinrichtigerzeileUNTILkeinsmehrdaCORxposstimmtPER;IFerfolgTHENnextfeld:=t.feldVSUBnextel;nextbegin:=1;INT VARi:=t.erstelVSUBnextfeld;WHILEi<nextelREPnextbeginINCR(t.lenVSUBi);iINCR1PER;nextwo:=nextbegin+x-anfangFI.sucheelementinrichtigerzeile:nextel:=pos(t.y,code(y),nextel+1).keinsmehrda:nextel=0.xposstimmt:erfolg:=anfang<=xANDende>x;erfolg.anfang:t.xVSUBnextel.ende:(t.xVSUBnextel)+(t.lenVSUBnextel).END PROCsearchfield;PROCput(TAG CONSTff,TEXT CONSTv,INT CONSTfeld):setinfo(ff.diainfo,feld);INT VARerstelem:=ff.erstelVSUBfeld;IFerstelem>0THEN IFnormalCOR NOTdarstbitTHENeput(ff,v,erstelem)ELSEeput(ff,LENGTHv*(ff.darstSUBfeld),erstelem)FI FI END PROCput;INT PROCleavingcode:charcodeEND PROCleavingcode;PROCputget(TAG CONSTff,ROWmaxfieldsTEXT VARv,INT VAReinstieg,TEXT VARtaste):put(ff,v);get(ff,v,einstieg,taste)END PROCputget;PROCput(TAG CONSTff,ROWmaxfieldsTEXT VARfieldvalues):INT VARiFORiFROM1UPTO LENGTHff.erstelREP IFfieldexists(ff,i)THENput(ff,fieldvalues(i),i)FI PER END PROCput;PROCget(TAG CONSTff,TEXT VAReingabe,INT CONSTfeld,TEXT VARexittaste):setinfo(ff.diainfo,feld);editieren.editieren:cursor(ff,feld);getcursor(lastx,lasty);out(beginmark);cursor(lastx,lasty);editget(eingabe,length(eingabe),length(ff,feld),code(cfeldvor)+code(choch)+code(crunter),abc+right+left,exittaste);out(endmark);cursor(lastx,lasty);put(ff,eingabe,feld);IFlength(exittaste)>1THENexittaste:=subtext(exittaste,2,2);FI.END PROCget;PROCputget(TAG CONSTff,TEXT VAReingabe,INT CONSTfeld,TEXT VARtaste):get(ff,eingabe,feld,taste)END PROCputget;PROCget(TAG CONSTff,ROWmaxfieldsTEXT VARfieldvalues,INT VARfeld,TEXT VARtaste):TEXT VARexittaste:="";INT VARaltesfeld;IF NOTfieldexists(ff,feld)THENerrorstop("startfeld nicht im tag")ELSE REPEATaltesfeld:=feld;setinfo(ff.diainfo,feld);IF NOTgeschuetztTHENeingabefeldELSEgeschuetztesfeldFI;charcode:=code(subtext(exittaste,1,1));IFcharcode=ctabTHENcharcode:=cfeldrueckELIFcharcode=cescTHEN IFsubtext(exittaste,2,2)=leftTHENcharcode:=cfeldrueckELIFsubtext(exittaste,2,2)=rightTHENcharcode:=cfeldvorFI;FI;executecommandcode(ff,feld);IFfeld=1THENfeld:=2FI;UNTILcharcode=cescPER;FI;.geschuetzt:INT VARgeheim;BOOL VARcl,protect,s,sp,l;fieldinfos(ff,feld,geheim,cl,protect,s,sp,l);protect.ankreuzen:cl.geschuetztesfeld:cursor(ff,feld);getcursor(lastx,lasty);REPinchar(exittaste)UNTILexittaste="�"PER;inchar(taste);.eingabefeld:cursor(ff,feld);getcursor(lastx,lasty);out(beginmark);cursor(lastx,lasty);editget(fieldvalues(feld),length(fieldvalues(feld)),length(ff,feld),code(cfeldvor)+code(choch)+code(crunter),abc+right+left,exittaste);out(endmark);IFankreuzenTHENankreuzfeldbehandlung;
FI;cursor(lastx,lasty);put(ff,fieldvalues(feld),feld);IFlength(exittaste)>1THENtaste:=subtext(exittaste,2,2);FI;.ankreuzfeldbehandlung:IFlength(fieldvalues(feld))>0THENfieldvalues(feld):=subtext(fieldvalues(feld),1,1)ELSEfieldvalues(feld):="_"FI;IFpos("_ ",fieldvalues(feld))>0THENfieldvalues(feld):="_"ELSEfieldvalues(feld):="X"FI;.END PROCget;PROCexecutecommandcode(TAG CONSTff,INT VARfeld):SELECTcharcodeOF CASEcfeldrueck:topriorfieldCASEcfeldvor:tonextfieldCASEchoch:goupifpossibleCASEcrunter:godownifpossibleCASEchome:tohomefieldCASEctab:setlasteditvaluesEND SELECT.topriorfield:REPEATfeld:=priorfield(ff,feld)UNTILwarerstesCORnichtgesperrtPER;IFwarerstesTHENtohomefieldFI.tonextfield:INT VARoldfeld:=feld;REPfeld:=nextfield(ff,feld)UNTILwarletztesCORnichtgesperrtPER;IFwarletztesTHENfeld:=oldfeld;IFbeimletztenrausfallenTHENcharcode:=cesc;beimletztenrausfallen:=FALSE FI FI.tohomefield:feld:=firstfield(ff);WHILEgesperrtREPfeld:=nextfield(ff,feld)PER.goupifpossible:BOOL VARerfolg;searchfield(ff,lastx,lasty-1,erfolg);IFerfolgANDnextnichtgesperrtTHENsetneweditvalues;feld:=nextfeldELSEsetlasteditvaluesFI.godownifpossible:searchfield(ff,lastx,lasty+1,erfolg);IFerfolgANDnextnichtgesperrtTHENsetneweditvalues;feld:=nextfeldELSEsetlasteditvaluesFI.nichtgesperrt:INT VARgeheim;BOOL VARcl,protect,s,sp,l;fieldinfos(ff,feld,geheim,cl,protect,s,sp,l);NOTprotect.nextnichtgesperrt:fieldinfos(ff,nextfeld,geheim,cl,protect,s,sp,l);NOTprotect.gesperrt:NOTnichtgesperrt.warletztes:feld<1.warerstes:feld<1.END PROCexecutecommandcode;INT PROCfirstfield(TAG CONSTt):t.feldVSUB1END PROCfirstfield;INT PROCnextfield(TAG CONSTt,INT CONSTfeld):INT VARel:=(t.erstelVSUBfeld)+1;WHILE(t.feldVSUBel)=feldREPelINCR1PER;t.feldVSUBelEND PROCnextfield;INT PROCpriorfield(TAG CONSTt,INT CONSTfeld):t.feldVSUB((t.erstelVSUBfeld)-1)END PROCpriorfield;LETmaxtags=20,dsname="simsel formulare";BOUND ROWmaxtagsTAG VARsimselformulare;PROCtagsankoppeln:IF NOTinitialized(inthistask)THEN IF NOTexists(dsname)THEN IF NOTexists(dsname,/simseltask)THENerrorstop("TAGs fehlen!")ELSEfetch(dsname,/simseltask);kopplean;FI;ELSEkopplean;FI;FI;.kopplean:DATASPACE VARtagds:=old(dsname);simselformulare:=tagds;forget(dsname,quiet);.END PROCtagsankoppeln;TAG PROCformular(INT CONSTi):IFi>maxtagsTHENerrorstop("So viele TAGs gibt es nicht: "+text(i))FI;simselformulare(i)END PROCformular;END PACKETsimselmasken;