home *** CD-ROM | disk | FTP | other *** search
/ Chip 1998 March / Chip_1998-03_cd.bin / tema / MINICAD / MC7DEMO / MINICAD.1 / HEX_BOLT.MPC < prev    next >
Text File  |  1997-04-30  |  16KB  |  927 lines
  1. Procedure HexBolts;
  2. {
  3. (c)1996, Diehl Graphsoft, Inc.
  4. Developed by Tom Urie
  5.  
  6. This procedure draws various types of hex and square bolts.
  7. }
  8. LABEL 10,90,99;
  9.  
  10. CONST
  11.     Alpha1 = 25;    {Chamfer angle of head for square bolts}
  12.     Alpha2 = 30;    {Chamfer angle of head for hex bolts}
  13.     nDataFiles = 6;
  14.  
  15. VAR
  16.     a,ch,d,di,f,g,h,h1,L,TL,p,r,s,t,td : REAL;
  17.     tpi,tpic,tpif,x0,y0 : REAL;
  18.  
  19.     PathLength : INTEGER;
  20.     i,nThreads,Type,ThdType,View : INTEGER;
  21.  
  22.     Size,Sz,Size1,Pathname : STRING;
  23.     SizeNotFound,Abort,Inch,UNC : BOOLEAN;
  24.  
  25.     SF,UPI : REAL;
  26.     Fmt : INTEGER;
  27.     UM,UM2 : STRING;
  28.     UName,DA : LONGINT;
  29.  
  30. Procedure HexBoltDialog;
  31. VAR
  32.     Width,x1,y1,x2,y2,px1,px2,px3,px4,py1,py2,py3,py4 : INTEGER;
  33.  
  34. Procedure AlignScr(Width:INTEGER; VAR x1,x2:INTEGER);
  35. VAR
  36.     scrx1,scry1,scrx2,scry2:INTEGER;
  37. BEGIN
  38.     GetScreen(scrx1,scry1,scrx2,scry2);
  39.     x1:=((scrx1+scrx2) div 2)-(Width div 2);
  40.     x2:=x1+Width; 
  41. END;
  42.  
  43. Procedure LocateButtons(DialogType,scnh,scnw : INTEGER);
  44. {
  45. This procedure locates the 'OK' and 'Cancel' buttons.
  46. }
  47. VAR
  48.     v1,v2,v3,v4 : INTEGER;
  49.     Mac : BOOLEAN;
  50.  
  51. Procedure Swap(VAR  m1,m2,m3,m4 : INTEGER);
  52. VAR
  53.     Temp : INTEGER;
  54. BEGIN
  55.     Temp:=m1;
  56.     m1:=m3;
  57.     m3:=Temp;
  58.     Temp:=m2;
  59.     m2:=m4;
  60.     m4:=Temp;
  61. END;        {of Swap}
  62.  
  63. BEGIN
  64.     Mac:=FALSE;
  65.     PathName:='External\Data\';
  66.     GetVersion(v1,v2,v3,v4);
  67.     IF v4 = 1 THEN
  68.     BEGIN
  69.         Mac:=TRUE;
  70.         PathName:=':Externals:External Data:';
  71.     END;
  72.  
  73.     IF DialogType = 1 THEN
  74.     BEGIN
  75.         px1:=(scnw DIV 2) - 80;
  76.         px2:=(scnw DIV 2) - 10;
  77.         px3:=(scnw DIV 2) + 10;
  78.         px4:=(scnw DIV 2) + 80;
  79.         IF Mac THEN SWAP(px1,px2,px3,px4);
  80.  
  81.         py1:=scnh-40;
  82.         py2:=scnh-20;
  83.         py3:=py1;
  84.         py4:=py2;
  85.     END ELSE IF DialogType = 2 THEN
  86.     BEGIN
  87.         px1:=scnw - 180;
  88.         px2:=scnw - 110;
  89.         px3:=scnw - 90;
  90.         px4:=scnw - 20;
  91.         IF Mac THEN SWAP(px1,px2,px3,px4);
  92.  
  93.         py1:=scnh-40;
  94.         py2:=scnh-20;
  95.         py3:=py1;
  96.         py4:=py2;
  97.     END ELSE
  98.     BEGIN
  99.         px1:=scnw - 90;
  100.         px2:=scnw - 20;
  101.         px3:=px1;
  102.         px4:=px2;
  103.  
  104.         py1:=scnh -70;
  105.         py2:=scnh - 50;
  106.         py3:=scnh - 40;
  107.         py4:=scnh - 20;
  108.         IF Mac THEN SWAP(py1,py2,py3,py4);
  109.     END;
  110. END;        {of Locate Buttons}
  111.  
  112. Procedure MakeDialog;
  113. {
  114. This procedure creates the main dialog box.
  115. }
  116. CONST
  117.     y1=100;
  118.     scnh=380;
  119.     scnw=300;
  120.     DialogType = 2;
  121. VAR
  122.     h : INTEGER;
  123.  
  124. BEGIN
  125.     AlignScr(scnw,x1,x2);
  126.     y2:=y1+scnh;
  127.  
  128.     LocateButtons(DialogType,scnh,scnw );
  129.  
  130.     BeginDialog(1,1,x1,y1,x2,y2);
  131.         AddButton('OK',1,1,px1,py1,px2,py2);
  132.         AddButton('Cancel',2,1,px3,py3,px4,py4);
  133.  
  134.         h:=10;
  135.         AddField('Type of Bolt:',4,1,20,h+19,145,h+35);
  136.         AddButton('Hex Bolt',6,3,20,h+40,200,h+55);
  137.         AddButton('Heavy Hex Bolt',7,3,20,h+60,200,h+75);
  138.         AddButton('Hex Cap Screw (Finished Hex Bolt)',8,3,20,h+80,250,h+95);
  139.         AddButton('Heavy Hex Structural Bolt',9,3,20,h+100,200,h+115);
  140.         AddButton('Heavy Hex Screw',10,3,20,h+120,200,h+135);
  141.         AddButton('Square Bolt',5,3,20,h+140,120,h+155);
  142.         AddField('',50,1,125,h+139,170,h+155);
  143.  
  144.         h:=5;
  145.         AddField('Series:',19,1,20,h-1,65,h+15);
  146.         AddButton('Inch',20,3,70,h,120,h+15);
  147.         AddButton('Metric',21,3,125,h,190,h+15);
  148.  
  149.         h:=185;
  150.         AddField('Size:',22,1,20,h-1,75,h+15);
  151.         AddField('',23,2,80,h,145,h+15);
  152.         AddField('in',26,1,153,h-1,175,h+15);
  153.  
  154.         AddField('Length:',24,1,20,h+24,75,h+40);
  155.         AddField('',25,2,80,h+25,145,h+40);
  156.         AddField('in',27,1,153,h+24,175,h+40);
  157.  
  158.         h:=240;
  159.         AddField('View:',28,1,220,h-1,255,h+15);
  160.         AddButton('Top',29,3,220,h+40,275,h+55);
  161.         AddButton('Front',30,3,220,h+20,275,h+35);
  162.         AddButton('Side',31,3,220,h+60,275,h+75);
  163.  
  164.         h:=240;
  165.         AddField('Threads:',34,1,20,h-1,75,h+15);
  166.         AddButton('UNC',35,3,80,h,140,h+15);
  167.         AddButton('UNF',36,3,145,h,205,h+15);
  168.  
  169.         AddButton('Type 1 (dotted lines)',37,3,20,h+20,200,h+35);
  170.         AddButton('Type 2 (solid lines)',38,3,20,h+40,200,h+55);
  171.         AddButton('Type 3 (detailed threads)',39,3,20,h+60,190,h+75);
  172.  
  173.     EndDialog;
  174. END;
  175.  
  176. BEGIN
  177.     MakeDialog;
  178. END;
  179.  
  180. Function GetFilename(Type:INTEGER) : STRING;
  181. {
  182. This procedure assigns filenames to the variable Filename.
  183. }
  184.  
  185. VAR
  186.     k : INTEGER;
  187.     Filename : ARRAY[1..2,1..nDataFiles] OF STRING;
  188.  
  189. BEGIN
  190.     Filename[1,1]:='SqBoltE.txt';
  191.     Filename[1,2]:='HxBolt1E.txt';
  192.     Filename[1,3]:='HxBolt2E.txt';
  193.     Filename[1,4]:='HxBolt3E.txt';
  194.     Filename[1,5]:='HxBolt4E.txt';
  195.     Filename[1,6]:='HxBolt5E.txt';
  196.  
  197.     Filename[2,2]:='HxBolt1M.txt';
  198.     Filename[2,3]:='HxBolt2M.txt';
  199.     Filename[2,4]:='HxBolt3M.txt';
  200.     Filename[2,5]:='HxBolt4M.txt';
  201.     Filename[2,6]:='HxBolt5M.txt';
  202.     
  203.     IF Inch THEN k:=1
  204.     ELSE k:=2;
  205.     GetFilename:=Filename[k,Type];
  206.  
  207. END;
  208.  
  209. Procedure GetData;
  210. {
  211. This procedure opens the data file and retreives the data.
  212. }
  213. LABEL 10,99;
  214.  
  215. VAR
  216.     File,Filename,WarningStr : STRING;
  217.  
  218. BEGIN
  219.     File:=GetFilename(Type);
  220.     Filename:=Concat(Pathname,File);
  221.     Open(Filename);
  222.  
  223.     IF FndError THEN BEGIN
  224.         ClrDialog;
  225.         Sysbeep;
  226.         WarningStr:=Concat('The data file <',File,'> cannot be found. Check your Toolkit Manual for further explanation.');
  227.         AlrtDialog(WarningStr);
  228.         Abort:=TRUE;
  229.         GoTo 99;
  230.     END;
  231.  
  232.     SizeNotFound:=FALSE;
  233.     WHILE NOT Eoln(Filename) DO
  234.     BEGIN
  235.         ReadLn(Sz,d,tpic,tpif,a,h,r,s);
  236.         IF Sz = Size THEN GOTO 10;
  237.     END;
  238.  
  239.     Close(Filename);
  240.     SysBeep;
  241.     AlrtDialog('That size is not available!');
  242.     SizeNotFound:=TRUE;
  243.     GoTo 99;
  244.  
  245.     10:Close(Filename);
  246.  
  247. 99:END;
  248.  
  249. Procedure GetInfo;
  250. {
  251. This procedure displays the main dialog box and retreives the information input by the user.
  252. }
  253. LABEL 10,20,99;
  254.  
  255. VAR
  256.     Done:Boolean;
  257.     Item:Integer;
  258.     RFlag : ARRAY [1..5] OF INTEGER;
  259.  
  260. Procedure SetRButton(i,Item : INTEGER);
  261. BEGIN
  262.     IF RFlag[i] <> Item THEN BEGIN
  263.         SetItem(RFlag[i],FALSE);
  264.         SetItem(Item,TRUE);
  265.         RFlag[i]:=Item;
  266.     END;
  267. END;
  268.  
  269. BEGIN
  270.     Done:=FALSE;
  271.     Abort:=FALSE;
  272.  
  273.     Type:=2;
  274.     View:=2;
  275.     Inch:=TRUE;
  276.     ThdType:=1;
  277.     UNC:=TRUE;
  278.     Size1:='1/2';
  279.     L:=2.000;
  280.  
  281.     RFlag[1]:=Type+4;
  282.     RFlag[2]:=20;
  283.     RFlag[3]:=View+28;
  284.     RFlag[4]:=35;
  285.     RFlag[5]:=ThdType+36;
  286.  
  287.     GetDialog(1);
  288.     SetTitle('Square & Hex Bolts');
  289.     SetItem(RFlag[1],TRUE);
  290.     SetItem(RFlag[2],TRUE);
  291.     SetItem(RFlag[3],TRUE);
  292.     SetItem(RFlag[4],TRUE);
  293.     SetItem(RFlag[5],TRUE);
  294.     SetField(23,Size1);
  295.     SetField(25,Num2Str(3,L));
  296.  
  297.     20:SelField(23);
  298.     REPEAT
  299.         DialogEvent(Item);
  300.  
  301.         IF Item=1 then
  302.             Done:=TRUE;
  303.  
  304.         IF Item=2 THEN
  305.         BEGIN
  306.             Done:=TRUE;
  307.             Abort:=TRUE;
  308.         END;
  309.  
  310.         IF (Item > 4) AND (Item < 17) THEN
  311.         BEGIN
  312.             IF (Item = 5) AND (NOT Inch) THEN
  313.                 Sysbeep
  314.             ELSE BEGIN
  315.                 SetRButton(1,Item);
  316.                 Type:=Item-4;
  317.             END;
  318.         END;
  319.  
  320.         IF (Item = 20) AND (NOT Inch) THEN
  321.         BEGIN
  322.             Inch:=TRUE;
  323.             SetRButton(2,Item);
  324.             SetField(26,'in');
  325.             SetField(27,'in');
  326.         END;
  327.  
  328.         IF (Item = 21) AND (Inch) THEN
  329.         BEGIN
  330.             Inch:=FALSE;
  331.             SetRButton(2,Item);
  332.             SetField(26,'mm');
  333.             SetField(27,'mm');
  334.             SetField(50,'<n/a>');
  335.             IF Type = 1 THEN
  336.             BEGIN
  337.                 Type:=2;
  338.                 SetRButton(1,6);
  339.             END;
  340.         END;
  341.  
  342.         IF (Item > 28) AND (Item < 32) THEN
  343.         BEGIN
  344.             SetRButton(3,Item);
  345.             View:=Item-28;            
  346.         END;
  347.  
  348.         IF (Item = 35) OR (Item = 36) THEN
  349.         BEGIN
  350.             SetRButton(4,Item);
  351.             IF Item = 35 THEN UNC:=TRUE
  352.             ELSE UNC:=FALSE;
  353.         END;
  354.  
  355.         IF (Item > 36) AND (Item < 40) THEN
  356.         BEGIN
  357.             SetRButton(5,Item);
  358.             ThdType:=Item-36;
  359.         END;
  360.  
  361.     UNTIL Done;
  362.  
  363.     IF Abort THEN GOTO 99;
  364.     Size1:=GetField(23);
  365.     Size:=Concat('''',Size1,'''');
  366.     UprString(Size);
  367.     L:=Str2Num(GetField(25));
  368.  
  369.     GetData;
  370.     IF Abort THEN GOTO 99;
  371.     IF SizeNotFound THEN
  372.     BEGIN
  373.         Done:=FALSE;
  374.         GOTO 20;
  375.     END;
  376.  
  377.     99:ClrDialog;
  378. END;
  379.  
  380. Function ThdLgthI(d,L : REAL) : REAL;
  381. {
  382. This procedure determines the length of threads for inch series machine screws.
  383. }
  384.  
  385. BEGIN
  386.     IF L < 2*d + 0.25 THEN
  387.         ThdLgthI:=L
  388.     ELSE IF L < 6 THEN
  389.         ThdLgthI:=2*d + 0.25
  390.     ELSE ThdLgthI:=2*d + 0.5;
  391. END;
  392.  
  393. Function ThdLgthM(d,L,p : REAL) : REAL;
  394. {
  395. This procedure determines the length of threads for mm series machine screws.
  396. }
  397.  
  398. BEGIN
  399.     IF d <= 3 THEN
  400.     BEGIN
  401.         IF L <= 3*d THEN
  402.             ThdLgthM:=L-p
  403.         ELSE IF L < 30 THEN
  404.             ThdLgthM:=L-2*p
  405.         ELSE
  406.             ThdLgthM:=25;
  407.     END ELSE
  408.     BEGIN
  409.         IF L <= 3*d THEN
  410.             ThdLgthM:=L-p
  411.         ELSE IF L < 50 THEN
  412.             ThdLgthM:=L-2*p
  413.         ELSE
  414.             ThdLgthM:=38;
  415.     END;
  416. END;
  417.  
  418. Procedure DrawTopView(Type : INTEGER);
  419. {
  420. This procedure draws the top view.
  421. }
  422.  
  423. BEGIN
  424.     Absolute;
  425.     MoveTo(x0-g/2,y0);
  426.     Relative;
  427.     ClosePoly;
  428.     IF Type = 1 THEN
  429.         Poly(0,0, g/2,g/2, g/2,-g/2, -g/2,-g/2)
  430.     ELSE
  431.         Poly(f,#60, f,#0, f,#-60, f,#-120, f,#180);
  432.     Absolute;
  433.     MoveTo(x0,y0);
  434.     Relative;
  435.     Arc(-a/2,a/2,a/2,-a/2,0,360);
  436. END;
  437.  
  438. Procedure DrawSideViewOfHead(Type : INTEGER);
  439. {
  440. This procedure draws the side view of the head.
  441. }
  442. LABEL 10;
  443.  
  444. VAR
  445.     p1,p2,q1,q2 : REAL;
  446.     k, nPoints : INTEGER;
  447.  
  448. BEGIN
  449.  
  450. {
  451. Square Head.
  452. }
  453.  
  454.     IF Type = 1 THEN
  455.     BEGIN
  456.         p1:=g/4;
  457.         IF View = 3 THEN BEGIN
  458.             Absolute;
  459.             MoveTo(x0-a/2, y0+s);
  460.             Relative;
  461.             ClosePoly;
  462.             Poly(0,0, 0,h, a,0, 0,-h);
  463.  
  464.             Absolute;
  465.             MoveTo(x0-a/2, y0+s+(h-ch));
  466.             Relative;
  467.             OpenPoly;
  468.             BeginPoly;
  469.                 LineTo(0, 0);
  470.                 CurveThrough(a/2, ch);
  471.                 LineTo(a/2, -ch);
  472.             EndPoly;
  473.         END
  474.  
  475.         ELSE BEGIN
  476.             Absolute;
  477.             MoveTo(x0-g/2, y0+s);
  478.             Relative;
  479.             ClosePoly;
  480.             BeginPoly;
  481.                 LineTo(0, 0);
  482.                 LineTo(0, (h-ch));
  483.                 LineTo((g-a)/2, ch);
  484.                 LineTo(a, 0);
  485.                 LineTo((g-a)/2, -ch);
  486.                 LineTo(0,- (h-ch));
  487.             EndPoly;
  488.  
  489.             Absolute;
  490.             MoveTo(x0-g/2, y0+s+(h-ch));
  491.             Relative;
  492.             OpenPoly;
  493.             BeginPoly;
  494.                 LineTo(0, 0);
  495.                 CurveThrough(p1, ch);
  496.                 LineTo(p1, -ch);
  497.                 CurveThrough(p1, ch);
  498.                 LineTo(p1, -ch);
  499.             EndPoly;
  500.  
  501.             Absolute;
  502.             MoveTo(x0, y0+s);
  503.             Relative;
  504.             LineTo(0, (h-ch));
  505.         END;
  506.  
  507.         Absolute;
  508.         MoveTo(x0-a/2, y0);
  509.         Relative;
  510.         IF s <> 0 THEN
  511.             Rect(0,0,a,s);
  512.  
  513.     END    {of Square Head}
  514.         
  515. {
  516. Hex  Head.
  517. }
  518.  
  519.     ELSE BEGIN
  520.         p1:=(g-f)/2;
  521.         IF View = 3 THEN BEGIN
  522.             Absolute;
  523.             MoveTo(x0-a/2, y0+s);
  524.             Relative;
  525.             ClosePoly;
  526.             Poly(0,0, 0,h1, a,0, 0,-h1);
  527.  
  528.             Move(-a, (h1-ch));
  529.             OpenPoly;
  530.             BeginPoly;
  531.                 LineTo(0, 0);
  532.                 CurveThrough(a/4, ch);
  533.                 LineTo(a/4, -ch);
  534.                 CurveThrough(a/4, ch);
  535.                 LineTo(a/4, -ch);
  536.             EndPoly;
  537.  
  538.             Move(-a/2, 0);
  539.             LineTo(0, -(h1-ch));
  540.             GOTO 10;
  541.         END;
  542.  
  543.         Absolute;
  544.         MoveTo(x0-g/2, y0+s);
  545.         Relative;
  546.         ClosePoly;
  547.         BeginPoly;
  548.             LineTo(0, 0);
  549.             LineTo(0, (h1-ch));
  550.             LineTo((g-a)/2, ch);
  551.             LineTo(a, 0);
  552.             LineTo((g-a)/2, -ch);
  553.             LineTo(0,- (h1-ch));
  554.         EndPoly;
  555.  
  556.         Absolute;
  557.         MoveTo(x0-g/2, y0+s+(h1-ch));
  558.         Relative;
  559.         OpenPoly;
  560.         BeginPoly;
  561.             LineTo(0, 0);
  562.             CurveThrough(p1/2, ch);
  563.             LineTo(p1/2, -ch);
  564.             CurveThrough(f/2, ch);
  565.             LineTo(f/2, -ch);
  566.             CurveThrough(p1/2, ch);
  567.             LineTo(p1/2, -ch);
  568.         EndPoly;
  569.  
  570.         Absolute;
  571.         MoveTo(x0+f/2, y0+s);
  572.         Relative;
  573.         LineTo(0, (h1-ch));
  574.         Move(-f, 0);
  575.         LineTo(0, -(h1-ch));
  576.  
  577.         10:Absolute;
  578.         MoveTo(x0-a/2, y0);
  579.         Relative;
  580.         IF s <> 0 THEN
  581.             Rect(0,0,a,s);
  582.  
  583.     END;     {of Hex Head}
  584.  
  585. END;
  586.  
  587. Procedure DrawThdType1;
  588. {
  589. This procedure draws non-detailed threads using dashed lines.
  590. }
  591. LABEL 10;
  592.  
  593. VAR
  594.     ch,pd : REAL;
  595.     
  596. BEGIN
  597.     ch:=td;
  598.     pd:=d - td;
  599.  
  600. {
  601. Draw body.
  602. }
  603.  
  604.     Absolute;
  605.     MoveTo((x0-d/2-r), y0);
  606.     Relative;
  607.     ClosePoly;
  608.     BeginPoly;
  609.         LineTo(0, 0);
  610.         IF r <> 0 THEN
  611.             ArcTo(r, 0, r);
  612.         LineTo(0, -(L-ch));
  613.         LineTo(td, -ch);
  614.         LineTo(di, 0);
  615.         LineTo(td, ch);
  616.         IF r <> 0 THEN
  617.         BEGIN
  618.             ArcTo(0, (L-ch), r);
  619.             LineTo(r, 0);
  620.         END ELSE
  621.             LineTo(0, (L-ch));
  622.     EndPoly;
  623.  
  624.     Absolute;
  625.     MoveTo(x0-d/2, y0-L+ch);
  626.     Relative;
  627.     LineTo(d, 0);
  628.  
  629. {
  630. Draw threads.
  631. }
  632.  
  633.     IF TL = L THEN GOTO 10;
  634.     Absolute;
  635.     MoveTo(x0-d/2, y0-L+TL);
  636.     Relative;
  637.     LineTo(d, 0);
  638.  
  639.     10:Absolute;
  640.     MoveTo(x0+di/2, y0-L);
  641.     PenPat(-2);
  642.     Line(0,TL);
  643.     Move(-di, -TL);
  644.     Line(0, TL);
  645. END;
  646.  
  647. Procedure DrawThdType2;
  648. {
  649. This procedure draws non-detailed threads using solid lines.
  650. }
  651. LABEL 10;
  652.  
  653. VAR
  654.     ch,pd : REAL;
  655.     k,k2 : INTEGER;
  656.     
  657. BEGIN
  658.     ch:=td;
  659.     pd:=d - td;
  660.  
  661. {
  662. Draw body.
  663. }
  664.  
  665.     Absolute;
  666.     MoveTo((x0-d/2-r), y0);
  667.     Relative;
  668.     ClosePoly;
  669.     BeginPoly;
  670.         LineTo(0, 0);
  671.         IF r <> 0 THEN
  672.             ArcTo(r, 0, r);
  673.         LineTo(0, -(L-ch));
  674.         LineTo(td, -ch);
  675.         LineTo(di, 0);
  676.         LineTo(td, ch);
  677.         IF r <> 0 THEN
  678.         BEGIN
  679.             ArcTo(0, (L-ch), r);
  680.             LineTo(r, 0);
  681.         END ELSE
  682.             LineTo(0, (L-ch));
  683.     EndPoly;
  684.  
  685.     Absolute;
  686.     MoveTo(x0-d/2, y0-L+ch);
  687.     Relative;
  688.     LineTo(d, 0);
  689.  
  690.     k2:=1;
  691.     IF TL = L THEN
  692.     BEGIN
  693.         nThreads:=(L - ch)/p;
  694.         p:=(L - ch)/nThreads;
  695.         k2:=0;
  696.     END;
  697.  
  698.     Absolute;
  699.     MoveTo(x0-d/2, y0-L+ch+p);
  700.     Relative;
  701.     FOR k:=1 TO nThreads-1 DO
  702.     BEGIN
  703.         LineTo(d, 0);
  704.         Move(-d, p);
  705.     END;
  706.     IF L > TL THEN
  707.         LineTo(d/2, 0);
  708.  
  709.     PenSize(1.25*FPenSize);
  710.     Absolute;
  711.     MoveTo(x0-di/2, y0-L+ch+p/2);
  712.     Relative;
  713.     FOR k:=1 TO nThreads-k2 DO
  714.     BEGIN
  715.         LineTo(di, 0);
  716.         Move(-di, p);
  717.     END;
  718.     IF L > TL THEN
  719.         LineTo(3*di/4, 0);
  720. END;
  721.  
  722. Procedure DrawThdType3;
  723. {
  724. This procedure draws detailed threads.
  725. }
  726.  
  727. CONST
  728.     k1 = 0.75;
  729.     k2 = 0.50;
  730.  
  731. VAR
  732.     p1,SL : REAL;
  733.     k,nPoints : INTEGER;
  734.  
  735. BEGIN
  736.     p1:=d - 5*td/2;
  737.     REPEAT
  738.         nThreads:=nThreads-1;
  739.     UNTIL ((nThreads+1)*p + p/2 +r) < L;
  740.     SL:=L - ((nThreads+1)*p + p/2);
  741.  
  742. {
  743. Draw bottom thread.
  744. }
  745.  
  746.     Absolute;
  747.     MoveTo(x0 - d/2 + 3*td/2, y0 - L);
  748.     Relative;
  749.     ClosePoly;
  750.     BeginPoly;
  751.         LineTo(0, 0);
  752.         LineTo(p1, 0);
  753.         LineTo(td/2, p/4);
  754.         LineTo(-td/2, p/4);
  755.         LineTo(td, p/2);
  756.         LineTo(-(d-td/2), -p/2);
  757.     EndPoly;
  758.  
  759.     Absolute;
  760.     MoveTo((x0 + d/2 - td/2), (y0 - L + p/4));
  761.     Relative;
  762.     LineTo(-(d/2 - td/2),  0);
  763.     LineTo(di/2, p/4);
  764.         
  765. {
  766. Draw first whole thread.
  767. }
  768.  
  769.     Absolute;
  770.     MoveTo((x0 - d/2 + td/2), (y0 - L +p/2));
  771.     Relative;
  772.     Poly(0,0, (d-td/2),p/2, -td, p/2, -di,-p/2);
  773.     Poly (0,0, di,p/2, td,p/2, -d,-p/2);
  774.     
  775. {
  776. Draw remaining whole threads.
  777. }
  778.  
  779.     Relative;
  780.     ClosePoly;
  781.     FOR i:=1 TO nThreads-1 DO BEGIN
  782.         Poly(0,0, d,p/2, -td,p/2, -di,-p/2);
  783.         Poly(0,0, di,p/2, td,p/2, -d,-p/2);
  784.     END;
  785.  
  786. {
  787. Draw last thread and shoulder.
  788. }
  789.  
  790.     Absolute;
  791.     MoveTo((x0 - d/2 - r), y0);
  792.     Relative;
  793.     ClosePoly;
  794.     BeginPoly;
  795.         LineTo(0, 0);
  796.         IF r <> 0 THEN
  797.             ArcTo(r, 0, r);
  798.         LineTo(0, -SL);
  799.         LineTo(td, -p/2);
  800.         LineTo(-td, -p/2);
  801.         LineTo(d, p/2);
  802.         IF r <> 0 THEN
  803.         BEGIN
  804.             ArcTo(0, SL+p/2, r);
  805.             LineTo(r, 0);
  806.         END ELSE
  807.             LineTo(0, SL+p/2);
  808.     EndPoly;
  809.     Absolute;
  810.     MoveTo(x0-d/2, y0-SL);
  811.     Relative;
  812.     LineTo((k1*di + td),0);
  813.     LineTo(-k1*di, -p/2);
  814. END;
  815.  
  816. BEGIN
  817. {
  818. Main Program.
  819. }
  820.  
  821.     DselectAll;
  822.     PushAttrs;
  823.  
  824. {
  825. Display the main dialog box and get the information.
  826. }
  827.  
  828.     HexBoltDialog;
  829.     SetCursor(ArrowC);
  830.     GetInfo;
  831.     IF Abort THEN GOTO 99;
  832.  
  833. {
  834. Get the location of the screw.
  835. }
  836.  
  837.     GetPt(x0,y0);
  838.  
  839. {
  840. Determine pitch, thread length and number of threads.
  841. }
  842.  
  843.     IF UNC THEN
  844.         tpi:=tpic
  845.     ELSE
  846.         tpi:=tpif;
  847.  
  848.     p:=1/tpi;
  849.     td:=0.86603/tpi;
  850.     di:=d-2*td;
  851.  
  852.     IF Inch THEN
  853.         TL:=ThdLgthI(d,L)
  854.     ELSE
  855.         TL:=ThdLgthM(d,L,p);
  856.     nThreads:=TL*tpi;
  857.  
  858. {
  859. Get drawing units and adjust parameters accordingly.
  860. }
  861.  
  862.     GetUnits(UName,DA,Fmt,UPI,UM,UM2);
  863.     IF Inch THEN
  864.         SF:=UPI
  865.     ELSE
  866.         SF:=UPI/25.4;
  867.  
  868.     d:=d*SF;
  869.     L:=L*SF;
  870.     a:=a*SF;
  871.     h:=h*SF;
  872.     r:=r*SF;
  873.     s:=s*SF;
  874.     TL:=TL*SF;
  875.     p:=p*SF;
  876.     td:=td*SF;
  877.     di:=di*SF;
  878.  
  879. {
  880. Calculate the variables needed to draw the screw.
  881. }
  882.  
  883.     IF Type = 1 THEN BEGIN
  884.         g:=a/Cos(PI/4);
  885.         ch:=(g-a)*Tan(Deg2Rad(Alpha1)/2);
  886.     END
  887.     ELSE BEGIN
  888.         g:=a/Cos(PI/6);
  889.         ch:=(g-a)*Tan(Deg2Rad(Alpha2))/2;
  890.         f:=a*Tan(PI/6);
  891.         h1:=h-s;
  892.     END;
  893.  
  894. {
  895. Draw top view
  896. }
  897.  
  898.     IF View = 1 THEN BEGIN
  899.         DrawTopView(Type);
  900.         GOTO 90;
  901.     END;
  902.  
  903. {
  904. Draw side view.
  905. }
  906.  
  907.     DrawSideViewOfHead(Type);
  908.  
  909. {
  910. Draw the threads.
  911. }
  912.  
  913.     IF L <= 0 THEN GOTO 90;
  914.     IF ThdType = 1 THEN
  915.          DrawThdType1
  916.     ELSE IF ThdType = 2 THEN
  917.          DrawThdType2
  918.     ELSE
  919.          DrawThdType3;
  920.  
  921.     90:Group;
  922.     PopAttrs;
  923.  
  924. 99:END;
  925.  
  926. RUN(HexBolts);
  927.