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