; Geeft de VML-code voor Boringen en Frezingen
; !!! Opties moet als .LOCAL doorgegeven worden !!!
; Mogelijke waarden voor Opties:
; + (algemeen)
; Node "AT" : Attribute Title; dit is de ToolTipText
; + (alleen bij $$CrossHVLeftTop, $$CrossDiagLeftTop)
; - "LW=S" : LineWeight=Small (1px i.p.v. 1.5px)
; + (alleen bij $$LosProfiel
; - "R=I" : voor inverse plaatsing
; - "D=..." : toont waarde (...) als text. OPGELET: EERSTE EN ENIGE OPTIE bij het tonen van Dossier
#define VMLTitle $G(Opties("AT"),"")
VMLShape(VmlID,MidX,MidY,intSize,Rotation,strColor,Opties)
Quit:(VmlID="KAD") $$KADFREES(MidX,MidY,Rotation,strColor,.Opties)
Quit:(VmlID="KADFER") $$KADFERFREES(MidX,MidY,Rotation,strColor,.Opties)
Quit:(VmlID="KAD120") $$KAD120FREES(MidX,MidY,Rotation,strColor,.Opties)
;Quit:(VmlID="KAD120Z") $$KAD120ZFREES(MidX,MidY,Rotation,strColor,.Opties)
Quit:($E(VmlID,1,4)="SD30") $$SD30FREES(MidX,MidY,Rotation,strColor,.Opties)
Quit:($E(VmlID,1,4)="SD35") $$SD35FREES(MidX,MidY,Rotation,strColor,.Opties)
Quit:($E(VmlID,1,5)="STRIM") $$STRIMxFREES(MidX,MidY,intSize,Rotation,strColor,.Opties)
Quit:(VmlID="UPPER") $$UPPERFREES(MidX,MidY,Rotation,strColor,.Opties)
Quit:(VmlID="UPPERZ") $$UPPERZFREES(MidX,MidY,Rotation,strColor,.Opties)
Quit:(VmlID="NOVAB") $$NOVABFREES(MidX,MidY,Rotation,strColor,.Opties)
Quit:(VmlID="NOVABZ") $$NOVABZFREES(MidX,MidY,Rotation,strColor,.Opties)
Quit:(VmlID="NOVAL") $$NOVAxLRxFREES(MidX,MidY,Rotation,strColor,.Opties)
Quit:(VmlID="NOVAR") $$NOVAxLRxFREES(MidX,MidY,Rotation,strColor,.Opties)
Quit:(VmlID="NOVALZ") $$NOVAxLRZxFREES(MidX,MidY,Rotation,strColor,.Opties)
Quit:(VmlID="NOVARZ") $$NOVAxLRZxFREES(MidX,MidY,Rotation,strColor,.Opties)
Quit ""
KADFREES(MidX,MidY,Rotation,FillColor,Opties) ; FREES in Kaderscharnier BLUM
New FreesL,FreesB
Set FreesB=16
Set FreesL=14
Quit $$KadFreesRect("-")
KADFERFREES(MidX,MidY,Rotation,FillColor,Opties) ; FREES in Kaderscharnier FERRARI
New FreesL,FreesB
Set FreesB=16
Set FreesL=22
Quit $$KadFreesRect("-")
KAD120FREES(MidX,MidY,Rotation,FillColor,Opties) ; FREES in Kaderscharnier Blum 120°
New FreesL,FreesB,VML
Set FreesB=2
Set FreesL=46
Set VML=$$KadFreesRect("-")
Set FreesB=16
Set FreesL=22
Set VML=VML_$$KadFreesRect("-")
Quit VML
Quit "Complexe Frees VML" ; (2 rechthoeken)
/*
KAD120ZFREES(MidX,MidY,Rotation,FillColor,Opties) ; FREES in Kaderscharnier Blum 120°
New FreesL,FreesB
Set FreesB=8
Set FreesL=46
Quit $$KadFreesRect("-")
*/
KadFreesRect(Type)
; (MidX,MidY) is het nulpunt van de frezing en ligt op de zijkant van de rechthoek (in de helft van de lange zijde)
New tmpRotation
Set FreesL=FreesL\2*2
Set tmpRotation=Rotation
Set:($G(Type)="-") tmpRotation=(tmpRotation+180)#360 ; Spiegeling over Lengte-as simuleren door rotatie van 180°
;d WL^vhDBG("Rotation: orig="_Rotation_" Type="_$G(Type)_" tmpRot="_tmpRotation)
Quit:(tmpRotation= 0) $$RectangleLeftTop(MidX,MidY-(FreesL\2), FreesB,FreesL, FillColor,FillColor,1,1,.Opties)
Quit:(tmpRotation= 90) $$RectangleLeftTop(MidX-(FreesL\2),MidY, FreesL,FreesB, FillColor,FillColor,1,1,.Opties)
Quit:(tmpRotation=180) $$RectangleLeftTop(MidX-FreesB,MidY-(FreesL\2), FreesB,FreesL, FillColor,FillColor,1,1,.Opties)
Quit:(tmpRotation=270) $$RectangleLeftTop(MidX-(FreesL\2),MidY-FreesB, FreesL,FreesB, FillColor,FillColor,1,1,.Opties)
Quit ""
SD30FREES(MidX,MidY,Rotation,FillColor,Opties) ; FREES in Schuifdeurbeslag
New Diam,MidOffs,Offs,OffsOppos,P1,P2
Set Diam=30
Set MidOffs=2.9
Set Offs=(Diam/2)-MidOffs
Set OffsOppos=(Diam/2)+MidOffs
Set P1=0.28 ; calculated sqrt
Set P2=29.72 ; opposite of arcP1
Quit:(Rotation= 0) $$SD3xShape(MidX-Offs,MidY-(Diam\2), Diam, FillColor,,Offs,P2,Offs,P1,.Opties)
Quit:(Rotation= 90) $$SD3xShape(MidX-(Diam\2),MidY-Offs, Diam, FillColor,,P1,Offs,P2,Offs,.Opties)
Quit:(Rotation=180) $$SD3xShape(MidX-OffsOppos,MidY-(Diam\2), Diam, FillColor,,OffsOppos,P1,OffsOppos,P2,.Opties)
Quit:(Rotation=270) $$SD3xShape(MidX-(Diam\2),MidY-OffsOppos, Diam, FillColor,,P2,OffsOppos,P1,OffsOppos,.Opties)
Quit ""
SD35FREES(MidX,MidY,Rotation,FillColor,Opties) ; FREES in Schuifdeurbeslag
New Diam,MidOffs,Offs,OffsOppos,P1,P2
Set Diam=35
Set MidOffs=7.5
Set Offs=(Diam/2)-MidOffs
Set OffsOppos=(Diam/2)+MidOffs
Set P1=1.69 ; calculated sqrt
Set P2=33.31 ; opposite of arcP1
Quit:(Rotation= 0) $$SD3xShape(MidX-Offs,MidY-(Diam\2), Diam, FillColor,,Offs,P2,Offs,P1,.Opties)
Quit:(Rotation= 90) $$SD3xShape(MidX-(Diam\2),MidY-Offs, Diam, FillColor,,P1,Offs,P2,Offs,.Opties)
Quit:(Rotation=180) $$SD3xShape(MidX-OffsOppos,MidY-(Diam\2), Diam, FillColor,,OffsOppos,P1,OffsOppos,P2,.Opties)
Quit:(Rotation=270) $$SD3xShape(MidX-(Diam\2),MidY-OffsOppos, Diam, FillColor,,P2,OffsOppos,P1,OffsOppos,.Opties)
Quit ""
SD3xShape(Left,Top,Diam,FillColor,BorderColor,arcX1,arcY1,arcX2,arcY2,Opties)
; Special shape used for SD (SchuifDeur)-beslag. Draw arc
New VML,scl,DiamScl
Set scl=100
Set DiamScl=(Diam*scl)\1
Set VML=""
Set VML=VML_""
Quit VML
STRIMxFREES(MidX,MidY,intSize,Rotation,FillColor,Opties) ; FREES in Schuifdeurbeslag "STRIMM"
New FreesL,FreesB
Set FreesL=intSize\2*2
Set FreesB=16
Quit:(Rotation#180= 0) $$RectangleLeftTop(MidX-(FreesB\2),MidY-(FreesL\2), FreesB,FreesL, FillColor,FillColor,1,1,.Opties)
Quit:(Rotation#180=90) $$RectangleLeftTop(MidX-(FreesL\2),MidY-(FreesB\2), FreesL,FreesB, FillColor,FillColor,1,1,.Opties)
Quit ""
UPPERFREES(MidX,MidY,Rotation,FillColor,Opties) ; FREES in Schuifdeurbeslag "UPPER"
New FreesL,FreesB
Set FreesB=16
Set FreesL=80
Quit $$KadFreesRect("+")
UPPERZFREES(MidX,MidY,Rotation,FillColor,Opties) ; FREES in Schuifdeurbeslag "UPPER"
New FreesL,FreesB
Set FreesB=12
Set FreesL=54
Quit $$KadFreesRect($S($G(Opties)["MirrorL=1;":"-", 1:"+")) ; UPPERZ steeds op ProfKant "EX" ==> steeds "-"
NOVABFREES(MidX,MidY,Rotation,FillColor,Opties) ; FREES in Schuifdeurbeslag "NOVA"
New FreesL,FreesB
Set FreesB=11
Set FreesL=6
Quit $$KadFreesRect("+")
NOVABZFREES(MidX,MidY,Rotation,FillColor,Opties) ; FREES in Schuifdeurbeslag "NOVA"
New VML,FreesL,FreesB
Set VML=""
Set FreesB=2
Set FreesL=6
s:('$D(ClientIP)) ClientIP="192.168.1.97"
;d WL^vhDBG("Nova BZ: x="_MidX_" y="_MidY_" rot="_Rotation)
;d WL^vhDBG("opties:"_$G(Opties))
Set VML=VML_$$KadFreesRect($S($G(Opties)["MirrorL=1;":"-", 1:"+")) ; NOVABZ steeds op ProfKant "EX" ==> steeds "+"
Set MidY=MidY-2
Set FreesB=8
Set FreesL=58
;d WL^vhDBG("Nova BZ2: x="_MidX_" y="_MidY_" rot="_Rotation)
Set VML=VML_$$KadFreesRect($S($G(Opties)["MirrorL=1;":"-", 1:"+")) ; NOVABZ steeds op ProfKant "EX" ==> steeds "+"
Quit VML
NOVAxLRxFREES(MidX,MidY,Rotation,FillColor,Opties) ; FREES in Schuifdeurbeslag "NOVA"
New FreesL,FreesB
Set FreesB=17
Set FreesL=26
Quit $$KadFreesRect("+")
NOVAxLRZxFREES(MidX,MidY,Rotation,FillColor,Opties) ; FREES (deel 2) in Schuifdeurbeslag "NOVA"
New FreesL,FreesB
Set FreesB=13
Set FreesL=55
Set MidY=MidY-2
Quit $$KadFreesRect($S($G(Opties)["MirrorL=1;":"-", 1:"+")) ; NOVAxLRZ steeds op ProfKant "EX" ==> steeds "+"
Oval(MidX,MidY,Width,Height,FillColor,BorderColor,Opties)
Quit $$OvalLeftTop(MidX-(Width\2),MidY-(Height\2), Width\2*2,Height\2*2, FillColor,$G(BorderColor,FillColor),.Opties)
Circle(MidX,MidY,Diam,FillColor,BorderColor,Opties)
Quit $$OvalLeftTop(MidX-(Diam\2),MidY-(Diam\2), Diam\2*2,, FillColor,$G(BorderColor,FillColor),.Opties)
Rectangle(MidX,MidY,Width,Height,FillColor,BorderColor,blnFill,Opties)
Quit $$RectangleLeftTop(MidX-(Width\2),MidY-(Height\2), Width\2*2,Height\2*2, FillColor,$G(BorderColor,FillColor),.blnFill,"1.0",.Opties)
/*
Quit ""
*/
CrossDiag(MidX,MidY,Width,Height,LineColor,Opties)
Quit $$CrossDiagLeftTop(MidX-(Width\2),MidY-(Height\2), Width\2*2,Height\2*2, LineColor,.Opties)
CrossHV(MidX,MidY,Width,Height,LineColor,Opties)
Quit $$CrossHVLeftTop(MidX-(Width\2),MidY-(Height\2), Width\2*2,Height\2*2, LineColor,.Opties)
TCross(MidX,MidY,Width,Height,LineColor,Rotation,Opties)
; Draws a T-Crossing.
; (MidX,MidY) is the position of the crosspoint, Rotation=90 corresponds to the " T " symbol. Rotate clockwise
; Used for KaderDeur.Zijboring: Rotation=0 corresponds to a zijboring PL(left), EX(externe zijkant)
Set Rotation=$G(Rotation,0)
New VML,W,H
Set W=Width
Set H=Height
Set VML=""
If Rotation=0 Do
. Set VML=VML_""
. Set VML=VML_""
. ; =$$TCrossLeftTop(MidX,MidY-(H\2), W,H\2*2,
Else If Rotation=90 Do
. Set VML=VML_""
. Set VML=VML_""
. ; =$$TCrossLeftTop(MidX-(W\2),MidY, W\2*2,H,
Else If Rotation=180 Do
. Set VML=VML_""
. Set VML=VML_""
. ; =$$TCrossLeftTop(MidX-W,MidY-(H\2), W,H\2*2,
Else If Rotation=270 Do
. Set VML=VML_""
. Set VML=VML_""
. ; =$$TCrossLeftTop(MidX-(W\2),MidY-H, W\2*2,H,
Else Quit ""
Quit VML
OvalLeftTop(Left,Top,Width,Height,FillColor,BorderColor,Opties)
; Draws an ellips with specified measurements in VML. [Height] is optional, default=Width
Set:($G(Height)'="0") Height=+$G(Height,Width)
Quit ""
RectangleLeftTop(Left,Top,Width,Height,FillColor,BorderColor,FillOpacity,BorderOpacity,Opties)
; Draws a rectangle; default is a solid line(border) and not filled ([FillOpacity=0]).
; To fill the rectangle: set [FillOpacity=1].
New VML
Set VML=""
Quit VML_">"
CrossDiagLeftTop(Left,Top,Width,Height,LineColor,Opties)
; Draws the diagonal lines (cross) of the surrounding rectangle
; Opties: "LW=S" : LineWeight=Small (1px i.p.v. 1.5px)
New VML,MaxX,MaxY,LW
Set Left=Left\1
Set Top=Top\1
Set MaxX=Left+(Width\1) ; \2*2)
Set MaxY=Top+(Height\1) ; \2*2)
Set LW=$S($G(Opties)["LW=S":"1px", 1:"1.5px")
Set VML=""
Set VML=VML_""
Set VML=VML_""
Quit VML
CrossHVLeftTop(Left,Top,Width,Height,LineColor,Opties)
; Draws the Horizontal-Vertical Cross ("+" sign) of the surrounding rectangle
; Opties: "LW=S" : LineWeight=Small (1px i.p.v. 1.5px)
New VML,MidX,MidY,LW
Set Left=Left\1
Set Top=Top\1
Set MidX=Left+(Width\2)
Set MidY=Top+(Height\2)
Set LW=$S($G(Opties)["LW=S":"1px", 1:"1.5px")
Set VML=""
Set VML=VML_""
Set VML=VML_""
Quit VML
TCrossLeftTop(Left,Top,Width,Height,LineColor,Rotation,Opties)
New VML,MidX,MidY,MaxX,MaxY
Set Left=Left\1
Set Top=Top\1
Set MidX=Left+(Width\2)
Set MidY=Top+(Height\2)
Set MaxX=Left+(Width\2*2)
Set MaxY=Top+(Height\2*2)
Set VML=""
If Rotation=0 Do
. Set VML=VML_""
. Set VML=VML_""
Else If Rotation=90 Do
. Set VML=VML_""
. Set VML=VML_""
Else If Rotation=180 Do
. Set VML=VML_""
. Set VML=VML_""
Else If Rotation=270 Do
. Set VML=VML_""
. Set VML=VML_""
Else Quit ""
Quit VML
LosProfGroepHeight(Breedte,Dikte,TypeZicht)
New Hght
Quit:(TypeZicht="ON") $G(Breedte,1000)
Quit:(TypeZicht="IN") $G(Dikte,1000)
Quit:(TypeZicht="BO") $G(Breedte,1000)
Quit:(TypeZicht="EX") $G(Dikte,1000)
; Else ; Standard Rectangle
Set Hght=$G(Breedte,1000)
Quit Hght
LosProfiel(Lengte,Breedte,Dikte,TypeZicht,Opties)
; TypeZicht : ProfZijkant dat het bovenaanzicht zal tonen
; Opties: "R=I" voor inverse plaatsing
; "D=..." toont waarde (...) als text. OPGELET: dit moet de LAATSTE OPTIE zijn bij het tonen van Dossier
New VML,sPath,InrLine,blnInrLine,DosNr
Set Lengte=$G(Lengte,1000)\1
Set Breedte=$G(Breedte,80)\1
Set Dikte=$G(Dikte,30)\1
Set DosNr=$S(";"_$G(Opties)[";D=":""_$P($P(Opties,";D=",1),";",2,99)_"", 1:"") ; _$P(Opties,";",1)_
If TypeZicht="ON" Do
. Set sPath="m0,0 l "_Lengte_",0, "_(Lengte-Breedte)_","_Breedte_", "_Breedte_","_Breedte_"xe"
. Set VML=""_DosNr_""
Else If TypeZicht="IN" Do
. Set InrLine=6
. Set sPath="m0,0 l "_Lengte_",0, "_Lengte_","_Dikte_", 0,"_Dikte_"x m"_Breedte_",0 l "_Breedte_","_Dikte
. Set sPath=sPath_" m"_(Lengte-Breedte)_",0 l "_(Lengte-Breedte)_","_Dikte_" m0,"_InrLine_" l "_InrLine_","_InrLine
. Set sPath=sPath_" m"_(Breedte-InrLine)_","_InrLine_" l "_Breedte_","_InrLine
. Set sPath=sPath_" m"_(Lengte-Breedte)_","_InrLine_" l "_(Lengte-Breedte+InrLine)_","_InrLine
. Set sPath=sPath_" m"_(Lengte-InrLine)_","_InrLine_" l "_(Lengte)_","_InrLine_" e"
. Set VML=""_DosNr_""
Else If TypeZicht="EX" Do
. Set InrLine=6
. Set sPath="m0,0 l "_Lengte_",0, "_Lengte_","_Dikte_", 0,"_Dikte_"xe"
. Set VML=""_DosNr_""
. Set blnInrLine='($G(Opties)["INRLINE=0") ; Voor Extern Profiel: Inner Lines tekenen (dashed); default=TRUE
. If blnInrLine Do
.. Set sPath="m"_Breedte_",0 l "_Breedte_","_Dikte_" m"_(Lengte-Breedte)_",0 l "_(Lengte-Breedte)_","_Dikte
.. Set sPath=sPath_" m0,"_(Dikte-InrLine)_" l "_InrLine_","_(Dikte-InrLine)
.. Set sPath=sPath_" m"_(Breedte-InrLine)_","_(Dikte-InrLine)_" l "_Breedte_","_(Dikte-InrLine)
.. Set sPath=sPath_" m"_(Lengte-Breedte)_","_(Dikte-InrLine)_" l "_(Lengte-Breedte+InrLine)_","_(Dikte-InrLine)
.. Set sPath=sPath_" m"_(Lengte-InrLine)_","_(Dikte-InrLine)_" l "_(Lengte)_","_(Dikte-InrLine)_" e"
.. Set VML=VML_""_""_""
. If 1 Do ; Zichtkant aanduiden met stippellijn
.. Set sPath="m0,0 l "_Lengte_",0 e"
.. Set VML=VML_""_""_""
. ; End of Profiel Extern
Else Do ; Draw Standard Rectangle
. Set sPath="m0,0 l "_Lengte_",0, "_Lengte_","_Breedte_", 0,"_Breedte_"xe"
. Set VML=""_DosNr_""
Quit VML
LosProfONCorner
; VML voor Los Profiel OP Kaderdeur getekend
; ZIE ProfONCorner()
Quit
ProfONCorner(CornerX,CornerY,ProfLengte,ProfBreedte,ProfPlaats,FillColor,BorderColor,FillOpacity,BorderOpacity,Opties)
; VML-vorm van een Profiel (ONder/boven-aanzicht), getekend vanuit de hoek van de KaderDeur
; In plaats van ...LeftTop() wordt hier gebruik gemaakt van ...Corner() omwille van de nauwkeurigheid (afrondingen!).
; Aanduiden van de Corners-(X,Y):
; - ProfPlaats="PL" ==> hoek: Links Boven
; - ProfPlaats="PB" ==> hoek: Links Boven
; - ProfPlaats="PR" ==> hoek: Rechts Boven
; - ProfPlaats="PO" ==> hoek: Links Onder
;
; Default is a solid line(border) and not filled ([FillOpacity=0]).
; To fill the rectangle: use [FillOpacity=1].
New VML,sPath,Lengte,Breedte,CXRechts,CYOnder
Set CXRechts=(CornerX-ProfBreedte)\1
Set CYOnder=(CornerY-ProfBreedte)\1
Set CornerX=CornerX\1
Set CornerY=CornerY\1
Set Lengte=ProfLengte\1
Set Breedte=ProfBreedte\1
If ProfPlaats="PL" Do
. Set sPath="m0,0 l 0,"_Lengte_", "_Breedte_","_(Lengte-Breedte)_", "_Breedte_","_Breedte_"xe"
. Set VML=""
Quit VML_" "_$G(Opties,"")_">"