home *** CD-ROM | disk | FTP | other *** search
/ PC & Mediji 1997 January / PCM_9701.iso / programi / minicad / minicad.1 / SHDR_SCR.MPC < prev    next >
Encoding:
Text File  |  1996-04-30  |  9.7 KB  |  449 lines
  1. Procedure ShoulderScrew;
  2. {
  3. (Windows version)
  4. ⌐1996, Diehl Graphsoft, Inc.
  5. Developed by Tom Urie
  6.  
  7. This procedure draws a shoulder screw.
  8. }
  9.  
  10. LABEL 10,20,30,89,90,99;
  11. CONST
  12.     Filename1='External\Data\ShldScri.txt';
  13.     Filename2='External\Data\ShldScrm.txt';
  14.     sdC=0.010;  {Depth of undercut (inches)}
  15.     PathL=14;
  16. VAR
  17.     d,a,h,j,s,t,tl,g,y,f,fl,td,b,dia,l,c : REAL;
  18.     di,l1,p,x0,y0,sd,tpi,SF : REAL;
  19.     i,n,ThdType,View,ScrType : INTEGER;
  20.     RFlag : ARRAY[1..2] OF INTEGER;
  21.     Sz,Size,Size1,Filename : STRING;
  22.     Ans,Abort,CFlag1,Inch : BOOLEAN;
  23.     UPI : REAL;
  24.     Fmt : INTEGER;
  25.     UM,UM2 : STRING;
  26.     UName,DA : LONGINT;
  27.  
  28. Procedure SSDialog;
  29. {
  30. This procedure defines the main dialog box.
  31. }
  32. VAR
  33.     Width,x1,y1,x2,y2,px1,px2,px3,px4,py1,py2 : INTEGER;
  34.  
  35. Procedure AlignScr(Width:INTEGER; VAR x1,x2:INTEGER);
  36. VAR
  37.     scrx1,scry1,scrx2,scry2:INTEGER;
  38. BEGIN
  39.     GetScreen(scrx1,scry1,scrx2,scry2);
  40.     x1:=((scrx1+scrx2) div 2)-(Width div 2);
  41.     x2:=x1+Width; 
  42. END;
  43.  
  44. Procedure MakeDialog1;
  45. CONST
  46.     y1=100;
  47.     scnh=190; scnw=290;
  48.     h=25;
  49. BEGIN
  50.     AlignScr(scnw,x1,x2);
  51.     y2:=y1+scnh;
  52.     px3:=scnw/2-70;
  53.     px4:=scnw/2-10;
  54.     px1:=scnw/2+10;
  55.     px2:=scnw/2+70;
  56.     py1:=scnh-40;
  57.     py2:=scnh-20;
  58.  
  59.     BeginDialog(1,1,x1,y1,x2,y2);
  60.         AddButton('OK',1,1,px3,py1,px4,py2);
  61.         AddButton('Cancel',2,1,px1,py1,px2,py2);
  62.         AddField('Size:',4,1,20,75,60,90);
  63.         AddField('',5,2,80,75,140,90);
  64.         AddField('in',17,1,148,75,170,90);
  65.         AddField('Length:',6,1,20,105,70,121);
  66.         AddField('',7,2,80,105,140,120);
  67.         AddField('in',18,1,148,105,170,120);
  68.         AddField('View:',8,1,190,40-h,245,55-h);
  69.         AddButton('Top',9,3,190,85-h,235,100-h);
  70.         AddButton('Side',10,3,190,65-h,235,80-h);
  71.         AddButton('Detailed',11,2,190,120-h,320,135-h);
  72.         AddField('Threads',12,1,210,137-h,280,152-h);
  73.         AddField('Series:',16,1,20,15,75,30);
  74.         AddButton('Inch',14,3,20,40,70,55);
  75.         AddButton('Metric',15,3,75,40,135,55);
  76.     EndDialog;
  77. END;
  78.  
  79. Procedure MakeDialog2;
  80. {
  81. This procedure creates a warning dialog box telling the user that the data file is missing.
  82. }
  83. CONST
  84.     y1=100;
  85.     scnh=120; scnw=395;
  86. VAR
  87.     Count1,Count2 : INTEGER;
  88.     File1,File2,WarningMsg : STRING;
  89. BEGIN
  90.     AlignScr(scnw,x1,x2);
  91.     y2:=y1+scnh;
  92.     Count1:=Len(Filename1)-PathL;
  93.     Count2:=Len(Filename2)-PathL;
  94.     File1:=Copy(Filename1,PathL+1,Count1);
  95.     File2:=Copy(Filename2,PathL+1,Count2);
  96. WarningMsg:=Concat('The files: ',File1,' and ',File2,' must be in the Data folder located in the External folder 
  97. for this program to run.');
  98.     BeginDialog(2,1,x1,y1,x2,y2);
  99.         AddButton('OK',1,1,155,75,235,105);
  100.         AddField(WarningMsg,2,1,20,10,380,60);
  101.     EndDialog;
  102. END;
  103.  
  104. BEGIN
  105.     MakeDialog1;
  106.     MakeDialog2;
  107. END;
  108.  
  109. Procedure GetWarning;
  110. {
  111. This procedure displays the warning dialog box.
  112. }
  113. VAR
  114.     Done:Boolean;
  115.     Item:Integer;
  116. BEGIN
  117.     Done:=FALSE;
  118.     GetDialog(2);
  119.     SetTitle('Warning!');
  120.     REPEAT
  121.         DialogEvent(Item);
  122.         IF Item=1 THEN
  123.             Done:=True;
  124.     UNTIL Done;
  125.     ClrDialog;
  126. END;
  127.  
  128. Procedure GetInfo;
  129. {
  130. This procedure displays the main dialog box and retrieves the information.
  131. }
  132. LABEL 10,15,99;
  133. VAR
  134.     Done,OK:Boolean;
  135.     Item:Integer;
  136.  
  137. Procedure SetRButton(i,Item : INTEGER);
  138. BEGIN
  139.     IF RFlag[i] <> Item THEN BEGIN
  140.         SetItem(RFlag[i],FALSE);
  141.         SetItem(Item,TRUE);
  142.         RFlag[i]:=Item;
  143.     END;
  144. END;
  145.  
  146. BEGIN
  147.     Done:=FALSE;
  148.     Abort:=FALSE;
  149.     IF Ans THEN BEGIN
  150.         Ans:=FALSE;
  151.         GOTO 10;
  152.     END;
  153.     Inch:=TRUE;
  154.     View:=2;
  155.     ThdType:=1;
  156.     RFlag[1]:=10;
  157.     RFlag[2]:=14;
  158.     CFlag1:=FALSE;
  159.     Inch:=TRUE;
  160.     10:GetDialog(1);
  161.     SetTitle('Shoulder Screws');
  162.     SetField(5,Size1);
  163.     IF View=1 THEN
  164.         SetField(7,'n/a')
  165.     ELSE
  166.         SetField(7,Num2StrF(L));
  167.     IF Inch THEN BEGIN
  168.         SetField(17,'in');
  169.         SetField(18,'in');
  170.     END
  171.     ELSE BEGIN
  172.         SetField(17,'mm');
  173.         SetField(18,'mm');
  174.     END;
  175.     SetItem(11,CFlag1);
  176.     SetItem(RFlag[1],TRUE);
  177.     SetItem(RFlag[2],TRUE);
  178.     SelField(5);
  179.     15:REPEAT
  180.         DialogEvent(Item);
  181.         IF Item=1 THEN
  182.             Done:=True;
  183.         IF Item=2 THEN BEGIN
  184.             Done:=TRUE;
  185.             Abort:=TRUE;
  186.         END;
  187.         IF Item = 9 THEN BEGIN
  188.             SetRButton(1,9);
  189.             View:=1;
  190.             SetField(7,'n/a');      
  191.         END;
  192.         IF Item = 10 THEN BEGIN
  193.             SetRButton(1,10);
  194.             View:=2;
  195.             SetField(7,Num2StrF(L));      
  196.         END;
  197.         IF Item=11 THEN BEGIN
  198.             SetItem(Item,NOT CFlag1);
  199.             CFlag1:=NOT CFlag1;
  200.         END;
  201.         IF Item=14 THEN BEGIN
  202.             SetRButton(2,Item);
  203.             Inch:=TRUE;
  204.             SetField(17,'in');
  205.             SetField(18,'in');
  206.             SelField(5);
  207.         END;
  208.         IF Item=15 THEN BEGIN
  209.             SetRButton(2,Item);
  210.             Inch:=FALSE;
  211.             SetField(17,'mm');
  212.             SetField(18,'mm');
  213.             SelField(5);
  214.         END;
  215.     UNTIL Done;
  216.     IF Abort THEN GOTO 99;
  217.     Size1:=GetField(5);
  218.     Size:=Concat('''',Size1,'''');
  219.     UprString(Size);
  220.     OK:=ValidNumStr(GetField(7),L);
  221.     IF (View = 2) AND (L <= 0) THEN BEGIN
  222.         Sysbeep;
  223.         Done:=FALSE;
  224.         SelField(7);
  225.         GOTO 15;
  226.     END;
  227.     IF CFlag1 THEN
  228.         ThdType:=2
  229.     ELSE
  230.         ThdType:=1;
  231.     99:ClrDialog;
  232. END;
  233.  
  234. Procedure GetData;
  235. {
  236. This procedure opens the data file and reads the data.
  237. }
  238. LABEL 15,20,99;
  239. BEGIN
  240.     If Inch THEN
  241.         Filename:=Filename1
  242.                 ELSE
  243.                     Filename:=Filename2;
  244.                 Open(Filename);
  245. {
  246. Display the warning dialog box if the data file cannot be found.
  247. }
  248.     IF FndError THEN BEGIN
  249.         Sysbeep;
  250.         GetWarning;
  251.         Abort:=TRUE;
  252.         GoTo 99;
  253.     END;
  254. {
  255. Read the data.
  256. }
  257.     WHILE NOT Eoln(Filename) DO BEGIN
  258.         ReadLn(Sz,d,a,h,j,s,t,tpi,tl,f,g);
  259.         IF Sz=Size THEN GoTo 20;
  260.     END;
  261.     Close(Filename);
  262. {
  263. Diaplay a warning if the specified size is not available.
  264. }
  265.     15:SysBeep;
  266.     AlrtDialog('That size is not available!');
  267.     Ans:=TRUE;
  268.     GoTo 99;
  269.     20:Close(Filename);
  270. 99:END;
  271.  
  272. {
  273. Main program.
  274. }
  275. BEGIN
  276.     DselectAll;
  277. {
  278. Display the main dialog box and get the information.
  279. }
  280.     SSDialog;
  281.     SetCursor(ArrowC);
  282.     Ans:=FALSE;
  283.     10:GetInfo;
  284.     IF Abort THEN GoTo 99;
  285.     GetData;
  286.     IF Abort THEN GoTo 99;
  287.     IF Ans THEN Goto 10;
  288. {
  289. Get drawing units and adjust parameters accordingly.
  290. }
  291.     GetUnits(UName,DA,Fmt,UPI,UM,UM2);
  292.                 IF Inch = TRUE THEN BEGIN
  293.                     SF:=UPI;
  294.                     sd:=sdc;
  295.                 END
  296.                 ELSE BEGIN
  297.                     SF:=UPI/25.4;
  298.                     sd:=sdc*25.4;
  299.                 END;
  300.     sd:=sd*SF;
  301.     L:=L*SF;
  302.     d:=d*SF;
  303.     a:=a*SF;
  304.     h:=h*SF;
  305.     j:=j*SF;
  306.     s:=s*SF;
  307.     t:=t*SF;
  308.     tl:=tl*SF;
  309.     f:=f*SF;
  310.     g:=g*SF;
  311.     tpi:=tpi/SF;
  312. {
  313. Get insertion point and calculate variables.
  314. }
  315.     GetPt(x0,y0);
  316.     c:=a-3.4641*(h-s);
  317.     y:=0.2887*j;
  318.     fl:=0.5774*j;
  319.     td:=0.86603/tpi;
  320.     b:=0.60640/tpi;
  321.     n:=(tl-g)*tpi;
  322.     di:=t-2*td;
  323.     p:=1/tpi;
  324.     l1:=tl-g-n*p;
  325.     IF View=2 THEN Goto 20;
  326. {
  327. Draw top view.
  328. }
  329.     Absolute;
  330.     MoveTo(x0,y0);
  331.     Relative;
  332.     Arc(-a/2,a/2,a/2,-a/2,0,360);
  333.     Arc(-c/2,c/2,c/2,-c/2,0,360);
  334.     MoveTo(0,y+fl/2);
  335.     Relative;
  336.     ClosePoly;
  337.     Poly(fl,#-30,fl,#-90,fl,#-150,fl,#150,fl,#90);
  338.     GOTO 90;
  339. {
  340. Draw side view.
  341.  
  342. Draw head.
  343. }
  344.     20:Absolute;
  345.     MoveTo(x0-a/2,y0);
  346.     Relative;
  347.     Rect(0,0,a,s);
  348.     Move(0,s);
  349.     Poly((a-c)/2,(h-s),c,0,(a-c)/2,-(h-s));
  350. {
  351. Draw shoulder.
  352. }
  353.     Move(-(a+d)/2,-(s+f));
  354.     Rect(0,0,d,-(l-f));
  355.     Move(sd,0);
  356.     Rect(0,0,(d-2*sd),f);
  357.     IF ThdType=2 THEN GoTo 30;
  358. {
  359. Draw non-detail threads.
  360. }
  361.     Absolute;
  362.     MoveTo(x0-t/2,y0-(L+g));
  363.     Relative;
  364.     Rect(0,0,t,-(tl-g-b));
  365.     Move(t,-(tl-g-b));
  366.     ClosePoly;
  367.     Poly(-td,-b,-(t-2*td),0,-td,b);
  368.     Move(td,-b);
  369.     PenPat(-2);
  370.     Line(0,(tl-g));
  371.     Move((t-2*td),0);
  372.     Line(0,-(tl-g));
  373.     PenPat(2);
  374.     Move(0,(tl-g));
  375.     Rect(0,0,-di,g);
  376.     GoTo 90;
  377. {
  378. Draw detailed threads.
  379. }
  380.     30:Absolute;
  381. {
  382. Draw bottom thread.
  383. }
  384.     MoveTo(x0-t/2,y0-L-tl+td);
  385.     Relative;
  386.     OpenPoly;
  387.     BeginPoly;
  388.         LineTo(0,0);
  389.         LineTo(td,-td);
  390.         LineTo(t-5*td/2+p/4,0);
  391.         LineTo(td-p/4,td-p/4);
  392.         LineTo(-(t/2-td/2),0);
  393.     EndPoly;
  394.     ClosePoly;
  395.     BeginPoly;
  396.         Lineto(0,0);
  397.         LineTo((t/2-td/2),0);
  398.         Line(-td/2,p/4);
  399.         LineTo(-(t/2-td/2),-p/4);
  400.     EndPoly;
  401.     OpenPoly;
  402.     BeginPoly;
  403.         LineTo(0,0);
  404.         LineTo((t/2-td/2),p/4);
  405.         LineTo(td,p/2);
  406.         Lineto(-t,-p/2);
  407.     EndPoly;
  408. {
  409. Draw whole threads.
  410. }
  411.     FOR i:=1 TO n-1 DO BEGIN
  412.         BeginPoly;
  413.             Line(0,0);
  414.             Line(td,p/2);
  415.             Line(di,p/2);
  416.             Line(td,-p/2);
  417.             Line(-t,-p/2);
  418.         EndPoly;
  419.         Move(td,p/2);
  420.         BeginPoly;
  421.             Line(0,0);
  422.             Line(-td,p/2);
  423.             Line(t,p/2);
  424.             Line(-td,-p/2);
  425.             Line(-di,-p/2);
  426.         EndPoly;
  427.         Move(-td,p/2);
  428.     END;
  429. {
  430. Draw last thread & shoulder.
  431. }
  432.     BeginPoly;
  433.         LineTo(0,0);
  434.         LineTo(td,p/2);
  435.         LineTo(-td/2,p/4);
  436.         LineTo(td/2,p/4);
  437.         Line(0,tl-n*p-td);
  438.         Line(di,0);
  439.         Line(0,-(tl-n*p-td));
  440.         Line(td,-p/2);
  441.     EndPoly;
  442.     Move(-(t-td),0);
  443.     Line(di/2,p/4);
  444.     Line(-(di+td)/2,0);
  445.     90:Group;
  446. 99:END;
  447.  
  448. RUN(ShoulderScrew);
  449.