home *** CD-ROM | disk | FTP | other *** search
/ Chip 1998 March / Chip_1998-03_cd.bin / tema / MINICAD / MC7DEMO / MINICAD.1 / DWG_FMS.MPC < prev    next >
Text File  |  1997-04-30  |  15KB  |  620 lines
  1. Procedure DrawingForm;
  2. {
  3. ⌐1997, Diehl Graphsoft, Inc.
  4. Developed by Tom Urie
  5.  
  6. This procedure creates an ASME, Archetectural, or ISO drawing border.
  7. }
  8. LABEL 10,20,99;
  9.  
  10. CONST
  11.     POffsetD=0;  {Default print offset.}
  12.     BWidthD=1/4;  {Default width of drawing border.}
  13.     LDivD=3.0;  {Approximate width of grid. Exact size depends on size of drawing border.}
  14.     TSize=12;  {Size of grid text.}
  15.     RecordName='TitleBlkInfo';  {Name of record attached to title block containing title block information.}
  16.     SymbolName='TitleBlk';  {Name of title block symbol definition.}
  17.  
  18. VAR
  19.     W,H : ARRAY [1..3,1..6] OF REAL;
  20.      x1,y1,x2,y2: REAL;
  21.     dx1,dy1,dy,POffset,Bwidth,LDiv,TBWdth, TBHgt : REAL;
  22.     n,Size,Type,OldType :  INTEGER;
  23.     i,j,k,NFields : INTEGER;
  24.     nZones : ARRAY[1..6,1..2] OF INTEGER;
  25.     RFlag : ARRAY[1..2] OF INTEGER;
  26.     AChar,Field,s : STRING;
  27.     FieldName,FieldNameD,FieldVal,NewVal : ARRAY[1..15] OF STRING;
  28.     Abort,ShowGrids,TitleBlock,OK : BOOLEAN;
  29.     TitleBlkH,RecordH,LayerH,SymbolH : HANDLE;
  30.  
  31.     Width,sx1,sy1,sx2,sy2,px1,px2,px3,px4,py1,py2,py3,py4 : INTEGER;
  32.  
  33.     UPI : REAL;
  34.     Fmt : INTEGER;
  35.     UM,UM2 : STRING;
  36.     UName,DA : LONGINT;
  37.  
  38. Procedure AlignScr(Width:INTEGER; VAR sx1,sx2:INTEGER);
  39. VAR
  40.     scrx1,scry1,scrx2,scry2:INTEGER;
  41. BEGIN
  42.     GetScreen(scrx1,scry1,scrx2,scry2);
  43.     sx1:=((scrx1+scrx2) div 2)-(Width div 2);
  44.     sx2:=sx1+Width; 
  45. END;
  46.  
  47. Procedure LocateButtons(DialogType,scnh,scnw : INTEGER);
  48. {
  49. This procedure locates the 'OK' and 'Cancel' buttons.
  50. }
  51. VAR
  52.     v1,v2,v3,v4 : INTEGER;
  53.     Mac : BOOLEAN;
  54.  
  55. Procedure Swap(VAR  m1,m2,m3,m4 : INTEGER);
  56. VAR
  57.     Temp : INTEGER;
  58. BEGIN
  59.     Temp:=m1;
  60.     m1:=m3;
  61.     m3:=Temp;
  62.     Temp:=m2;
  63.     m2:=m4;
  64.     m4:=Temp;
  65. END;        {of Swap}
  66.  
  67. BEGIN
  68.     Mac:=FALSE;
  69.     GetVersion(v1,v2,v3,v4);
  70.     IF v4 = 1 THEN Mac:=TRUE;
  71.  
  72.     IF DialogType = 1 THEN
  73.     BEGIN
  74.         px1:=(scnw DIV 2) - 80;
  75.         px2:=(scnw DIV 2) - 10;
  76.         px3:=(scnw DIV 2) + 10;
  77.         px4:=(scnw DIV 2) + 80;
  78.         IF Mac THEN SWAP(px1,px2,px3,px4);
  79.  
  80.         py1:=scnh-40;
  81.         py2:=scnh-20;
  82.         py3:=py1;
  83.         py4:=py2;
  84.     END ELSE IF DialogType = 2 THEN
  85.     BEGIN
  86.         px1:=scnw - 180;
  87.         px2:=scnw - 110;
  88.         px3:=scnw - 90;
  89.         px4:=scnw - 20;
  90.         IF Mac THEN SWAP(px1,px2,px3,px4);
  91.  
  92.         py1:=scnh-40;
  93.         py2:=scnh-20;
  94.         py3:=py1;
  95.         py4:=py2;
  96.     END ELSE
  97.     BEGIN
  98.         px1:=scnw - 90;
  99.         px2:=scnw - 20;
  100.         px3:=px1;
  101.         px4:=px2;
  102.  
  103.         py1:=scnh -70;
  104.         py2:=scnh - 50;
  105.         py3:=scnh - 40;
  106.         py4:=scnh - 20;
  107.         IF Mac THEN SWAP(py1,py2,py3,py4);
  108.     END;
  109. END;        {of Locate Buttons}
  110.  
  111. Procedure BorderDialog;
  112. {
  113. This procedure defines the main dialog boxe.
  114. }
  115.  
  116. Procedure MakeBorderDialog;
  117. CONST
  118.     sy1=100;
  119.     scnh =175; scnw =390;
  120.     h=30;
  121.     DialogType = 3;
  122.  
  123. BEGIN
  124.     AlignScr(scnw,sx1,sx2);
  125.     sy2:=sy1+scnh;
  126.     LocateButtons(DialogType,scnh,scnw );
  127.     
  128.     BeginDialog(1,1,sx1,sy1,sx2,sy2);
  129.         AddButton('OK',1,1,px1,py1,px2,py2);
  130.         AddButton('Cancel',2,1,px3,py3,px4,py4);
  131.  
  132.         AddField('Type:',5,1,20,40-h,75,55-h);
  133.         AddButton('ASME',6,3,20,65-h,75,80-h);
  134.         AddButton('Arch',7,3,20,85-h,75,100-h);
  135.         AddButton('ISO',8,3,20,105-h,75,120-h);
  136.  
  137.         AddButton('Show Title Block',9,2,175,100-h,310,115-h);
  138.         AddButton('Show Grids',10,2,175,125-h,265,140-h);
  139.  
  140.         AddField('Size:',17,1,100,40-h,150,55-h);
  141.         AddButton('',11,3,100,65-h,115,80-h);
  142.         AddButton('',12,3,100,85-h,115,100-h);
  143.         AddButton('',13,3,100,105-h,115,120-h);
  144.         AddButton('',14,3,100,125-h,115,140-h);
  145.         AddButton('',15,3,100,145-h,115,160-h);
  146.         AddButton('',16,3,100,165-h,115,180-h);
  147.  
  148.         AddField('Print Offset:',18,1,175,45-h,275,60-h);
  149.         AddField('',19,2,285,45-h,345,60-h);
  150.  
  151.         AddField('Border Width:',20,1,175,70-h,275,85-h);
  152.         AddField('',21,2,285,70-h,345,85-h);
  153.  
  154.         AddField('A',22,1,118,65-h,135,80-h);
  155.         AddField('B',23,1,118,85-h,135,100-h);
  156.         AddField('C',24,1,118,105-h,135,120-h);
  157.         AddField('D',25,1,118,125-h,135,140-h);
  158.         AddField('E',26,1,118,145-h,135,160-h);
  159.         AddField('F',27,1,118,165-h,155,180-h);
  160.  
  161.         AddField('in.',28,1,353,45-h,375,60-h);
  162.         AddField('in.',29,1,353,70-h,375,85-h);
  163.     EndDialog;
  164. END;
  165.  
  166. BEGIN
  167.     MakeBorderDialog;
  168. END;
  169.  
  170. Procedure TitleDialog;
  171. {
  172. This procedure defines the title block information dialog box.
  173. }
  174.  
  175.  
  176. Procedure MakeTitleDialog(NFields : INTEGER);
  177. CONST
  178.     sy1=100;
  179.     scnw=325;
  180.     h1=30;
  181.     DialogType = 1;
  182.  
  183. VAR
  184.     scnh,i,j,h : INTEGER;
  185.  
  186. BEGIN
  187.     scnh:=85+25*NFields;
  188.     AlignScr(scnw,sx1,sx2);
  189.     sy2:=sy1+scnh;
  190.     LocateButtons(DialogType,scnh,scnw );
  191.     
  192.     BeginDialog(2,1,sx1,sy1,sx2,sy2);
  193.         AddButton('OK',1,1,px1,py1,px2,py2);
  194.         AddButton('Cancel',2,1,px3,py3,px4,py4);
  195.  
  196.         h:=25-h1;
  197.         j:=3;
  198.         FOR i:= 1 TO NFields DO BEGIN
  199.             h:=h+25;
  200.             j:=j+2;
  201.             AddField(FieldNameD[i],j,1,20,h,125,h+15);
  202.             AddField(FieldVal[i],j+1,2,135,h,300,h+15);
  203.         END;
  204.     EndDialog;
  205. END;
  206.  
  207. BEGIN
  208.     MakeTitleDialog(NFields);
  209. END;
  210.  
  211. Procedure SetRButton(i,Item : INTEGER);
  212. BEGIN
  213.     IF RFlag[i] <> Item THEN BEGIN
  214.         SetItem(RFlag[i],FALSE);
  215.         SetItem(Item,TRUE);
  216.         RFlag[i]:=Item;
  217.     END;
  218. END;
  219.  
  220. Procedure GetBorderInfo;
  221. {
  222. This procedure displays the main dialog box and retrieves the information.
  223. }
  224. VAR
  225.     Done : Boolean;
  226.     Item,i : Integer;
  227.     A : STRING;
  228. BEGIN
  229.     Done:=FALSE;
  230.     Abort:=FALSE;
  231.     Size:=1;
  232.     Type:=1;
  233.     POffset:=POffsetD;
  234.     BWidth:=BWidthD;
  235.     TitleBlock:=FALSE;
  236.     ShowGrids:=FALSE;
  237.     RFlag[1]:=6;
  238.     RFlag[2]:=11;
  239.     GetDialog(1);
  240.     SetTitle('Drawing Forms');
  241.     SetItem(6,TRUE);
  242.     SetItem(11,TRUE);
  243.     SetField(19,Num2StrF(POffset));
  244.     SetField(21,Num2StrF(BWidth));
  245.     SelField(19);
  246.     REPEAT
  247.         DialogEvent(Item);
  248.         IF Item=1 THEN
  249.             Done:=TRUE;
  250.         IF Item=2 THEN BEGIN
  251.             Done:=TRUE;
  252.             Abort:=TRUE;
  253.         END;
  254.         IF (Item > 5) AND (Item < 9) THEN BEGIN
  255.             SetRButton(1,Item);
  256.             OldType:=Type;
  257.             Type:=Item-5;
  258.             IF (Item = 8) AND (OldType <> 3) THEN BEGIN
  259.                 SetField(22,'A0');
  260.                 SetField(23,'A1');
  261.                 SetField(24,'A2');
  262.                 SetField(25,'A3');
  263.                 SetField(26,'A4');
  264.                 SetField(27,'<n/a>');
  265.                 SetField(19,Num2StrF(POffset*25.4));
  266.                 SetField(21,Num2StrF(BWidth*25.4));
  267.                 SetField(28,'mm');
  268.                 SetField(29,'mm');
  269.                 SetRButton(2,11);
  270.                 Size:=1;
  271.             END
  272.             ELSE IF ((Type = 1) OR (Type = 2)) AND (OldType = 3) THEN BEGIN
  273.                 SetField(22,'A');
  274.                 SetField(23,'B');
  275.                 SetField(24,'C');
  276.                 SetField(25,'D');
  277.                 SetField(26,'E');
  278.                 SetField(27,'F');
  279.                 SetField(19,Num2StrF(POffset));
  280.                 SetField(21,Num2StrF(BWidth));
  281.                 SetField(28,'in.');
  282.                 SetField(29,'in.');
  283.             END;
  284.         END; 
  285.         IF Item=9 THEN BEGIN
  286.             TitleBlock:=NOT TitleBlock;
  287.             SetItem(9,TitleBlock);
  288.         END; 
  289.         IF Item = 10 THEN BEGIN
  290.             ShowGrids:=NOT ShowGrids;
  291.             SetItem(10,ShowGrids);
  292.         END; 
  293.         IF (Item > 10) AND (Item < 17) THEN BEGIN
  294.             IF (Type = 3) AND (Item = 16) THEN BEGIN
  295.                 SysBeep;
  296.                 SetRButton(2,11);
  297.                 Size:=1;
  298.             END
  299.             ELSE BEGIN
  300.                 SetRButton(2,Item);
  301.                 Size:=Item-10;
  302.             END;
  303.         END;
  304.     UNTIL Done;
  305.     OK:=ValidNumStr(GetField(19), POffset);
  306.     OK:=ValidNumStr(GetField(21), BWidth);
  307.     IF Type = 3 THEN BEGIN
  308.         POffset:=POffset/25.4;
  309.         BWidth:=BWidth/25.4;
  310.     END;
  311.     ClrDialog;
  312. END;
  313.  
  314. Procedure GetTitleInfo;
  315. {
  316. This procedure displays the title block information dialog box and retrieves the information.
  317. }
  318. VAR
  319.     Done : BOOLEAN;
  320.     i,n,Item : INTEGER;
  321. BEGIN
  322.     Done:=FALSE;
  323.     Abort:=FALSE;
  324.     GetDialog(2);
  325.     SetTitle('Title Block Information');
  326.     REPEAT
  327.         DialogEvent(Item);
  328.         IF Item=1 THEN
  329.             Done:=TRUE;
  330.         IF Item=2 THEN BEGIN
  331.             Done:=TRUE;
  332.             Abort:=TRUE;
  333.         END; 
  334.     UNTIL Done;
  335.     n:=4;
  336.     FOR i:=1 TO NFields DO BEGIN
  337.         n:=n+2;
  338.         NewVal[i]:=GetField(n);
  339.     END;
  340.     ClrDialog;
  341. END;
  342.  
  343. BEGIN
  344. {
  345. Main Program.
  346.  
  347. Display the main dialog box and get the information.
  348. }
  349.  
  350.     BorderDialog;
  351.     SetCursor(ArrowC);
  352.     GetBorderInfo;
  353.     IF Abort THEN GOTO 99;
  354.     DselectAll;
  355.     PushAttrs;
  356.  
  357. {
  358. Get units/inch adjust constants.
  359. }
  360.  
  361.     GetUnits(UName,DA,Fmt,UPI,UM,UM2);
  362.     POffset:=POffset*UPI;
  363.     BWidth:=BWidth*UPI;
  364.     LDiv:=LDivD*UPI;
  365.  
  366. {
  367. Set attributes.
  368. }
  369.  
  370.     FillPat(0);
  371.     PenFore(255);
  372.     PenSize(20);
  373.     PenPat(2);
  374.     NameClass('None');
  375.  
  376. {
  377. Assign standard sheet sizes to the variables W & H.
  378. }
  379.  
  380.     IF Type = 1 THEN BEGIN
  381.         W[1,1]:=11;W[1,2]:=17;W[1,3]:=22;W[1,4]:=34;
  382.         W[1,5]:=44;W[1,6]:=40;
  383.         H[1,1]:=8.5;H[1,2]:=11;H[1,3]:=17;H[1,4]:=22;
  384.         H[1,5]:=34;H[1,6]:=28;
  385.     END
  386.     ELSE IF Type = 2 THEN BEGIN
  387.         W[1,1]:=12;W[1,2]:=18;W[1,3]:=24;W[1,4]:=36;
  388.         W[1,5]:=48;W[1,6]:=42;
  389.         H[1,1]:=9;H[1,2]:=12;H[1,3]:=18;H[1,4]:=24;
  390.         H[1,5]:=36;H[1,6]:=30;
  391.     END
  392.     ELSE BEGIN
  393.         W[1,1]:=46.811;W[1,2]:=33.110;W[1,3]:=23.386;
  394.         W[1,4]:=16.535;W[1,5]:=11.693;
  395.         H[1,1]:=33.110;H[1,2]:=23.386;H[1,3]:=16.535;
  396.         H[1,4]:=11.693;H[1,5]:=8.268;
  397.     END;
  398.  
  399. {
  400. Calculate outer and inner border sizes and adjust for units per inch.
  401. }
  402.  
  403.     FOR n:=1 TO 6 DO BEGIN
  404.         W[2,n]:=W[1,n]*UPI-2*POffset;
  405.         W[3,n]:=W[2,n]-2*BWidth;
  406.         H[2,n]:=H[1,n]*UPI-2*POffset;
  407.         H[3,n]:=H[2,n]-2*BWidth;
  408.     END;
  409.     x1:=W[3,Size]/2;
  410.     y1:=H[3,Size]/2;
  411.     x2:=W[2,Size]/2;
  412.     y2:=H[2,Size]/2;
  413.  
  414. {
  415. Insert title block symbol & text.
  416. }
  417.  
  418.     Layer('Drawing Form');
  419.     SetScale(1);
  420.     Absolute;
  421.     IF NOT TitleBlock THEN GOTO 10;
  422.  
  423. {
  424. Get the title block symbol handle, record handle and number of fields.
  425. }
  426.  
  427.     SymbolH:=GetObject(SymbolName);
  428.     IF SymbolH = NIL THEN BEGIN
  429.         SysBeep;
  430.         s:=Concat('There is no title block symbol named ',SymbolName,' in the symbol library!');
  431.         AlrtDialog(s);
  432.         GOTO 99;
  433.     END;
  434.     RecordH:=GetObject(RecordName);
  435.     IF RecordH = NIL THEN BEGIN
  436.         SysBeep;
  437.         s:=Concat('There is no record named ',RecordName,' in this drawing!');
  438.         AlrtDialog(s);
  439.         GOTO 99;
  440.     END;
  441.     NFields:=NumFields(RecordH);
  442.  
  443. {
  444. Assign the field names to the variable FieldName[i]. Append a colon to the field names to display in the dialog box. 
  445. }
  446.  
  447.     FOR i:=1 TO NFields DO BEGIN
  448.         FieldName[i]:=GetFldName(RecordH,i);
  449.         FieldNameD[i]:=Concat(FieldName[i],':');
  450.     END;
  451.  
  452. {
  453. Get the current default values of all fields of the record.
  454. }
  455.  
  456.     FOR i:=1 TO NFields DO BEGIN
  457.         Field:=Concat('''',RecordName,'''','.','''',FieldName[i],'''');
  458.         FieldVal[i]:=EvalStr(SymbolH,Field);
  459.     END;
  460.  
  461. {
  462. Assign any delault values for the title block here; Field[4] is the date, Field[5] is the drawing size.
  463. }
  464.  
  465.     FieldVal[4]:=Date(2,0);
  466.     IF (Type = 1) OR (Type = 2) THEN
  467.         FieldVal[5]:=Chr(64+Size)
  468.     ELSE BEGIN
  469.         IF Size = 1 THEN FieldVal[5]:='A0'
  470.         ELSE IF Size = 2 THEN FieldVal[5]:='A1'
  471.         ELSE IF Size = 3 THEN FieldVal[5]:='A2'
  472.         ELSE IF Size = 4 THEN FieldVal[5]:='A3'
  473.         ELSE FieldVal[5]:='A4';
  474.     END;
  475.  
  476. {
  477. Display the title block information dialog box.
  478. }
  479.  
  480.     TitleDialog;
  481.     GetTitleInfo;
  482.     IF Abort THEN GOTO 99;
  483.     Symbol(SymbolName,x1,-y1,0);
  484.     SymbolH:=LSActLayer;
  485.  
  486. {
  487. Get the title block information and enter the values into the record.
  488. }
  489.  
  490.     FOR i:=1 TO NFields DO BEGIN
  491.         SetRField(SymbolH,RecordName,FieldName[i],NewVal[i]);
  492.     END;
  493.  
  494. {
  495. Draw Borders.
  496. }
  497.  
  498.     10:PenSize(20);
  499.     Rect(-x1,y1,x1,-y1);        
  500.     PenSize(7);
  501.     Rect(-x2,y2,x2,-y2);
  502.  
  503. {
  504. Draw grids.
  505. }
  506.  
  507.     IF NOT ShowGrids THEN GOTO 20;
  508.  
  509. {
  510. Draw grid lines.
  511. }
  512.  
  513.     IF Type = 3 THEN BEGIN
  514.         NZones[1,1]:=12; NZones[1,2]:=16;
  515.         NZones[2,1]:=8; NZones[2,2]:=12;
  516.         NZones[3,1]:=6; NZones[3,2]:=8;
  517.         NZones[4,1]:=4; NZones[4,2]:=6;
  518.         NZones[5,1]:=2; NZones[5,2]:=2;
  519.     END
  520.     ELSE BEGIN
  521.         NZones[1,1]:=2; NZones[1,2]:=2;
  522.         NZones[2,1]:=2; NZones[2,2]:=4;
  523.         NZones[3,1]:=4; NZones[3,2]:=4;
  524.         NZones[4,1]:=4; NZones[4,2]:=8;
  525.         NZones[5,1]:=8; NZones[5,2]:=8;
  526.         NZones[6,1]:=6; NZones[6,2]:=8;
  527.     END;
  528.     dx1:=2*x1/NZones[Size,2];
  529.     dy1:=2*y1/NZones[Size,1];
  530.     TextFont(3);
  531.     TextSize(TSize);
  532.     TextFace([bold]);
  533.     TextFlip(0);
  534.     TextRotate(#0);
  535.     TextSpace(2);
  536.     TextJust(2);
  537.     Absolute;
  538.     MoveTo(-x1,y1+BWidth);
  539.     Relative;
  540.     FOR n:=1 TO NZones[Size,2]-1 DO BEGIN
  541.         MoveTo(dx1,-BWidth);
  542.         LineTo(0,BWidth);
  543.     END;
  544.     Absolute;
  545.     MoveTo(-x1,-(y1+BWidth));
  546.     Relative;
  547.     FOR n:=1 TO NZones[Size,2]-1 DO BEGIN
  548.         MoveTo(dx1,BWidth);
  549.         LineTo(0,-BWidth);
  550.     END;
  551.     Absolute;
  552.     MoveTo(-(x1+BWidth),y1);
  553.     Relative;
  554.     FOR n:=1 TO NZones[Size,1]-1 DO BEGIN
  555.         MoveTo(BWidth,-dy1);
  556.         LineTo(-BWidth,0);
  557.     END;
  558.     Absolute;
  559.     MoveTo(x1,y1);
  560.     Relative;
  561.     FOR n:=1 TO NZones[Size,1]-1 DO BEGIN
  562.         MoveTo(BWidth,-dy1);
  563.         LineTo(-BWidth,0);
  564.     END;
  565.  
  566. {
  567. Enter grid numbers at top and bottom.
  568. }
  569.  
  570.     dy:=BWidth/2+0.6*TSize*UPI/72;
  571.     Absolute;
  572.     MoveTo(x1+dx1/2,y1+dy);
  573.     Relative;
  574.     FOR n:=1 TO NZones[Size,2] DO BEGIN
  575.         TextOrigin(-dx1,0);
  576.         BeginText;
  577.             Num2Str(0,n)
  578.         EndText;
  579.     END;
  580.     dy:=BWidth/2-0.6*TSize*UPI/72;
  581.     Absolute;
  582.     MoveTo(x1+dx1/2,-(y1+dy));
  583.     Relative;
  584.     FOR n:=1 TO NZones[Size,2] DO BEGIN
  585.         Achar:=Chr(64+n);
  586.         TextOrigin(-dx1,0);
  587.         BeginText;
  588.                 Num2Str(0,n)
  589.         EndText;
  590.     END;
  591.  
  592. {
  593. Enter grid letters along sides.
  594. }
  595.  
  596.     Absolute;
  597.     MoveTo(-(x1+BWidth/2),-(y1+dy1/2));
  598.     Relative;
  599.     FOR n:=1 TO NZones[Size,1] DO BEGIN
  600.         Achar:=Chr(64+n);
  601.         TextOrigin(0,dy1);
  602.         BeginText;
  603.             Achar
  604.         EndText;
  605.     END;
  606.     Absolute;
  607.     MoveTo(x1+BWidth/2,-(y1+dy1/2));
  608.     Relative;
  609.     FOR n:=1 TO NZones[Size,1] DO BEGIN
  610.         Achar:=Chr(64+n);
  611.         TextOrigin(0,dy1);
  612.         BeginText;
  613.             AChar
  614.         EndText;
  615.     END;
  616.     20:Group;
  617.     PopAttrs;
  618. 99:END;
  619.  
  620. RUN(DrawingForm);