home *** CD-ROM | disk | FTP | other *** search
/ Chip 1998 March / Chip_1998-03_cd.bin / tema / MINICAD / MC7DEMO / MINICAD.1 / OBJSUBS.TXT < prev    next >
Text File  |  1997-04-22  |  7KB  |  299 lines
  1. <!---------------------------------------------------------->
  2. Procedure DeriveArcBBox(CenterX,CenterY,Rad:REAL; VAR X1,Y1,X2,Y2:REAL);
  3. BEGIN
  4.     X1:=CenterX-Rad;
  5.     Y1:=CenterY+Rad;
  6.     X2:=CenterX+Rad;
  7.     Y2:=CenterY-Rad;
  8. END;
  9. <!---------------------------------------------------------->
  10. Procedure DeriveOvalBBox(CenX,CenY,HorAx,VerAx:REAL; VAR X1,Y1,X2,Y2:REAL);
  11. BEGIN
  12.     X1:=CenX-HorAx;
  13.     Y1:=CenY+VerAx;
  14.     X2:=CenX+HorAx;
  15.     Y2:=CenY-VerAx;
  16. END;
  17. <!---------------------------------------------------------->
  18. Procedure CircleByCtrRad(CenX,CenY,Rad:REAL);
  19. VAR
  20.     X1,Y1,X2,Y2:REAL;
  21. BEGIN
  22.     X1:=CenX-Rad;
  23.     Y1:=CenY+Rad;
  24.     X2:=CenX+Rad;
  25.     Y2:=CenY-Rad;
  26.     Oval(X1,Y1,X2,Y2);
  27. END;
  28. <!---------------------------------------------------------->
  29. Procedure ArcByCtrRad(CenX,CenY,Rad,StartAngle,SweepAngle:REAL);
  30. VAR
  31.     X1,Y1,X2,Y2:REAL;
  32. BEGIN
  33.     X1:=CenX-Rad;
  34.     Y1:=CenY+Rad;
  35.     X2:=CenX+Rad;
  36.     Y2:=CenY-Rad;
  37.     Arc(X1,Y1,X2,Y2,StartAngle,SweepAngle);
  38. END;
  39. <!---------------------------------------------------------->
  40. Procedure ArcPoints(ArcHd:HANDLE;VAR StartX,StartY,EndX,EndY:REAL);
  41. VAR
  42.     StartAngle,ArcAngle,SweepAngle,R,CenX,CenY:REAL;
  43. BEGIN
  44.     GetArc(ArcHd,StartAngle,ArcAngle);
  45.  
  46.     R:=(HPerim(ArcHd)/(Deg2Rad(ArcAngle)))*12;
  47.     HCenter(ArcHd,CenX,CenY);
  48.  
  49.     StartX:=CenX+(R*(cos(Deg2Rad(StartAngle))));
  50.     StartY:=CenY+(R*(sin(Deg2Rad(StartAngle))));
  51.  
  52.     SweepAngle:=ArcAngle+StartAngle;
  53.     EndX:=CenX+(R*(cos(Deg2Rad(SweepAngle))));
  54.     EndY:=CenY+(R*(sin(Deg2Rad(SweepAngle))));
  55. END;
  56. <!---------------------------------------------------------->
  57. Function ArcRadius(ArcHd:HANDLE):REAL;
  58. VAR
  59.     AAng,Rad:REAL;
  60. BEGIN
  61.     AAng:=HAngle(ArcHd);
  62.     Rad:=(HPerim(ArcHd)*12/Deg2Rad(AAng));
  63.     ArcRadius:=Rad;
  64. END;
  65. <!---------------------------------------------------------->
  66. Procedure ObjectInfo(ObjectHd:HANDLE;VAR LayerN,ClassN,NameN:STRING;VAR Type,FillPatNum,LStyleNum,LWt :INTEGER);
  67. VAR
  68.     LayerHd:HANDLE;
  69. BEGIN
  70.     LayerHd:=GetLayer(ObjectHd);
  71.     LayerN:=GetLName(LayerHd);
  72.     
  73.     ClassN:=GetClass(ObjectHd);
  74.     NameN:=GetName(ObjectHd);
  75.     
  76.     Type:=GetType(ObjectHd);
  77.     FillPatNum:=GetFPat(ObjectHd);
  78.     LStyleNum:=GetLS(ObjectHd);
  79.     LWt:=GetLW(ObjectHd);
  80. END;
  81. <!---------------------------------------------------------->
  82. Procedure ObjectGeom2D(ObjectHd: HANDLE;VAR BBoxX1,BBoxY1,BBoxX2,BBoxY2,Ht,Width,Area,Perim:REAL);
  83. BEGIN
  84.     GetBBox(ObjectHd,BBoxX1,BBoxY1,BBoxX2,BBoxY2);
  85.     Ht:=HHeight(ObjectHd);
  86.     Width:=HWidth(ObjectHd);
  87.     Area:=HArea(ObjectHd);
  88.     Perim:=HPerim(ObjectHd);
  89. END;
  90. <!---------------------------------------------------------->
  91. Procedure ObjectGeom3D(ObjectHd: HANDLE;VAR Ht,Width,Depth,CenX,CenY,CenZ:REAL);
  92. BEGIN
  93.     Get3DInfo(ObjectHd,Ht,Width,Depth);
  94.     Get3DCnter(ObjectHd,CenX,CenY,CenZ);
  95. END;
  96. <!---------------------------------------------------------->
  97. Procedure TextInfo(ObjectHd:HANDLE;VAR ContentStr:STRING;FontID,Size,StyleSum:INTEGER);
  98. BEGIN
  99.     ContentStr:=GetText(ObjectHd);
  100.     FontID:=GetFont(ObjectHd);
  101.     Size:=GetSize(ObjectHd);
  102.     StyleSum:=GetStyle(ObjectHd);
  103. END;
  104. <!---------------------------------------------------------->
  105. Procedure StyleReader(StyleIndex:INTEGER;VAR IsPlain,IsBold,IsItal,IsUnd,IsOutL,IsShad:BOOLEAN);
  106. VAR
  107.     StyleArray:ARRAY [1..6] OF BOOLEAN;
  108.     i,FlagCompare:INTEGER;
  109. BEGIN
  110.     i:=1;
  111.     FlagCompare:=16;
  112.     
  113.     StyleArray[1]:=FALSE;
  114.     StyleArray[2]:=FALSE;
  115.     StyleArray[3]:=FALSE;
  116.     StyleArray[4]:=FALSE;
  117.     StyleArray[5]:=FALSE;
  118.     IsPlain:=FALSE;
  119.  
  120.     
  121.     WHILE StyleIndex > 0 DO BEGIN
  122.         IF StyleIndex >= FlagCompare THEN BEGIN
  123.             StyleIndex:=StyleIndex-FlagCompare;
  124.             StyleArray[i]:=TRUE;
  125.         END;
  126.         
  127.         i:=i+1;
  128.         FlagCompare:=FlagCompare DIV 2;
  129.         IF (FlagCompare = 0) THEN FlagCompare:=1;
  130.     END;
  131.     
  132.     IsShad:=StyleArray[1];
  133.     IsOutL:=StyleArray[2];
  134.     IsUnd:=StyleArray[3];
  135.     IsItal:=StyleArray[4];
  136.     IsBold:=StyleArray[5];
  137.     
  138.     IF NOT (IsShad)&(NOT IsOutL)&(NOT IsUnd)&(NOT IsItal)&(NOT IsBold) THEN
  139.         IsPlain:=TRUE;
  140. END;
  141. <!---------------------------------------------------------->
  142. Function TraverseWall(WallHd:HANDLE;SymbolName:STRING;SelectStat:BOOLEAN):HANDLE;
  143. VAR
  144.     Hd:HANDLE;
  145.     Type:INTEGER;
  146.     Nm:STRING;
  147.     Sel,Hit:BOOLEAN;
  148. BEGIN
  149.     Hd:=FIn3D(WallHd);
  150.     WHILE (Hd<>NIL) AND (NOT Hit) DO BEGIN
  151.         Type:=GetType(Hd);
  152.         IF Type=15 THEN BEGIN
  153.             SelectStat:=Selected(Hd);
  154.             Nm:=GetSymName(Hd);
  155.             
  156.             IF ((Nm=SymbolName)AND(SelectStat=Sel)) THEN Hit:=TRUE;
  157.         END
  158.         ELSE BEGIN
  159.             Hd:=NextObj(Hd);
  160.         END;
  161.     END;
  162.     
  163.     TraverseWall:=Hd;
  164. END;
  165. <!---------------------------------------------------------->
  166. Function TraverseWallName(WallHd:HANDLE):STRING;
  167. VAR
  168.     Hd:HANDLE;
  169.     Type:INTEGER;
  170.     Nm:STRING;
  171.     Sel,Hit:BOOLEAN;
  172. BEGIN
  173.     Hit:=FALSE;
  174.     Hd:=FIn3D(WallHd);
  175.     WHILE (Hd<>NIL) AND (NOT Hit) DO BEGIN
  176.         Type:=GetType(Hd);
  177.         IF Type=15 THEN BEGIN            
  178.             IF (Selected(Hd)) THEN Hit:=TRUE;
  179.         END
  180.         ELSE BEGIN
  181.             Hd:=NextObj(Hd);
  182.         END;
  183.     END;
  184.     
  185.     TraverseWallName:=GetSymName(Hd);
  186. END;
  187. <!---------------------------------------------------------->
  188. Procedure MakeModelLink(LayerName,LinkName:STRING);
  189. BEGIN
  190.     IF LinkName='NIL' THEN BEGIN
  191.         LinkName:=Concat(LayerName,' Link');
  192.     END;
  193.     LayerRef(LayerName);
  194.     ResetOrientation3D;
  195.     UnLckObjs;
  196.     SetName(LNewObj,LinkName);
  197.     LckObjs;
  198. END;
  199. <!---------------------------------------------------------->
  200. Procedure SwapLink(LinkName:STRING;NewLayer:STRING);
  201. VAR
  202.     oldLinkHd,newLinkHd,LHd:HANDLE;
  203.     name:STRING;
  204.     Found:BOOLEAN;
  205. BEGIN
  206.     oldLinkHd:=GetObject(LinkName);
  207.     Found:=False;
  208.     LHd:=FLayer;
  209.     newLinkHd:=NIL;
  210.  
  211.     WHILE (LHd<> NIL) & (NOT Found) DO BEGIN
  212.         name:=GetLName(LHd);
  213.         IF name=NewLayer THEN BEGIN
  214.             Found:=True;
  215.             newLinkHd:=LHd;
  216.         END;
  217.         LHd:=NextLayer(LHd);
  218.     END;
  219.  
  220.     IF newLinkHd <> NIL THEN BEGIN
  221.         SetHDef(oldLinkHd,newLinkHd);
  222.         ResetOrientation3D;
  223.         Redraw;
  224.     END
  225.     ELSE BEGIN
  226.         AlrtDialog('Warning: new link was not found');
  227.     END;
  228. END;
  229. <!---------------------------------------------------------->
  230. Procedure MoveSymInWall(h:HANDLE;dist:REAL);
  231. VAR
  232.     sh:HANDLE;
  233.     x1,y1,x2,y2,d:REAL;
  234.     symName:STRING;
  235.  
  236. Function TraverseWallSel(WallHd:HANDLE):HANDLE;
  237. VAR
  238.     Hd:HANDLE;
  239.     Type:INTEGER;
  240.     Sel,Hit:BOOLEAN;
  241. BEGIN
  242.     Hit:=FALSE;
  243.     Hd:=FIn3D(WallHd);
  244.     
  245.     WHILE (Hd<>NIL) AND (NOT Hit) DO BEGIN
  246.         Type:=GetType(Hd);
  247.         
  248.         IF Type=15 THEN BEGIN            
  249.             IF (Selected(Hd)) THEN Hit:=TRUE
  250.         ELSE
  251.             Hd:=NextObj(Hd);    
  252.         END
  253.         ELSE BEGIN
  254.             Hd:=NextObj(Hd);
  255.         END;
  256.     END;
  257.     
  258.     TraverseWallSel:=Hd;
  259. END;
  260.  
  261. BEGIN
  262.     IF(GetType(h) = 68) THEN BEGIN
  263.         GetSegPt1(h,x1,y1);
  264.         sh:=TraverseWallSel(h);
  265.         IF sh <> NIL THEN BEGIN
  266.             GetSymLoc(sh,x2,y2);
  267.             symName:=GetSymName(sh);
  268.     
  269.             d:=Distance(x1,y1,x2,y2);
  270.             d:=d+dist;
  271.     
  272.             IF DeleteWallSym(sh) THEN
  273.                 AddSymToWall(h,d,0,FALSE,FALSE,symName);
  274.         END;
  275.     END;        
  276. END;
  277. <!---------------------------------------------------------->
  278. Procedure SetCustomLightColor(hd:HANDLE;rpercent,gpercent,bpercent:INTEGER);
  279. VAR
  280.     red,grn,blu:LONGINT;
  281.  
  282. FUNCTION PercentToRGB(percentage:INTEGER):LONGINT;
  283. CONST 
  284.     MAX_RGB = 65535;
  285. VAR
  286.     calcRGB:LONGINT;
  287. BEGIN
  288.     calcRGB:= Trunc((MAX_RGB * (percentage/100)));
  289.     Percent2RGB := calcRGB;
  290. END;
  291.     
  292. BEGIN
  293.     red:=PercentToRGB(rpercent);
  294.     grn:=PercentToRGB(gpercent);
  295.     blu:=PercentToRGB(gpercent);
  296.     
  297.     SetPenFore(hd,red,grn,blu);
  298. END;
  299.