home *** CD-ROM | disk | FTP | other *** search
/ Chip 1998 March / Chip_1998-03_cd.bin / tema / MINICAD / MC7DEMO / MINICAD.1 / MACH_SCR.MPC < prev    next >
Text File  |  1997-04-30  |  28KB  |  1,499 lines
  1. Procedure MachineScrews;
  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 10,90,99;
  9.  
  10. CONST
  11.     maxPoints = 10;
  12.     k1= 0.3333;
  13.     k2 = 0.132;    {Used to determine thickness of flange of Metric hex flange head.}
  14.     nDataFiles = 12;
  15.  
  16. VAR
  17.     a,b,c,d,di,f,j,h,h1,h2,L,TL,p,r,rf,s,t,td,u,w : REAL;
  18.     tpi,tpic,tpif,Theta,x0,y0 : REAL;
  19.     x,y,Rt,xt,yt : ARRAY[1..maxPoints] OF REAL;
  20.  
  21.     PathLength : INTEGER;
  22.     i,nThreads,Type,ThdType,View : INTEGER;
  23.     
  24.     Size,Sz,Size1,Pathname : STRING;
  25.     SizeNotFound,Abort,Inch,FirstTime,ShowThreads,ShowSlot,UNC : BOOLEAN;
  26.  
  27.     SF,UPI : REAL;
  28.     Fmt : INTEGER;
  29.     UM,UM2 : STRING;
  30.     UName,DA : LONGINT;
  31.  
  32. Procedure MachScrDialogs;
  33. {
  34. This procedure creates the dialog boxes.
  35. }
  36. VAR
  37.     Width,x1,y1,x2,y2,px1,px2,px3,px4,py1,py2,py3,py4 : INTEGER;
  38.  
  39. Procedure AlignScr(Width:INTEGER; VAR x1,x2:INTEGER);
  40. VAR
  41.     scrx1,scry1,scrx2,scry2:INTEGER;
  42. BEGIN
  43.     GetScreen(scrx1,scry1,scrx2,scry2);
  44.     x1:=((scrx1+scrx2) div 2)-(Width div 2);
  45.     x2:=x1+Width; 
  46. END;
  47.  
  48. Procedure LocateButtons(DialogType,scnh,scnw : INTEGER);
  49. {
  50. This procedure locates the 'OK' and 'Cancel' buttons.
  51. }
  52. VAR
  53.     v1,v2,v3,v4 : INTEGER;
  54.     Mac : BOOLEAN;
  55.  
  56. Procedure Swap(VAR  m1,m2,m3,m4 : INTEGER);
  57. VAR
  58.     Temp : INTEGER;
  59. BEGIN
  60.     Temp:=m1;
  61.     m1:=m3;
  62.     m3:=Temp;
  63.     Temp:=m2;
  64.     m2:=m4;
  65.     m4:=Temp;
  66. END;        {of Swap}
  67.  
  68. BEGIN
  69.     Mac:=FALSE;
  70.     PathName:='External\Data\';
  71.     GetVersion(v1,v2,v3,v4);
  72.     IF v4 = 1 THEN
  73.     BEGIN
  74.         Mac:=TRUE;
  75.         PathName:=':Externals:External Data:';
  76.     END;
  77.  
  78.     IF DialogType = 1 THEN
  79.     BEGIN
  80.         px1:=(scnw DIV 2) - 80;
  81.         px2:=(scnw DIV 2) - 10;
  82.         px3:=(scnw DIV 2) + 10;
  83.         px4:=(scnw DIV 2) + 80;
  84.         IF Mac THEN SWAP(px1,px2,px3,px4);
  85.  
  86.         py1:=scnh-40;
  87.         py2:=scnh-20;
  88.         py3:=py1;
  89.         py4:=py2;
  90.     END ELSE IF DialogType = 2 THEN
  91.     BEGIN
  92.         px1:=scnw - 180;
  93.         px2:=scnw - 110;
  94.         px3:=scnw - 90;
  95.         px4:=scnw - 20;
  96.         IF Mac THEN SWAP(px1,px2,px3,px4);
  97.  
  98.         py1:=scnh-40;
  99.         py2:=scnh-20;
  100.         py3:=py1;
  101.         py4:=py2;
  102.     END ELSE
  103.     BEGIN
  104.         px1:=scnw - 90;
  105.         px2:=scnw - 20;
  106.         px3:=px1;
  107.         px4:=px2;
  108.  
  109.         py1:=scnh -70;
  110.         py2:=scnh - 50;
  111.         py3:=scnh - 40;
  112.         py4:=scnh - 20;
  113.         IF Mac THEN SWAP(py1,py2,py3,py4);
  114.     END;
  115. END;        {of Locate Buttons}
  116.  
  117. Procedure MakeDialogs;
  118. {
  119. This procedure defines the dialog boxes.
  120. }
  121. CONST
  122.     y1=100;
  123.     scnh=380;
  124.     scnw=300;
  125.     DialogType = 1;
  126.  
  127. VAR
  128.     h : INTEGER;
  129.  
  130. BEGIN
  131.     AlignScr(scnw,x1,x2);
  132.     y2:=y1+scnh;
  133.  
  134.     LocateButtons(DialogType,scnh,scnw);
  135.  
  136. {
  137. Inch dialog box.
  138. }
  139.  
  140.     BeginDialog(1,1,x1,y1,x2,y2);
  141.         AddButton('OK',1,1,px1,py1,px2,py2);
  142.         AddButton('Cancel',2,1,px3,py3,px4,py4);
  143.  
  144.         h:=15;
  145.         AddField('Type of Head:',4,1,20,44-h,145,60-h);
  146.  
  147.         AddButton('Flat Csk (82 deg)',5,3,20,65-h,155,80-h);
  148.         AddButton('Flat Csk (100 deg)',6,3,20,85-h,155,100-h);
  149.         AddButton('Oval Countersunk',7,3,20,105-h,155,120-h);
  150.         AddButton('Fillister',13,3,20,125-h,165,140-h);
  151.         AddButton('Hex Washer (no slot)',8,3,20,145-h,165,160-h);
  152.         AddButton('Hex Washer (slotted)',9,3,20,165-h,165,180-h);
  153.  
  154.         AddButton('Truss',10,3,175,65-h,250,80-h);
  155.         AddButton('Binding',11,3,175,85-h,250,100-h);
  156.         AddButton('Pan',12,3,175,105-h,250,120-h);
  157.         AddButton('Round',14,3,175,125-h,250,140-h);
  158.         AddButton('Hex (no slot)',15,3,175,145-h,270,160-h);
  159.         AddButton('Hex (slotted)',16,3,175,165-h,270,180-h);
  160.  
  161.         h:=150;
  162.         AddField('Series:',19,1,20,154-h,65,170-h);
  163.         AddButton('Inch',20,3,70,155-h,120,170-h);
  164.         AddButton('Metric',21,3,125,155-h,190,170-h);
  165.  
  166.         h:=185;
  167.         AddField('Size:',22,1,20,h-1,75,h+15);
  168.         AddField('',23,2,80,h,145,h+15);
  169.         AddField('in',50,1,153,h-1,175,h+15);
  170.  
  171.         AddField('Length:',24,1,20,h+24,75,h+40);
  172.         AddField('',25,2,80,h+25,145,h+40);
  173.         AddField('in',51,1,153,h+25,175,h+40);
  174.  
  175.         h:=-200;
  176.         AddField('View:',28,1,220,39-h,275,55-h);
  177.         AddButton('Top',29,3,220,80-h,275,95-h);
  178.         AddButton('Front',30,3,220,60-h,275,75-h);
  179.         AddButton('Side',31,3,220,100-h,275,115-h);
  180.  
  181.         h:=235;
  182.         AddField('Threads:',34,1,20,h+4,75,h+20);
  183.         AddButton('UNC',35,3,80,h+4,130,h+20);
  184.         AddButton('UNF',36,3,135,h+4,200,h+20);
  185.  
  186.         AddButton('Type 1 (dashed lines)',37,3,20,h+25,200,h+40);
  187.         AddButton('Type 2 (solid lines)',38,3,20,h+45,200,h+60);
  188.         AddButton('Type 3 (detailed threads)',39,3,20,h+65,190,h+80);
  189.  
  190.     EndDialog;
  191.  
  192. {
  193. Metric dialog box.
  194. }
  195.  
  196.     BeginDialog(2,1,x1,y1,x2,y2-20);
  197.         AddButton('OK',1,1,px1,py1-20,px2,py2-20);
  198.         AddButton('Cancel',2,1,px3,py3-20,px4,py4-20);
  199.  
  200.         h:=15;
  201.         AddField('Type of Head:',4,1,20,44-h,145,60-h);
  202.  
  203.         AddButton('Flat Csk (90 deg)',5,3,20,65-h,155,80-h);
  204.         AddButton('Oval Countersunk',7,3,20,85-h,155,100-h);
  205.         AddButton('Pan',12,3,20,105-h,155,120-h);
  206.         AddButton('Hex',15,3,20,125-h,165,140-h);
  207.         AddButton('Hex Flange',8,3,20,145-h,155,160-h);
  208.  
  209.         h:=150;
  210.         AddField('Series:',19,1,20,154-h,65,170-h);
  211.         AddButton('Inch',20,3,70,155-h,120,170-h);
  212.         AddButton('Metric',21,3,125,155-h,190,170-h);
  213.  
  214.         h:=165;
  215.         AddField('Size:',22,1,20,h-1,75,h+15);
  216.         AddField('',23,2,80,h,145,h+15);
  217.         AddField('mm',50,1,153,h-1,175,h+15);
  218.  
  219.         AddField('Length:',24,1,20,h+24,75,h+40);
  220.         AddField('',25,2,80,h+25,145,h+40);
  221.         AddField('mm',51,1,153,h+25,175,h+40);
  222.  
  223.         h:=-180;
  224.         AddField('View:',28,1,220,39-h,275,55-h);
  225.         AddButton('Top',29,3,220,80-h,275,95-h);
  226.         AddButton('Front',30,3,220,60-h,275,75-h);
  227.         AddButton('Side',31,3,220,100-h,275,115-h);
  228.  
  229.         h:=215;
  230.         AddField('Threads:',34,1,20,h+4,75,h+20);
  231.         AddButton('Type 1 (dotted lines)',37,3,20,h+25,200,h+40);
  232.         AddButton('Type 2 (solid lines)',38,3,20,h+45,200,h+60);
  233.         AddButton('Type 3 (detailed threads)',39,3,20,h+65,190,h+80);
  234.  
  235.     EndDialog;
  236. END;
  237.  
  238. BEGIN
  239.     MakeDialogs;
  240. END;
  241.  
  242. Function GetFilename(Type:INTEGER) : STRING;
  243. {
  244. This procedure assigns file names to the variable Filename.
  245. }
  246.  
  247. VAR
  248.     k : INTEGER;
  249.     Filename : ARRAY[1..2,1..nDataFiles] OF STRING;
  250.  
  251. BEGIN
  252.     Filename[1,1]:='MFlat82E.txt';
  253.     Filename[1,2]:='MFlat00E.txt';
  254.     Filename[1,3]:='MOvalE.txt';
  255.     Filename[1,4]:='MHexWE.txt';
  256.     Filename[1,5]:='MHexWE.txt';
  257.     Filename[1,6]:='MTrussE.txt';
  258.     Filename[1,7]:='MBindE.txt';
  259.     Filename[1,8]:='MPanE.txt';
  260.     Filename[1,9]:='MFillE.txt';
  261.     Filename[1,10]:='MRoundE.txt';
  262.     Filename[1,11]:='MHexE.txt';
  263.     Filename[1,12]:='MHexE.txt';
  264.  
  265.     Filename[2,1]:='MFlat90M.txt';
  266.     Filename[2,3]:='MOvalM.txt';
  267.     Filename[2,4]:='MHexFM.txt';
  268.     Filename[2,8]:='MPanM.txt';
  269.     Filename[2,11]:='MHexM.txt';
  270.     
  271.     IF Inch THEN k:=1
  272.     ELSE k:=2;
  273.     GetFilename:=Filename[k,Type];
  274. END;
  275.  
  276. Procedure GetData;
  277. {
  278. This procedure opens the data file and retreives the data.
  279. }
  280. LABEL 10,99;
  281.  
  282. VAR
  283.     File,Filename,WarningStr : STRING;
  284.  
  285. BEGIN
  286.     File:=GetFilename(Type);
  287.     Filename:=Concat(Pathname,File);
  288.     Open(Filename);
  289.  
  290.     IF FndError THEN BEGIN
  291.         ClrDialog;
  292.         Sysbeep;
  293.         WarningStr:=Concat('The data file <',File,'> cannot be found. Check your Toolkit Manual for further explanation.');
  294.         AlrtDialog(WarningStr);
  295.         Abort:=TRUE;
  296.         GoTo 99;
  297.     END;
  298.  
  299.     SizeNotFound:=FALSE;
  300.     WHILE NOT Eoln(Filename) DO
  301.     BEGIN
  302.         IF (Type = 1) OR (Type = 2) THEN
  303.             ReadLn(Sz,d,tpic,tpif,a,j,t)
  304.         ELSE IF (Type = 3) OR (Type = 10) OR  (Type = 11) OR  (Type = 12) THEN
  305.             ReadLn(Sz,d,tpic,tpif,a,h,j,t)
  306.         ELSE IF (Type = 4) OR (Type = 5) THEN
  307.             ReadLn(Sz,d,tpic,tpif,a,h,b,u,j,t)
  308.         ELSE IF (Type = 6) OR (Type = 8) THEN
  309.             ReadLn(Sz,d,tpic,tpif,a,h,r,j,t)
  310.         ELSE IF Type = 7 THEN
  311.             ReadLn(Sz,d,tpic,tpif,a,h,f,j,t)
  312.         ELSE IF Type = 9 THEN
  313.             ReadLn(Sz,d,tpic,tpif,a,h,s,j,t);
  314.  
  315.         IF Sz = Size THEN GOTO 10;
  316.     END;
  317.  
  318.     Close(Filename);
  319.     SysBeep;
  320.     AlrtDialog('That size is not available!');
  321.     SizeNotFound:=TRUE;
  322.     GoTo 99;
  323.  
  324.     10:Close(Filename);
  325. 99:END;
  326.  
  327. Procedure GetInfo;
  328. {
  329. This procedure displays the main dialog box and retreives the information input by the user.
  330. }
  331. LABEL 10,20,99;
  332.  
  333. VAR
  334.     Done:Boolean;
  335.     Item:Integer;
  336.     RFlag : ARRAY [1..5] OF INTEGER;
  337.  
  338. Procedure SetRButton(i,Item : INTEGER);
  339. BEGIN
  340.     IF RFlag[i] <> Item THEN BEGIN
  341.         SetItem(RFlag[i],FALSE);
  342.         SetItem(Item,TRUE);
  343.         RFlag[i]:=Item;
  344.     END;
  345. END;
  346.  
  347. BEGIN
  348.     Done:=FALSE;
  349.     Abort:=FALSE;
  350.  
  351.     Type:=1;
  352.     View:=2;
  353.     ThdType:=1;
  354.     Inch:=TRUE;
  355.     UNC:=TRUE;
  356.     Size1:='3/8';
  357.     L:=1.000;
  358.  
  359.     10:RFlag[1]:=Type+4;
  360.     RFlag[2]:=View+28;
  361.     IF UNC THEN
  362.         RFlag[4]:=35
  363.     ELSE
  364.         RFlag[4]:=36;
  365.     RFlag[5]:=ThdType+36;
  366.  
  367.      IF Inch THEN
  368.     BEGIN
  369.         RFlag[3]:=20;
  370.         GetDialog(1);
  371.     END ELSE
  372.     BEGIN
  373.         RFlag[3]:=21;
  374.         GetDialog(2);
  375.     END;
  376.     SetTitle('Machine Screws');
  377.  
  378.     SetItem(RFlag[1],TRUE);
  379.     SetItem(RFlag[2],TRUE);
  380.     SetItem(RFlag[3],TRUE);
  381.     IF Inch THEN
  382.         SetItem(RFlag[4],TRUE);
  383.     SetItem(RFlag[5],TRUE);
  384.  
  385.     SetField(23,Size1);
  386.     SetField(25,Num2Str(3,L));
  387.     20:SelField(23);
  388.     REPEAT
  389.         DialogEvent(Item);
  390.  
  391.         IF Item=1 then
  392.             Done:=TRUE;
  393.  
  394.         IF Item=2 THEN
  395.         BEGIN
  396.             Done:=TRUE;
  397.             Abort:=TRUE;
  398.         END;
  399.  
  400.         IF (Item > 4) AND (Item < 17) THEN
  401.         BEGIN
  402.             SetRButton(1,Item);
  403.             Type:=Item-4;
  404.         END;
  405.  
  406.         IF (Item > 28) AND (Item < 32) THEN
  407.         BEGIN
  408.             SetRButton(2,Item);
  409.             View:=Item-28;            
  410.         END;
  411.  
  412.         IF (Item = 20) AND (NOT Inch)  THEN
  413.         BEGIN
  414.             Inch:=TRUE;
  415.             SetRButton(3,Item);
  416.             ClrDialog;
  417.             GetDialog(1);
  418.             GOTO 10;
  419.         END;
  420.  
  421.         IF (Item = 21) AND (Inch)  THEN
  422.         BEGIN
  423.             Inch:=FALSE;
  424.             SetRButton(3,Item);
  425.             ClrDialog;
  426.             IF (Type=2) OR (Type=6) OR (Type=7) OR (Type=9) OR (Type=10) THEN
  427.             BEGIN;
  428.                 Type:=1;
  429.                 RFlag[1]:=5;
  430.             END;
  431.             GetDialog(2);
  432.             GOTO 10;
  433.         END;
  434.  
  435.         IF (Item = 35) OR (Item = 36) THEN
  436.         BEGIN
  437.             SetRButton(4,Item);
  438.             IF Item = 35 THEN UNC:=TRUE
  439.             ELSE UNC:=FALSE;
  440.         END;
  441.  
  442.         IF (Item > 36) AND (Item < 40) THEN
  443.         BEGIN
  444.             SetRButton(5,Item);
  445.             ThdType:=Item-36;
  446.         END;
  447.     UNTIL Done;
  448.  
  449.     IF Abort THEN GOTO 99;
  450.     Size1:=GetField(23);
  451.     Size:=Concat('''',Size1,'''');
  452.     UprString(Size);
  453.     L:=Str2Num(GetField(25));
  454.  
  455.     GetData;
  456.     IF Abort THEN GOTO 99;
  457.     IF SizeNotFound THEN
  458.     BEGIN
  459.         Done:=FALSE;
  460.         GOTO 20;
  461.     END;
  462.  
  463.     99:    ClrDialog;
  464. END;
  465.  
  466. Procedure DrawPolyPoint(x,y,R : REAL);
  467. {
  468. This procedure draws a polyline point based on the value of R:
  469. R = 0    ==> Corner point
  470. R > 0    ==> Arc point of radius, R
  471. R = -1    ==> Cubic spline point
  472. R = any value less than 0 except -1
  473.             ==> Bezier control point
  474. }
  475.  
  476. BEGIN
  477.     IF R = 0 THEN
  478.         LineTo(x,y)
  479.     ELSE IF R > 0 THEN
  480.         ArcTo(x,y,R)
  481.     ELSE IF R = -1 THEN
  482.         CurveThrough(x,y)
  483.     ELSE
  484.         CurveTo(x,y);
  485. END;    {of DrawPolyPoint}
  486.  
  487. Function ThdLgthI(d,L,p : REAL) : REAL;
  488. {
  489. This procedure determines the length of threads for inch series machine screws.
  490. }
  491.  
  492. BEGIN
  493.     IF d <= 0.125 THEN
  494.     BEGIN
  495.         IF L <= 3*d THEN
  496.             ThdLgthI:=L-p
  497.         ELSE IF L < 1.125+2*p THEN
  498.             ThdLgthI:=L-2*p
  499.         ELSE
  500.             ThdLgthI:=1.125;
  501.     END ELSE
  502.     BEGIN
  503.         IF L <= 3*d THEN
  504.             ThdLgthI:=L-p
  505.         ELSE IF L < 2.000+2*p THEN
  506.             ThdLgthI:=L-2*p
  507.         ELSE
  508.             ThdLgthI:=2.000;
  509.     END;
  510. END;
  511.  
  512. Function ThdLgthM(d,L,p : REAL) : REAL;
  513. {
  514. This procedure determines the length of threads for mm series machine screws.
  515. }
  516.  
  517. BEGIN
  518.     IF d <= 3 THEN
  519.     BEGIN
  520.         IF L <= 3*d THEN
  521.             ThdLgthM:=L-p
  522.         ELSE IF L < 30 THEN
  523.             ThdLgthM:=L-2*p
  524.         ELSE
  525.             ThdLgthM:=25;
  526.     END ELSE
  527.     BEGIN
  528.         IF L <= 3*d THEN
  529.             ThdLgthM:=L-p
  530.         ELSE IF L < 50 THEN
  531.             ThdLgthM:=L-2*p
  532.         ELSE
  533.             ThdLgthM:=38;
  534.     END;
  535. END;
  536.  
  537. Procedure DrawTopView(Type : INTEGER);
  538. {
  539. This procedure draws the top view.
  540. }
  541.  
  542. LABEL 10;
  543.  
  544. VAR
  545.     c,q1,q2,q3,Alpha,Beta : REAL;
  546.     i,k,nPoints : INTEGER;
  547.  
  548. BEGIN
  549. {
  550. Flat and Oval Countersunk Heads.
  551. }
  552.  
  553.     IF Type <= 3 THEN BEGIN
  554.  
  555.         IF Type = 3 THEN
  556.             t:=t-h2;
  557.         Alpha:=ArcCos(j/a);
  558.         q1:=a*Tan(Alpha/2)/2;
  559.         q2:=a*Sin(Alpha)/2;
  560.         c:=a/2 - t*Tan(Theta/2);
  561.         q3:=Sqrt(c^2 - (j/2)^2);
  562.  
  563.         Absolute;
  564.         MoveTo(x0+j/2, y0+q2);
  565.         Relative;
  566.         ClosePoly;
  567.         BeginPoly;
  568.             LineTo(0,0);
  569.             ArcTo((a-j)/2, -(q2-q1), a/2);
  570.             ArcTo(0, -2*q1, a/2);
  571.             LineTo(-(a-j)/2, -(q2-q1));
  572.         EndPoly;
  573.  
  574.         Absolute;
  575.         MoveTo(x0-j/2, y0+q2);
  576.         Relative;
  577.         BeginPoly;
  578.             LineTo(0,0);
  579.             ArcTo(-(a-j)/2, -(q2-q1), a/2);
  580.             ArcTo(0, -2*q1, a/2);
  581.             LineTo((a-j)/2, -(q2-q1));
  582.         EndPoly;
  583.  
  584.         Absolute;
  585.         MoveTo(x0-j/2, y0+q3);
  586.         Relative;
  587.         BeginPoly;
  588.             LineTo(0,0);
  589.             CurveThrough(j/2, (c-q3));
  590.             LineTo(j/2, -(c-q3));
  591.             LineTo(0,-2*q3);
  592.             CurveThrough(-j/2, -(c-q3));
  593.             LineTo(-j/2, (c-q3));
  594.         EndPoly;
  595.  
  596.     END    {of Flat and Oval Countersunk Heads}
  597.  
  598. {
  599. Hex and Hex Washer Heads (no slots).
  600. }
  601.  
  602.     ELSE IF (Type = 4) OR (Type = 11) THEN
  603.     BEGIN
  604.         IF Type = 4 THEN
  605.         BEGIN
  606.             Absolute;
  607.             MoveTo(x0,y0);
  608.             Relative;
  609.             Arc(-b/2,b/2,b/2,-b/2,0,360);
  610.         END;
  611.  
  612.         Absolute;
  613.         MoveTo(x0-w/2, y0);
  614.         Closepoly;
  615.         Poly(f,#-60, f,#0, f,#60, f,#120, f,#-180);
  616.  
  617.         Absolute;
  618.         MoveTo(x0,y0);
  619.         Relative;
  620.         Arc(-a/2,a/2,a/2,-a/2,0,360);
  621.     END
  622.  
  623. {
  624. Hex and Hex Washer Heads (slotted).
  625. }
  626.     ELSE IF (Type = 5) OR (Type = 12) THEN
  627.     BEGIN
  628.  
  629.         Alpha:=ArcCos(j/a);
  630.         q1:=a*Tan(Alpha/2)/2;
  631.         q2:=a*Sin(Alpha)/2;
  632.         c:=a/2 - t*Tan(Theta/2);
  633.         q3:=Sqrt(c^2 - (j/2)^2);
  634.  
  635.         IF Type = 5 THEN
  636.         BEGIN
  637.             Absolute;
  638.             MoveTo(x0,y0);
  639.             Relative;
  640.             Arc(-b/2,b/2,b/2,-b/2,0,360);
  641.         END;
  642.  
  643.         Absolute;
  644.         MoveTo(x0-w/2, y0);
  645.         Closepoly;
  646.         Poly(f,#-60, f,#0, f,#60, f,#120, f,#-180);
  647.  
  648.         Absolute;
  649.         MoveTo(x0+j/2, y0+q2);
  650.         Relative;
  651.         ClosePoly;
  652.         BeginPoly;
  653.             LineTo(0,0);
  654.             ArcTo((a-j)/2, -(q2-q1), a/2);
  655.             ArcTo(0, -2*q1, a/2);
  656.             LineTo(-(a-j)/2, -(q2-q1));
  657.         EndPoly;
  658.  
  659.         Absolute;
  660.         MoveTo(x0-j/2, y0+q2);
  661.         Relative;
  662.         BeginPoly;
  663.             LineTo(0,0);
  664.             ArcTo(-(a-j)/2, -(q2-q1), a/2);
  665.             ArcTo(0, -2*q1, a/2);
  666.             LineTo((a-j)/2, -(q2-q1));
  667.         EndPoly;
  668.  
  669.     END
  670.  
  671. {
  672. Truss, Binding and Round Heads.
  673. }
  674.  
  675.     ELSE IF (Type = 6) OR (Type = 7) OR (Type = 10) THEN
  676.     BEGIN
  677.  
  678.         IF Type = 7 THEN
  679.         BEGIN
  680.             c:=a/2 - (h-t)*Tan(Deg2Rad(5));
  681.             Alpha:=Rad2Deg(ArcCos(j/b));
  682.         END ELSE
  683.             c:=Sqrt(r^2 - (r-t)^2);
  684.         q1:=Sqrt(c^2 - (j/2)^2);
  685.  
  686.         Absolute;
  687.         MoveTo(x0,y0);
  688.         Relative;
  689.         Arc(-a/2,a/2,a/2,-a/2,0,360);
  690.  
  691.         IF Type = 7 THEN
  692.         BEGIN
  693.             Arc(-b/2,b/2,b/2,-b/2,-Alpha,2*Alpha);
  694.             Arc(-b/2,b/2,b/2,-b/2,180-Alpha,2*Alpha);
  695.         END;
  696.  
  697.         Absolute;
  698.         MoveTo(x0-j/2, y0+q1);
  699.         Relative;
  700.         BeginPoly;
  701.             LineTo(0,0);
  702.             CurveThrough(j/2, (c-q1));
  703.             LineTo(j/2, -(c-q1));
  704.             LineTo(0,-2*q1);
  705.             CurveThrough(-j/2, -(c-q1));
  706.             LineTo(-j/2, (c-q1));
  707.         EndPoly;
  708.  
  709.     END    {of Truss, Binding and Round Heads}
  710.  
  711. {
  712. Pan and Fillister Heads.
  713. }
  714.  
  715.     ELSE IF (Type = 8) OR (Type = 9) THEN
  716.     BEGIN
  717.  
  718.         q1:=Sqrt(a^2 - j^2)/2;
  719.  
  720.         Absolute;
  721.         MoveTo(x0,y0);
  722.         Relative;
  723.         Arc(-a/2,a/2,a/2,-a/2,0,360);
  724.         Move(j/2, q1);
  725.         LineTo(0, -2*q1);
  726.         Move(-j, 0);
  727.         LineTo(0, 2*q1);
  728.  
  729.     END;
  730.  
  731. END;
  732.  
  733. Procedure DrawSideViewOfHead(Type : INTEGER);
  734. {
  735. This procedure draws the side view of the head.
  736. }
  737. LABEL 10;
  738.  
  739. VAR
  740.     ch,p1,p2,q1,q2 : REAL;
  741.     Alpha,Beta1,Beta2 : REAL;
  742.     k, nPoints : INTEGER;
  743.  
  744. BEGIN
  745.  
  746. {
  747. Flat Countersunk Head.
  748. }
  749.  
  750.     IF (Type = 1) OR (Type = 2) THEN BEGIN
  751.  
  752.         y0:=y0-h;
  753.         Absolute;
  754.         MoveTo(x0-d/2, y0);
  755.         Relative;
  756.         ClosePoly;
  757.         BeginPoly;
  758.             LineTo(0, 0);
  759.             LineTo(-(a-d)/2,  h);
  760.             IF View = 2 THEN
  761.             BEGIN
  762.                 LineTo((a-j)/2, 0);
  763.                 LineTo(0, -t);
  764.                 LineTo(j, 0);
  765.                 LineTo(0, t);
  766.                 LineTo((a-j)/2 ,0);
  767.             END ELSE
  768.                 LineTo(a, 0);
  769.             LineTo(-(a-d)/2, -h);
  770.         EndPoly;
  771.  
  772.     END    {of Flat Countersunk Head}
  773.  
  774. {
  775. Oval Countersunk Head.
  776. }
  777.  
  778.     ELSE IF Type = 3 THEN
  779.     BEGIN
  780.  
  781.         IF View = 3 THEN
  782.             j:=0;
  783.         Alpha:=ArcSin(a/(2*r));
  784.         Beta1:=ArcCos(a/(2*r));
  785.         Beta2:=ArcSin(j/(2*r));
  786.         Alpha:=Pi/2 - (Beta1+Beta2);
  787.         p1:=r*Sin(Beta2 + Alpha/2)/Cos(Alpha/2);
  788.         q1:=r*Cos(Beta2 + Alpha/2)/Cos(Alpha/2) - r*Sin(Beta1);
  789.         q2:=r*(Cos(Beta2)-Sin(Beta1));
  790.  
  791.         x[1]:=-d/2;            y[1]:=0;                Rt[1]:=0;
  792.         x[2]:=-a/2;            y[2]:=h1;            Rt[2]:=0;
  793.         x[3]:=-p1;            y[3]:=h1+q1;        Rt[3]:=r;
  794.         IF View = 2 THEN
  795.         BEGIN
  796.             nPoints:=10;
  797.             x[4]:=-j/2;            y[4]:=h1+q2;        Rt[4]:=0;
  798.             x[5]:=-j/2;            y[5]:=h-t;            Rt[5]:=0;
  799.             x[6]:=j/2;            y[6]:=h-t;            Rt[6]:=0;
  800.             x[7]:=j/2;            y[7]:=h1+q2;        Rt[7]:=0;
  801.             x[8]:=p1;            y[8]:=h1+q1;        Rt[8]:=r;
  802.             x[9]:=a/2;            y[9]:=h1;            Rt[9]:=0;
  803.             x[10]:=d/2;            y[10]:=0;            Rt[10]:=0;
  804.         END ELSE
  805.         BEGIN
  806.             nPoints:=6;
  807.             x[4]:=p1;            y[4]:=h1+q1;        Rt[4]:=r;
  808.             x[5]:=a/2;            y[5]:=h1;            Rt[5]:=0;
  809.             x[6]:=d/2;            y[6]:=0;                Rt[6]:=0;
  810.         END;
  811.  
  812.         y0:=y0-h1;
  813.         ClosePoly;
  814.         Absolute;
  815.         BeginPoly;
  816.             FOR k:=1 TO nPoints DO
  817.             BEGIN
  818.                 xt[k]:=x0+x[k];    yt[k]:=y0+y[k];
  819.                 DrawPolyPoint(xt[k],yt[k],Rt[k]);
  820.             END;
  821.         EndPoly;
  822.  
  823.         Absolute;
  824.         MoveTo(x0-a/2,y0+h1);
  825.         Relative;
  826.         IF View = 2 THEN
  827.         BEGIN
  828.             LineTo((a-j)/2, 0);
  829.             MoveTo(j, 0);
  830.             LineTo((a-j)/2, 0);
  831.         END ELSE
  832.             LineTo(a, 0);
  833.  
  834.     END    {of Oval Countersunk Head}
  835.  
  836. {
  837. Hex and Hex Washer Heads.
  838. }
  839.  
  840.     ELSE IF (Type = 4) OR (Type = 5) OR (Type = 11) OR (Type = 12) THEN BEGIN
  841.         
  842.         ch:=(w-a)*Tan(Pi/6)/2;
  843.         p1:=(w+f)/4;
  844.         IF (Type = 4) AND (NOT Inch) THEN BEGIN
  845.             c:=k2*(h+u);
  846.             u:=u-ch;
  847.             h:=h+ch;
  848.         END ELSE
  849.             c:=u;
  850.  
  851.         IF View = 3 THEN BEGIN
  852.             Absolute;
  853.             MoveTo(x0-a/2, y0+u);
  854.             Relative;
  855.             IF Inch THEN ClosePoly
  856.             ELSE OpenPoly;
  857.             Poly(0,0, 0,h, a,0, 0,-h);
  858.  
  859.             Move(-a, (h-ch));
  860.             OpenPoly;
  861.             BeginPoly;
  862.                 LineTo(0, 0);
  863.                 CurveThrough(a/4, ch);
  864.                 LineTo(a/4, -ch);
  865.                 CurveThrough(a/4, ch);
  866.                 LineTo(a/4, -ch);
  867.             EndPoly;
  868.  
  869.             Move(-a/2, 0);
  870.             LineTo(0, -(h-ch));
  871.  
  872.             IF (Type = 4) AND (NOT Inch) THEN
  873.             BEGIN    
  874.                 Absolute;
  875.                 MoveTo(x0-b/2, y0+c);
  876.                 Relative;
  877.                 OpenPoly;
  878.                 BeginPoly;    
  879.                     LineTo(0,0);
  880.                     LineTo((b-a)/2, (u-c));
  881.                     CurveThrough(a/4, ch);
  882.                     LineTo(a/4, -ch);
  883.                     CurveThrough(a/4, ch);
  884.                     LineTo(a/4, -ch);
  885.                     LineTo((b-a)/2, -(u-c));
  886.                 EndPoly;
  887.             END;
  888.             GOTO 10;
  889.         END;
  890.  
  891.         Absolute;
  892.         MoveTo(x0-w/2, y0+u);
  893.         Relative;
  894.         IF Inch THEN ClosePoly
  895.         ELSE OpenPoly;
  896.         BeginPoly;
  897.             LineTo(0, 0);
  898.             LineTo(0, (h-ch));
  899.             LineTo((w-a)/2, ch);
  900.             IF (Type = 5) OR (Type = 12) THEN
  901.             BEGIN
  902.                 LineTo((a-j)/2, 0);
  903.                 LineTo(0, -t);
  904.                 LineTo(j, 0);
  905.                 LineTo(0, t);
  906.                 LineTo((a-j)/2, 0);
  907.             END ELSE
  908.                 LineTo(a, 0);
  909.             LineTo((w-a)/2, -ch);
  910.             LineTo(0,- (h-ch));
  911.         EndPoly;
  912.  
  913.         Absolute;
  914.         MoveTo(x0-w/2, y0+u+(h-ch));
  915.         Relative;
  916.         OpenPoly;
  917.         IF (Type = 5) OR (Type = 12) THEN
  918.         BEGIN
  919.             BeginPoly;
  920.                 LineTo(0, 0);
  921.                 CurveThrough((w/2-p1), ch);
  922.                 LineTo((p1-f/2), -ch);
  923.                 CurveThrough(f/6, 2*ch/3);
  924.                 LineTo((f/3 - j/2), ch/3);
  925.             EndPoly;
  926.  
  927.             Move(j, 0);
  928.             BeginPoly;
  929.                 LineTo(0, 0);
  930.                 CurveThrough((f/3 - j/2), -ch/3);
  931.                 LineTo(f/6, -2*ch/3);
  932.                 CurveThrough((p1-f/2), ch);
  933.                 LineTo((w/2-p1), -ch);
  934.             EndPoly;
  935.         END ELSE
  936.         BEGIN
  937.             BeginPoly;
  938.                 LineTo(0, 0);
  939.                 CurveThrough((w/2-p1), ch);
  940.                 LineTo((p1-f/2), -ch);
  941.                 CurveThrough(f/2, ch);
  942.                 LineTo(f/2, -ch);
  943.                 CurveThrough((p1-f/2), ch);
  944.                 LineTo((w/2-p1), -ch);
  945.             EndPoly;
  946.         END;
  947.  
  948.         Absolute;
  949.         MoveTo(x0+f/2, y0+u);
  950.         Relative;
  951.         LineTo(0, (h-ch));
  952.         Move(-f, 0);
  953.         LineTo(0, -(h-ch));
  954.  
  955.         IF (Type = 4) AND (NOT Inch) THEN
  956.         BEGIN    
  957.             Absolute;
  958.             MoveTo(x0-b/2, y0+c);
  959.             Relative;
  960.             OpenPoly;
  961.             BeginPoly;    
  962.                 LineTo(0,0);
  963.                 LineTo((b-w)/2, (u-c));
  964.                 CurveThrough((w/2-p1), ch);
  965.                 LineTo((p1-f/2), -ch);
  966.                 CurveThrough(f/2, ch);
  967.                 LineTo(f/2, -ch);
  968.                 CurveThrough((p1-f/2), ch);
  969.                 LineTo((w/2-p1), -ch);
  970.                 LineTo((b-w)/2, -(u-c));
  971.             EndPoly;
  972.         END;
  973.  
  974.         10:IF (Type = 4)  OR (Type =5) THEN
  975.         BEGIN
  976.             Absolute;
  977.             MoveTo(x0-b/2, y0);
  978.             Relative;
  979.             Rect(0,0,b,c);
  980.         END;
  981.  
  982.     END {of Hex and Hex Washer Heads}
  983.  
  984. {
  985. Truss Head & Fillister Head.
  986. }
  987.  
  988.     ELSE IF (Type = 6) OR (Type = 9) THEN
  989.     BEGIN
  990.  
  991.         IF View = 3 THEN
  992.             j:=0;
  993.         Beta1:=ArcCos(a/(2*r));
  994.         Beta2:=ArcSin(j/(2*r));
  995.         Alpha:=Pi/2 - (Beta1+Beta2);
  996.         p1:=r*Sin(Beta2 + Alpha/2)/Cos(Alpha/2);
  997.         q1:=r*Cos(Beta2 + Alpha/2)/Cos(Alpha/2) - r*Sin(Beta1);
  998.         q2:=r*(Cos(Beta2)-Sin(Beta1));
  999.  
  1000.         x[1]:=-a/2;            y[1]:=-0;            Rt[1]:=0;
  1001.         x[2]:=-a/2;            y[2]:=s;            Rt[2]:=0;
  1002.         x[3]:=-p1;            y[3]:=s+q1;        Rt[3]:=r;
  1003.  
  1004.         IF View = 2 THEN
  1005.         BEGIN
  1006.             nPoints:=10;
  1007.             x[4]:=-j/2;            y[4]:=s+q2;            Rt[4]:=0;
  1008.             x[5]:=-j/2;            y[5]:=h-t;            Rt[5]:=0;
  1009.             x[6]:=j/2;            y[6]:=h-t;            Rt[6]:=0;
  1010.             x[7]:=j/2;            y[7]:=s+q2;            Rt[7]:=0;
  1011.             x[8]:=p1;            y[8]:=s+q1;            Rt[8]:=r;
  1012.             x[9]:=a/2;            y[9]:=s;                Rt[9]:=0;
  1013.             x[10]:=a/2;            y[10]:=0;            Rt[10]:=0;
  1014.         END ELSE
  1015.         BEGIN
  1016.             nPoints:=6;
  1017.             x[4]:=p1;            y[4]:=s+q1;            Rt[4]:=r;
  1018.             x[5]:=a/2;            y[5]:=s;                Rt[5]:=0;
  1019.             x[6]:=a/2;            y[6]:=0;                Rt[6]:=0;
  1020.         END;
  1021.  
  1022.         ClosePoly;
  1023.         Absolute;
  1024.         BeginPoly;
  1025.             FOR k:=1 TO nPoints DO
  1026.             BEGIN
  1027.                 xt[k]:=x0+x[k];    yt[k]:=y0+y[k];
  1028.                 DrawPolyPoint(xt[k],yt[k],Rt[k]);
  1029.             END;
  1030.         EndPoly;
  1031.  
  1032.         MoveTo(x0-a/2,y0+s);
  1033.         Relative;
  1034.         IF Type = 9 THEN
  1035.         BEGIN
  1036.             LineTo((a-j)/2,0);
  1037.             MoveTo(j,0);
  1038.             LineTo((a-j)/2,0);
  1039.         END ELSE
  1040.             LineTo(a,0);
  1041.  
  1042.     END    {of Truss Head & Fillister Head}
  1043.  
  1044. {
  1045. Binding Head.
  1046. }
  1047.  
  1048.     ELSE IF TYPE = 7 THEN
  1049.     BEGIN
  1050.  
  1051.         IF View = 3 THEN
  1052.             j:=0;
  1053.         Beta1:=ArcCos(b/(2*r));
  1054.         Beta2:=ArcSin(j/(2*r));
  1055.         Alpha:=Pi/2 - (Beta1+Beta2);
  1056.         p1:=r*Sin(Beta2 + Alpha/2)/Cos(Alpha/2);
  1057.         q1:=r*Cos(Beta2 + Alpha/2)/Cos(Alpha/2) - r*Sin(Beta1);
  1058.         q2:=r*(Cos(Beta2)-Sin(Beta1));
  1059.  
  1060.         x[1]:=-a/2;            y[1]:=-0;            Rt[1]:=0;
  1061.         x[2]:=-b/2;            y[2]:=h1;            Rt[2]:=0;
  1062.         x[3]:=-p1;            y[3]:=h1+q1;        Rt[3]:=r;
  1063.  
  1064.         IF View = 2 THEN
  1065.         BEGIN
  1066.             nPoints:=10;
  1067.             x[4]:=-j/2;            y[4]:=h1+q2;        Rt[4]:=0;
  1068.             x[5]:=-j/2;            y[5]:=h-t;            Rt[5]:=0;
  1069.             x[6]:=j/2;            y[6]:=h-t;            Rt[6]:=0;
  1070.             x[7]:=j/2;            y[7]:=h1+q2;        Rt[7]:=0;
  1071.             x[8]:=p1;            y[8]:=h1+q1;        Rt[8]:=r;
  1072.             x[9]:=b/2;            y[9]:=h1;            Rt[9]:=0;
  1073.             x[10]:=a/2;            y[10]:=0;            Rt[10]:=0;
  1074.         END ELSE
  1075.         BEGIN
  1076.             nPoints:=6;
  1077.             x[4]:=p1;            y[4]:=h1+q1;        Rt[4]:=r;
  1078.             x[5]:=b/2;            y[5]:=h1;            Rt[5]:=0;
  1079.             x[6]:=a/2;            y[6]:=0;            Rt[6]:=0;
  1080.         END;
  1081.  
  1082.         ClosePoly;
  1083.         Absolute;
  1084.         BeginPoly;
  1085.             FOR k:=1 TO nPoints DO
  1086.             BEGIN
  1087.                 xt[k]:=x0+x[k];    yt[k]:=y0+y[k];
  1088.                 DrawPolyPoint(xt[k],yt[k],Rt[k]);
  1089.             END;
  1090.         EndPoly;
  1091.  
  1092.         Absolute;
  1093.         MoveTo(x0-b/2,y0+h1);
  1094.         Relative;
  1095.         LineTo((b-j)/2,0);
  1096.         MoveTo(j,0);
  1097.         LineTo((b-j)/2,0);
  1098.  
  1099.     END    {of Binding Head}
  1100.  
  1101. {
  1102. Pan Head.
  1103. }
  1104.  
  1105.     ELSE IF TYPE = 8 THEN
  1106.     BEGIN
  1107.  
  1108.         x[1]:=-a/2;        y[1]:=0;            Rt[1]:=0;
  1109.         x[2]:=-a/2;        y[2]:=h;            Rt[2]:=r;
  1110.  
  1111.         IF View = 2 THEN
  1112.         BEGIN
  1113.             nPoints:=8;
  1114.             x[3]:=-j/2;        y[3]:=h;            Rt[3]:=0;
  1115.             x[4]:=-j/2;        y[4]:=h-t;        Rt[4]:=0;
  1116.             x[5]:=j/2;        y[5]:=h-t;        Rt[5]:=0;
  1117.             x[6]:=j/2;        y[6]:=h;            Rt[6]:=0;
  1118.             x[7]:=a/2;        y[7]:=h;            Rt[7]:=r;
  1119.             x[8]:=a/2;        y[8]:=0;            Rt[8]:=0;
  1120.         END ELSE
  1121.         BEGIN
  1122.             nPoints:=4;
  1123.             x[3]:=a/2;        y[3]:=h;            Rt[3]:=r;
  1124.             x[4]:=a/2;        y[4]:=0;            Rt[4]:=0;
  1125.         END;
  1126.  
  1127.         ClosePoly;
  1128.         Absolute;
  1129.         BeginPoly;
  1130.             FOR k:=1 TO nPoints DO
  1131.             BEGIN
  1132.                 xt[k]:=x0+x[k];    yt[k]:=y0+y[k];
  1133.                 DrawPolyPoint(xt[k],yt[k],Rt[k]);
  1134.             END;
  1135.         EndPoly;
  1136.     END    {of Pan Head}
  1137.  
  1138. {
  1139. Round Head.
  1140. }
  1141.  
  1142.     ELSE IF Type = 10 THEN
  1143.     BEGIN
  1144.         q1:=0.9*h;
  1145.         
  1146.         Absolute;
  1147.         MoveTo(x0-a/2, y0);
  1148.         Relative;
  1149.         ClosePoly;
  1150.         BeginPoly;
  1151.             LineTo(0, 0);
  1152.             CurveTo(0, q1);
  1153.             IF View = 2 THEN
  1154.             BEGIN
  1155.                 LineTo((a-j)/2, (h-q1));
  1156.                 LineTo(0, -t);
  1157.                 LineTo(j, 0);
  1158.                 LineTo(0, t);
  1159.                 CurveTo((a-j)/2, -(h-q1));
  1160.             END ELSE
  1161.                 CurveTo(a, 0);
  1162.             LineTo(0, -q1);
  1163.         EndPoly;
  1164.     END;    {of Round Head}
  1165.  
  1166. END;
  1167.  
  1168. Procedure DrawThdType1;
  1169. {
  1170. This procedure draws Type 1 threads (dashed lines).
  1171. }
  1172.  
  1173. VAR
  1174.     ch,pd : REAL;
  1175.     
  1176. BEGIN
  1177.     ch:=(d-di)*Tan(PI/4)/2;
  1178.     pd:=d - td;
  1179.  
  1180.     {Absolute;
  1181.     MoveTo(x0-pd/2, y0);
  1182.     Relative;
  1183.     Rect(0,0,pd,-(L-TL));}
  1184.  
  1185.     Absolute;
  1186.     MoveTo((x0-pd/2), y0-(L-TL));
  1187.     Relative;
  1188.     ClosePoly;
  1189.     BeginPoly;
  1190.         LineTo(0, 0);
  1191.         ArcTo(0, (L-TL), rf);
  1192.         LineTo(-rf, 0);
  1193.         LineTo((pd+2*rf), 0);
  1194.         ArcTo(-rf, 0, rf);
  1195.         LineTo(0, -(L-TL));
  1196.     EndPoly;
  1197.  
  1198.     Absolute;
  1199.     MoveTo(x0-d/2, y0-(L-TL));
  1200.     Relative;
  1201.     ClosePoly;
  1202.     Poly(0,0, 0,-(TL-ch), td,-ch, di,0, td,ch, 0,(TL-ch));
  1203.     Move(0,-(TL-ch));
  1204.     LineTo(-d,0);
  1205.  
  1206.     Move(td,-ch);
  1207.     PenPat(-2);
  1208.     Line(0,TL);
  1209.     Move(di,0);
  1210.     Line(0,-TL);
  1211.  
  1212. END;
  1213.  
  1214. Procedure DrawThdType2;
  1215. {
  1216. This procedure draws non-detailed threads using solid lines.
  1217. }
  1218. LABEL 10;
  1219.  
  1220. VAR
  1221.     ch,pd : REAL;
  1222.     k,k2 : INTEGER;
  1223.     
  1224. BEGIN
  1225.     ch:=(d-di)*Tan(PI/4)/2;
  1226.     pd:=d - td;
  1227.     nThreads:=(TL - ch)/p;
  1228.     p:=(TL - ch)/nThreads;
  1229.  
  1230. {
  1231. Draw body.
  1232. }
  1233.  
  1234.     Absolute;
  1235.     MoveTo((x0-pd/2), y0-(L-TL));
  1236.     Relative;
  1237.     ClosePoly;
  1238.     BeginPoly;
  1239.         LineTo(0, 0);
  1240.         ArcTo(0, (L-TL), rf);
  1241.         LineTo(-rf, 0);
  1242.         LineTo((pd+2*rf), 0);
  1243.         ArcTo(-rf, 0, rf);
  1244.         LineTo(0, -(L-TL));
  1245.     EndPoly;
  1246.  
  1247.     Absolute;
  1248.     MoveTo(x0-d/2, y0-(L-TL));
  1249.     Relative;
  1250.     ClosePoly;
  1251.     Poly(0,0, 0,-(TL-ch), td,-ch, di,0, td,ch, 0,(TL-ch));
  1252.     Move(0,-(TL-ch));
  1253.     LineTo(-d,0);
  1254.  
  1255. {
  1256. Draw threads.
  1257. }
  1258.  
  1259.     Absolute;
  1260.     MoveTo(x0-d/2, y0-L+ch+p);
  1261.     Relative;
  1262.     FOR k:=1 TO nThreads-1 DO
  1263.     BEGIN
  1264.         LineTo(d, 0);
  1265.         Move(-d, p);
  1266.     END;
  1267.  
  1268.     PenSize(1.5*FPenSize);
  1269.     Absolute;
  1270.     MoveTo(x0-di/2, y0-L+ch+p/2);
  1271.     Relative;
  1272.     FOR k:=1 TO nThreads DO
  1273.     BEGIN
  1274.         LineTo(di, 0);
  1275.         Move(-di, p);
  1276.     END;
  1277.  
  1278. END;
  1279.  
  1280. Procedure DrawThdType3;
  1281. {
  1282. This procedure draws Type 3 threads (detailed).
  1283. }
  1284.  
  1285. CONST
  1286.     k1 = 0.75;
  1287.     k2 = 0.50;
  1288.  
  1289. VAR
  1290.     q1,q2 : REAL;
  1291.  
  1292. BEGIN
  1293.  
  1294. {
  1295. Draw bottom thread.
  1296. }
  1297.  
  1298.     Absolute;
  1299.     MoveTo(x0-d/2, y0-L);
  1300.     Relative;
  1301.     ClosePoly;
  1302.     Poly(0,0, d,p/2, -td,-p/2);
  1303.  
  1304. {
  1305. Draw whole threads.
  1306. }
  1307.  
  1308.     Absolute;
  1309.     MoveTo(x0-d/2, y0-L);
  1310.     Relative;
  1311.     ClosePoly;
  1312.     FOR i:=1 TO nThreads DO BEGIN
  1313.         Poly(0,0, d,p/2, -td,p/2, -di,-p/2);
  1314.         Poly(0,0, di,p/2, td,p/2, -d,-p/2);
  1315.     END;
  1316.  
  1317. {
  1318. Draw last thread and shoulder.
  1319. }
  1320.  
  1321.     q1:=L - (p*(nThreads + 1/2) + k1*p/2 + (k1-k2)*p/2);
  1322.     q2:=L - (p*(nThreads + 1/2) + k2*p/2);
  1323.  
  1324.     ClosePoly;
  1325.     BeginPoly;
  1326.         LineTo(0, 0);
  1327.         LineTo(td, p/2);
  1328.         LineTo(-k1*td, k1*p/2);
  1329.         LineTo((k1-k2)*td, (k1-k2)*p/2);
  1330.         ArcTo(0, q1, rf);
  1331.         LineTo(-rf, 0);
  1332.         LineTo((d - 2*k2*td + 2*rf), 0);
  1333.         ArcTo(-rf, 0, rf);
  1334.         LineTo(0, -q2);
  1335.         LineTo(k2*td, -k2*p/2);
  1336.     EndPoly;
  1337.  
  1338.     Move(-(di+td),0);
  1339.     LineTo(k1*di,k1*p/2);
  1340.     LineTo(-k1*(di+td),0);
  1341.  
  1342. END;
  1343.  
  1344. BEGIN
  1345. {
  1346. Main Program.
  1347. }
  1348.  
  1349.     DselectAll;
  1350.     PushAttrs;
  1351.  
  1352. {
  1353. Display the main dialog box, get the information and read the data file.
  1354. }
  1355.  
  1356.     MachScrDialogs;
  1357.     SetCursor(ArrowC);
  1358.     FirstTime:=TRUE;
  1359.     GetInfo;
  1360.     IF Abort THEN GOTO 99;
  1361.     IF UNC THEN
  1362.         tpi:=tpic
  1363.     ELSE
  1364.         tpi:=tpif;
  1365.  
  1366. {
  1367. Get the location of the screw.
  1368. }
  1369.  
  1370.     GetPt(x0,y0);
  1371.  
  1372. {
  1373. Get drawing units and adjust parameters accordingly.
  1374. }
  1375.  
  1376.     GetUnits(UName,DA,Fmt,UPI,UM,UM2);
  1377.     IF Inch = TRUE THEN
  1378.         SF:=UPI
  1379.     ELSE
  1380.         SF:=UPI/25.4;
  1381.  
  1382.     d:=d*SF;
  1383.     L:=L*SF;
  1384.     a:=a*SF;
  1385.     b:=b*SF;
  1386.     f:=f*SF;
  1387.     j:=j*SF;
  1388.     h:=h*SF;
  1389.     t:=t*SF;
  1390.     u:=u*SF;
  1391.     tpi:=tpi/SF;
  1392.  
  1393. {
  1394. Calculate the variables needed to draw the screw.
  1395. }
  1396.  
  1397.     IF (Type = 1) OR (Type = 2) THEN BEGIN
  1398.         IF Type = 1 THEN
  1399.         BEGIN
  1400.             IF Inch THEN
  1401.                 Theta:=Deg2Rad(82)
  1402.             ELSE
  1403.                 Theta:=PI/2;
  1404.         END ELSE
  1405.             Theta:=Deg2Rad(100);
  1406.         h:=(a-d)/(2*Tan(Theta/2));
  1407.         L:=L-h;
  1408.         TL:=TL-h;
  1409.     END
  1410.  
  1411.     ELSE IF Type = 3 THEN
  1412.     BEGIN
  1413.         IF Inch THEN Theta:=Deg2Rad(82)
  1414.         ELSE Theta:=PI/2;
  1415.         h1:=(a-d)/(2*Tan(Theta/2));
  1416.         h2:=h-h1;
  1417.         r:=((a/2)^2 + h2^2)/(2*h2);
  1418.         L:=L-h1;
  1419.         TL:=TL-h1;
  1420.     END
  1421.  
  1422.     ELSE IF (Type = 4) OR (Type = 5) OR (Type = 11) OR (Type = 12) THEN
  1423.     BEGIN
  1424.         w:=a/Cos(Pi/6);
  1425.         f:=a*Tan(Pi/6);
  1426.          IF (Type = 11) OR (Type = 12) THEN
  1427.             u:=0;
  1428.     END
  1429.  
  1430.     ELSE IF Type = 6 THEN
  1431.     BEGIN
  1432.         IF 4*r^2 >= a^2 THEN
  1433.             h1:=(2*r - Sqrt(4*r^2 - a^2))/2
  1434.         ELSE
  1435.             h1:=h;
  1436.         s:=h-h1;
  1437.     END
  1438.  
  1439.     ELSE IF TYPE = 7 THEN
  1440.     BEGIN
  1441.         h1:=h-f;
  1442.         b:=a - 2*h1*Tan(Deg2Rad(5));
  1443.         r:=((b/2)^2 + f^2)/(2*f);
  1444.     END
  1445.  
  1446.     ELSE IF Type = 9 THEN
  1447.     BEGIN
  1448.         h1:=h-s;
  1449.         r:=((a/2)^2 + h1^2)/(2*h1);
  1450.     END;
  1451.  
  1452.     p:=1/tpi;
  1453.     td:=0.86603/tpi;
  1454.     di:=d-2*td;
  1455.     rf:=td/2;
  1456.  
  1457.     IF Inch THEN
  1458.         TL:=ThdLgthI(d,L,p)
  1459.     ELSE
  1460.         TL:=ThdLgthM(d,L,p);
  1461.     nThreads:=TL*tpi-1;
  1462.     IF (nThreads + 1/4)*p > L THEN
  1463.         nThreads:=nThreads-1;
  1464.  
  1465. {
  1466. Draw top view
  1467. }
  1468.  
  1469.     IF View = 1 THEN
  1470.     BEGIN
  1471.         DrawTopView(Type);
  1472.         GOTO 90;
  1473.     END;
  1474.  
  1475. {
  1476. Draw side view.
  1477. }
  1478.  
  1479.     DrawSideViewOfHead(Type);
  1480.  
  1481. {
  1482. Draw the threads.
  1483. }
  1484.  
  1485.     IF L <= 0 THEN GOTO 90;
  1486.     IF ThdType = 1 THEN
  1487.          DrawThdType1
  1488.     ELSE IF ThdType = 2 THEN
  1489.          DrawThdType2
  1490.     ELSE
  1491.          DrawThdType3;
  1492.  
  1493.     90:Group;
  1494.     PopAttrs;
  1495.  
  1496. 99:END;
  1497.  
  1498. RUN(MachineScrews);
  1499.