home *** CD-ROM | disk | FTP | other *** search
/ Chip 1998 March / Chip_1998-03_cd.bin / tema / MINICAD / MC7DEMO / MINICAD.1 / CIRCLES.MPC < prev    next >
Text File  |  1997-04-30  |  5KB  |  297 lines
  1. Procedure CreateCircle;
  2. {
  3. @1997, Diehl Graphsoft, Inc.
  4. Developed by Tom Urie
  5.  
  6. This procedure allows the user to place an unlimited number of circles of the same size on a drawing.
  7. }
  8. LABEL 5,10,99;
  9.  
  10. CONST
  11.     k1=0.25;
  12.     k2=0.125;
  13.     k3=0.0625;
  14.  
  15. VAR
  16.     x,y,x1,y1,xm,ym,Dia : REAL;
  17.     KeyCode : INTEGER;
  18.     Abort,OK,NextClick,CenterMark : BOOLEAN;
  19.  
  20. Procedure CircleDialog;
  21. {
  22. This procedure creates the dialog box.
  23. }
  24. VAR
  25.     Width,x1,y1,x2,y2,px1,px2,px3,px4,py1,py2,py3,py4 : INTEGER;
  26.  
  27. Procedure AlignScr(Width:INTEGER; VAR x1,x2:INTEGER);
  28. VAR
  29.     scrx1,scry1,scrx2,scry2:INTEGER;
  30. BEGIN
  31.     GetScreen(scrx1,scry1,scrx2,scry2);
  32.     x1:=((scrx1+scrx2) div 2)-(Width div 2);
  33.     x2:=x1+Width; 
  34. END;
  35.  
  36. Procedure LocateButtons(DialogType,scnh,scnw : INTEGER);
  37. {
  38. This procedure locates the 'OK' and 'Cancel' buttons.
  39. }
  40. VAR
  41.     v1,v2,v3,v4 : INTEGER;
  42.     Mac : BOOLEAN;
  43.  
  44. Procedure Swap(VAR  m1,m2,m3,m4 : INTEGER);
  45. VAR
  46.     Temp : INTEGER;
  47. BEGIN
  48.     Temp:=m1;
  49.     m1:=m3;
  50.     m3:=Temp;
  51.     Temp:=m2;
  52.     m2:=m4;
  53.     m4:=Temp;
  54. END;        {of Swap}
  55.  
  56. BEGIN
  57.     Mac:=FALSE;
  58.     GetVersion(v1,v2,v3,v4);
  59.     IF v4 = 1 THEN Mac:=TRUE;
  60.  
  61.     IF DialogType = 1 THEN
  62.     BEGIN
  63.         px1:=(scnw DIV 2) - 80;
  64.         px2:=(scnw DIV 2) - 10;
  65.         px3:=(scnw DIV 2) + 10;
  66.         px4:=(scnw DIV 2) + 80;
  67.         IF Mac THEN SWAP(px1,px2,px3,px4);
  68.  
  69.         py1:=scnh-40;
  70.         py2:=scnh-20;
  71.         py3:=py1;
  72.         py4:=py2;
  73.     END ELSE IF DialogType = 2 THEN
  74.     BEGIN
  75.         px1:=scnw - 180;
  76.         px2:=scnw - 110;
  77.         px3:=scnw - 90;
  78.         px4:=scnw - 20;
  79.         IF Mac THEN SWAP(px1,px2,px3,px4);
  80.  
  81.         py1:=scnh-40;
  82.         py2:=scnh-20;
  83.         py3:=py1;
  84.         py4:=py2;
  85.     END ELSE
  86.     BEGIN
  87.         px1:=scnw - 90;
  88.         px2:=scnw - 20;
  89.         px3:=px1;
  90.         px4:=px2;
  91.  
  92.         py1:=scnh -70;
  93.         py2:=scnh - 50;
  94.         py3:=scnh - 40;
  95.         py4:=scnh - 20;
  96.         IF Mac THEN SWAP(py1,py2,py3,py4);
  97.     END;
  98. END;        {of Locate Buttons}
  99.  
  100. Procedure MakeDialog;
  101. {
  102. This procedure defines the dialog box.
  103. }
  104. CONST
  105.     y1=100;
  106.     scnw =  230;    scnh = 225;
  107.     DialogType = 1;
  108.  
  109. VAR
  110.     h : INTEGER;
  111.  
  112. BEGIN
  113.     AlignScr(scnw,x1,x2);
  114.     y2:=y1+scnh;
  115.     LocateButtons(DialogType,scnh,scnw );
  116.     
  117.     BeginDialog(1,1,x1,y1,x2,y2);
  118.         AddButton('OK',1,1,px1,py1,px2,py2);
  119.         AddButton('Cancel',2,1,px3,py3,px4,py4);
  120.  
  121.         h:=-30;                AddField('Diameter:',5,1,20,45+h,100,60+h);
  122.         AddField('',6,2,105,45+h,205,60+h);
  123.         AddField('Location:',7,1,20,75+h,130,90+h);
  124.         AddField('X:',8,1,20,100+h,50,115+h);
  125.         AddField('',9,2,55,100+h,155,115+h);
  126.         AddField('Y:',10,1,20,125+h,50,140+h);
  127.         AddField('',11,2,55,125+h,155,140+h);
  128.         AddButton('Next Click(s)',12,3,20,155+h,120,170+h);
  129.  
  130.         AddButton('Show Center Mark',13,2,20,180+h,170,195+h);
  131.  
  132.     EndDialog;
  133. END;
  134.  
  135. BEGIN
  136.     MakeDialog;
  137. END;
  138.  
  139. Procedure GetInfo;
  140. {
  141. This procedure displays the dialog box and retrieves the information.
  142. }
  143. LABEL 10,20,30,99;
  144. VAR
  145.     Item : INTEGER;
  146.     Done : BOOLEAN;
  147.  
  148. BEGIN
  149.     Done:=FALSE;
  150.     Abort:=FALSE;
  151.     NextClick:=TRUE;
  152.     CenterMark:=FALSE;
  153.     GetDialog(1);
  154.     SetTitle('Create Circle');
  155.     SetItem(12,NextClick);
  156.     SetField(6,Num2Str(4,Dia));
  157.     SelField(6);
  158.     REPEAT
  159.         DialogEvent(Item);
  160.         IF Item = 1 THEN
  161.             Done:=TRUE;
  162.         IF Item = 2 THEN
  163.         BEGIN
  164.             Done:=TRUE;
  165.             Abort:=TRUE;
  166.         END;
  167.  
  168.         IF (Item=9) AND (NextClick) THEN
  169.         BEGIN
  170.             NextClick:=FALSE;
  171.             SetItem(12,FALSE);
  172.             SetField(9,Num2StrF(x));
  173.             SetField(11,Num2StrF(y));
  174.             SelField(9);
  175.         END;
  176.  
  177.         IF (Item=11) AND (NextClick) THEN
  178.         BEGIN
  179.             NextClick:=FALSE;
  180.             SetItem(12,FALSE);
  181.             SetField(9,Num2StrF(x));
  182.             SetField(11,Num2StrF(y));
  183.             SelField(9);
  184.         END;
  185.  
  186.         IF Item=12 THEN
  187.         BEGIN
  188.             IF NOT NextClick THEN
  189.             BEGIN
  190.                 NextClick:=TRUE;
  191.                 SetItem(12,TRUE);
  192.                 SetField(9,'');
  193.                 SetField(11,'');
  194.                 SelField(6);
  195.             END ELSE BEGIN
  196.                 NextClick:=FALSE;
  197.                 SetItem(12,FALSE);
  198.                 SetField(9,Num2StrF(x));
  199.                 SetField(11,Num2StrF(y));
  200.                 SelField(9);
  201.             END;
  202.         END;
  203.  
  204.         IF Item=13 THEN
  205.         BEGIN
  206.             CenterMark:=NOT CenterMark;
  207.             SetItem(13,CenterMark);
  208.         END;
  209.  
  210.     UNTIL Done;
  211.     IF Abort THEN GOTO 99;
  212.     OK:=ValidNumStr(GetField(6),Dia);
  213.     IF Dia <= 0 THEN
  214.     BEGIN
  215.         Sysbeep;
  216.         GOTO 10;
  217.     END;
  218.     OK:=ValidNumStr(GetField(9),x);
  219.     OK:=ValidNumStr(GetField(11),y);
  220. 99:ClrDialog;
  221. END;
  222.  
  223. Procedure CMark(Dia,x,y : REAL);
  224. VAR
  225.     L1,L2 : REAL;
  226. BEGIN
  227.     PushAttrs;
  228.     PenPat(2);
  229.     PenSize(5);
  230.     L1:=k1;
  231.     IF L1 > Dia/2 THEN L1:=0.5*Dia;
  232.     L2:=Dia/2 + k2 - k3 - L1/2;
  233.     Absolute;
  234.     MoveTo(x,y);
  235.     Relative;
  236.     Move(-(Dia/2+k2),0);
  237.     Line(L2,0);
  238.     Move(k3,0);
  239.     Line(L1,0);
  240.     Move(k3,0);
  241.     Line(L2,0);
  242.     Absolute;
  243.     MoveTo(x,y);
  244.     Relative;
  245.     Move(0,-(Dia/2+k2));
  246.     Line(0,L2);
  247.     Move(0,k3);
  248.     Line(0,L1);
  249.     Move(0,k3);
  250.     Line(0,L2);
  251.     PopAttrs;
  252. END;
  253.  
  254. {
  255. Main Program.
  256. }
  257. BEGIN
  258.     DSelectAll;
  259. {
  260. Display dialog box.
  261. }
  262.     CircleDialog;
  263.     SetCursor(ArrowC);
  264. {
  265. Get information from the dialog box.
  266. }
  267.     GetInfo;
  268.     IF Abort THEN GOTO 99;
  269.     IF NextClick THEN
  270.     BEGIN
  271.         Message('Click location of circles(s). Hit any key to quit.');
  272.         SetCursor(LgCrossC);
  273.     END;
  274.  
  275.     WHILE NOT KeyDown(KeyCode) DO
  276.     BEGIN
  277.         IF NOT NextClick THEN GOTO 5;
  278.         10:IF MouseDown(x,y) THEN
  279.         BEGIN
  280.             5:Absolute;
  281.             MoveTo(x,y);
  282.             Relative;
  283.             Arc(-Dia/2,Dia/2,Dia/2,-Dia/2,0,360);
  284.             IF CenterMark THEN
  285.             BEGIN
  286.                 CMark(Dia,x,y);
  287.                 Group;
  288.                 DSelectAll;
  289.             END;
  290.             Redraw;
  291.             IF NOT NextClick THEN GOTO 99;
  292.         END;
  293.     END;
  294.     ClrMessage;
  295. 99:END;
  296.  
  297. RUN(CreateCircle);