home *** CD-ROM | disk | FTP | other *** search
/ Atari FTP / ATARI_FTP_0693.zip / ATARI_FTP_0693 / Tex / td187src.lzh / CIRCLES.I < prev    next >
Text File  |  1991-12-14  |  22KB  |  662 lines
  1. IMPLEMENTATION MODULE Circles ;
  2.  
  3. FROM Types     IMPORT TextPosTyp;
  4. IMPORT Types;
  5.  
  6. IMPORT mtAppl;
  7. IMPORT Diverses;
  8. IMPORT MagicAES;
  9. IMPORT MagicVDI;
  10. IMPORT MagicSys;
  11. IMPORT MathLib0 ;
  12.  
  13. IMPORT OwnBoxes;
  14. IMPORT Variablen ;
  15. IMPORT CommonData ;
  16. IMPORT HelpModule;
  17. IMPORT Fill;
  18. IMPORT Undo;
  19.  
  20. TYPE mkMode = (mkQuarter, mkCircle, mkDisk, mkArc, mkEllipse, mkEllArc);
  21.  
  22.  
  23. CONST HorizLines   = 0;
  24.       VertiLines   = 1;
  25.       DiagLftLines = 2;
  26.       DiagRgtLines = 3;
  27.  
  28. PROCEDURE Make ( Mode : mkMode; FillMode : INTEGER ) ;
  29.  
  30. VAR rx , ry , mx, my, rox, roy,
  31.     r, dx1, dx2, dy1, dy2,
  32.     x , y , b , e , bo , eo , xpic, ypic,
  33.     dum, h, mr                : INTEGER ;
  34.     keystate, but             : BITSET ;
  35.     fillstyle, fillstyleindex : INTEGER ;
  36.     xy                        : Types.CodeAryTyp ;
  37.     Surround                  : ARRAY [0..3] OF INTEGER;
  38.     halfcircle                : BOOLEAN;
  39.     lbut, rbut, allok         : BOOLEAN;
  40.     startangle, endangle      : INTEGER;
  41.     xold, yold                : INTEGER;
  42.     hlppos1, hlppos2          : INTEGER;
  43.     HelpAngle1,
  44.     HelpAngle2,
  45.     HelpEllipse,
  46.     HelpQuarter,
  47.     HelpHalf,
  48.     HelpFull                  : ARRAY [0..59] OF CHAR;
  49.  
  50.   PROCEDURE ReplaceAngleVal(VAR str : ARRAY OF CHAR;
  51.                             angleval, strpos : INTEGER);
  52.   VAR dum : INTEGER;
  53.   BEGIN
  54.     IF strpos>0 THEN
  55.       str[strpos]   := CHR(ORD('0') + MagicSys.CastToCard(angleval DIV 100));
  56.       dum := angleval MOD 100;
  57.       str[strpos+1] := CHR(ORD('0') + MagicSys.CastToCard(dum DIV 10));
  58.       str[strpos+2] := CHR(ORD('0') + MagicSys.CastToCard(dum MOD 10));
  59.     END;
  60.   END ReplaceAngleVal;
  61.  
  62.   PROCEDURE NewAngleVal(VAR angle, xold, x   : INTEGER;
  63.                         keystate             : BITSET);
  64.   VAR shift, ctrl, alt : BOOLEAN;
  65.   BEGIN
  66.     shift := (MagicAES.KRSHIFT IN keystate) OR
  67.              (MagicAES.KLSHIFT IN keystate);
  68.     ctrl  := MagicAES.KCTRL IN keystate;
  69.     alt   := MagicAES.KALT IN keystate;
  70.     IF (xold<x) THEN
  71.       IF shift THEN
  72.         DEC(angle, 5);
  73.       ELSIF alt AND NOT ctrl THEN
  74.         (* auf nächst niedrigeren Wert *)
  75.         IF angle = 0 THEN
  76.           angle := -45;
  77.          ELSE
  78.           angle := ((angle-1) DIV 45) * 45;
  79.         END;
  80.       ELSIF ctrl AND NOT alt THEN
  81.         (* auf nächst niedrigeren Wert *)
  82.         IF angle = 0 THEN
  83.           angle := -90;
  84.          ELSE
  85.           angle := ((angle-1) DIV 90) * 90;
  86.         END;
  87.       ELSIF ctrl AND alt THEN
  88.         (* auf nächst niedrigeren Wert *)
  89.         IF angle = 0 THEN
  90.           angle := -180;
  91.          ELSE
  92.           angle := ((angle-1) DIV 180) * 180;
  93.         END;
  94.       ELSE
  95.         DEC(angle, 1);
  96.       END;
  97.      ELSE
  98.       IF shift THEN
  99.         INC(angle, 5);
  100.       ELSIF alt AND NOT ctrl THEN
  101.         (* auf nächst höheren Wert *)
  102.         angle := ((angle DIV 45) +1) * 45;
  103.       ELSIF ctrl AND NOT alt THEN
  104.         (* auf nächst höheren Wert *)
  105.         angle := ((angle DIV 90) +1) * 90;
  106.       ELSIF ctrl AND alt THEN
  107.         (* auf nächst höheren Wert *)
  108.         angle := ((angle DIV 180) +1) * 180;
  109.       ELSE
  110.         INC(angle, 1);
  111.       END;
  112.     END;
  113.     xold := x;
  114.     WHILE (angle>360) DO DEC(angle, 360); END;
  115.     WHILE (angle<  0) DO INC(angle, 360); END;
  116.   END NewAngleVal;
  117.  
  118. BEGIN
  119.   OwnBoxes.WaitForDepress(mx, my);
  120.   Diverses.GetHelpText(6, HelpEllipse);
  121.   Diverses.GetHelpText(6, HelpQuarter);
  122.   Diverses.GetHelpText(7, HelpHalf);
  123.   Diverses.GetHelpText(8, HelpFull);
  124.   Diverses.GetHelpText(9, HelpAngle1);
  125.   Diverses.GetHelpText(10, HelpAngle2);
  126.   hlppos1 := 0;
  127.   WHILE (HelpAngle1[hlppos1]<>0C) AND (HelpAngle1[hlppos1]<>'?') DO
  128.     INC(hlppos1);
  129.   END;
  130.   IF (HelpAngle1[hlppos1  ]<>'?') OR
  131.      (HelpAngle1[hlppos1+1]<>'?') OR
  132.      (HelpAngle1[hlppos1+2]<>'?') THEN
  133.     hlppos1 := -1;
  134.   END;
  135.   hlppos2 := 0;
  136.   WHILE (HelpAngle2[hlppos2]<>0C) AND (HelpAngle2[hlppos2]<>'?') DO
  137.     INC(hlppos2);
  138.   END;
  139.   IF (HelpAngle2[hlppos2  ]<>'?') OR
  140.      (HelpAngle2[hlppos2+1]<>'?') OR
  141.      (HelpAngle2[hlppos2+2]<>'?') THEN
  142.     hlppos2 := -1;
  143.   END;
  144.  
  145.   mr := Variablen.MaxCircle() ;
  146.   IF (Mode = mkDisk) AND (FillMode=0) THEN
  147.     mr := Variablen.MaxDisk() ;
  148.   END ;
  149.   mr := Variablen.PixDistance ( mr );
  150.  
  151.   rox := 0 ;
  152.   roy := 0 ;
  153.   b   := 0 ;
  154.   e   := 3600 ;
  155.   h   := 0 ;
  156.   bo  := 0 ;
  157.   eo  := 3600 ;
  158.  
  159.   MagicVDI.SetLineEndstyles ( mtAppl.VDIHandle , MagicVDI.Cornerd , MagicVDI.Cornerd ) ;
  160.   dum := MagicVDI.SetLinetype ( mtAppl.VDIHandle , MagicVDI.Line ) ;
  161.   dum := MagicVDI.SetLinewidth ( mtAppl.VDIHandle , CommonData.LineWidth ) ;
  162.  
  163.   IF FillMode>=0 THEN
  164.     Fill.SetFillMode(FillMode);
  165.   END;
  166.  
  167.   dum := MagicVDI.SetLinecolor ( mtAppl.VDIHandle , MagicAES.BLACK ) ;
  168.  
  169.   REPEAT
  170.  
  171.     OwnBoxes.GetMKState(x, y, but, keystate);
  172.     OwnBoxes.MousePos(x, y, xpic, ypic, lbut, rbut);
  173.     Variablen.Position (TRUE, x, y, mx, my ) ;
  174.     halfcircle := (MagicAES.KLSHIFT IN keystate) OR
  175.                   (MagicAES.KRSHIFT IN keystate);
  176.     IF NOT ((Mode=mkEllipse) OR (Mode=mkEllArc)) THEN
  177.       rx := Diverses.round ( MathLib0.sqrt (
  178.               MathLib0.real ( x - mx ) * MathLib0.real ( x - mx ) +
  179.               MathLib0.real ( y - my ) * MathLib0.real ( y - my ) ) );
  180.  
  181.       IF rx > mr THEN rx := mr END ;
  182.       ry := rx;
  183.      ELSE
  184.       rx := ABS(x-mx); ry := ABS(y-my);
  185.     END;
  186.  
  187.     IF (rx <> rox) OR (ry <>roy) THEN
  188.  
  189.       IF Mode = mkQuarter THEN
  190.         IF halfcircle THEN
  191.           HelpModule.HelpMessage(HelpHalf);
  192.          ELSE
  193.           HelpModule.HelpMessage(HelpQuarter);
  194.         END;
  195.         IF x - mx < 0 THEN (* linke Seite *)
  196.           IF halfcircle THEN
  197.             IF ABS(y-my)<=ABS(x-mx) THEN
  198.               b := 900; e := 2700;
  199.               h := ORD(Types.Left);
  200.              ELSE
  201.               IF (y-my)<0 THEN       (* Y-Achse invers !! *)
  202.                 b := 0; e := 1800;
  203.                 h := ORD(Types.Top);
  204.                ELSE
  205.                 b := 1800; e := 3600;
  206.                 h := ORD(Types.Bottom);
  207.               END;
  208.             END;
  209.            ELSE
  210.             IF y - my < 0 THEN b :=  900 ; e := 1800 ;
  211.                                h := ORD(Types.LeftTop)  ;
  212.                           ELSE b := 1800 ; e := 2700 ;
  213.                                h := ORD(Types.LeftBot)  ;
  214.             END ;
  215.           END ;
  216.         ELSE (* rechte Seite *)
  217.           IF halfcircle THEN
  218.             IF ABS(y-my)<=ABS(x-mx) THEN
  219.               b := 2700; e := 900;
  220.               h := ORD(Types.Right);
  221.              ELSE
  222.               IF (y-my)<0 THEN       (* Y-Achse invers !! *)
  223.                 b := 0; e := 1800;
  224.                 h := ORD(Types.Top);
  225.                ELSE
  226.                 b := 1800; e := 3600;
  227.                 h := ORD(Types.Bottom);
  228.               END;
  229.             END;
  230.            ELSE
  231.             IF y - my < 0 THEN b :=    0 ; e :=  900 ;
  232.                                h := ORD(Types.RightTop) ;
  233.                           ELSE b := 2700 ; e :=    0 ;
  234.                                h := ORD(Types.RightBot) ;
  235.             END ;
  236.           END ;
  237.         END ;
  238.        ELSIF (Mode = mkEllipse) OR (Mode=mkEllArc) THEN
  239.         HelpModule.HelpMessage(HelpEllipse);
  240.        ELSE
  241.         HelpModule.HelpMessage(HelpFull);
  242.       END ;
  243.  
  244.       dum := MagicVDI.SetWritemode ( mtAppl.VDIHandle , MagicVDI.XOR ) ;
  245.       MagicVDI.SetClipping ( mtAppl.VDIHandle , CommonData.ClipXY , TRUE) ;
  246.       Diverses.MouseOff;
  247.       CASE Mode OF
  248.        mkDisk:
  249.          Fill.SetFillMode(FillMode);
  250.          MagicVDI.Circle ( mtAppl.VDIHandle , mx , my , rox ) ;
  251.          MagicVDI.Circle ( mtAppl.VDIHandle , mx , my , rx ) ;
  252.          Fill.SetFillMode(-1); |
  253.        mkEllArc,
  254.        mkEllipse:
  255.         IF FillMode>=0 THEN
  256.           Fill.SetFillMode(FillMode);
  257.           MagicVDI.Ellipse ( mtAppl.VDIHandle , mx , my , rox, roy);
  258.           MagicVDI.Ellipse ( mtAppl.VDIHandle , mx , my , rx, ry);
  259.          ELSE
  260.           MagicVDI.EllipticalArc ( mtAppl.VDIHandle , mx , my , rox, roy, bo, eo);
  261.           MagicVDI.EllipticalArc ( mtAppl.VDIHandle , mx , my , rx, ry, b, e);
  262.         END;
  263.        ELSE
  264.         MagicVDI.Arc ( mtAppl.VDIHandle , mx , my , rox , bo , eo ) ;
  265.         MagicVDI.Arc ( mtAppl.VDIHandle , mx , my , rx , b , e ) ;
  266.       END ;
  267.       Diverses.MouseOn;
  268.       MagicVDI.SetClipping ( mtAppl.VDIHandle , CommonData.ClipXY , FALSE) ;
  269.       dum := MagicVDI.SetWritemode ( mtAppl.VDIHandle , MagicVDI.REPLACE ) ;
  270.  
  271.       rox := rx ;
  272.       roy := ry ;
  273.       bo  := b ;
  274.       eo  := e ;
  275.  
  276.     END ;
  277.  
  278.   UNTIL lbut OR rbut;
  279.  
  280.   dum := MagicVDI.SetWritemode ( mtAppl.VDIHandle , MagicVDI.XOR ) ;
  281.   MagicVDI.SetClipping ( mtAppl.VDIHandle , CommonData.ClipXY , TRUE) ;
  282.   Diverses.MouseOff;
  283.   CASE Mode OF
  284.    mkDisk:
  285.     Fill.SetFillMode(FillMode);
  286.     MagicVDI.Circle ( mtAppl.VDIHandle , mx , my , rox ) ;
  287.     Fill.SetFillMode(-1); |
  288.    mkEllArc,
  289.    mkEllipse:
  290.     IF FillMode>=0 THEN
  291.       Fill.SetFillMode(FillMode);
  292.       MagicVDI.Ellipse ( mtAppl.VDIHandle , mx , my , rox , roy);
  293.       Fill.SetFillMode(-1);
  294.      ELSE
  295.       MagicVDI.EllipticalArc ( mtAppl.VDIHandle , mx , my , rox , roy, bo, eo);
  296.     END; |
  297.   ELSE
  298.     MagicVDI.Arc ( mtAppl.VDIHandle , mx , my , rox , bo , eo ) ;
  299.   END ;
  300.   Diverses.MouseOn;
  301.   MagicVDI.SetClipping ( mtAppl.VDIHandle , CommonData.ClipXY , FALSE) ;
  302.   dum := MagicVDI.SetWritemode ( mtAppl.VDIHandle , MagicVDI.REPLACE ) ;
  303.  
  304.   IF lbut AND NOT rbut THEN
  305.  
  306.     MagicVDI.SetClipping ( mtAppl.VDIHandle , CommonData.ClipXY , TRUE) ;
  307.     Diverses.MouseOff;
  308.     CASE Mode OF
  309.      mkDisk:
  310.       IF FillMode=0 THEN
  311.         Fill.SetFillMode(FillMode);
  312.         MagicVDI.Circle ( mtAppl.VDIHandle , mx , my , rox ) ;
  313.         Fill.SetFillMode(-1);
  314.       END; |
  315.      mkEllArc,
  316.      mkEllipse:
  317.       IF FillMode=0 THEN
  318.         Fill.SetFillMode(FillMode);
  319.         MagicVDI.Ellipse ( mtAppl.VDIHandle , mx , my , rx, ry ) ;
  320.         Fill.SetFillMode(-1);
  321.        ELSE
  322.         MagicVDI.EllipticalArc ( mtAppl.VDIHandle , mx , my , rx , ry, b, e);
  323.       END;|
  324.      ELSE
  325.       MagicVDI.Arc ( mtAppl.VDIHandle , mx , my , rx , b , e ) ;
  326.     END ;
  327.     Diverses.MouseOn;
  328.     MagicVDI.SetClipping ( mtAppl.VDIHandle , CommonData.ClipXY , FALSE) ;
  329.  
  330.     OwnBoxes.WaitForDepress(xold, yold);
  331.  
  332.     IF (Mode = mkArc) OR (Mode=mkEllArc) THEN
  333.       startangle := 0;
  334.       endangle   := 360;
  335.       ReplaceAngleVal(HelpAngle1, startangle, hlppos1);
  336.       HelpModule.HelpMessage(HelpAngle1);
  337.       REPEAT
  338.         OwnBoxes.GetMKState(x, y, but, keystate);
  339.         OwnBoxes.MousePos  (x, y, xpic, ypic, lbut, rbut);
  340.         IF (xold<>x) THEN
  341.          dum := MagicVDI.SetWritemode ( mtAppl.VDIHandle , MagicVDI.XOR ) ;
  342.          MagicVDI.SetClipping ( mtAppl.VDIHandle , CommonData.ClipXY , TRUE) ;
  343.          Diverses.MouseOff;
  344.          IF Mode=mkArc THEN
  345.            MagicVDI.Arc ( mtAppl.VDIHandle , mx , my , rx ,
  346.                           10*startangle, 10 *endangle);
  347.           ELSE
  348.            MagicVDI.EllipticalArc ( mtAppl.VDIHandle , mx , my , rx, ry,
  349.                           10*startangle, 10 *endangle);
  350.          END;
  351.          NewAngleVal(startangle, xold, x, keystate);
  352.          IF Mode=mkArc THEN
  353.            MagicVDI.Arc ( mtAppl.VDIHandle , mx , my , rx ,
  354.                           10*startangle, 10 *endangle);
  355.           ELSE
  356.            MagicVDI.EllipticalArc ( mtAppl.VDIHandle , mx , my , rx, ry,
  357.                           10*startangle, 10 *endangle);
  358.          END;
  359.          Diverses.MouseOn;
  360.          MagicVDI.SetClipping ( mtAppl.VDIHandle , CommonData.ClipXY , FALSE) ;
  361.          dum := MagicVDI.SetWritemode ( mtAppl.VDIHandle , MagicVDI.REPLACE ) ;
  362.          ReplaceAngleVal(HelpAngle1, startangle, hlppos1);
  363.          HelpModule.HelpMessage(HelpAngle1);
  364.         END;
  365.       UNTIL lbut;
  366.  
  367.       OwnBoxes.WaitForDepress(x, y);
  368.  
  369.       ReplaceAngleVal(HelpAngle2, endangle, hlppos2);
  370.       HelpModule.HelpMessage(HelpAngle2);
  371.       REPEAT
  372.         OwnBoxes.GetMKState(x, y, but, keystate);
  373.         OwnBoxes.MousePos  (x, y, xpic, ypic, lbut, rbut);
  374.         IF (xold<>x) THEN
  375.          dum := MagicVDI.SetWritemode ( mtAppl.VDIHandle , MagicVDI.XOR ) ;
  376.          MagicVDI.SetClipping ( mtAppl.VDIHandle , CommonData.ClipXY , TRUE) ;
  377.          Diverses.MouseOff;
  378.          IF Mode=mkArc THEN
  379.            MagicVDI.Arc ( mtAppl.VDIHandle , mx , my , rx ,
  380.                           10*startangle, 10 *endangle);
  381.           ELSE
  382.            MagicVDI.EllipticalArc ( mtAppl.VDIHandle , mx , my , rx, ry,
  383.                           10*startangle, 10 *endangle);
  384.          END;
  385.          NewAngleVal(endangle, xold, x, keystate);
  386.          IF Mode=mkArc THEN
  387.            MagicVDI.Arc ( mtAppl.VDIHandle , mx , my , rx ,
  388.                           10*startangle, 10 *endangle);
  389.           ELSE
  390.            MagicVDI.EllipticalArc ( mtAppl.VDIHandle , mx , my , rx, ry,
  391.                           10*startangle, 10 *endangle);
  392.          END;
  393.          Diverses.MouseOn;
  394.          MagicVDI.SetClipping ( mtAppl.VDIHandle , CommonData.ClipXY , FALSE) ;
  395.          dum := MagicVDI.SetWritemode ( mtAppl.VDIHandle , MagicVDI.REPLACE ) ;
  396.          ReplaceAngleVal(HelpAngle2, endangle, hlppos2);
  397.          HelpModule.HelpMessage(HelpAngle2);
  398.         END;
  399.       UNTIL lbut;
  400.  
  401.       OwnBoxes.WaitForDepress(x, y);
  402.  
  403.     END;
  404.  
  405.     FOR dum := 0 TO 9 DO xy [ dum ] := 0 END ;
  406.     Variablen.PixToPic ( mx , my , xy [ 1 ] , xy [ 2 ] ) ;
  407.     xy [ 3 ] := Variablen.PicDistance ( rx ) ;
  408.     xy [ 8 ] := CommonData.LineWidth ;
  409.     Surround[0] := xy[1] - xy[3];
  410.     Surround[1] := xy[2] + xy[3];
  411.     Surround[2] := 2 * xy[3] ;
  412.     Surround[3] := 2 * xy[3] ;
  413.  
  414.     allok := TRUE;
  415.  
  416.     CASE Mode OF
  417.       mkQuarter :
  418.           xy [ 0 ] := ORD(Types.Oval );
  419.           xy [ 4 ] := Variablen.PicDistance ( h ) ;
  420.           dx2 := 0; dy2 := 0;
  421.           CASE VAL(Types.TextPosTyp, xy[ 4 ]) OF
  422.             Types.Left     : dx1 := -rx; dy1 := +rx;
  423.                              dx2 :=   0; dy2 := +rx; |
  424.             Types.Right    : dx1 :=   0; dy1 := +rx;
  425.                              dx2 :=   0; dy2 := +rx; |
  426.             Types.Top      : dx1 := -rx; dy1 := +rx;
  427.                              dx2 := +rx; dy2 :=   0; |
  428.             Types.Bottom   : dx1 := -rx; dy1 :=   0;
  429.                              dx2 := +rx; dy2 :=   0; |
  430.             Types.LeftTop  : dx1 := -rx; dy1 := +rx; |
  431.             Types.LeftBot  : dx1 := -rx; dy1 :=   0; |
  432.             Types.RightTop : dx1 :=   0; dy1 := +rx; |
  433.             Types.RightBot : dx1 :=   0; dy1 :=   0; |
  434.           ELSE
  435.           END ;
  436.           Surround[0] := xy[1] + Variablen.PicDistance ( dx1 );
  437.           Surround[1] := xy[2] + Variablen.PicDistance ( dy1 );
  438.           Surround[2] := xy[3] + Variablen.PicDistance ( dx2 );
  439.           Surround[3] := xy[3] + Variablen.PicDistance ( dy2 );
  440.           |
  441.       mkCircle :
  442.           xy [ 0 ] := ORD(Types.Circle ); |
  443.       mkDisk :
  444.           IF FillMode=0 THEN
  445.             xy [ 0 ] := ORD(Types.Disk );
  446.            ELSE
  447.             xy [ 0 ] := ORD(Types.Circle );
  448.           END;
  449.           xy [ 5 ] := FillMode; |
  450.       mkEllArc,
  451.       mkEllipse :
  452.           xy [ 0 ] := ORD(Types.Ellipse );
  453.           xy [ 4 ] := Variablen.PicDistance ( ry ) ;
  454.           IF Mode = mkEllArc THEN
  455.             xy [ 5 ] := startangle;
  456.             xy [ 6 ] := endangle - startangle;
  457.            ELSE
  458.             xy [ 5 ] :=   0;  (* Vorbereitung auf beliebigen E.-Bogen *)
  459.             xy [ 6 ] := 360;
  460.           END;
  461.           WHILE xy[6] > 360 DO  DEC(xy[6], 360); END;
  462.           WHILE xy[6] <   0 DO  INC(xy[6], 360); END;
  463.           IF xy[6]=0 THEN
  464.             allok := FALSE;
  465.           END;
  466.           IF FillMode = 0 THEN
  467.             xy [ 7 ] := 1;
  468.           END;
  469.           Surround[0] := xy[1] - xy[3];
  470.           Surround[1] := xy[2] + xy[4];
  471.           Surround[2] := 2 * xy[3];
  472.           Surround[3] := 2 * xy[4];
  473.           |
  474.       mkArc :
  475.           xy [ 0 ] := ORD(Types.Arc );
  476.           xy[4] := startangle;
  477.           xy[5] := endangle - startangle;
  478.           WHILE xy[5] > 360 DO  DEC(xy[5], 360); END;
  479.           WHILE xy[5] <   0 DO  INC(xy[5], 360); END;
  480.           IF xy[5]=0 THEN
  481.             allok := FALSE;
  482.           END; |
  483.      ELSE
  484.     END ;
  485.     IF allok THEN
  486.       Undo.PrepareUndo(TRUE);
  487.       Variablen.NewObject ( xy , NIL, NIL, Surround ) ;
  488.     END;
  489.   END;
  490.  
  491. END Make ;
  492.  
  493. (**
  494. PROCEDURE Quarter ( ) ;
  495. BEGIN
  496.   Make ( mkQuarter, -1 ) ;
  497. END Quarter ;
  498. **)
  499.  
  500. PROCEDURE Circle ( ) ;
  501. BEGIN
  502.   Make ( mkCircle, -1 ) ;
  503. END Circle ;
  504.  
  505. PROCEDURE Disk (FillFlag : INTEGER);
  506. BEGIN
  507.   Make ( mkDisk, FillFlag-1 ) ;
  508. END Disk ;
  509.  
  510. PROCEDURE Arc ();
  511. BEGIN
  512.   Make ( mkArc, -1 ) ;
  513. END Arc;
  514.  
  515. PROCEDURE Ellipse (FillFlag : INTEGER);
  516. BEGIN
  517.   Make ( mkEllipse, FillFlag-1 ) ;
  518. END Ellipse;
  519.  
  520. PROCEDURE EllArc ();
  521. BEGIN
  522.   Make ( mkEllArc, -1 ) ;
  523. END EllArc;
  524.  
  525. PROCEDURE Show ( Object : Types.ObjectPtrTyp ) ;
  526.  
  527. VAR mx, my, rx , ry , r , b , e , dum, dx1, dx2, dy1, dy2 : INTEGER ;
  528.     t1, t2, t3, t4 : INTEGER;
  529.     fillstyle, fillstyleindex : INTEGER;
  530. BEGIN
  531.   Variablen.PicToPix( mx , my , Object^.Code [ 1 ] , Object^.Code [ 2 ] ) ;
  532.   rx := Variablen.PixDistance ( Object^.Code [ 3 ]);
  533.   IF VAL(Types.DrawObjectTyp, Object^.Code [ 0 ])=
  534.      Types.Oval THEN
  535.     dx2 := rx; dy2 := rx;
  536.     CASE VAL(TextPosTyp, Object^.Code [ 4 ]) OF
  537.       Left     : dx1 :=  -rx;  dy1 :=  +rx;
  538.                  dx2 :=   rx;  dy2 := 2*rx;
  539.                  b   :=  900;  e   := 2700; |
  540.       Right    : dx1 :=    0;  dy1 :=  +rx;
  541.                  dx2 :=   rx;  dy2 := 2*rx;
  542.                  b   := 2700;  e   :=  900; |
  543.       Top      : dx1 :=  -rx;  dy1 :=  +rx;
  544.                  dx2 := 2*rx;  dy2 :=   rx;
  545.                  b   :=    0;  e   := 1800; |
  546.       Bottom   : dx1 :=  -rx;  dy1 :=    0;
  547.                  dx2 := 2*rx;  dy2 :=   rx;
  548.                  b   := 1800;  e   := 3600; |
  549.       LeftTop  : dx1 :=  -rx;  dy1 :=  +rx;
  550.                  b   :=  900;  e   := 1800; |
  551.       LeftBot  : dx1 :=  -rx;  dy1 :=    0;
  552.                  b   := 1800;  e   := 2700; |
  553.       RightTop : dx1 :=    0;  dy1 :=  +rx;
  554.                  b   :=    0;  e   :=  900; |
  555.       RightBot : dx1 :=    0;  dy1 :=    0;
  556.                  b   := 2700;  e   :=    0; |
  557.     ELSE
  558.     END ;
  559.   ELSIF VAL(Types.DrawObjectTyp, Object^.Code [ 0 ])=
  560.         Types.Ellipse THEN
  561.     ry := Variablen.PixDistance ( Object^.Code [ 4 ]);
  562.     dx1 := -rx;
  563.     dy1 := +ry;
  564.     dx2 := 2*rx;
  565.     dy2 := 2*ry;
  566.     WHILE Object^.Code[6] > 360 DO DEC(Object^.Code[6], 360); END;
  567.     WHILE Object^.Code[6] <   0 DO INC(Object^.Code[6], 360); END;
  568.     b := 10 * Object^.Code[5];
  569.     e := b + 10 * Object^.Code[6];
  570.     IF b>3600 THEN b := b - 3600; END;
  571.     IF e>3600 THEN e := e - 3600; END;
  572.   ELSE
  573.     IF VAL(Types.DrawObjectTyp, Object^.Code [ 0 ])=
  574.         Types.Arc THEN
  575.        WHILE Object^.Code[5] > 360 DO DEC(Object^.Code[5], 360); END;
  576.        WHILE Object^.Code[5] <   0 DO INC(Object^.Code[5], 360); END;
  577.        b := 10 * Object^.Code[4];
  578.        e := b + 10 * Object^.Code[5];
  579.        IF b>3600 THEN b := b - 3600; END;
  580.        IF e>3600 THEN e := e - 3600; END;
  581.     END;
  582.     dx1 := -rx;
  583.     dy1 := +rx;
  584.     dx2 := 2*rx;
  585.     dy2 := 2*rx;
  586.   END ;
  587.   IF Object^.SurrDirty THEN
  588.     Object^.Surround[0] := Object^.Code[1] + CommonData.FatherXOffset + dx1;
  589.     Object^.Surround[1] := Object^.Code[2] + CommonData.FatherYOffset + dy1;
  590.     Object^.Surround[2] := dx2;
  591.     Object^.Surround[3] := dy2;
  592.     Object^.SurrDirty   := FALSE;
  593.   END;
  594.  
  595.   IF Variablen.Visible(Object^.Surround) THEN
  596.     dum := MagicVDI.SetLinewidth ( mtAppl.VDIHandle , Object^.Code [ 8 ] ) ;
  597.     dum := MagicVDI.SetLinetype ( mtAppl.VDIHandle , MagicVDI.Line ) ;
  598.     dum := MagicVDI.SetLinecolor ( mtAppl.VDIHandle , MagicAES.BLACK ) ;
  599.     MagicVDI.SetLineEndstyles ( mtAppl.VDIHandle ,
  600.                                 MagicVDI.Cornerd , MagicVDI.Cornerd ) ;
  601.  
  602.     CASE VAL(Types.DrawObjectTyp, Object^.Code [ 0 ]) OF
  603.       Types.Disk   :
  604.         Fill.SetFillMode(Object^.Code[5]);
  605.         MagicVDI.Circle ( mtAppl.VDIHandle , mx , my , rx ) ;
  606.         Fill.SetFillMode(-1); |
  607.       Types.Circle :
  608.         MagicVDI.Arc ( mtAppl.VDIHandle , mx , my , rx , 0 , 3600 ) ; |
  609.       Types.Ellipse :
  610.         IF (Object^.Code[7]<>0) AND (b=0) AND (e=3600) THEN
  611.           Fill.SetFillMode(0);
  612.           MagicVDI.Ellipse ( mtAppl.VDIHandle , mx , my , rx , ry );
  613.           Fill.SetFillMode(-1);
  614.          ELSE
  615.           MagicVDI.EllipticalArc ( mtAppl.VDIHandle , mx , my ,
  616.                                  rx , ry , b, e ) ;
  617.         END; |
  618.       Types.Arc,
  619.       Types.Oval   :
  620.         MagicVDI.Arc ( mtAppl.VDIHandle , mx , my , rx , b , e ) ; |
  621.     END ;
  622.  
  623.   END ;
  624.  
  625. END Show ;
  626.  
  627. PROCEDURE Change ( Object : Types.ObjectPtrTyp;
  628.                    DX, DY : LONGREAL ) ;
  629. VAR factor : LONGREAL;
  630.     new    : INTEGER;
  631.  
  632. BEGIN
  633.   IF DX>DY THEN factor := DX; ELSE factor := DY; END;
  634.   IF factor<>0.0 THEN
  635.     IF   (ORD(Object^.Code[0]) = ORD(Types.Circle))
  636.       OR (ORD(Object^.Code[0]) = ORD(Types.Arc)) THEN
  637.       new := Diverses.round(MathLib0.real(Object^.Code[3]) * factor);
  638.       IF new > Variablen.MaxCircle() THEN
  639.         new := Variablen.MaxCircle();
  640.       END;
  641.      ELSIF ORD(Object^.Code[0]) = ORD(Types.Disk) THEN
  642.       new := Diverses.round(MathLib0.real(Object^.Code[3]) * factor);
  643.       IF new > Variablen.MaxDisk() THEN
  644.         new := Variablen.MaxDisk();
  645.       END;
  646.      ELSIF ORD(Object^.Code[0]) = ORD(Types.Ellipse) THEN
  647.       new := Diverses.round(MathLib0.real(Object^.Code[4]) * DY);
  648.       Object^.Code[4] := new;
  649.       new := Diverses.round(MathLib0.real(Object^.Code[3]) * DX);
  650.      ELSE
  651.       new := Diverses.round(MathLib0.real(Object^.Code[3]) * factor);
  652.       IF new > Variablen.MaxCircle() THEN
  653.         new := Variablen.MaxCircle();
  654.       END;
  655.     END;
  656.     Object^.Code[3] := new;
  657.     Object^.SurrDirty := TRUE;
  658.   END;
  659. END Change;
  660.  
  661. END Circles .
  662.