1
2
3
4
|
PACKETmaskenDEFINES TAG,:=,tagsankoppeln,formular,show,putget,setfieldinfos:LETbeginmark="",endmark="",chome=1,choch=3,cfeldrueck=19,crunter=10,ctab=9,cfeldvor=13,cesc=27,right="�",left="�",taglines=24,maxfields=100;TEXT VARabc:="";INT VARi;FORiFROM33UPTO39REPabcCATcode(i)PER;FORiFROM42UPTO59REPabcCATcode(i)PER;FORiFROM62UPTO90REPabcCATcode(i)PER;FORiFROM97UPTO122REPabcCATcode(i)PER;FORiFROM214UPTO220REPabcCATcode(i)PER;abcCATcode(251);BOOL VARclosedbit,protectbit,darstbit,tabbit,leftbit,exitbit,rollbit,normal:=TRUE;INT VARworkint;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:=;BOOL PROCfieldexists(TAG CONSTa,INT CONSTfeldnr):(a.erstelVSUBfeldnr)>0END PROCfieldexists;PROCsetinfo(TEXT CONSTstring,INT CONSTpos):workint:=stringVSUBpos;IFworkint>0THENsetallvaluesELSEnormal:=TRUE END IF.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 END IF 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:=leftbitEND IF END PROCfieldinfos;PROCsetfieldinfos(TAG VARt,INT CONSTfeld,BOOL CONSTclosed,protected,secret):INT VARcd:=(t.diainfoVSUBfeld)MOD32;IFsecretTHENcdINCR32END IF;IFprotectedTHENcdINCR64END IF;IFclosedTHENcdINCR128END IF;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 LEAVEeputEND IF;zumelementarfeld;PER;gibrestaus;REPelementarfeldweiterzaehlen;IFgehoertzumnaechstenfeldTHEN LEAVEeputEND IF;zumelementarfeld;gibhintergrundausPER.zumerstenelementarfeld:tlen:=LENGTHt;tout:=abwo-1;afeld:=ff.feldVSUBelfeld;ael:=elfeld;positionieren(ff).fuelleelementarfeld:outsubtext(t,tout+1,tout+al);toutINCRal.nochgenugtextda:tout+al<tlen.elementarfeldweiterzaehlen:aelINCR1.zumelementarfeld:positionieren(ff).gehoertzumnaechstenfeld:(ff.feldVSUBael)<>afeld.gibrestaus:outsubtext(t,tout+1,tlen);IFtout+al>tlenTHENoutsubtext(grund,ax+tlen-tout,ax+al-1)END IF.gibhintergrundaus:outsubtext(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 LEAVElengthWITH0END IF;INT VARlen:=0;REPlenINCRfeldlaenge;zumnaechstenelementarfeldUNTILgehoertzumnaechstenfeldPER;len.zumerstenelementarfeld:ael:=ff.erstelVSUBfeld.zumnaechstenelementarfeld:aelINCR1.gehoertzumnaechstenfeld:(ff.feldVSUBael)<>feld.feldlaenge:ff.lenVSUBaelEND PROClength;PROCshow(TAG CONSTff):INT VARi;FORiFROM1UPTOff.ymaxREPcursor(1,i);out(ff.formblatt(i))END REP END PROCshow;INT VARcharcode:=0,lastx,lasty;INT VARaktbegin,aktfeld,aktel,wo;INT VARnextfeld,nextel,nextwo,nextbegin;PROCsetneweditvalues:aktfeld:=nextfeld;aktbegin:=nextbegin;aktel:=nextel;wo:=nextwo;END PROCsetneweditvalues;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-anfangEND IF.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;PROCputget(TAG CONSTff,ROWmaxfieldsTEXT VARv,INT VAReinstieg,TEXT VARtaste):enablestop;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)END IF PER END PROCput;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)END IF END IF END PROCput;PROCget(TAG CONSTff,ROWmaxfieldsTEXT VARfieldvalues,INT VARfeld,TEXT VARtaste):TEXT VARexittaste:="";INT VARaltesfeld;IF NOTfieldexists(ff,feld)THENerrorstop("startfeld nicht im tag")ELSE REPaltesfeld:=feld;setinfo(ff.diainfo,feld);IF NOTgeschuetztTHENeingabefeldELSEgeschuetztesfeldEND IF;charcode:=code(subtext(exittaste,1,1));IFcharcode=ctabTHENcharcode:=cfeldrueckELIFcharcode=cescTHEN IFsubtext(exittaste,2,2)=leftTHENcharcode:=cfeldrueckELIFsubtext(exittaste,2,2)=rightTHENcharcode:=cfeldvorEND IF END IF;executecommandcode(ff,feld);IFfeld=1THENfeld:=2END IF UNTILcharcode=cescPER;END IF.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(ff,feld)+30,length(ff,feld),code(cfeldvor)+code(choch)+code(crunter),abc+right+left,exittaste);cursor(lastx+length(ff,feld),lasty);out(endmark);IFankreuzenTHENerrorstop("Ankreuzfelder gibt's bei 'Mathe' nicht!")END IF;cursor(lastx,lasty);put(ff,fieldvalues(feld),feld);IFlength(exittaste)>1THENtaste:=subtext(exittaste,2,2)END IF END PROCget;PROCexecutecommandcode(TAG CONSTff,INT VARfeld):SELECTcharcodeOF CASEcfeldrueck:topriorfieldCASEcfeldvor:tonextfieldCASEchoch:goupifpossibleCASEcrunter:godownifpossibleCASEchome:tohomefieldCASEctab:END SELECT.topriorfield:REPEATfeld:=priorfield(ff,feld)UNTILwarerstesCORnichtgesperrtPER;IFwarerstesTHENtohomefieldEND IF.tonextfield:REPfeld:=nextfield(ff,feld)UNTILwarletztesCORnichtgesperrtPER;IFwarletztesTHENtohomefieldEND IF.tohomefield:feld:=firstfield(ff);WHILEgesperrtREPfeld:=nextfield(ff,feld)PER.goupifpossible:BOOL VARerfolg;searchfield(ff,lastx,lasty-1,erfolg);IFerfolgANDnextnichtgesperrtTHENsetneweditvalues;feld:=nextfeldEND IF.godownifpossible:searchfield(ff,lastx,lasty+1,erfolg);IFerfolgANDnextnichtgesperrtTHENsetneweditvalues;feld:=nextfeldEND IF.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=50,dsname="mathe formulare",depottask="ls-MENUKARTEN";BOUND ROWmaxtagsTAG VARmatheformulare;PROCtagsankoppeln:IF NOTexists(dsname)THENfetch("mathe formulare",/depottask)END IF;matheformulare:=old("mathe formulare")END PROCtagsankoppeln;TAG PROCformular(INT CONSTi):IFi>maxtagsTHENerrorstop("So viele TAGs gibt es nicht: "+text(i))END IF;matheformulare(i)END PROCformular;LETnil13byte="�������������",nil4byte="����",nilbyte="�";PROCreplaceiac(TEXT VARstring,INT CONSTwo,TEXT CONSTwas):IF LENGTHstring<=LENGTHwas+wo-1THENstretch(string,LENGTHwas+wo-1)FI;replace(string,wo,was)END PROCreplaceiac;PROCstretch(TEXT VARt,INT CONSTwo):WHILE LENGTHt<=wo-13REPtCAT
nil13bytePER;WHILE LENGTHt<=wo-4REPtCATnil4bytePER;WHILE LENGTHt<woREPtCATnilbytePER END PROCstretch;INT OP VSUB(TEXT CONSTstring,INT CONSTpos):code(stringSUBpos)END OP VSUB;END PACKETmasken
|
