1 TCHUI.System 1 %RegisteredObject 0 *108\*107\*109\*106\*119\*117\*116\*118\*113\*120\*110\*108\*107\*109\*106\*119\*117\*116\*118\*113\*120\*110\ B;1\U;4\K;5\I;7\b;22\u;24\k;25\i;27 %Integer %Integer %Integer %Integer %Integer %Integer %Integer %Integer Laatst ingestelde font als de nieuwe instelling gelijk is aan het ingestelde dan wordt er niets naar het scherm geschreven TFont %Boolean ParentCanvas,Top,Left,Height,Width,InitializeTerminal 1 " ; instellen van G0=ASCII; G1=DEC Supplemental; G2 = Graphical set en G3 = Technical set Write $C(15) ; mapping G0 -> GL Write $C(27),"~" ; mapping G1 -> GR ]]> Rij,Kol Width,Align,Text,MetEllipsis Width) & $G(MetEllipsis,1) Do . Set Width=Width-1 . Set MetEllipsis=1 Else Do . Set MetEllipsis="" Set Text=$E(Text,1,Width) Set Align=$G(Align,$$$alLeft) If $$$alLeft[Align Set Text=Text_$J("",Width-$L(Text)) ;alignering Else If Align=$$$alRight Set Text=$J(Text,Width) Else If Align=$$$alCenter Set Text=$J("",(Width-$L(Text))\2)_Text_$J("",Width-$L(Text)-((Width-$L(Text))\2)) Else If Align=$$$alFill,$L(Text) Set $P(Text,Text,Width\$L(Text))=Text,Text=$E(Text,1,Width) Do ..TextOut(Text_$S(MetEllipsis:$$$chEllipsis,1:"")) ]]> Width,Align,Text,MetEllipsis Width) & $G(MetEllipsis,1) Do . Set Width=Width-1 . Set MetEllipsis=1 Else Do . Set MetEllipsis=0 Set Text=$E(Text,1,Width) Set Align=$G(Align,"L") If Align="R" Do ..MoveTo(,..CurrentKol+Width-$L(Text)) If Align="C" Do ..MoveTo(,..CurrentKol+(Width-$L(Text)\2)) If Align="F",$L(Text) Set $P(Text,Text,Width\$L(Text))=Text,Text=$E(Text,1,Width) Do ..TextOut(Text_$S(MetEllipsis:$$$chEllipsis,1:"")) ]]> Bepaalt de textlengte rekening houdend met Esc karakters, elke esc. sequence bestaat uit 3 kar. maar op scherm is het slechts 1 kar Text Text,CharPos CharPos Set $E(Tmp,CharPos-Lengte+1,$L(Tmp))="" . Set Res=Res_Tmp . Set Lengte=Lengte+$L(Tmp) . Set $E(Text,1,$L(Tmp))="" . Quit:Lengte' Text Text,Style,FGColor,BGColor Width,HoekL,HoekR Width,lbIntersections Height,HoekT,HoekB,lbIntersections Height,lbIntersections Fills the specified rectangle on the canvas Rij,Kol,Height,Width,Style,FGColor,BGColor Frame+Fill Rij,Kol,Height,Width Draws a rectangle (border). Rij,Kol,Height,Width Rij1,Kol1,Rij2,Kol2,Char 1 lbRechten HK2) || (HRVR2)) "GN SNIJPUNT" ; geen kruising ; Knooppunt is (HR,VK) Set R=HR,K=VK ; Hoekpunt is bepaald nu nog CharCode van hoek If VK=HK1 Do ; Links . If HR=VR1 Set CharCode="*108" ; LeftTop . Else If HR=VR2 Set CharCode="*109" ; LeftBottom . Else Set CharCode="*116" ;LeftMidden Else If VK=HK2 Do ; Rechts . If HR=VR1 Set CharCode="*107" ;RightTop . Else If HR=VR2 Set CharCode="*106" ;RightBottom . Else Set CharCode="*117" ; RightMidden Else Do ; Midden . If HR=VR1 Set CharCode="*119" ; Top . Else If HR=VR2 Set CharCode="*118" ; Bottom . Else Set CharCode="*110" ; Midden Quit "" ExtractH(Lijn,R,K1,K2) ; R,K1 en K2 via .Local Set R=$LI($LI(Lijn,1),1) Set K1=$LI($LI(Lijn,1),2) Set K2=$LI($LI(Lijn,2),2) If K1>K2 Do . Set K2=K1 . Set K1=$LI($LI(Lijn,2),2) Quit ExtractV(Lijn,K,R1,R2) Set K=$LI($LI(Lijn,1),2) Set R1=$LI($LI(Lijn,1),1) Set R2=$LI($LI(Lijn,2),1) If R1>R2 Do . Set R2=R1 . Set R1=$LI($LI(Lijn,2),1) Quit LijnRichting(Lijn) Quit $S($LI($LI(Lijn,1),1)=$LI($LI(Lijn,2),1):"H",$LI($LI(Lijn,1),2)=$LI($LI(Lijn,2),2):"V",1:"X") ]]> Font Style,FGColor,BGColor Style,FGColor,BGColor,Absoluut 49)&&($G(Style)'["B") Style=$G(Style)_"B" ; Hilite Set:($P(GR,";",2)<49)&&($G(Style)["B") Style=$TR(Style,"B","") ; Dark Set GR =..GRforStyle(.Style,.Absoluut)_GR_..GRforBGColor(.BGColor) ;GR is leeg of bevat als eerste een ";" deze moet verwijderd worden Write:$L(GR) $C(27,91),$E(GR,2,99),"m" ]]> GR kleine letter is afzetten van een GR en een grote letter is op zetten. Style,Absoluut Color Color Control 0 $$$Top(Rect) $$$Top(Rect)=$$$Top(BGRect) Set:$$$Left(BGRect)>$$$Left(Rect) $$$VertPos(Rect)=$$$VertPos(Rect)+$$$Left(BGRect)-$$$Left(Rect),$$$Left(Rect)=$$$Left(BGRect) ; Rechts onder Set:$$$Bottom(BGRect)<$$$Bottom(Rect) $$$Bottom(Rect)=$$$Bottom(BGRect) Set:$$$Right(BGRect)<$$$Right(Rect) $$$Right(Rect)=$$$Right(BGRect) ; Controle of de rectangle nog zinvol is Set:($$$Bottom(Rect)<$$$Top(Rect))||($$$Right(Rect)<$$$Left(Rect)) Rect="" Quit ClippingHorizontaal(FGRect,Rects) New I,Rect,NewRect For I=1:1:Rects Do . Set Rect=$G(Rects(I)) . Quit:Rect="" ; Er kunnen gaten en lege Rects ontstaan . ; Controle of het disjunct is . If ($$$Top(FGRect)>$$$Bottom(Rect)) || ($$$Bottom(FGRect)<$$$Top(Rect)) || ($$$Left(FGRect)>$$$Right(Rect)) || ($$$Right(FGRect)<$$$Left(Rect)) Quit . ; Controle of het volledig verborgen is . If $$IsHidden(FGRect,Rect) Kill Rects(I) Quit . ; Controle op horizontale snijlijnen . If $$$Top(FGRect)>$$$Top(Rect) Do ; De top ligt hoger dan de FG top, er wordt een NewRect aangemaakt en Rect wordt verkleind . . Set NewRect=Rect . . Set $$$Bottom(NewRect)=$$$Top(FGRect)-1 ; volledig vrij boven FGrect . . Set $$$Top(Rect)=$$$Top(FGRect) ; verder onderzoeken . . ;Set:'$$IsHidden(FGRect,NewRect) Rects($I(Rects))=NewRect . . Set Rects($I(Rects))=NewRect . . Set Rects(I)=Rect . If $$$Bottom(FGRect)<$$$Bottom(Rect) Do ; De bottom ligt lager dan de FG bottom, er wordt een NewRect aangemaakt en Rect wordt verkleind . . Set NewRect=Rect . . Set $$$Top(NewRect)=$$$Bottom(FGRect)+1 ; volledig vrij onder FGrect . . Set $$$Bottom(Rect)=$$$Bottom(FGRect) ; tussen top en bottom van FGRect . . ;Set:'$$IsHidden(FGRect,NewRect) Rects($I(Rects))=NewRect . . Set Rects($I(Rects))=NewRect . . Set Rects(I)=Rect . If $$IsHidden(FGRect,Rect) Kill Rects(I) Quit ClippingVertikaal(FGRect,Rects) For I=1:1:Rects Do . Set Rect=$G(Rects(I)) . Quit:Rect="" ; Er kunnen gaten en lege Rects ontstaan . ; Controle of het disjunct is . If ($$$Top(FGRect)>$$$Bottom(Rect)) || ($$$Bottom(FGRect)<$$$Top(Rect)) || ($$$Left(FGRect)>$$$Right(Rect)) || ($$$Right(FGRect)<$$$Left(Rect)) Quit . ; Controle of het volledig verborgen is . If $$IsHidden(FGRect,Rect) Kill Rects(I) Quit . ; Controle op horizontale snijlijnen . If $$$Left(FGRect)>$$$Left(Rect) Do ; De top ligt hoger dan de FG top, er wordt een NewRect aangemaakt en Rect wordt verkleind . . Set NewRect=Rect . . Set $$$Right(NewRect)=$$$Left(FGRect)-1 ; volledig vrij links van FGrect . . Set $$$Left(Rect)=$$$Left(FGRect) ; verder onderzoeken . . Set $$$VertPos(Rect)=$$$VertPos(Rect)+$$$Left(Rect)-$$$Left(NewRect) ; de vertikale positie verplaatsten (nodig voor TextOut) . . ;Set:'$$IsHidden(FGRect,NewRect) Rects($I(Rects))=NewRect . . Set Rects($I(Rects))=NewRect . . Set Rects(I)=Rect . If $$$Right(FGRect)<$$$Right(Rect) Do ; De bottom ligt lager dan de FG bottom, er wordt een NewRect aangemaakt en Rect wordt verkleind . . Set NewRect=Rect . . Set $$$Left(NewRect)=$$$Right(FGRect)+1 ; volledig vrij rechts van FGrect . . Set $$$Right(Rect)=$$$Right(FGRect) ; tussen links en rechts van FGRect . . ;Set:'$$IsHidden(FGRect,NewRect) Rects($I(Rects))=NewRect . . Set $$$VertPos(NewRect)=$$$VertPos(Rect)+$$$Left(NewRect)-$$$Left(Rect) . . Set Rects($I(Rects))=NewRect . . Set Rects(I)=Rect . If $$IsHidden(FGRect,Rect) Kill Rects(I) Quit IsHidden(FGRect,Rect) Quit ($$$Top(FGRect)'>$$$Top(Rect)) && ($$$Bottom(FGRect)'<$$$Bottom(Rect)) && ($$$Left(FGRect)'>$$$Left(Rect)) && ($$$Right(FGRect)'<$$$Right(Rect)) DispRects(Rects) For I=1:1:Rects Do . Do W^vhDBG("["_I_"] ") . Do DispRect($G(Rects(I))) Quit DispRect(Rect) IF Rect="" Do WL^vhDBG("Empty Rect") Quit Do WL^vhDBG("Top:"_$$$Top(Rect)_" Left:"_$$$Left(Rect)_" Bottom:"_$$$Bottom(Rect)_" Right:"_$$$Right(Rect)_$S($LD(Rect,5):" VertPos:"_$$$VertPos(Rect),1:"")) Quit ]]>