home *** CD-ROM | disk | FTP | other *** search
/ Chip 1998 March / Chip_1998-03_cd.bin / tema / MINICAD / MC7DEMO / MINICAD.1 / CAP_SCR.MPC < prev    next >
Text File  |  1997-04-30  |  21KB  |  1,165 lines
  1. Procedure CapScrews;
  2. {
  3. (c)1997, Diehl Graphsoft, Inc.
  4. Developed by Tom Urie
  5.  
  6. This procedure draws various types of slotted machine screws.
  7. }
  8. LABEL 90,99;
  9.  
  10. CONST
  11.     Mac = FALSE;
  12.     T1 = 45;        {Chamfer angle of head for cap head screws}
  13.     k1 = 1.375;        {These constants are use to    }
  14.     k2 = 0.40;        {determine the shape of the    }
  15.     k3 = 0.60;        {button head screw.            }
  16.     k4 = 0.034;        {Used to determine fillet radius under the head of the screw.}
  17.     k5 = 0.5;        {Used to determine the chamfer of the bottom of the threads.}
  18.     k6 = 0.75;        {Used to draw  the the last thread of detailed threads.}
  19.  
  20.     maxPoints = 10;
  21.     nDataFiles = 6;
  22.  
  23. VAR
  24.     a,a1,aMin,c,d,di,f,j,h,h1,h2,L,TL,p,r,rf,s,t,td : REAL;
  25.     tpi,tpic,tpif,Theta,x0,y0 : REAL;
  26.     x,y,dx,dy,Rt,xt,yt : ARRAY[1..maxPoints] OF REAL;
  27.  
  28.     i,nThreads,Type,ThdType,View : INTEGER;
  29.  
  30.     Size,Sz,Size1,Pathname : STRING;
  31.     Abort,Inch,SizeNotFound,UNC : BOOLEAN;
  32.  
  33.     SF,UPI : REAL;
  34.     Fmt : INTEGER;
  35.     UM,UM2 : STRING;
  36.     UName,DA : LONGINT;
  37.  
  38. Procedure CapScrDialog;
  39. VAR
  40.     Width,x1,y1,x2,y2,px1,px2,px3,px4,py1,py2,py3,py4 : INTEGER;
  41.  
  42. Procedure AlignScr(Width:INTEGER; VAR x1,x2:INTEGER);
  43. VAR
  44.     scrx1,scry1,scrx2,scry2:INTEGER;
  45. BEGIN
  46.     GetScreen(scrx1,scry1,scrx2,scry2);
  47.     x1:=((scrx1+scrx2) div 2)-(Width div 2);
  48.     x2:=x1+Width; 
  49. END;
  50.  
  51. Procedure LocateButtons(DialogType,scnh,scnw : INTEGER);
  52. {
  53. This procedure locates the 'OK' and 'Cancel' buttons.
  54. }
  55. VAR
  56.     v1,v2,v3,v4 : INTEGER;
  57.     Mac : BOOLEAN;
  58.  
  59. Procedure Swap(VAR  m1,m2,m3,m4 : INTEGER);
  60. VAR
  61.     Temp : INTEGER;
  62. BEGIN
  63.     Temp:=m1;
  64.     m1:=m3;
  65.     m3:=Temp;
  66.     Temp:=m2;
  67.     m2:=m4;
  68.     m4:=Temp;
  69. END;        {of Swap}
  70.  
  71. BEGIN
  72.     Mac:=FALSE;
  73.     PathName:='External\Data\';
  74.     GetVersion(v1,v2,v3,v4);
  75.     IF v4 = 1 THEN
  76.     BEGIN
  77.         Mac:=TRUE;
  78.         PathName:=':Externals:External Data:';
  79.     END;
  80.  
  81.     IF DialogType = 1 THEN
  82.     BEGIN
  83.         px1:=(scnw DIV 2) - 80;
  84.         px2:=(scnw DIV 2) - 10;
  85.         px3:=(scnw DIV 2) + 10;
  86.         px4:=(scnw DIV 2) + 80;
  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 IF DialogType = 2 THEN
  94.     BEGIN
  95.         px1:=scnw - 180;
  96.         px2:=scnw - 110;
  97.         px3:=scnw - 90;
  98.         px4:=scnw - 20;
  99.         IF Mac THEN SWAP(px1,px2,px3,px4);
  100.  
  101.         py1:=scnh-40;
  102.         py2:=scnh-20;
  103.         py3:=py1;
  104.         py4:=py2;
  105.     END ELSE
  106.     BEGIN
  107.         px1:=scnw - 90;
  108.         px2:=scnw - 20;
  109.         px3:=px1;
  110.         px4:=px2;
  111.  
  112.         py1:=scnh -70;
  113.         py2:=scnh - 50;
  114.         py3:=scnh - 40;
  115.         py4:=scnh - 20;
  116.         IF Mac THEN SWAP(py1,py2,py3,py4);
  117.     END;
  118. END;        {of Locate Buttons}
  119.  
  120. Procedure MakeDialog;
  121. {
  122. This procedure creates the dialog box.
  123. }
  124. CONST
  125.     y1=100;
  126.     scnh=380;
  127.     scnw=300;
  128.     DialogType = 2;
  129.  
  130. VAR
  131.     h,h1 : INTEGER;
  132.  
  133. BEGIN
  134.     AlignScr(scnw,x1,x2);
  135.     y2:=y1+scnh;
  136.  
  137.     LocateButtons(DialogType,scnh,scnw );
  138.  
  139.     BeginDialog(1,1,x1,y1,x2,y2);
  140.         AddButton('OK',1,1,px1,py1,px2,py2);
  141.         AddButton('Cancel',2,1,px3,py3,px4,py4);
  142.  
  143.         h:=30;
  144.         AddField('Type of Head:',4,1,20,h-1,145,h+15);
  145.         AddButton('Hex Socket Head',5,3,20,h+20,200,h+35);
  146.         AddButton('Hex Socket Flat Csk Head',6,3,20,h+40,210,h+55);
  147.         AddButton('Hex Socket Button Head',7,3,20,h+60,200,h+75);
  148.         AddButton('Slotted Flat Csk Head',8,3,20,h+80,180,h+95);
  149.         AddButton('Slotted Round Head',9,3,20,h+100,180,h+115);
  150.         AddButton('Slotted Fillister Head',10,3,20,h+120,180,h+135);
  151.         AddField('',11,1,185,h+80,230,h+95);
  152.         AddField('',12,1,185,h+100,230,h+115);
  153.         AddField('',13,1,185,h+120,230,h+135);
  154.  
  155.         h:=5;
  156.         AddField('Series:',19,1,20,h-1,65,h+15);
  157.         AddButton('Inch',20,3,70,h,120,h+15);
  158.         AddButton('Metric',21,3,125,h,190,h+15);
  159.  
  160.         h:=185;
  161.         AddField('Size:',22,1,20,h-1,75,h+15);
  162.         AddField('',23,2,80,h,145,h+15);
  163.         AddField('in',50,1,153,h-1,175,h+15);
  164.  
  165.         AddField('Length:',24,1,20,h+24,75,h+40);
  166.         AddField('',25,2,80,h+25,145,h+40);
  167.         AddField('in',51,1,153,h+25,175,h+40);
  168.  
  169.         h:=240;
  170.         AddField('View:',28,1,220,h-1,275,h+15);
  171.         AddButton('Top',29,3,220,h+40,275,h+55);
  172.         AddButton('Front',30,3,220,h+20,275,h+35);
  173.         AddButton('Side',31,3,220,h+60,275,h+75);
  174.  
  175.         h:=240;
  176.         AddField('Threads:',34,1,20,h-1,75,h+15);
  177.         AddButton('UNC',35,3,80,h,140,h+15);
  178.         AddButton('UNF',36,3,145,h,205,h+15);
  179.  
  180.         AddButton('Type 1 (dotted lines)',37,3,20,h+20,200,h+35);
  181.         AddButton('Type 2 (solid lines)',38,3,20,h+40,200,h+55);
  182.         AddButton('Type 3 (detailed threads)',39,3,20,h+60,190,h+75);
  183.  
  184.     EndDialog;
  185. END;
  186.  
  187. BEGIN
  188.     MakeDialog;
  189. END;
  190.  
  191. Function GetFilename(Type:INTEGER) : STRING;
  192. {
  193. This procedure assigns filenames to the variable Filename.
  194. }
  195.  
  196. VAR
  197.     k : INTEGER;
  198.     Filename : ARRAY[1..2,1..nDataFiles] OF STRING;
  199.  
  200. BEGIN
  201.     Filename[1,1]:='CapHSocE.txt';
  202.     Filename[1,2]:='CapHFltE.txt';
  203.     Filename[1,3]:='CapHButE.txt';
  204.     Filename[1,4]:='CapSFltE.txt';
  205.     Filename[1,5]:='CapSRndE.txt';
  206.     Filename[1,6]:='CapSFilE.txt';
  207.  
  208.     Filename[2,1]:='CapHSocM.txt';
  209.     Filename[2,2]:='CapHFltHM.txt';
  210.     Filename[2,3]:='CapHButM.txt';
  211.     
  212.     IF Inch THEN k:=1
  213.     ELSE k:=2;
  214.     GetFilename:=Filename[k,Type];
  215.  
  216. END;
  217.  
  218. Procedure GetData;
  219. {
  220. This procedure opens the data file and retreives the data.
  221. }
  222. LABEL 10,99;
  223.  
  224. VAR
  225.     File,Filename,WarningStr : STRING;
  226.  
  227. BEGIN
  228.     File:=GetFilename(Type);
  229.     Filename:=Concat(Pathname,File);
  230.     SizeNotFound:=FALSE;
  231.     Open(Filename);
  232.  
  233.     IF FndError THEN BEGIN
  234.         ClrDialog;
  235.         Sysbeep;
  236.         WarningStr:=Concat('The data file <',File,'> cannot be found. Check your Toolkit Manual for further explanation.');
  237.         AlrtDialog(WarningStr);
  238.         Abort:=TRUE;
  239.         GoTo 99;
  240.     END;
  241.  
  242.     WHILE NOT Eoln(Filename) DO
  243.     BEGIN
  244.         IF (Type = 1) OR (Type = 3) THEN
  245.             ReadLn(Sz,d,tpic,tpif,a,h,s,j)
  246.         ELSE IF Type = 2  THEN
  247.             ReadLn(Sz,d,tpic,tpif,a,aMin,j)
  248.         ELSE IF Type = 4 THEN
  249.             ReadLn(Sz,d,tpic,tpif,a,aMin,j,t)
  250.         ELSE IF Type = 5 THEN
  251.             ReadLn(Sz,d,tpic,tpif,a,h,j,t)
  252.         ELSE IF Type = 6 THEN
  253.             ReadLn(Sz,d,tpic,tpif,a,h,s,j,t);
  254.  
  255.         IF Sz = Size THEN GOTO 10;
  256.     END;
  257.  
  258.     Close(Filename);
  259.     SysBeep;
  260.     AlrtDialog('That size is not available!');
  261.     SizeNotFound:=TRUE;
  262.     GoTo 99;
  263.  
  264.     10:Close(Filename);
  265.     {Message(Sz,'   ',d,'   ',a,'   ',h,'   ',j,'   ',t,'   ',tpic,'   ',tpif);}
  266.  
  267. 99:END;
  268.  
  269. Procedure GetInfo;
  270. {
  271. This procedure displays the main dialog box and retreives the information input by the user.
  272. }
  273. LABEL 10,20,99;
  274.  
  275. VAR
  276.     Done:Boolean;
  277.     Item:Integer;
  278.     RFlag : ARRAY [1..5] OF INTEGER;
  279.  
  280. Procedure SetRButton(i,Item : INTEGER);
  281. BEGIN
  282.     IF RFlag[i] <> Item THEN BEGIN
  283.         SetItem(RFlag[i],FALSE);
  284.         SetItem(Item,TRUE);
  285.         RFlag[i]:=Item;
  286.     END;
  287. END;
  288.  
  289. BEGIN
  290.     Done:=FALSE;
  291.     Abort:=FALSE;
  292.  
  293.     Type:=1;
  294.     Inch:=TRUE;
  295.     View:=2;
  296.     UNC:=TRUE;
  297.     ThdType:=1;
  298.     Size1:='1/2';
  299.     L:=1.000;
  300.  
  301.     RFlag[1]:=Type+4;
  302.     RFlag[2]:=20;
  303.     RFlag[3]:=View+28;
  304.     RFlag[4]:=35;
  305.     RFlag[5]:=ThdType+36;
  306.  
  307.     GetDialog(1);
  308.     SetTitle('Cap Screws');
  309.     SetItem(RFlag[1],TRUE);
  310.     SetItem(RFlag[2],TRUE);
  311.     SetItem(RFlag[3],TRUE);
  312.     SetItem(RFlag[4],TRUE);
  313.     SetItem(RFlag[5],TRUE);
  314.  
  315.     SetField(23,Size1);
  316.     SetField(25,Num2Str(3,L));
  317.     20:SelField(23);
  318.  
  319.     REPEAT
  320.         DialogEvent(Item);
  321.  
  322.         IF Item=1 then
  323.             Done:=TRUE;
  324.  
  325.         IF Item=2 THEN
  326.         BEGIN
  327.             Done:=TRUE;
  328.             Abort:=TRUE;
  329.         END;
  330.  
  331.         IF (Item > 4) AND (Item < 11) THEN
  332.         BEGIN
  333.             IF (NOT Inch) AND (Item > 7) THEN
  334.                 Sysbeep
  335.             ELSE BEGIN
  336.                 SetRButton(1,Item);
  337.                 Type:=Item-4;
  338.             END;
  339.         END;
  340.  
  341.         IF (Item = 20) AND (NOT Inch)  THEN
  342.         BEGIN
  343.             SetRButton(2,Item);
  344.             Inch:=TRUE;
  345.             SetField(11,'');
  346.             SetField(12,'');
  347.             SetField(13,'');
  348.             SetField(50,'in');
  349.             SetField(51,'in');
  350.         END;
  351.  
  352.         IF (Item = 21) AND (Inch)  THEN
  353.         BEGIN
  354.             SetRButton(2,Item);
  355.             Inch:=FALSE;
  356.             SetField(11,'<n/a>');
  357.             SetField(12,'<n/a>');
  358.             SetField(13,'<n/a>');
  359.             SetField(50,'mm');
  360.             SetField(51,'mm');
  361.             IF Type >3 THEN
  362.             BEGIN
  363.                 SetRButton(1,5);
  364.                 Type:=1;
  365.             END;
  366.         END;
  367.  
  368.         IF (Item > 28) AND (Item < 32) THEN
  369.         BEGIN
  370.             SetRButton(3,Item);
  371.             View:=Item-28;            
  372.         END;
  373.  
  374.         IF (Item = 35) OR (Item = 36) THEN
  375.         BEGIN
  376.             SetRButton(4,Item);
  377.             IF Item = 35 THEN UNC:=TRUE
  378.             ELSE UNC:=FALSE;
  379.         END;
  380.  
  381.         IF (Item > 36) AND (Item < 40) THEN
  382.         BEGIN
  383.             SetRButton(5,Item);
  384.             ThdType:=Item-36;
  385.         END;
  386.  
  387.     UNTIL Done;
  388.  
  389.     IF Abort THEN GOTO 99;
  390.     Size1:=GetField(23);
  391.     Size:=Concat('''',Size1,'''');
  392.     UprString(Size);
  393.     L:=Str2Num(GetField(25));
  394.  
  395.     GetData;
  396.     IF Abort THEN GOTO 99;
  397.     IF SizeNotFound THEN
  398.     BEGIN
  399.         Done:=FALSE;
  400.         GOTO 20;
  401.     END;
  402.  
  403.     99:ClrDialog;
  404. END;
  405.  
  406. Procedure DrawPolyPoint(x,y,R : REAL);
  407. {
  408. This procedure draws a polyline point based on the value of R:
  409. R = 0    ==> Corner point
  410. R > 0    ==> Arc point of radius, R
  411. R = -1    ==> Cubic spline point
  412. R = any value less than 0 except -1
  413.             ==> Bezier control point
  414. }
  415.  
  416. BEGIN
  417.     IF R = 0 THEN
  418.         LineTo(x,y)
  419.     ELSE IF R > 0 THEN
  420.         ArcTo(x,y,R)
  421.     ELSE IF R = -1 THEN
  422.         CurveThrough(x,y)
  423.     ELSE
  424.         CurveTo(x,y);
  425. END;    {of DrawPolyPoint}
  426.  
  427. Function ThdLgthI(d,L : REAL) : REAL;
  428. {
  429. This procedure determines the length of threads for inch series machine screws.
  430. }
  431.  
  432. BEGIN
  433.     IF L < 2*d + 0.5 THEN
  434.         ThdLgthI:=L
  435.     ELSE IF L < 4*d + 1 THEN
  436.         ThdLgthI:=2*d + 0.5
  437.     ELSE ThdLgthI:=L/2;
  438. END;
  439.  
  440. Function ThdLgthM(d,L,p : REAL) : REAL;
  441. {
  442. This procedure determines the length of threads for mm series machine screws.
  443. }
  444.  
  445. BEGIN
  446.     IF d <= 3 THEN
  447.     BEGIN
  448.         IF L <= 3*d THEN
  449.             ThdLgthM:=L-p
  450.         ELSE IF L < 30 THEN
  451.             ThdLgthM:=L-2*p
  452.         ELSE
  453.             ThdLgthM:=25;
  454.     END ELSE
  455.     BEGIN
  456.         IF L <= 3*d THEN
  457.             ThdLgthM:=L-p
  458.         ELSE IF L < 50 THEN
  459.             ThdLgthM:=L-2*p
  460.         ELSE
  461.             ThdLgthM:=38;
  462.     END;
  463. END;
  464.  
  465. Procedure DrawTopView(Type : INTEGER);
  466. {
  467. This procedure draws the top view.
  468. }
  469. VAR
  470.     Alpha,c,q1,q2,q3 : REAL;
  471. BEGIN
  472.     Absolute;
  473.     MoveTo(x0,y0);
  474.     Relative;
  475.  
  476. {
  477. Hex socket, Flat, and Button heads.
  478. }
  479.  
  480.     IF Type < 4 THEN
  481.     BEGIN
  482.         Arc(-a/2,a/2,a/2,-a/2,0,360);
  483.         IF Type <> 2 THEN
  484.         Arc(-c/2,c/2,c/2,-c/2,0,360);
  485.         MoveTo(0,f);
  486.         Closepoly;
  487.         Poly(f,#-30, f,#-90, f,#-150, f,#150, f,#90);
  488.     END    {of Hex socket, Flat, and Button heads}
  489.  
  490. {
  491. Slotted Flat Countersunk Head.
  492. }
  493.  
  494.     ELSE IF Type = 4 THEN
  495.     BEGIN
  496.         Alpha:=ArcCos(j/a);
  497.         q1:=a*Tan(Alpha/2)/2;
  498.         q2:=a*Sin(Alpha)/2;
  499.         c:=a/2 - t*Tan(Theta/2);
  500.         q3:=Sqrt(c^2 - (j/2)^2);
  501.  
  502.         Absolute;
  503.         MoveTo(x0+j/2, y0+q2);
  504.         Relative;
  505.         ClosePoly;
  506.         BeginPoly;
  507.             LineTo(0,0);
  508.             ArcTo((a-j)/2, -(q2-q1), a/2);
  509.             ArcTo(0, -2*q1, a/2);
  510.             LineTo(-(a-j)/2, -(q2-q1));
  511.         EndPoly;
  512.  
  513.         Absolute;
  514.         MoveTo(x0-j/2, y0+q2);
  515.         Relative;
  516.         BeginPoly;
  517.             LineTo(0,0);
  518.             ArcTo(-(a-j)/2, -(q2-q1), a/2);
  519.             ArcTo(0, -2*q1, a/2);
  520.             LineTo((a-j)/2, -(q2-q1));
  521.         EndPoly;
  522.  
  523.         Absolute;
  524.         MoveTo(x0-j/2, y0+q3);
  525.         Relative;
  526.         BeginPoly;
  527.             LineTo(0,0);
  528.             CurveThrough(j/2, (c-q3));
  529.             LineTo(j/2, -(c-q3));
  530.             LineTo(0,-2*q3);
  531.             CurveThrough(-j/2, -(c-q3));
  532.             LineTo(-j/2, (c-q3));
  533.         EndPoly;
  534.  
  535.     END    {of Slotted Flat Countersunk Head}
  536.  
  537. {
  538. Round Head.
  539. }
  540.  
  541.     ELSE IF Type = 5 THEN
  542.     BEGIN
  543.         c:=Sqrt(r^2 - (r-t)^2);
  544.         q1:=Sqrt(c^2 - (j/2)^2);
  545.  
  546.         Absolute;
  547.         MoveTo(x0,y0);
  548.         Relative;
  549.         Arc(-a/2,a/2,a/2,-a/2,0,360);
  550.  
  551.         Absolute;
  552.         MoveTo(x0-j/2, y0+q1);
  553.         Relative;
  554.         BeginPoly;
  555.             LineTo(0,0);
  556.             CurveThrough(j/2, (c-q1));
  557.             LineTo(j/2, -(c-q1));
  558.             LineTo(0,-2*q1);
  559.             CurveThrough(-j/2, -(c-q1));
  560.             LineTo(-j/2, (c-q1));
  561.         EndPoly;
  562.  
  563.     END    {of Round Head}
  564.  
  565. {
  566. Fillister Head.
  567. }
  568.  
  569.     ELSE IF Type = 6 THEN
  570.     BEGIN
  571.         q1:=Sqrt(a^2 - j^2)/2;
  572.  
  573.         Absolute;
  574.         MoveTo(x0,y0);
  575.         Relative;
  576.         Arc(-a/2,a/2,a/2,-a/2,0,360);
  577.         Move(j/2, q1);
  578.         LineTo(0, -2*q1);
  579.         Move(-j, 0);
  580.         LineTo(0, 2*q1);
  581.  
  582.     END;    {of Fillister Head}
  583.  
  584. END;
  585.  
  586. Procedure DrawSideViewOfHead(Type : INTEGER);
  587. {
  588. This procedure draws the side view of the head.
  589. }
  590. LABEL 10;
  591.  
  592. VAR
  593.     ch,p1,p2,q1,q2 : REAL;
  594.     Alpha,Beta1,Beta2 : REAL;
  595.     k, nPoints : INTEGER;
  596.  
  597. BEGIN
  598.  
  599. {
  600. Cap Head.
  601. }
  602.     IF Type = 1 THEN
  603.     BEGIN
  604.         Absolute;
  605.         MoveTo(x0 - a/2, y0);
  606.         Relative;
  607.         ClosePoly;
  608.         Poly(0,0, 0,s, (a-c)/2,(h-s), c,0, (a-c)/2,-(h-s), 0,-s);
  609.         Move(0,s);
  610.         LineTo(-a,0);
  611.     END    {of Cap Head}
  612.  
  613. {
  614. Flat Countersunk Head.
  615. }
  616.  
  617.     ELSE IF Type = 2 THEN BEGIN
  618.         y0:=y0-h;
  619.         Absolute;
  620.         MoveTo(x0-d/2, y0);
  621.         Relative;
  622.         ClosePoly;
  623.         BeginPoly;
  624.             LineTo(0, 0);
  625.             LineTo(-(a1-d)/2,  (h-s));
  626.             LineTo(0, s);
  627.             LineTo(a1, 0);
  628.             LineTo(0, -s);
  629.             LineTo(-(a1-d)/2, -(h-s));
  630.         EndPoly;
  631.  
  632.         Absolute;
  633.         MoveTo(x0-a1/2,  y0+(h-s));
  634.         Relative;
  635.         LineTo(a1, 0);
  636.     END    {of Flat Countersunk Head}
  637.  
  638. {
  639. Button Head.
  640. }
  641.  
  642.     ELSE IF Type = 3 THEN
  643.     BEGIN
  644.         p1:=k2*(a-c)/2;
  645.         q1:=k3*(h-s);
  646.         p2:=(a-c)/2 - p1;
  647.         q2:=(h-s) - q1;
  648.  
  649.         Absolute;
  650.         MoveTo(x0 - a/2, y0);
  651.         Relative;
  652.         ClosePoly;
  653.         BeginPoly;
  654.             LineTo(0, 0);
  655.             LineTo(0, s);
  656.             CurveThrough(p1, q1);
  657.             LineTo(p2,  q2);
  658.             LineTo(c, 0);
  659.             CurveThrough(p2, -q2);
  660.             LineTo(p1, -q1);
  661.             LineTo(0, -s);
  662.         EndPoly;
  663.  
  664.         Absolute;
  665.         MoveTo(x0-a/2,  y0+s);
  666.         Relative;
  667.         LineTo(a, 0);
  668.     END    {of Button Head}
  669.  
  670. {
  671. Slotted Flat Countersunk.
  672. }
  673.  
  674.     ELSE IF Type = 4 THEN
  675.     BEGIN
  676.         y0:=y0-h;
  677.         Absolute;
  678.         MoveTo(x0-d/2, y0);
  679.         Relative;
  680.         ClosePoly;
  681.         BeginPoly;
  682.             LineTo(0,0);
  683.             LineTo(-(a-d)/2, h);
  684.             IF View = 2 THEN
  685.             BEGIN
  686.                 LineTo((a-j)/2, 0);
  687.                 LineTo(0, -t);
  688.                 LineTo(j, 0);
  689.                 LineTo(0, t);
  690.                 LineTo((a-j)/2, 0);
  691.             END ELSE
  692.                 LineTo(a, 0);
  693.             LineTo(-(a-d)/2, -h);
  694.         EndPoly;
  695.  
  696.     END    {of Slotted Flat Countersunk}
  697.  
  698. {
  699. Slotted Round Head.
  700. }
  701.  
  702.     ELSE IF Type = 5 THEN
  703.     BEGIN
  704.         IF View = 3 THEN
  705.             j:=0;
  706.         Beta1:=ArcCos(a/(2*r));
  707.         Beta2:=ArcSin(j/(2*r));
  708.         Alpha:=Pi/2 - (Beta1+Beta2);
  709.         p1:=r*Sin(Beta2 + Alpha/2)/Cos(Alpha/2);
  710.         q1:=r*Cos(Beta2 + Alpha/2)/Cos(Alpha/2) - r*Sin(Beta1);
  711.         q2:=r*(Cos(Beta2)-Sin(Beta1));
  712.  
  713.         x[1]:=-a/2;            y[1]:=0;            Rt[1]:=0;
  714.         x[2]:=-p1;            y[2]:=q1;            Rt[2]:=r;
  715.         IF View = 2 THEN
  716.         BEGIN
  717.             nPoints:=8;
  718.             x[3]:=-j/2;            y[3]:=q2;            Rt[3]:=0;
  719.             x[4]:=-j/2;            y[4]:=h-t;            Rt[4]:=0;
  720.             x[5]:=j/2;            y[5]:=h-t;            Rt[5]:=0;
  721.             x[6]:=j/2;            y[6]:=q2;            Rt[6]:=0;
  722.             x[7]:=p1;            y[7]:=q1;            Rt[7]:=r;
  723.             x[8]:=a/2;            y[8]:=0;            Rt[8]:=0;
  724.         END ELSE
  725.         BEGIN
  726.             nPoints:=4;
  727.             x[3]:=p1;            y[3]:=q1;            Rt[3]:=r;
  728.             x[4]:=a/2;            y[4]:=0;            Rt[4]:=0;
  729.         END;
  730.  
  731.         ClosePoly;
  732.         Absolute;
  733.         BeginPoly;
  734.             FOR k:=1 TO nPoints DO
  735.             BEGIN
  736.                 xt[k]:=x0+x[k];    yt[k]:=y0+y[k];
  737.                 DrawPolyPoint(xt[k],yt[k],Rt[k]);
  738.             END;
  739.         EndPoly;
  740.     END    {of Slotted Round Head}
  741.  
  742. {
  743. Slotted Fillister Head.
  744. }
  745.  
  746.     ELSE IF Type = 6 THEN
  747.     BEGIN
  748.         IF View = 3 THEN
  749.             j:=0;
  750.         Beta1:=ArcCos(a/(2*r));
  751.         Beta2:=ArcSin(j/(2*r));
  752.         Alpha:=Pi/2 - (Beta1+Beta2);
  753.         p1:=r*Sin(Beta2 + Alpha/2)/Cos(Alpha/2);
  754.         q1:=r*Cos(Beta2 + Alpha/2)/Cos(Alpha/2) - r*Sin(Beta1);
  755.         q2:=r*(Cos(Beta2)-Sin(Beta1));
  756.  
  757.         x[1]:=-a/2;            y[1]:=-0;        Rt[1]:=0;
  758.         x[2]:=-a/2;            y[2]:=s;            Rt[2]:=0;
  759.         x[3]:=-p1;            y[3]:=s+q1;        Rt[3]:=r;
  760.  
  761.         IF View = 2 THEN
  762.         BEGIN
  763.             nPoints:=10;
  764.             x[4]:=-j/2;            y[4]:=s+q2;        Rt[4]:=0;
  765.             x[5]:=-j/2;            y[5]:=h-t;        Rt[5]:=0;
  766.             x[6]:=j/2;            y[6]:=h-t;        Rt[6]:=0;
  767.             x[7]:=j/2;            y[7]:=s+q2;        Rt[7]:=0;
  768.             x[8]:=p1;            y[8]:=s+q1;        Rt[8]:=r;
  769.             x[9]:=a/2;            y[9]:=s;            Rt[9]:=0;
  770.             x[10]:=a/2;            y[10]:=0;        Rt[10]:=0;
  771.         END ELSE
  772.         BEGIN
  773.             nPoints:=6;
  774.             x[4]:=p1;            y[4]:=s+q1;        Rt[4]:=r;
  775.             x[5]:=a/2;            y[5]:=s;            Rt[5]:=0;
  776.             x[6]:=a/2;            y[6]:=0;            Rt[6]:=0;
  777.         END;
  778.  
  779.         ClosePoly;
  780.         Absolute;
  781.         BeginPoly;
  782.             FOR k:=1 TO nPoints DO
  783.             BEGIN
  784.                 xt[k]:=x0+x[k];    yt[k]:=y0+y[k];
  785.                 DrawPolyPoint(xt[k],yt[k],Rt[k]);
  786.             END;
  787.         EndPoly;
  788.  
  789.         MoveTo(x0-a/2,y0+s);
  790.         Relative;
  791.         IF View = 2 THEN
  792.         BEGIN
  793.             LineTo((a-j)/2,0);
  794.             MoveTo(j,0);
  795.             LineTo((a-j)/2,0);
  796.         END ELSE
  797.             LineTo(a,0);
  798.  
  799.     END;    {of Slotted Fillister Head}
  800.  
  801. END;
  802.  
  803. Procedure DrawThdType1;
  804. {
  805. This procedure draws non-detailed threads using dashed lines.
  806. }
  807. LABEL 10;
  808.  
  809. VAR
  810.     ch,pd : REAL;
  811.     
  812. BEGIN
  813.     ch:=td;
  814.     pd:=d - td;
  815.  
  816. {
  817. Draw body.
  818. }
  819.  
  820.     Absolute;
  821.     MoveTo((x0-d/2-rf), y0);
  822.     Relative;
  823.     ClosePoly;
  824.     BeginPoly;
  825.         LineTo(0, 0);
  826.         IF (Type <> 2) OR (Type <> 4) THEN
  827.             ArcTo(rf, 0, rf);
  828.         LineTo(0, -(L-ch));
  829.         LineTo(td, -ch);
  830.         LineTo(di, 0);
  831.         LineTo(td, ch);
  832.         IF (Type <> 2) OR (Type <> 4) THEN
  833.         BEGIN
  834.             ArcTo(0, (L-ch), rf);
  835.             LineTo(rf, 0);
  836.         END ELSE
  837.             LineTo(0, (L-ch));
  838.     EndPoly;
  839.  
  840.     Absolute;
  841.     MoveTo(x0-d/2, y0-L+ch);
  842.     Relative;
  843.     LineTo(d, 0);
  844.  
  845.     IF TL = L THEN GOTO 10;
  846.     Absolute;
  847.     MoveTo(x0-d/2, y0-L+TL);
  848.     Relative;
  849.     LineTo(d, 0);
  850.  
  851.     10:Absolute;
  852.     MoveTo(x0+di/2, y0-L);
  853.     PenPat(-2);
  854.     Line(0,TL);
  855.     Move(-di, -TL);
  856.     Line(0, TL);
  857. END;
  858.  
  859. Procedure DrawThdType2;
  860. {
  861. This procedure draws non-detailed threads using solid lines.
  862. }
  863. LABEL 10;
  864.  
  865. VAR
  866.     ch,pd : REAL;
  867.     k,k2 : INTEGER;
  868.     
  869. BEGIN
  870.     ch:=td;
  871.     pd:=d - td;
  872.  
  873. {
  874. Draw body.
  875. }
  876.  
  877.     Absolute;
  878.     MoveTo((x0-d/2-rf), y0);
  879.     Relative;
  880.     ClosePoly;
  881.     BeginPoly;
  882.         LineTo(0, 0);
  883.         ArcTo(rf, 0, rf);
  884.         LineTo(0, -(L-ch));
  885.         LineTo(td, -ch);
  886.         LineTo(di, 0);
  887.         LineTo(td, ch);
  888.         ArcTo(0, (L-ch), rf);
  889.         LineTo(rf, 0);
  890.     EndPoly;
  891.     Absolute;
  892.     MoveTo(x0-d/2, y0-L+ch);
  893.     Relative;
  894.     LineTo(d, 0);
  895.  
  896.     k2:=1;
  897.     IF TL = L THEN
  898.     BEGIN
  899.         nThreads:=(L - ch)/p;
  900.         p:=(L - ch)/nThreads;
  901.         k2:=0;
  902.     END;
  903.  
  904.     Absolute;
  905.     MoveTo(x0-d/2, y0-L+ch+p);
  906.     Relative;
  907.     FOR k:=1 TO nThreads-1 DO
  908.     BEGIN
  909.         LineTo(d, 0);
  910.         Move(-d, p);
  911.     END;
  912.     IF L > TL THEN
  913.         LineTo(d/2, 0);
  914.  
  915.     PenSize(1.5*FPenSize);
  916.     Absolute;
  917.     MoveTo(x0-di/2, y0-L+ch+p/2);
  918.     Relative;
  919.     FOR k:=1 TO nThreads-k2 DO
  920.     BEGIN
  921.         LineTo(di, 0);
  922.         Move(-di, p);
  923.     END;
  924.     IF L > TL THEN
  925.         LineTo(3*di/4, 0);
  926. END;
  927.  
  928. Procedure DrawThdType3;
  929. {
  930. This procedure draws detailed threads.
  931. }
  932.  
  933. CONST
  934.     k1 = 0.75;
  935.     k2 = 0.50;
  936.  
  937. VAR
  938.     p1,SL : REAL;
  939.     k,nPoints : INTEGER;
  940.  
  941. BEGIN
  942.     p1:=d - 5*td/2;
  943.     REPEAT
  944.         nThreads:=nThreads-1;
  945.     UNTIL ((nThreads+1)*p + p/2 +rf) < L;
  946.     SL:=L - ((nThreads+1)*p + p/2);
  947.  
  948. {
  949. Draw bottom thread.
  950. }
  951.  
  952.     Absolute;
  953.     MoveTo(x0 - d/2 + 3*td/2, y0 - L);
  954.     Relative;
  955.     ClosePoly;
  956.     BeginPoly;
  957.         LineTo(0, 0);
  958.         LineTo(p1, 0);
  959.         LineTo(td/2, p/4);
  960.         LineTo(-td/2, p/4);
  961.         LineTo(td, p/2);
  962.         LineTo(-(d-td/2), -p/2);
  963.     EndPoly;
  964.  
  965.     Absolute;
  966.     MoveTo((x0 + d/2 - td/2), (y0 - L + p/4));
  967.     Relative;
  968.     LineTo(-(d/2 - td/2),  0);
  969.     LineTo(di/2, p/4);
  970.         
  971. {
  972. Draw first whole thread.
  973. }
  974.  
  975.     Absolute;
  976.     MoveTo((x0 - d/2 + td/2), (y0 - L +p/2));
  977.     Relative;
  978.     Poly(0,0, (d-td/2),p/2, -td, p/2, -di,-p/2);
  979.     Poly (0,0, di,p/2, td,p/2, -d,-p/2);
  980.     
  981. {
  982. Draw remaining whole threads.
  983. }
  984.  
  985.     Relative;
  986.     ClosePoly;
  987.     FOR i:=1 TO nThreads-1 DO BEGIN
  988.         Poly(0,0, d,p/2, -td,p/2, -di,-p/2);
  989.         Poly(0,0, di,p/2, td,p/2, -d,-p/2);
  990.     END;
  991.  
  992. {
  993. Draw last thread and shoulder.
  994. }
  995.  
  996.     Absolute;
  997.     MoveTo((x0 - d/2 - rf), y0);
  998.     Relative;
  999.     ClosePoly;
  1000.     BeginPoly;
  1001.         LineTo(0, 0);
  1002.         IF rf <> 0 THEN
  1003.             ArcTo(rf, 0, rf);
  1004.         LineTo(0, -SL);
  1005.         LineTo(td, -p/2);
  1006.         LineTo(-td, -p/2);
  1007.         LineTo(d, p/2);
  1008.         IF rf <> 0 THEN
  1009.         BEGIN
  1010.             ArcTo(0, SL+p/2, rf);
  1011.             LineTo(rf, 0);
  1012.         END ELSE
  1013.             LineTo(0, SL+p/2);
  1014.     EndPoly;
  1015.     Absolute;
  1016.     MoveTo(x0-d/2, y0-SL);
  1017.     Relative;
  1018.     LineTo((k6*di + td),0);
  1019.     LineTo(-k6*di, -p/2);
  1020.  
  1021. END;
  1022.  
  1023. BEGIN
  1024. {
  1025. Main Program.
  1026. }
  1027.  
  1028.     DselectAll;
  1029.     PushAttrs;
  1030.  
  1031. {
  1032. Display the main dialog box and get the information.
  1033. }
  1034.  
  1035.     CapScrDialog;
  1036.     SetCursor(ArrowC);
  1037.     GetInfo;
  1038.     IF Abort THEN GOTO 99;
  1039.  
  1040. {
  1041. Get the location of the screw.
  1042. }
  1043.  
  1044.     GetPt(x0,y0);
  1045.  
  1046. {
  1047. Determine pitch, thread length and number of threads.
  1048. }
  1049.  
  1050.     IF UNC THEN
  1051.         tpi:=tpic
  1052.     ELSE
  1053.         tpi:=tpif;
  1054.  
  1055.     p:=1/tpi;
  1056.     td:=0.86603/tpi;
  1057.     di:=d-2*td;
  1058.     IF Type <> 2 THEN
  1059.         rf:=k4*d
  1060.     ELSE
  1061.         rf:=0;
  1062.  
  1063.     IF Inch THEN
  1064.         TL:=ThdLgthI(d,L)
  1065.     ELSE
  1066.         TL:=ThdLgthM(d,L,p);
  1067.     nThreads:=TL*tpi;
  1068.  
  1069. {
  1070. Get drawing units and adjust parameters accordingly.
  1071. }
  1072.  
  1073.     GetUnits(UName,DA,Fmt,UPI,UM,UM2);
  1074.     IF Inch = TRUE THEN
  1075.         SF:=UPI
  1076.     ELSE
  1077.         SF:=UPI/25.4;
  1078.  
  1079.     d:=d*SF;
  1080.     L:=L*SF;
  1081.     a:=a*SF;
  1082.     aMin:=aMin*SF;
  1083.     h:=h*SF;
  1084.     s:=s*SF;
  1085.     j:=j*SF;
  1086.     t:=t*SF;
  1087.     TL:=TL*SF;
  1088.     p:=p*SF;
  1089.     td:=td*SF;
  1090.     di:=di*SF;
  1091.     rf:=rf*SF;
  1092.  
  1093. {
  1094. Calculate the variables needed to draw the screw.
  1095. }
  1096.  
  1097.     IF Type = 1 THEN BEGIN
  1098.         c:=a - 2*(h-s)/Tan(Deg2Rad(T1));
  1099.         f:=j*Tan(Pi/6);
  1100.     END
  1101.  
  1102.     ELSE IF (Type = 2) OR (Type = 4)  THEN
  1103.     BEGIN
  1104.         IF Inch THEN Theta:=Deg2Rad(82)
  1105.         ELSE Theta:=PI/2;
  1106.         h:=(a-d)/(2*Tan(Theta/2));
  1107.         a1:=(a+aMin)/2;
  1108.         s:=(a-a1)/(2*Tan(Theta/2));
  1109.         L:=L-h;
  1110.         TL:=TL-h;
  1111.         rf:=0;
  1112.         f:=j*Tan(Pi/6);
  1113.     END
  1114.  
  1115.     ELSE IF Type = 3 THEN
  1116.     BEGIN
  1117.         c:=k1*j;
  1118.         f:=j*Tan(Pi/6);
  1119.     END
  1120.  
  1121.     ELSE IF Type = 5 THEN
  1122.     BEGIN
  1123.         r:=((a/2)^2 + h^2)/(2*h);
  1124.     END
  1125.  
  1126.     ELSE IF Type = 6 THEN
  1127.     BEGIN
  1128.         h1:=h-s;
  1129.         r:=((a/2)^2 + h1^2)/(2*h1);
  1130.     END;
  1131.  
  1132. {
  1133. Draw top view
  1134. }
  1135.  
  1136.     IF View = 1 THEN BEGIN
  1137.         DrawTopView(Type);
  1138.         GOTO 90;
  1139.     END;
  1140.  
  1141. {
  1142. Draw side view.
  1143. }
  1144.  
  1145.     DrawSideViewOfHead(Type);
  1146.  
  1147. {
  1148. Draw the threads.
  1149. }
  1150.  
  1151.     IF L <= 0 THEN GOTO 90;
  1152.     IF ThdType = 1 THEN
  1153.          DrawThdType1
  1154.     ELSE IF ThdType = 2 THEN
  1155.          DrawThdType2
  1156.     ELSE
  1157.          DrawThdType3;
  1158.  
  1159.     90:Group;
  1160.     PopAttrs;
  1161.  
  1162. 99:END;
  1163.  
  1164. RUN(CapScrews);
  1165.