home *** CD-ROM | disk | FTP | other *** search
/ Chip 1998 March / Chip_1998-03_cd.bin / tema / MINICAD / MC7DEMO / MINICAD.1 / CUT_LINE.MPC < prev    next >
Encoding:
Text File  |  1997-04-30  |  5.1 KB  |  272 lines
  1. Procedure CutLine;
  2. {
  3. ⌐1996, Diehl Graphsoft, Inc.
  4. Developed by Tom Urie
  5.  
  6. This procedure creates a cut, or section, line and applies the section name. Up to 10 segments of the line are allowed.
  7. }
  8.  
  9. LABEL 5,20,30,99;
  10.  
  11. CONST
  12.     LeaderLgth=0.375;  {Length of leader}
  13.     ArrowLgth=0.1875;  {Size of arrowhead}
  14.     Alpha=15;  {Angle of arrowhead}
  15.     TxtCenter=0.1875;  {Used to place text above arrowhead}
  16.     TxtOffset=0.125;  {Used to center text on arrowhead}
  17.     TxtSizeR=14;   {Reference text point size}
  18. VAR
  19.     r,xs,ys,xt,yt,LScale,L1,L2,L3,L4,L5,TxtC : REAL;
  20.     x,y : ARRAY[1..10] OF REAL;
  21.     Theta : ARRAY[1..2] OF REAL;
  22.     i,j,k,TxtSize : INTEGER;
  23.     Section : STRING;
  24.     Abort : BOOLEAN;
  25.     LayerH,TxtH : HANDLE;
  26.     UPI,SF : REAL;
  27.     Fmt : INTEGER;
  28.     UM,UM2 : STRING;
  29.     UName,DA : LONGINT;
  30.  
  31. Procedure CutLineDialog;
  32. VAR
  33.     Width,x1,y1,x2,y2,px1,px2,px3,px4,py1,py2,py3,py4 : INTEGER;
  34.  
  35. Procedure AlignScr(Width:INTEGER; VAR x1,x2:INTEGER);
  36. VAR
  37.     scrx1,scry1,scrx2,scry2:INTEGER;
  38. BEGIN
  39.     GetScreen(scrx1,scry1,scrx2,scry2);
  40.     x1:=((scrx1+scrx2) div 2)-(Width div 2);
  41.     x2:=x1+Width; 
  42. END;
  43.  
  44. Procedure LocateButtons(DialogType,scnh,scnw : INTEGER);
  45. {
  46. This procedure locates the 'OK' and 'Cancel' buttons.
  47. }
  48. VAR
  49.     v1,v2,v3,v4 : INTEGER;
  50.     Mac : BOOLEAN;
  51.  
  52. Procedure Swap(VAR  m1,m2,m3,m4 : INTEGER);
  53. VAR
  54.     Temp : INTEGER;
  55. BEGIN
  56.     Temp:=m1;
  57.     m1:=m3;
  58.     m3:=Temp;
  59.     Temp:=m2;
  60.     m2:=m4;
  61.     m4:=Temp;
  62. END;        {of Swap}
  63.  
  64. BEGIN
  65.     Mac:=FALSE;
  66.     GetVersion(v1,v2,v3,v4);
  67.     IF v4 = 1 THEN Mac:=TRUE;
  68.  
  69.     IF DialogType = 1 THEN
  70.     BEGIN
  71.         px1:=(scnw DIV 2) - 80;
  72.         px2:=(scnw DIV 2) - 10;
  73.         px3:=(scnw DIV 2) + 10;
  74.         px4:=(scnw DIV 2) + 80;
  75.         IF Mac THEN SWAP(px1,px2,px3,px4);
  76.  
  77.         py1:=scnh-40;
  78.         py2:=scnh-20;
  79.         py3:=py1;
  80.         py4:=py2;
  81.     END ELSE IF DialogType = 2 THEN
  82.     BEGIN
  83.         px1:=scnw - 180;
  84.         px2:=scnw - 110;
  85.         px3:=scnw - 90;
  86.         px4:=scnw - 20;
  87.         IF Mac THEN SWAP(px1,px2,px3,px4);
  88.  
  89.         py1:=scnh-40;
  90.         py2:=scnh-20;
  91.         py3:=py1;
  92.         py4:=py2;
  93.     END ELSE
  94.     BEGIN
  95.         px1:=scnw - 90;
  96.         px2:=scnw - 20;
  97.         px3:=px1;
  98.         px4:=px2;
  99.  
  100.         py1:=scnh -70;
  101.         py2:=scnh - 50;
  102.         py3:=scnh - 40;
  103.         py4:=scnh - 20;
  104.         IF Mac THEN SWAP(py1,py2,py3,py4);
  105.     END;
  106. END;        {of Locate Buttons}
  107.  
  108. Procedure MakeDialog;
  109.  
  110. CONST
  111.     y1=100;
  112.     scnw = 240;
  113.     scnh = 90;
  114.     DialogType = 1;
  115.  
  116. VAR
  117.     h : INTEGER;
  118.  
  119. BEGIN
  120.  
  121.     AlignScr(scnw,x1,x2);
  122.     y2:=y1+scnh;
  123.     LocateButtons(DialogType,scnh,scnw );
  124.     
  125.     BeginDialog(1,1,x1,y1,x2,y2);
  126.         AddButton('OK',1,1,px1,py1,px2,py2);
  127.         AddButton('Cancel',2,1,px3,py3,px4,py4);
  128.  
  129.         AddField('Type in section name:',5,1,20,14+h,165,30+h);
  130.         AddField('A',6,2,170,15+h,210,30+h);
  131.     EndDialog;
  132. END;
  133.  
  134. BEGIN
  135.     MakeDialog;
  136. END;
  137.  
  138. Procedure GetInfo;
  139. VAR
  140.     Done:Boolean;
  141.     Item:Integer;
  142.  
  143. BEGIN
  144.     Done:=FALSE;
  145.     Abort:=FALSE;
  146.     GetDialog(1);
  147.     SetTitle('Cut Line');
  148.     SelField(6);
  149.     REPEAT
  150.         DialogEvent(Item);
  151.         IF Item=1 THEN
  152.             Done:=TRUE;
  153.         IF Item=2 THEN
  154.         BEGIN
  155.             Done:=TRUE;
  156.             Abort:=TRUE;
  157.         END;         
  158.     UNTIL Done;
  159.     Section:=GetField(6);
  160.     ClrDialog;
  161. END;
  162.  
  163. {
  164. Main Program
  165. }
  166. BEGIN
  167.     CutLineDialog;
  168.     SetCursor(ArrowC);
  169.     GetInfo;
  170.     IF Abort THEN GOTO 99;
  171. {
  172. Set attributes.
  173. }
  174.     PushAttrs;
  175.     TextJust(2);
  176. {
  177. Get units per inch and layer scale.
  178. }
  179.     GetUnits(UName,DA,Fmt,UPI,UM,UM2);
  180.     LayerH:=ActLayer;
  181.     LScale:=GetLScale(LayerH);
  182. {
  183. Get text size.
  184. }
  185.     DSelectAll;
  186.     TextOrigin(0,0);
  187.     BeginText;
  188.         ' '
  189.     EndText;
  190.     TxtH:=FSActLayer;
  191.     TxtSize:=GetSize(TxtH);
  192.     DelObject(TxtH);
  193.     TxtC:=TxtSize/TxtSizeR;
  194. {
  195. Adjust leader and arrowhead size for units, scale, and text size.
  196. }
  197.     L1:=LeaderLgth*LScale*UPI;
  198.     L2:=ArrowLgth*LScale*UPI/Cos(Deg2Rad(Alpha));
  199.     L3:=2*L2*Sin(Deg2Rad(Alpha));
  200.     L4:=TxtCenter*LScale*UPI*TxtC;
  201.     L5:=TxtOffset*LScale*UPI*TxtC;
  202.     AngleVar;
  203.     Absolute;
  204. {
  205. Get path for cut line and draw lines
  206. }
  207.     DSelectAll;
  208.     GetLine(x[1],y[1],x[2],y[2]);
  209.     IF (x[1]=x[2]) AND (y[1]=y[2]) THEN GOTO 99;
  210.     MoveTo(x[1],y[1]);
  211.     LineTo(x[2],y[2]);
  212.     Redraw;
  213.     j:=2;
  214.     FOR i:=3 TO 10 DO
  215.     BEGIN
  216.         GetPtL(x[i-1],y[i-1],x[i],y[i]);
  217.         IF (x[i-1]=x[i]) AND (y[i-1]=y[i]) THEN GOTO 5;
  218.         LineTo(x[i],y[i]);
  219.         Redraw;
  220.         j:=j+1;
  221.     END;
  222. {
  223. Determine on which side of line to put arrows
  224. }
  225.     5:GetPt(xs,ys);
  226.     r:=Distance(x[1],y[1],x[2],y[2]);
  227.     Theta[1]:=Rad2Deg(ArcCos((x[2]-x[1])/r));
  228.     IF y[2] < y[1] THEN
  229.         Theta[1]:=360 - Theta[1];
  230.     r:=Distance(x[j],y[j],x[j-1],y[j-1]);
  231.     Theta[2]:=Rad2Deg(ArcCos((x[j]-x[j-1])/r));
  232.     IF y[j] < y[j-1] THEN
  233.         Theta[2]:=360 - Theta[2];
  234.     yt:=(ys-y[1])*Cos(Deg2Rad(Theta[1])) + (x[1]-xs)*Sin(Deg2Rad(Theta[1]));
  235.     IF yt < 0 THEN
  236.     BEGIN
  237.         Theta[1]:=180+Theta[1];
  238.         Theta[2]:=180+Theta[2];
  239.     END;
  240.     PenPat(2);
  241. {
  242. Draw extension lines and arrowheads
  243. }
  244.     k:=1;
  245.     FOR i:=1 TO 2 DO
  246.     BEGIN
  247.         Absolute;
  248.         MoveTo(x[k],y[k]);
  249.         Relative;
  250.         Line(L1,#(Theta[i]+90));
  251.          Move(L3/2,#(Theta[i]+180));
  252.         FillPat(2);
  253.         ClosePoly;
  254.         Poly(0,0,L2,#(90-Alpha+Theta[i]),L2,#-(90-Alpha-Theta[i]));
  255. {
  256. Place text
  257. }
  258.         xt:=x[k]-(L1+L2*Cos(Deg2Rad(Alpha))+L4)*Sin(Deg2Rad(Theta[i]));
  259.         yt:=y[k]+(L1+L2*Cos(Deg2Rad(Alpha))+L4)*Cos(Deg2Rad(Theta[i]))+L5;
  260.         Absolute;
  261.         TextOrigin(xt,yt);
  262.         FillPat(1);
  263.         BeginText;
  264.             Section
  265.         EndText;
  266.         k:=j;
  267.     END;
  268.     Group;
  269.     PopAttrs;
  270. 99:END;
  271.  
  272. Run(CutLine);