home *** CD-ROM | disk | FTP | other *** search
/ PC & Mediji 1997 January / PCM_9701.iso / programi / minicad / minicad.1 / WASHER.MPC < prev    next >
Encoding:
Text File  |  1996-04-30  |  15.0 KB  |  627 lines
  1. Procedure Washer;
  2. {
  3. (Windows version)
  4. ⌐1996, Diehl Graphsoft, Inc.
  5. Developed by Tom Urie
  6.  
  7. This procedure draws plain, lock, and user specified washers.
  8. }
  9.  
  10. LABEL 10,20,30,99;
  11. CONST
  12.     Filename1='External\Data\PlnWashi.txt';
  13.     Filename2='External\Data\PlnWashm.txt';
  14.     Filename3='External\Data\LokWashi.txt';
  15.     Filename4='External\Data\LokWashm.txt';
  16.     SWF=0.05;  {Used to determine the width of the slot on lock washers.}
  17.     Theta=30.0;  {Angle of the slot on lock washers.}
  18.     PathL=14;
  19. VAR
  20.     ID,OD,T :  REAL;
  21.     OD1,T1 : ARRAY [1..3] OF REAL;
  22.     x0,y0,x1,y1,x2,y2,SW:REAL;
  23.     Style,Type,View,Series,n:INTEGER;
  24.     RFlag : ARRAY[1..5] OF INTEGER;
  25.     Ans,Abort,OK:BOOLEAN;
  26.     Sz,Size,Size1:STRING;
  27.     FileName:ARRAY [1..4] OF STRING;
  28.     SA,DA:LONGINT;
  29.     Fmt:INTEGER;
  30.     SF,UPI:REAL;
  31.     UM,UM2:STRING;
  32.     Inch:BOOLEAN;
  33.  
  34. Procedure WasherDialog;
  35. {
  36. This procedure defines the various dialog boxes.
  37. }
  38. VAR
  39.     Width,x1,y1,x2,y2,px1,px2,px3,px4,py1,py2 : INTEGER;
  40.  
  41. Procedure AlignScr(Width:INTEGER; VAR x1,x2:INTEGER);
  42. VAR
  43.     scrx1,scry1,scrx2,scry2:INTEGER;
  44. BEGIN
  45.     GetScreen(scrx1,scry1,scrx2,scry2);
  46.     x1:=((scrx1+scrx2) div 2)-(Width div 2);
  47.     x2:=x1+Width; 
  48. END;
  49.  
  50. Procedure MakeDialog1;
  51. {
  52. This procedure defines the dialog box for Plain Washers.
  53. }
  54. CONST
  55.     y1=100;
  56.     scnh=265; scnw=280;
  57.     h=30;
  58. BEGIN
  59.     AlignScr(scnw,x1,x2);
  60.     y2:=y1+scnh;
  61.     px3:=scnw-160;
  62.     px4:=scnw-100;
  63.     px1:=scnw-80;
  64.     px2:=scnw-20;
  65.     py1:=scnh-40;
  66.     py2:=scnh-20;
  67.  
  68.     BeginDialog(1,1,x1,y1,x2,y2);
  69.         AddButton('OK',1,1,px3,py1,px4,py2);
  70.         AddButton('Cancel',2,1,px1,py1,px2,py2);
  71.         AddField('Type:',13,1,20,40-h,60,55-h);
  72.         AddButton('Inch (Type B Plain Washer)',14,3,20,65-h,250,80-h);
  73.         AddButton('Metric (Metric Plain Washer)',15,3,20,85-h,260,100-h);
  74.         AddField('Bolt or Screw Size:',4,1,20,118-h,160,133-h);
  75.         AddField('',5,2,165,118-h,225,133-h);
  76.         AddField('in',16,1,233,118-h,255,133-h);
  77.         AddField('Series:',6,1,20,150-h,100,165-h);
  78.         AddButton('Narrow',7,3,20,175-h,100,190-h);
  79.         AddButton('Regular',8,3,20,195-h,100,210-h);
  80.         AddButton('Wide',9,3,20,215-h,100,230-h);
  81.         AddField('View:',10,1,165,150-h,205,165-h);
  82.         AddButton('Top',11,3,165,175-h,205,190-h);
  83.         AddButton('Side',12,3,165,195-h,210,210-h);
  84.     EndDialog;
  85. END;
  86.  
  87. Procedure MakeDialog2;
  88. {
  89. This procedure defines the dialog box for User Defined Plain Washers.
  90. }
  91. CONST
  92.     y1=100;
  93.     scnh=170; scnw=270;
  94.     h=30;
  95. BEGIN
  96.     AlignScr(scnw,x1,x2);
  97.     y2:=y1+scnh;
  98.     px3:=scnw-160;
  99.     px4:=scnw-100;
  100.     px1:=scnw-80;
  101.     px2:=scnw-20;
  102.     py1:=scnh-40;
  103.     py2:=scnh-20;
  104.  
  105.     BeginDialog(2,1,x1,y1,x2,y2);
  106.         AddButton('OK',1,1,px3,py1,px4,py2);
  107.         AddButton('Cancel',2,1,px1,py1,px2,py2);
  108.         AddField('Inside Diameter:',4,1,20,45-h,143,60-h);
  109.         AddField('',5,2,156,45-h,240,60-h);
  110.         AddField('Outside Diameter:',6,1,20,70-h,143,85-h);
  111.         AddField('',7,2,156,70-h,240,85-h);
  112.         AddField('Thickness:',8,1,20,95-h,143,110-h);
  113.         AddField('',9,2,156,95-h,240,110-h);
  114.         AddField('View:',10,1,20,120-h,90,135-h);
  115.         AddButton('Top',11,3,20,145-h,60,160-h);
  116.         AddButton('Side',12,3,20,165-h,65,180-h);
  117.     EndDialog;
  118. END;
  119.  
  120. Procedure MakeDialog3;
  121. {
  122. This procedure defines the dialog box for Lock Washers.
  123. }
  124. CONST
  125.     y1=100;
  126.     scnh=245; scnw=280;
  127.     h=30;
  128. BEGIN
  129.     AlignScr(scnw,x1,x2);
  130.     y2:=y1+scnh;
  131.     px3:=scnw-160;
  132.     px4:=scnw-100;
  133.     px1:=scnw-80;
  134.     px2:=scnw-20;
  135.     py1:=scnh-40;
  136.     py2:=scnh-20;
  137.  
  138.     BeginDialog(3,1,x1,y1,x2,y2);
  139.         AddButton('OK',1,1,px3,py1,px4,py2);
  140.         AddButton('Cancel',2,1,px1,py1,px2,py2);
  141.         AddField('Type:',13,1,20,40-h,60,55-h);
  142.         AddButton('Inch',14,3,20,65-h,70,80-h);
  143.         AddButton('Metric',15,3,80,65-h,140,80-h);
  144.         AddField('Bolt or Screw Size:',4,1,20,98-h,160,113-h);
  145.         AddField('',5,2,165,98-h,225,113-h);
  146.         AddField('in',17,1,233,98-h,255,113-h);
  147.         AddField('Series:',6,1,20,130-h,100,145-h);
  148.         AddButton('Regular',7,3,20,155-h,100,170-h);
  149.         AddButton('Heavy',8,3,20,175-h,100,190-h);
  150.         AddButton('Extra Duty',9,3,20,195-h,100,210-h);
  151.         AddField('',16,1,105,195-h,155,210-h);
  152.         AddField('View:',10,1,165,130-h,205,145-h);
  153.         AddButton('Top',11,3,165,155-h,205,170-h);
  154.         AddButton('Side',12,3,165,175-h,210,190-h);
  155.     EndDialog;
  156. END;
  157.  
  158. Procedure MakeDialog4;
  159. {
  160. This procedure defines the main dialog box.
  161. }
  162. CONST
  163.     y1=100;
  164.     scnh=170; scnw=270;
  165.     h=30;
  166. BEGIN
  167.     AlignScr(scnw,x1,x2);
  168.     y2:=y1+scnh;
  169.     px3:=scnw-160;
  170.     px4:=scnw-100;
  171.     px1:=scnw-80;
  172.     px2:=scnw-20;
  173.     py1:=scnh-40;
  174.     py2:=scnh-20;
  175.  
  176.     BeginDialog(4,1,x1,y1,x2,y2);
  177.         AddButton('OK',1,1,px3,py1,px4,py2);
  178.         AddButton('Cancel',2,1,px1,py1,px2,py2);
  179.         AddField('Type of Washer:',4,1,20,40-h,195,55-h);
  180.         AddButton('Plain Washer - Commercial',5,3,20,65-h,220,80-h);    
  181.         AddButton('Plain Washer - User Defined',6,3,20,85-h,220,100-h);
  182.         AddButton('Helical Spring Lock Washer',7,3,20,105-h,220,120-h);
  183.     EndDialog;
  184. END;
  185.  
  186. Procedure MakeDialog5;
  187. {
  188. This procedure defines the warning dialog box for missing data files.
  189. }
  190. CONST
  191.     y1=100;
  192.     scnh=120; scnw=395;
  193. VAR
  194.     Count1,Count2,Count3,Count4 : INTEGER;
  195.     File1,File2,File3,File4,WarningMsg : STRING;
  196. BEGIN
  197.     AlignScr(scnw,x1,x2);
  198.     y2:=y1+scnh;
  199.     Count1:=Len(Filename1)-PathL;
  200.     Count2:=Len(Filename2)-PathL;
  201.     Count3:=Len(Filename3)-PathL;
  202.     Count4:=Len(Filename4)-PathL;
  203.     File1:=Copy(Filename1,PathL+1,Count1);
  204.     File2:=Copy(Filename2,PathL+1,Count2);
  205.     File3:=Copy(Filename3,PathL+1,Count3);
  206.     File4:=Copy(Filename4,PathL+1,Count4);
  207. WarningMsg:=Concat('The files: ',File1,', ',File2,', ',File3,', and ',File4,' must be in the Data folder located in 
  208. the External folder for this program to run.');
  209.     BeginDialog(5,1,x1,y1,x2,y2);
  210.         AddButton('OK',1,1,155,75,235,105);
  211.         AddField(WarningMsg,2,1,20,10,380,60);
  212.     EndDialog;
  213. END;
  214.  
  215. BEGIN
  216.     MakeDialog1;
  217.     MakeDialog2;
  218.     MakeDialog3;
  219.     MakeDialog4;
  220.     MakeDialog5;
  221. END;
  222.  
  223. Procedure GetWarning;
  224. {
  225. This procedure displays the file warning dialog box.
  226. }
  227. VAR
  228.     Done:Boolean;
  229.     Item:Integer;
  230. BEGIN
  231.     Done:=FALSE;
  232.     GetDialog(5);
  233.     SetTitle('Warning!');
  234.     REPEAT
  235.         DialogEvent(Item);
  236.         IF Item=1 THEN
  237.             Done:=True;
  238.     UNTIL Done;
  239.     ClrDialog;
  240. END;
  241.  
  242. Procedure SetRButton(i,Item : INTEGER);
  243. BEGIN
  244.     IF RFlag[i] <> Item THEN BEGIN
  245.         SetItem(RFlag[i],FALSE);
  246.         SetItem(Item,TRUE);
  247.         RFlag[i]:=Item;
  248.     END;
  249. END;
  250.  
  251. Procedure GetInfo1;
  252. {
  253. This procedure displays the Plain Washer dialog box and retrieves the information.
  254. }
  255. LABEL 10;
  256. VAR
  257.     Done:boolean;
  258.     Item:integer;
  259.  
  260. BEGIN
  261.     Done:=FALSE;
  262.     Abort:=FALSE;
  263.     IF Ans THEN BEGIN
  264.         Ans:=FALSE;
  265.         GOTO 10;
  266.     END;
  267.     Type:=1;
  268.     View:=1;
  269.     Series:=2;
  270.     Inch:=TRUE;
  271.     RFlag[1]:=8;
  272.     RFlag[2]:=11;
  273.     RFlag[3]:=14;
  274.     10:GetDialog(1);
  275.     SetTitle('Plain Washers');
  276.     SetItem(RFlag[1],TRUE);
  277.     SetItem(RFlag[2],TRUE);
  278.     SetItem(RFlag[3],TRUE);
  279.     IF Inch THEN SetField(16,'in')
  280.     ELSE SetField(16,'mm');
  281.     SetField(5,Size1);
  282.     SelField(5);
  283.     REPEAT
  284.         DialogEvent(Item);
  285.         IF Item=1 THEN
  286.             Done:=TRUE;
  287.         IF Item=2 then BEGIN
  288.             Done:=TRUE;
  289.             Abort:=TRUE;
  290.         END;
  291.         IF (Item > 6) AND (Item < 10) THEN BEGIN
  292.             SetRButton(1,Item);
  293.             Series:=Item-6;
  294.         END;
  295.         IF (Item=11) OR (Item=12) THEN BEGIN
  296.             SetRButton(2,Item);
  297.             View:=Item-10;
  298.         END;
  299.         IF Item=14 THEN BEGIN
  300.             SetRButton(3,Item);
  301.             Type:=1;
  302.             Inch:=TRUE;
  303.             SetField(16,'in');
  304.             SelField(5);
  305.         END;
  306.         IF Item=15 THEN BEGIN
  307.             SetRButton(3,Item);
  308.             Type:=2;
  309.             Inch:=FALSE;
  310.             SetField(16,'mm');
  311.             SelField(5);
  312.         END;
  313.     UNTIL DONE;
  314.     Size1:=GetField(5);
  315.     UprString(Size);
  316.     Size:=ConCat('''',Size1,'''');
  317.     UprString(Size);
  318.     ClrDialog;
  319. END;
  320.  
  321. Procedure GetInfo2;
  322. {
  323. This procedure displays the User Defined Washer dialog box and retrieves the information.
  324. }
  325. LABEL 10,15,99;
  326. VAR
  327.     Done:boolean;
  328.     Item:integer;
  329.  
  330. BEGIN
  331.     Done:=FALSE;
  332.     Abort:=FALSE;
  333.     IF Ans THEN BEGIN
  334.         Ans:=FALSE;
  335.         GOTO 10;
  336.     END;
  337.     View:=1;
  338.     RFlag[1]:=11;
  339.     10:GetDialog(2);
  340.     SetTitle('User Defined Plain Washers');
  341.     SetItem(RFlag[1],TRUE);
  342.     SetField(5,Num2Str(4,ID));
  343.     SetField(7,Num2Str(4,OD));
  344.     SetField(9,Num2Str(4,T));
  345.     SelField(5);
  346.     15:REPEAT
  347.         DialogEvent(Item);
  348.         IF Item=1 THEN
  349.             Done:=TRUE;
  350.         IF Item=2 then BEGIN
  351.             Done:=TRUE;
  352.             Abort:=TRUE;
  353.         END;
  354.         IF (Item = 11) OR (Item = 12) THEN BEGIN
  355.             SetRButton(1,Item);
  356.             View:=Item-10;
  357.         END;
  358.     UNTIL DONE;
  359.     IF Abort THEN GOTO 99;
  360.     OK:=ValidNumStr(GetField(5),ID);
  361.     OK:=ValidNumStr(GetField(7),OD);
  362.     OK:=ValidNumStr(GetField(9),T);
  363.     99:ClrDialog;
  364. END;
  365.  
  366. Procedure GetInfo3;
  367. {
  368. This procedure displays the Helical Spring Lock Washer dialog box and retrieves the informaion.
  369. }
  370. LABEL 10;
  371. VAR
  372.     Done:boolean;
  373.     Item:integer;
  374.  
  375. BEGIN
  376.     Done:=FALSE;
  377.     Abort:=FALSE;
  378.     IF Ans THEN BEGIN
  379.         Ans:=FALSE;
  380.         GOTO 10;
  381.     END;
  382.     Type:=3;
  383.     View:=1;
  384.     Series:=1;
  385.     Inch:=TRUE;
  386.     RFlag[1]:=7;
  387.     RFlag[2]:=11;
  388.     RFlag[3]:=14;
  389.     10:GetDialog(3);
  390.     SetTitle('Helical Spring Lock Washers');
  391.     SetItem(RFlag[1],TRUE);
  392.     SetItem(RFlag[2],TRUE);
  393.     SetItem(RFlag[3],TRUE);
  394.     IF Inch THEN BEGIN
  395.         SetField(16,'');
  396.         SetField(17,'in');
  397.     END
  398.     ELSE BEGIN
  399.         SetField(16,'<n/a>');
  400.         SetField(17,'mm');
  401.     END;
  402.     SetField(5,Size1);
  403.     SelField(5);
  404.     REPEAT
  405.         DialogEvent(Item);
  406.         IF Item=1 THEN
  407.             Done:=TRUE;
  408.         IF Item=2 then BEGIN
  409.             Done:=TRUE;
  410.             Abort:=TRUE;
  411.         END;
  412.         IF (Item > 6) AND (Item < 9) THEN BEGIN
  413.             SetRButton(1,Item);
  414.             Series:=Item-6;
  415.         END;
  416.         IF Item = 9 THEN BEGIN
  417.             If Type <> 4 THEN BEGIN
  418.                 SetRButton(1,Item);
  419.                 Series:=Item-6;
  420.             END
  421.             ELSE Sysbeep;
  422.         END;
  423.         IF (Item=11) OR (Item=12) THEN BEGIN
  424.             SetRButton(2,Item);
  425.             View:=Item-10;
  426.         END;
  427.         IF Item=14 THEN BEGIN
  428.             SetRButton(3,Item);
  429.             Type:=3;
  430.             Inch:=TRUE;
  431.             SetField(16,'');
  432.             SetField(17,'in');
  433.             SelField(5);
  434.         END;
  435.         IF Item=15 THEN BEGIN
  436.             SetRButton(3,Item);
  437.             Type:=4;
  438.             Inch:=FALSE;
  439.             SetField(16,'<n/a>');
  440.             SetField(17,'mm');
  441.             SelField(5);
  442.             IF Series = 3 THEN BEGIN
  443.                 SetRButton(1,7);
  444.                 Series:=1;
  445.             END;
  446.         END;
  447.     UNTIL DONE;
  448.     Size1:=GetField(5);
  449.     UprString(Size);
  450.     Size:=ConCat('''',Size1,'''');
  451.     UprString(Size);
  452.     ClrDialog;
  453. END;
  454.  
  455. Procedure GetInfo4;
  456. {
  457. This procedure displays the main dialog box and retrieves the information.
  458. }
  459. VAR
  460.     Done:BOOLEAN;
  461.     Item:INTEGER;
  462.  
  463. BEGIN
  464.     Done:=FALSE;
  465.     Abort:=FALSE;
  466.     RFlag[1]:=5;
  467.     GetDialog(4);
  468.     SetTitle('Washers');
  469.     SetItem(RFlag[1],TRUE);
  470.     REPEAT
  471.         DialogEvent(Item);
  472.         IF Item = 1 THEN
  473.             Done:=TRUE;
  474.         IF Item = 2 then BEGIN
  475.             Done:=TRUE;
  476.             Abort:=TRUE;
  477.         END;
  478.         IF Item > 4 THEN BEGIN
  479.             SetRButton(1,Item);
  480.             Style:=Item-4;
  481.         END;
  482.     UNTIL DONE;
  483.     ClrDialog;
  484. END;
  485.  
  486. Procedure GetData;
  487. {
  488. This procedure opens the data file and reads the data.
  489. }
  490. LABEL 10,20,99;
  491. BEGIN
  492.     Filename[1]:=Filename1;
  493.     Filename[2]:=Filename2;
  494.     Filename[3]:=Filename3;
  495.     Filename[4]:=Filename4;
  496.     Open(Filename[Type]);
  497.     IF FndError THEN BEGIN
  498.         Sysbeep;
  499.         GetWarning;
  500.         Abort:=TRUE;
  501.         GoTo 99;
  502.     END;
  503.     WHILE NOT Eoln(Filename[Type]) DO BEGIN
  504.         IF Type <> 4 THEN
  505. ReadLn(Sz,ID,OD1[1],OD1[2],OD1[3],T1[1],T1[2],T1[3])
  506.         ELSE
  507.             ReadLn(Sz,ID,OD1[1],OD1[2],T1[1],T1[2]);
  508.         IF Sz=Size THEN GoTo 20;
  509.     END;
  510.     Close(Filename[Type]);
  511.     10:SysBeep;
  512.     AlrtDialog('That size is not available!');
  513.     Ans:=TRUE;
  514.     GoTo 99;
  515.     20:Close(Filename[Type]);
  516.     FOR n:=1 TO 3 DO BEGIN
  517.         IF (Series = n) AND (OD1[n] = 0.0) THEN GOTO 10;
  518.     END;
  519. 99:END;
  520.  
  521. {
  522. Main program.
  523. }
  524. BEGIN
  525.     DSelectAll;
  526.     PushAttrs;
  527.     Style:=1;
  528. {
  529. Create the dialog boxes.
  530. }
  531.     WasherDialog;
  532.     SetCursor(ArrowC);
  533. {
  534. Display the main dialog box and get the type of washer to draw.
  535. }
  536.     GetInfo4;
  537.     IF Abort THEN GOTO 99;
  538. {
  539. Display the proper dialog box and get the information.
  540. }
  541.     IF (Style=1) OR (Style=3) THEN BEGIN
  542.         Ans:=FALSE;
  543.         10:IF Style=1 THEN
  544.             GetInfo1
  545.         ELSE
  546.             GetInfo3;
  547.         IF Abort THEN GOTO 99;
  548.         GetData;
  549.         IF Abort THEN GOTO 99;
  550.         IF Ans THEN GOTO 10;
  551.             OD:=OD1[Series];
  552.             T:=T1[Series];
  553.     END
  554.     ELSE BEGIN
  555.         Type:=5;
  556.         ANS:=FALSE;
  557.         20:GetInfo2;
  558.         IF Abort THEN GOTO 99;
  559.         IF ID < OD THEN GOTO 30;
  560.         Ans:=TRUE;
  561.         SysBeep;
  562.         AlrtDialog('ID must be less than OD!');
  563.         GOTO 20;
  564.     END;
  565. {
  566. Get the units per inch and adjust the parameters accordingly.
  567. }
  568.     GetUnits(SA,DA,Fmt,UPI,UM,UM2);
  569.     IF Inch=TRUE THEN
  570.         SF:=UPI
  571.     ELSE
  572.         SF:=UPI/25.4;
  573.     ID:=SF*ID;
  574.     OD:=SF*OD;
  575.     T:=SF*T;
  576.     30:GetPt(x0,y0);    
  577.     IF View=1 THEN BEGIN
  578. {
  579. Draw Top View.
  580. }
  581.         Absolute;
  582.         MoveTo(x0,y0);
  583.         Relative;
  584.         Arc(-OD/2,OD/2,OD/2,-OD/2,0,360);
  585.         Arc(-ID/2,ID/2,ID/2,-ID/2,0,360);
  586.         IF (Type=3) OR (TYPE=4) THEN BEGIN
  587.             SW:=SWF*ID;
  588.             x1:=SW/2;
  589.             y1:=Sqrt((OD/2)^2-x1^2);
  590.             x2:=SW/2;
  591.             y2:=Sqrt((ID/2)^2-x1^2);
  592.             Move(-x1,-y1);
  593.             Line(0,(y1-y2));
  594.             Move(2*x1,0);
  595.             Line(0,(y2-y1));
  596.         END;
  597.     END
  598.     ELSE BEGIN
  599. {
  600. Draw Side View.
  601. }
  602.         Absolute;
  603.         MoveTo(x0,y0);
  604.         Relative;
  605.         Rect(-OD/2,t,OD/2,0);
  606.         PushAttrs;
  607.         PenPat(-2);
  608.         Move(-ID/2,0);
  609.         Line(0,t);
  610.         Move(ID,0);
  611.         Line(0,-t);
  612.         PopAttrs;
  613.         IF (Type=3) OR (TYPE=4) THEN BEGIN
  614.             SW:=SWF*ID;
  615.             x1:=T*Tan(Deg2Rad(Theta));
  616.             Move(-ID/2,T);
  617.             Line(-x1,-T);
  618.             Move(-SW,0);
  619.             Line(x1,T);
  620.         END;
  621.     END;
  622.     Group;
  623.     PopAttrs;
  624. 99:END;
  625.  
  626. Run(Washer);
  627.