XMLWrite(DevObj,BedKey,ColSize,Opties,%this)
#define STRIP(%v) $E(%v,1,$F(%v_"?.",".")-1-2)
#define DFLBedSize 3040
New Key,FileN,MultiBed,PB
Set MultiBed=%this.EindeVolgNr-BedKey+1
Set Key=""
Do BEGINTAG^XMLWRITE(DevObj, "FREESBED")
Do WRITELN^XMLWRITE(DevObj)
Do TAGWRITE^XMLWRITE(DevObj, "BEDKEY", BedKey)
Do WRITELN^XMLWRITE(DevObj)
Do TAGWRITE^XMLWRITE(DevObj, "VOLGNR", BedKey_$S(MultiBed>1:"-"_%this.EindeVolgNr_" ("_MultiBed_"x)" , 1:""))
Do WRITELN^XMLWRITE(DevObj)
Do TAGWRITE^XMLWRITE(DevObj, "KALIBER", %this.BedDef.Omschrijving)
Do WRITELN^XMLWRITE(DevObj)
Set PB=%this.ProfielBeperking
Do TAGWRITE^XMLWRITE(DevObj, "PROFBEPERK", PB, $S($L(PB,"-")>1:"OMS="""_$P(PB,"-",1)_"-"_$P(PB,"-",2)_"""", 1:""))
Do WRITELN^XMLWRITE(DevObj)
If (%this.BedDef.KaliberType="UN")&&($L(PB)) Do ; Only for "Universeel" type
. Do TAGWRITE^XMLWRITE(DevObj, "PROFKALURL", $TR($TR(PB, "-","_"), ";","")_".gif")
. Do WRITELN^XMLWRITE(DevObj)
Do TAGWRITE^XMLWRITE(DevObj, "CNCZONE", %this.CNCZone)
Do WRITELN^XMLWRITE(DevObj)
Do TAGWRITE^XMLWRITE(DevObj, "TOELEVERING", %this.ToelevListGet())
Do WRITELN^XMLWRITE(DevObj)
For Set FileN=%this.CNCFiles.GetNext(.Key) Quit:(Key="") Do
. Do:(FileN'="") TAGWRITE^XMLWRITE(DevObj, "CNCFILE", $$$STRIP(FileN))
. Do WRITELN^XMLWRITE(DevObj)
Do BEGINTAG^XMLWRITE(DevObj,"DRAWBED", "xmlns:v=""urn:schemas-microsoft-com:vml""", "CSizeMax="""_$$$DFLBedSize_"""")
Do WRITELN^XMLWRITE(DevObj)
Do %this.XMLVectorWrite(DevObj,$G(Opties),"")
Do WRITELN^XMLWRITE(DevObj)
Do ENDTAG^XMLWRITE(DevObj,"DRAWBED")
Do WRITELN^XMLWRITE(DevObj)
Do ENDTAG^XMLWRITE(DevObj,"FREESBED")
Do WRITELN^XMLWRITE(DevObj)
Quit
XMLVectorWrite(DevObj,Opties,ColSize,%this)
#define PatchVMLBug(%v) (%v+1)
New Scale,CSY,blnMainGroup
New Rij,Kol,NRows,NCols,ColWid,RowHght,ColSpacing,TextHght,BedWid,BedHght
New GroupStyle,emPosFirst,emPosFirstEnd,emPosSecond
New Param1,Param2
Set NRows=%this.MaxRij()
Set NCols=%this.MaxKolom()
Set emPosFirst=%this.BedDef.Vakken.GetNext("").BeginPos
Set emPosFirstEnd=%this.BedDef.Vakken.GetNext("").EindPos
Set emPosSecond=%this.BedDef.Vakken.GetAt("102").BeginPos
Set ColWid=emPosSecond.X-emPosFirst.X
Set ColSpacing=emPosSecond.X-emPosFirstEnd.X
Set RowHght=emPosFirstEnd.Y-emPosFirst.Y
Set TextHght=100
Set BedHght=NRows*(RowHght+TextHght)
Set BedWid=NCols*ColWid
If $G(ColSize)>0 Do
. Set Scale=ColSize/BedWid
. Set blnMainGroup=1
Else Do
. Set ColSize=BedWid
. Set Scale=1
. Set blnMainGroup=0
If blnMainGroup Do
. ; Construct Main Group
. Set GroupStyle="position:absolute; left:1pt; top:1pt; width:"_(ColSize\1)_"pt; height:"_(ColSize\1)_"pt; rotation:0;"
. Set CSY=BedWid/1
. Set Param1="style='"_GroupStyle_"'"
. Set Param2="coordsize="""_(BedWid\1)_","_(CSY\1)_""" coordorigin=""0,0"" "
. Do WRITELN^XMLWRITE(DevObj)
. Do BEGINTAG^XMLWRITE(DevObj, "v:GROUP", "class=""clsMain""", Param1, Param2)
. Do WRITELN^XMLWRITE(DevObj)
; Draw Profielen + Labels
For Rij=1:1:NRows Do
. For Kol=1:1:NCols Do
.. Do xvwDrawProfAndLabel ;(DevObj, %this, Rij, Kol, Scale, RowHght, ColWid, TextHght)
Do WRITELN^XMLWRITE(DevObj)
; Draw Kaliber Kader+Raster
Do xvwDrawRaster ;(DevObj, NRows, NCols, RowHght, ColWid, TextHght)
; Add ToolLijst for Frezing
Do:($G(Opties)["VTL=1") xvwAddToolLijst ;(DevObj, NCols*ColWid, NRows*(RowHght+TextHght))
If blnMainGroup Do
. Do ENDTAG^XMLWRITE(DevObj,"v:GROUP")
. Do WRITELN^XMLWRITE(DevObj)
Quit
xvwDrawProfAndLabel ;(DevObj,%this,Rij,Kol,Scale,RowHght,ColWid,TextHght)
New emVak,emDefVak,VLeft,VTop,VWid,VHght,OptieLW,Param1,Param2,Param3,sProfInfo,sProfInfo2,OffsetTop,pVakKey,NL
Set pVakKey=%this.GetRijKolomKey(Rij,Kol)
Set emVak=%this.Vakken.GetAt(pVakKey)
Quit:(emVak.BezetCode'="P") ; Hier ligt geen profiel
Set emDefVak=%this.BedDef.Vakken.GetAt(pVakKey)
Set VLeft=(Kol-1)*ColWid
Set VTop=(Rij-1)*(RowHght+TextHght)
Set VWid=emDefVak.EindPos.X-emDefVak.BeginPos.X
; Draw Label
Set OffsetTop=$S(emDefVak.Richting'["I":RowHght, 1:0)+(TextHght/2)-10
Set sProfInfo=emVak.Profiel.Lengte_$$xvwGekoppeldVak ; _emVak.Gekoppeld
Set sProfInfo2=emVak.Profiel.KaderDeur.Dossier_" - "_$E(emVak.Profiel.ProfPlaats,2,2)_$S(%this.VakRichtingUser(pVakKey)="I":" - invers!", 1:"")
Set NL=$C(13)_$C(10)
Set Param2="from="""_(VLeft+10\1)_","_(VTop+OffsetTop\1)_""" to="""_(VLeft+VWid-10\1)_","_$$$PatchVMLBug(VTop+OffsetTop\1)_""""
Set Param3="strokecolor=""black"" strokeweight=""0px"""
Set Param1=NL_""_NL_""_NL
Set Param1=Param1_""_NL
Do TAGWRITE^XMLWRITE(DevObj, "v:line", Param1, Param2, Param3)
Do WRITELN^XMLWRITE(DevObj)
Set Param2="from="""_(VLeft+185\1)_","_(VTop+OffsetTop\1)_""" to="""_(VLeft+VWid-10\1)_","_$$$PatchVMLBug(VTop+OffsetTop\1)_""""
Set Param3="strokecolor=""black"" strokeweight=""0px"""
Set Param1=NL_""_NL_""_NL
Set Param1=Param1_""_NL
Do TAGWRITE^XMLWRITE(DevObj, "v:line", Param1, Param2, Param3)
Do WRITELN^XMLWRITE(DevObj)
; Draw Prof
Set OffsetTop=$S(emDefVak.Richting'["I":10, 1:TextHght-10)
If $G(Opties)["DM=L" Do
. Set VHght=20
. Set VScale=$S(VHght>10:1, 1:10/VHght)
Else Do
. Set VHght=emDefVak.EindPos.Y-emDefVak.BeginPos.Y
. Set VScale=1
. Set:(Scale'>0.5) OptieLW=";LW=S"
Set Param1="style='position:absolute; left:"_(VLeft\1)_"; top:"_(VTop+OffsetTop\1)_"; width:"_(VWid\1)_"; height:"_(VHght\1)_";'"
Set Param2="coordsize="""_(VWid\1)_","_(VHght\1)_""" coordorigin=""0,0"" "
Do WRITELN^XMLWRITE(DevObj)
Do BEGINTAG^XMLWRITE(DevObj, "v:GROUP", Param1, Param2)
Do WRITELN^XMLWRITE(DevObj)
Do:($L(emVak.Profiel)) emVak.Profiel.XMLVectorWrite(DevObj,$G(Opties)_$G(OptieLW)_$S(emVak.Richting="I":";R=I", 1:"")_";INRLINE=0;NOPT",VWid,VWid)
Do WRITELN^XMLWRITE(DevObj)
Do ENDTAG^XMLWRITE(DevObj,"v:GROUP")
Do WRITELN^XMLWRITE(DevObj)
Quit
xvwGekoppeldVak()
Quit:(+emVak.Gekoppeld'>0) ""
Quit:(emVak.Gekoppeld =pVakKey) " k*" ; Gekoppeld profiel, VakKey komt overeen (Kantelen) !!!
Quit:(emVak.Gekoppeld'=pVakKey) " *" ; Gekoppeld profiel, maar ligt in een ander VAK (Wisselen) !!!
Quit ""
; Previous version (until 14/04/2004)
;Quit $S(+emVak.Gekoppeld>0:" *", 1:"") ; _emVak.Gekoppeld _ "-"_pVakKey
xvwDrawRaster ;(DevObj,NRows,NCols,RowHght,ColWid,TextHght)
New Rij,Kol
;New BedHght,BedWid,Rij,Kol
;Set BedHght=NRows*(RowHght+TextHght)
;Set BedWid=NCols*ColWid
Do TAGWRITE^XMLWRITE(DevObj, "v:rect", "", "style='left:0; top:0; width:"_(BedWid\1)_"; height:"_(BedHght\1)_"; z-index:-1;'", "strokeweight=""2px""")
Do WRITELN^XMLWRITE(DevObj)
For Rij=1:1:NRows-1 Do
. Do WRITE^XMLWRITE(DevObj,"")
. Do WRITELN^XMLWRITE(DevObj)
For Kol=1:1:NCols-1 Do
. If $$xvwIsKolomVerlengd(%this,Kol+1) Do
.. ; Draw dashed line
.. Do TAGWRITE^XMLWRITE(DevObj,"v:line", "", "from="""_(Kol*ColWid\1)_",0"" to="""_(Kol*ColWid\1)_","_(BedHght\1)_"""")
. Else Do
.. ; Draw small filled rectangle
.. Do TAGWRITE^XMLWRITE(DevObj,"v:rect", "", "style='left:"_(Kol*ColWid-5\1)_"; top:0; width:6; height:"_(BedHght\1)_";'")
. Do WRITELN^XMLWRITE(DevObj)
Do WRITELN^XMLWRITE(DevObj)
Quit
xvwAddToolLijst ;(DevObj,BedWid,BedHght)
New lMain,lLoc,Param1,Param2,Param3,iLoc,iTool,sLoc,sTool,NL
New objFT
Set Param1="style='position:absolute; left:0; top:"_(BedHght+10\1)_"; width:"_(BedWid\1)_"; height:250;'"
Set Param2="coordsize="""_(BedWid\1)_",250"" coordorigin=""0,0"" "
Do WRITELN^XMLWRITE(DevObj)
Do BEGINTAG^XMLWRITE(DevObj, "v:GROUP", Param1, Param2)
Do WRITELN^XMLWRITE(DevObj)
;Do TAGWRITE^XMLWRITE(DevObj, "v:rect", "", "style='left:0; top:0; width:"_(BedWid\1)_"; height:"_(250\1)_"; z-index:-1;'", "strokeweight=""2px""")
;Do WRITELN^XMLWRITE(DevObj)
Set NL=$C(13)_$C(10)
Set lMain=%this.ToolLijst()
Set:($LL(lMain)) objFT=##class(Res.PI.FreesTool).%New()
For iLoc=1:1:$LL(lMain) Do
. Set lLoc=$LIST(lMain,iLoc)
. Set sLoc=$LIST(lLoc,1) ; First element indicated the Locatie; following elements are $LB(Tool,Count)
. Do xvwVLineTool(((iLoc-1)*700), 30, $S(objFT:objFT.LocatieLogicalToDisplay(sLoc), 1:sLoc))
. For iTool=2:1:$LL(lLoc) Do
.. Do xvwVLineTool(((iLoc-1)*700)+50, ((iTool-1)*50)+30, $LIST($LIST(lLoc,iTool),1)_" - "_$LIST($LIST(lLoc,iTool),2))
Do:($G(objFT)) objFT.%Close()
Do WRITELN^XMLWRITE(DevObj)
Do ENDTAG^XMLWRITE(DevObj,"v:GROUP")
Do WRITELN^XMLWRITE(DevObj)
Quit
xvwVLineTool(XFrom,Y,sString)
Set Param2="from="""_(XFrom\1)_","_(Y\1)_""" to="""_(XFrom+600\1)_","_$$$PatchVMLBug(Y\1)_""""
Set Param3="strokecolor=""black"" strokeweight=""0px"""
Set Param1=NL_""_NL_""_NL
Set Param1=Param1_""_NL
Do TAGWRITE^XMLWRITE(DevObj, "v:line", Param1, Param2, Param3)
Do WRITELN^XMLWRITE(DevObj)
xvwIsKolomVerlengd(%this,KolID)
New Rij,blnIsVerlengd
Set blnIsVerlengd=0
For Rij=1:1:%this.MaxRij() Do
. Set:(%this.Vakken.GetAt(%this.GetRijKolomKey(Rij,KolID)).BezetCode="L") blnIsVerlengd=1
Quit blnIsVerlengd
XMLRijVector(DevObj,Rij,Opties,ColSize,%this)
#define DFLBedSize 3040
New Kol,emVak,emDefVak,PLeft,PTop,PWid,PHght,Scale,OptieLW
New Param1,Param2
Set Scale=$G(ColSize,$$$DFLBedSize)/$$$DFLBedSize
Set PTop=0
If $G(Opties)["TOP=" Do
. Set PTop=+$E(Opties,$F(Opties,"TOP="),99) ; "+"-sign: evaluate to numeric ==> truncate the rest of the line.
. Set Opties=$P(Opties,"TOP="_PTop,1)_$P(Opties,"TOP="_PTop,2)
For Kol=1:1:%this.MaxKolom() Do
. Set emVak=%this.Vakken.GetAt(%this.GetRijKolomKey(Rij,Kol))
. Quit:(emVak.BezetCode'="P") ; Hier ligt geen profiel
. Set emDefVak=%this.BedDef.Vakken.GetAt(%this.GetRijKolomKey(Rij,Kol))
. Set PLeft=emDefVak.BeginPos.X
. Set PWid=emDefVak.EindPos.X-emDefVak.BeginPos.X
. If $G(Opties)["DM=L" Do
.. Set PHght=20
.. Set VScale=$S(PHght*Scale>10:Scale, 1:10/PHght)
. Else Do
.. Set PHght=emDefVak.EindPos.Y-emDefVak.BeginPos.Y
.. Set:(Scale'>0.5) OptieLW=";LW=S"
.. Set VScale=Scale
. Set Param1="style='position:absolute; left:"_(PLeft*Scale\1)_"pt; top:"_(PTop*Scale\1)_"pt; width:"_(PWid*Scale\1)_"pt; height:"_(PHght*VScale\1)_"pt;'"
. Set Param2="coordsize="""_(PWid\1)_","_(PHght\1)_""" coordorigin=""0,0"" "
. Do WRITELN^XMLWRITE(DevObj)
. Do BEGINTAG^XMLWRITE(DevObj, "v:GROUP", Param1, Param2)
. Do WRITELN^XMLWRITE(DevObj)
. ;
. Do:($L(emVak.Profiel)) emVak.Profiel.XMLVectorWrite(DevObj,$G(Opties)_$G(OptieLW)_$S(emVak.Richting="I":";R=I", 1:"")_";NOPT",PWid,PWid)
. ;
. Do ENDTAG^XMLWRITE(DevObj,"v:GROUP")
. Do WRITELN^XMLWRITE(DevObj)
Quit
; =================================================================================================================
; Short Methods
; They can be inserted in the class Fabr.Frees.emBed
; =================================================================================================================
; emBed.AutoBeletPrevious(StopAt,VakKey,[VakRij,VakKolom])
AutoBeletPrevious ; Parameters StopAt,VakKey,VakRij,VakKolom
#define UCASE(%v) $ZCVT(%v,"U")
; Alle vorige Vrije plaatsen op AutoBelet zetten; dit vanwege de sequentiële werkwijze.
; [Simple&Stupid methode] Alle voorgaande vakken achterwaarts doorlopen, totdat "P"rofiel gevonden is.
New emVak,blnP
Set:('$D(VakKey)) VakKey=%this.GetRijKolomKey($G(VakRij),$G(VakKol))
Set:(VakKey'>0) VakKey=""
Set blnP=($$$UCASE(StopAt)="PROF")
For Do %this.PreviousVak(.VakKey) Quit:(VakKey'>0) Set emVak=%this.Vakken.GetAt(VakKey) Quit:(blnP)&&(emVak.BezetCode="P") Do
. Set:(emVak.BezetCode="V") emVak.BezetCode="A"
If VakKey="" Set (VakRij,VakKolom)=""
Else Do
. Set VakRij=%this.GetRij(VakKey)
. Set VakKolom=%this.GetKolom(VakKey)
Quit
BeletTotBegin ; Parameters: [geen]
New emVak,VakKey,tmpKey
; VakKey van laatste profiel zoeken
Set VakKey=""
For Do %this.NextVak(.VakKey) Quit:(VakKey'>0) Set emVak=%this.Vakken.GetAt(VakKey) Do
. Set:(emVak.BezetCode="P") tmpKey=VakKey
; Alle vorige vakken tot begin van het bed op AutoBelet zetten
Do:($G(tmpKey)>0) %this.AutoBeletPrevious("BEGIN",tmpKey)
Quit
ToolLijst()
New TLoc,TToolData,VakKey,FKey,emVak,emProf,emFrez
New lMain,lLoc,sLoc,sTool
New x
Set VakKey=""
For Set emVak=%this.Vakken.GetNext(.VakKey) Quit:(VakKey="") Do
. Quit:(emVak.BezetCode'="P")
. Set emProf=emVak.Profiel
. Set FKey=""
. For Set emFrez=emProf.Frezingen.GetNext(.FKey) Quit:(FKey="") Do
.. Quit:('emFrez.FreesTool)
.. Set x=$INCREMENT(TLoc(emFrez.FreesTool.Locatie,emFrez.FreesTool.ToolNaam))
.. Set:($G(TToolData(emFrez.FreesTool.ToolNaam))="") TToolData(emFrez.FreesTool.ToolNaam)=emFrez.FreesTool.ItemID
; Convert TLoc into a ListBuild
Set lMain=""
Set sLoc=""
For Set sLoc=$O(TLoc(sLoc)) Quit:(sLoc="") Do
. Set lLoc=""
. Set sTool=""
. For Set sTool=$O(TLoc(sLoc,sTool)) Quit:(sTool="") Do
.. Set lLoc=lLoc_$LB($LB(sTool, TToolData(sTool)_" (#"_TLoc(sLoc,sTool)_")"))
. Set:(lLoc'="") lMain=lMain_$LB($LB(sLoc)_lLoc) ; Insert Locatie at the begin of ListBuild
;merge ^wvLOCT("AR")=TLoc
;set ^wvLOCT("LB")=lMain
Quit lMain
VakRichtingCalc() ; Parameters: VakKey, UserRichting
New RichBed,RichProf,PB
Set RichBed=""
Set RichProf=""
If %this.BedDef Do
. Set:(%this.BedDef.Vakken.GetAt(VakKey)) RichBed=%this.BedDef.Vakken.GetAt(VakKey).Richting
. Set:($L(%this.ProfielBeperking)) RichProf=%this.BedDef.ProfSpecs.GetAt(%this.ProfielBeperking).Richting
Quit $S(($L(RichBed_RichProf_$G(UserRichting),"I")-1)#2=1:"I", 1:"") ; N occurences of "I" is odd ==> return "I" , else return ""
VakRichtingUser() ; Parameters: VakKey
New RichBed,RichProf
Set RichBed=""
Set RichProf=""
Set RichVak=%this.Vakken.GetAt(VakKey).Richting ; Resulting Richting; ~substract~ other Richtingen from this value
If %this.BedDef Do
. Set:(%this.BedDef.Vakken.GetAt(VakKey)) RichBed=%this.BedDef.Vakken.GetAt(VakKey).Richting
. Set:($L(%this.ProfielBeperking)) RichProf=%this.BedDef.ProfSpecs.GetAt(%this.ProfielBeperking).Richting
Quit $S(($L(RichBed_RichProf_RichVak,"I")-1)#2=1:"I", 1:"") ; N occurences of "I" is odd ==> return "I" , else return ""
IsProfielPlaatsbaar(emProfiel,%this)
New PZ,UL,BeperkPZ,BeperkUL,Key ; ,PZList,PZUL
Set PZ=emProfiel.KaderDeur.ProfType.ItemID_"-"_emProfiel.ProfZijkant
Set UL=emProfiel.FreesUitloop
Set Key=%this.ProfielBeperking
If $L(Key) Do
. Set BeperkPZ=$P(Key,"-",1)_"-"_$P(Key,"-",2)
. Set BeperkUL=";"_$P(Key,"-",3)_";"
Quit:($L(Key)) (BeperkPZ=PZ)&&(BeperkUL[(";"_UL_";"))
; Else
Quit (%this.BedDef.ExtendedPZUL()[(PZ_"-"_UL))
SetProfielBeperking ; Parameters: ForceRecalc
If (%this.IsLeeg()) Set %this.ProfielBeperking=""
Else If (%this.ProfielBeperking="")||($G(ForceRecalc)=1) Set %this.ProfielBeperking=$$spbDeterminePB
Else ; ProfielBeperking is already set.
Quit
spbDeterminePB()
; Zoek met eerste profiel van het bed naar de overeenkomstige ArrayKey
New PB,Key,emVak
Set PB=""
Set Key=""
For Do %this.NextVak(.Key) Quit:(Key="") Do Quit:(PB'="")
. Set emVak=%this.Vakken.GetAt(Key)
. Set:(emVak.BezetCode="P") PB=%this.BedDef.GetArrayKey(emVak.Profiel)
Quit PB