home *** CD-ROM | disk | FTP | other *** search
/ Chip 1998 March / Chip_1998-03_cd.bin / tema / MINICAD / MC7DEMO / MINICAD.1 / SHLD_SCR.MPC < prev    next >
Encoding:
Text File  |  1997-04-30  |  9.2 KB  |  548 lines
  1. Procedure ShoulderScrew;
  2. {
  3. (c)1997, Diehl Graphsoft, Inc.
  4. Developed by Tom Urie
  5.  
  6. This procedure draws a shoulder screw.
  7. }
  8.  
  9. LABEL 10,20,30,89,90,99;
  10.  
  11. CONST
  12.     Mac = FALSE;
  13.      Filename1='ShldScrE.txt';
  14.      Filename2='ShldScrM.txt';
  15.      sdC=0.010;  {Depth of undercut (inches)}
  16.     kps1 = 0.75;
  17.     kps2 = 1.25;
  18.  
  19. VAR
  20.     a,b,c,d,di,dia,f,fl,g,h,L,L1,j,s,t,td,tl : REAL;
  21.     p,p1,q1,x0,y0,y,sd,tpi,SF : REAL;
  22.     i,n,ThdType,View,ScrType,nThreads : INTEGER;
  23.     Sz,Size,Size1,Pathname : STRING;
  24.     Ans,Abort,Inch,SizeNotFound : BOOLEAN;
  25.  
  26.     UPI : REAL;
  27.     Fmt : INTEGER;
  28.     UM,UM2 : STRING;
  29.     UName,DA : LONGINT;
  30.  
  31. Procedure SSDialog;
  32. {
  33. This procedure defines the main dialog box.
  34. }
  35. VAR
  36.      Width,x1,y1,x2,y2,px1,px2,px3,px4,py1,py2,py3,py4 : INTEGER;
  37.  
  38. Procedure AlignScr(Width:INTEGER; VAR x1,x2:INTEGER);
  39. VAR
  40.      scrx1,scry1,scrx2,scry2:INTEGER;
  41. BEGIN
  42.     GetScreen(scrx1,scry1,scrx2,scry2);
  43.      x1:=((scrx1+scrx2) div 2)-(Width div 2);
  44.      x2:=x1+Width; 
  45. END;
  46.  
  47. Procedure LocateButtons(DialogType,scnh,scnw : INTEGER);
  48. {
  49. This procedure locates the 'OK' and 'Cancel' buttons.
  50. }
  51. VAR
  52.     v1,v2,v3,v4 : INTEGER;
  53.     Mac : BOOLEAN;
  54.  
  55. Procedure Swap(VAR  m1,m2,m3,m4 : INTEGER);
  56. VAR
  57.     Temp : INTEGER;
  58. BEGIN
  59.     Temp:=m1;
  60.     m1:=m3;
  61.     m3:=Temp;
  62.     Temp:=m2;
  63.     m2:=m4;
  64.     m4:=Temp;
  65. END;        {of Swap}
  66.  
  67. BEGIN
  68.     Mac:=FALSE;
  69.     PathName:='External\Data\';
  70.     GetVersion(v1,v2,v3,v4);
  71.     IF v4 = 1 THEN
  72.     BEGIN
  73.         Mac:=TRUE;
  74.         PathName:=':Externals:External Data:';
  75.     END;
  76.  
  77.     IF DialogType = 1 THEN
  78.     BEGIN
  79.         px1:=(scnw DIV 2) - 80;
  80.         px2:=(scnw DIV 2) - 10;
  81.         px3:=(scnw DIV 2) + 10;
  82.         px4:=(scnw DIV 2) + 80;
  83.         IF Mac THEN SWAP(px1,px2,px3,px4);
  84.  
  85.         py1:=scnh-40;
  86.         py2:=scnh-20;
  87.         py3:=py1;
  88.         py4:=py2;
  89.     END ELSE IF DialogType = 2 THEN
  90.     BEGIN
  91.         px1:=scnw - 180;
  92.         px2:=scnw - 110;
  93.         px3:=scnw - 90;
  94.         px4:=scnw - 20;
  95.         IF Mac THEN SWAP(px1,px2,px3,px4);
  96.  
  97.         py1:=scnh-40;
  98.         py2:=scnh-20;
  99.         py3:=py1;
  100.         py4:=py2;
  101.     END ELSE
  102.     BEGIN
  103.         px1:=scnw - 90;
  104.         px2:=scnw - 20;
  105.         px3:=px1;
  106.         px4:=px2;
  107.  
  108.         py1:=scnh -70;
  109.         py2:=scnh - 50;
  110.         py3:=scnh - 40;
  111.         py4:=scnh - 20;
  112.         IF Mac THEN SWAP(py1,py2,py3,py4);
  113.     END;
  114. END;        {of Locate Buttons}
  115.  
  116. Procedure MakeDialog1;
  117. CONST
  118.      y1=100;
  119.      scnh=250;
  120.     scnw=290;
  121.     DialogType = 1;
  122.  
  123. VAR
  124.     h : INTEGER;
  125.  
  126. BEGIN
  127.      AlignScr(scnw,x1,x2);
  128.      y2:=y1+scnh;
  129.  
  130.     LocateButtons(DialogType,scnh,scnw);
  131.  
  132.     BeginDialog(1,1,x1,y1,x2,y2);
  133.         AddButton('OK',1,1,px1,py1,px2,py2);
  134.         AddButton('Cancel',2,1,px3,py3,px4,py4);
  135.  
  136.         h:=45;
  137.          AddField('Size:',4,1,20,4+h,60,20+h);
  138.          AddField('',5,2,80,5+h,140,20+h);
  139.          AddField('in',17,1,148,5+h,170,20+h);
  140.          AddField('Length:',6,1,19,29+h,70,45+h);
  141.          AddField('',7,2,80,30+h,140,45+h);
  142.          AddField('in',18,1,148,30+h,170,45+h);
  143.  
  144.         h:=0;
  145.          AddField('View:',8,1,190,5+h,245,20+h);
  146.          AddButton('Top',9,3,190,45+h,235,60+h);
  147.          AddButton('Side',10,3,190,25+h,235,40+h);
  148.  
  149.          AddField('Series:',16,1,20,4,75,20);
  150.          AddButton('Inch',14,3,20,25,70,40);
  151.          AddButton('Metric',15,3,75,25,135,40);
  152.  
  153. h:=110;
  154.         AddField('Threads:',20,1,20,h+4,75,h+20);
  155.         AddButton('Type 1 (dashed lines)',21,3,20,h+25,200,h+40);
  156.         AddButton('Type 2 (solid lines)',22,3,20,h+45,200,h+60);
  157.         AddButton('Type 3 (detailed threads)',23,3,20,h+65,190,h+80);
  158.  
  159.      EndDialog;
  160. END;
  161.  
  162. BEGIN
  163.     MakeDialog1;
  164. END;
  165.  
  166. Procedure GetData;
  167. {
  168. This procedure opens the data file and reads the data.
  169. }
  170. LABEL 15,20,99;
  171.  
  172. VAR
  173.     File,Filename,WarningStr : STRING;
  174.  
  175. BEGIN
  176. {
  177. Open the data file.
  178. }
  179.  
  180.     IF Inch=True THEN
  181.         File:=Filename1
  182.     ELSE
  183.         File:=Filename2;
  184.     Filename:=Concat(Pathname,File);
  185.     SizeNotFound:=FALSE;
  186.     Open(Filename);
  187.  
  188. {
  189. Display the warning dialog box if the data file cannot be found.
  190. }
  191.  
  192.     IF FndError THEN BEGIN
  193.         ClrDialog;
  194.         Sysbeep;
  195.         WarningStr:=Concat('The data file <',File,'> cannot be found. Check your Toolkit Manual for further explanation.');
  196.         AlrtDialog(WarningStr);
  197.         Abort:=TRUE;
  198.         GoTo 99;
  199.     END;
  200.  
  201. {
  202. Read the data.
  203. }
  204.     WHILE NOT Eoln(Filename) DO BEGIN
  205.         ReadLn(Sz,d,a,h,j,s,t,tpi,tl,f,g);
  206.         IF Sz=Size THEN GoTo 20;
  207.     END;
  208.     Close(Filename);
  209.  
  210. {
  211. Diaplay a warning if the specified size is not available.
  212. }
  213.  
  214.     15:SysBeep;
  215.     AlrtDialog('That size is not available!');
  216.     SizeNotFound:=TRUE;
  217.     GoTo 99;
  218.     20:Close(Filename);
  219. 99:END;
  220.  
  221. Procedure GetInfo;
  222. {
  223. This procedure displays the main dialog box and retrieves the information.
  224. }
  225. LABEL 10,15,99;
  226. VAR
  227.     Done,OK:Boolean;
  228.      Item:Integer;
  229.      RFlag : ARRAY[1..3] OF INTEGER;
  230.  
  231. Procedure SetRButton(i,Item : INTEGER);
  232. BEGIN
  233.      IF RFlag[i] <> Item THEN BEGIN
  234.         SetItem(RFlag[i],FALSE);
  235.         SetItem(Item,TRUE);
  236.         RFlag[i]:=Item;
  237.     END;
  238. END;
  239.  
  240. BEGIN
  241.     Done:=FALSE;
  242.     Abort:=FALSE;
  243.     Inch:=TRUE;
  244.     View:=2;
  245.     ThdType:=1;
  246.     RFlag[1]:=10;
  247.     RFlag[2]:=14;
  248.     RFlag[3]:=ThdType+20;
  249.     
  250.     Size1:='1/2';
  251.     L:=1.000;
  252.  
  253.     GetDialog(1);
  254.     SetTitle('Shoulder Screws');
  255.     SetField(5,Size1);
  256.     SetField(7,Num2Str(3,L));
  257.     SetItem(RFlag[1],TRUE);
  258.     SetItem(RFlag[2],TRUE);
  259.     SetItem(RFlag[3],TRUE);
  260.     SelField(5);
  261.  
  262.     15:REPEAT
  263.         DialogEvent(Item);
  264.         IF Item=1 THEN
  265.             Done:=True;
  266.  
  267.         IF Item=2 THEN
  268.         BEGIN
  269.             Done:=TRUE;
  270.             Abort:=TRUE;
  271.         END;
  272.  
  273.         IF Item = 9 THEN
  274.         BEGIN
  275.             SetRButton(1,9);
  276.             View:=1;
  277.             SetField(7,'n/a');      
  278.         END;
  279.  
  280.         IF Item = 10 THEN
  281.         BEGIN
  282.             SetRButton(1,10);
  283.             View:=2;
  284.             SetField(7,Num2StrF(L));      
  285.         END;
  286.  
  287.         IF Item=14 THEN
  288.         BEGIN
  289.             SetRButton(2,Item);
  290.             Inch:=TRUE;
  291.             SetField(17,'in');
  292.             SetField(18,'in');
  293.             SelField(5);
  294.         END;
  295.  
  296.         IF Item=15 THEN
  297.         BEGIN
  298.             SetRButton(2,Item);
  299.             Inch:=FALSE;
  300.             SetField(17,'mm');
  301.             SetField(18,'mm');
  302.             SelField(5);
  303.         END;
  304.  
  305.         IF (Item > 20) AND (Item < 24) THEN
  306.         BEGIN
  307.             SetRButton(3,Item);
  308.             ThdType:=Item-20;
  309.         END;
  310.  
  311.     UNTIL Done;
  312.  
  313.     IF Abort THEN GOTO 99;
  314.     Size1:=GetField(5);
  315.     Size:=Concat('''',Size1,'''');
  316.     UprString(Size);
  317.     OK:=ValidNumStr(GetField(7),L);
  318.  
  319.     GetData;
  320.     IF Abort THEN GOTO 99;
  321.     IF SizeNotFound THEN
  322.     BEGIN
  323.         Done:=FALSE;
  324.         SelField(5);
  325.         GOTO 15;
  326.     END;
  327.  
  328.     99:ClrDialog;
  329. END;
  330.  
  331. {
  332. Main program.
  333. }
  334. BEGIN
  335.     DselectAll;
  336.     PushAttrs;
  337. {
  338. Display the main dialog box and get the information.
  339. }
  340.     SSDialog;
  341.     SetCursor(ArrowC);
  342.     GetInfo;
  343.     IF Abort THEN GoTo 99;
  344.  
  345. {
  346. Get drawing units and adjust parameters accordingly.
  347. }
  348.  
  349.     GetUnits(UName,DA,Fmt,UPI,UM,UM2);
  350.     IF Inch = TRUE THEN
  351.     BEGIN
  352.         SF:=UPI;
  353.         sd:=sdc;
  354.     END ELSE
  355.     BEGIN
  356.         SF:=UPI/25.4;
  357.         sd:=sdc*25.4;
  358.     END;
  359.  
  360.     sd:=sd*SF;
  361.     L:=L*SF;
  362.     d:=d*SF;
  363.     a:=a*SF;
  364.     h:=h*SF;
  365.     j:=j*SF;
  366.     s:=s*SF;
  367.     t:=t*SF;
  368.     tl:=tl*SF;
  369.     f:=f*SF;
  370.     g:=g*SF;
  371.     tpi:=tpi/SF;
  372.  
  373. {
  374. Get insertion point and calculate variables.
  375. }
  376.  
  377.     GetPt(x0,y0);
  378.  
  379.     c:=a-3.4641*(h-s);
  380.     {y:=0.2887*j;}
  381.     fl:=0.5774*j;
  382.     td:=0.86603/tpi;
  383.     b:=0.60640/tpi;
  384.     di:=t-2*td;
  385.     p:=1/tpi;
  386.     p1:=t - 5*td/2;
  387.     nThreads:=(tl-g-p)*tpi;
  388.     q1:=tl-(nThreads + 1.5)*p;
  389.     {l1:=tl-g-n*p;}
  390.  
  391.     IF View = 2 THEN Goto 20;
  392.  
  393. {
  394. Draw top view.
  395. }
  396.  
  397.     Absolute;
  398.     MoveTo(x0,y0);
  399.     Relative;
  400.     Arc(-a/2,a/2,a/2,-a/2,0,360);
  401.     Arc(-c/2,c/2,c/2,-c/2,0,360);
  402.     MoveTo(0,y+fl/2);
  403.     Relative;
  404.     ClosePoly;
  405.     Poly(fl,#-30,fl,#-90,fl,#-150,fl,#150,fl,#90);
  406.     GOTO 90;
  407.  
  408. {
  409. Draw side view.
  410. }
  411. {
  412. Draw head.
  413. }
  414.  
  415.     20:Absolute;
  416.     MoveTo(x0-a/2,y0);
  417.     Relative;
  418.     Rect(0,0,a,s);
  419.     Move(0,s);
  420.     Poly((a-c)/2,(h-s),c,0,(a-c)/2,-(h-s));
  421.     IF L = 0 THEN GOTO 90;
  422.  
  423. {
  424. Draw shoulder.
  425. }
  426.  
  427.     Move(-(a+d)/2,-(s+f));
  428.     Rect(0,0,d,-(l-f));
  429.     Move(sd,0);
  430.     Rect(0,0,(d-2*sd),f);
  431.     IF ThdType = 3 THEN GOTO  30;
  432.  
  433. {
  434. Draw Type 1 or Type 2 threads.
  435. }
  436.  
  437.     L1:=nThreads*p + 2*td;
  438.     g:=tl - L1;
  439.     Absolute;
  440.     MoveTo(x0 - di/2, y0 - L);
  441.     Relative;
  442.     Rect(0,0,di,-g);
  443.     Move(0, -g);
  444.     ClosePoly;
  445.     Poly(0,0, -td,-td, 0,-(L1-2*td), td,-td, di,0 ,td,td, 0,(L1-2*td), -td,td);
  446.  
  447.     IF ThdType = 1 THEN
  448.     BEGIN
  449.         Move(td,-td);
  450.         LineTo(-t, 0);
  451.         Move(0, -(L1-2*td));
  452.         LineTo(t, 0);
  453.         Move(-td, -td);
  454.         PenPat(-2);
  455.         PenSize(kps1*FPenSize);
  456.         LineTo(0, L1);
  457.         Move(-di, -L1);
  458.         LineTo(0, L1);
  459.     END ELSE
  460.     BEGIN
  461.         Move(td,-td);
  462.         FOR i:=1 TO nThreads+1 DO
  463.         BEGIN
  464.             LineTo(-t, 0);
  465.             Move(t, -p);
  466.         END;
  467.         PenSize(kps2*FPenSize);
  468.         MoveTo(-td, 3*p/2);
  469.         FOR i:=1 TO nThreads DO
  470.         BEGIN
  471.             LineTo(-di,0);
  472.             Move(di,p);
  473.         END;
  474.     END;
  475.  
  476.     GOTO 90;
  477. {
  478. Draw Type 3 (detailed) threads.
  479. }
  480. {
  481. Draw bottom thread.
  482. }
  483.  
  484.     30:Absolute;
  485.     MoveTo(x0 - t/2 + 3*td/2, y0 - L - tl);
  486.     Relative;
  487.     ClosePoly;
  488.     BeginPoly;
  489.         LineTo(0, 0);
  490.         LineTo(p1, 0);
  491.         LineTo(td/2, p/4);
  492.         LineTo(-td/2, p/4);
  493.         LineTo(td, p/2);
  494.         LineTo(-(t-td/2), -p/2);
  495.     EndPoly;
  496.  
  497.     Absolute;
  498.     MoveTo((x0 + t/2 - td/2), (y0 - L - tl + p/4));
  499.     Relative;
  500.     LineTo(-(t/2 - td/2),  0);
  501.     LineTo(di/2, p/4);
  502.  
  503. {
  504. Draw first whole thread.
  505. }
  506.  
  507.     Absolute;
  508.     MoveTo((x0 - t/2 + td/2), (y0 - L - tl + p/2));
  509.     Relative;
  510.     Poly(0,0, (t - td/2),p/2, -td, p/2, -di,-p/2);
  511.     Poly (0,0, di,p/2, td,p/2, -t,-p/2);
  512.  
  513. {
  514. Draw remaining whole threads.
  515. }
  516.  
  517.     Relative;
  518.     ClosePoly;
  519.     FOR i:=1 TO nThreads-1 DO BEGIN
  520.         Poly(0,0, t,p/2, -td,p/2, -di,-p/2);
  521.         Poly(0,0, di,p/2, td,p/2, -t,-p/2);
  522.     END;
  523.  
  524. {
  525. Draw last thread & shoulder.
  526. }
  527.  
  528.     BeginPoly;
  529.         LineTo(0,0);
  530.         LineTo(td,p/2);
  531.         LineTo(-td/2,p/4);
  532.         LineTo(td/2,p/4);
  533.         Line(0,q1);
  534.         Line(di,0);
  535.         Line(0,-q1);
  536.         Line(td,-p/2);
  537.     EndPoly;
  538.  
  539.     Move(-(t-td),0);
  540.     Line(di/2,p/4);
  541.     Line(-(di+td)/2,0);
  542.  
  543.     90:Group;
  544.     PopAttrs;
  545. 99:END;
  546.  
  547. RUN(ShoulderScrew);
  548.