home *** CD-ROM | disk | FTP | other *** search
/ Chip 1998 March / Chip_1998-03_cd.bin / tema / MINICAD / MC7DEMO / MINICAD.1 / CREATEDL.MPC < prev    next >
Text File  |  1997-04-30  |  5KB  |  205 lines
  1. PROCEDURE MakeLinks;
  2. CONST
  3.  
  4. {DATA LABEL LAYER, CLASS, RECORD & FIELD NAMES}
  5.  
  6.     kLegendLayerName = 'Legend';
  7.     kLegendSymName ='Key Symbol';
  8.     kLabelKeyClassName ='Key Labels';
  9.     kIDStart = 1000;
  10.     kIDRec = 'Key Symbol Data';
  11.     kIDFld = 'Next ID';
  12.     kDLinkRec ='Links';
  13.     kDLinkID ='Linked to';
  14.     kDLinkFldName ='Item';
  15.     kRec ='Instruments';
  16.     kFldItems = 'Focus,Color,Dimmer,Unit Number,Circuit,Channel,Lamp,Type,Position,Template,Ganged with,Remarks,Frame Size';
  17.  
  18. {***** DATA LABEL OPTIONS *****}
  19.  
  20.     kUnlinkCreate = TRUE;
  21.     kUnlinkUpdate = TRUE;
  22.     kLinkUpdateFound = TRUE;
  23.     kLinkUpdateNew = TRUE;
  24.     kLinkDeleteBefore = TRUE;
  25.     kLinkCreateNew = TRUE;
  26.     kLinkCreateMissing = TRUE;
  27.     kLabelUpdate = TRUE;
  28.     kLabelDeleteOrphan = TRUE;
  29.  
  30. {***** OTHER LOCAL CONSTANTS *****}
  31.  
  32.     kEmptyValue = '0';
  33.  
  34. VAR
  35.     userLayerHan,tHan,locHan,symHan,keyHan:HANDLE;
  36.     selGroupHan,labelGroupHan:HANDLE;
  37.     n,x1,x2,y1,y2,symRot:REAL;
  38.     i:INTEGER;
  39.     userLayerName,strItem,strID,nextID,DBRef : STRING;
  40.  
  41. PROCEDURE ParseStr(write : BOOLEAN);
  42. VAR
  43.     fldCount, item : INTEGER;
  44.     fldItemStr, fieldName : STRING;
  45. BEGIN
  46.     fldCount:=0;
  47.     fldItemStr:= kFldItems;
  48.     WHILE(POS(',',fldItemStr) <> 0) DO
  49.     BEGIN
  50.         item:= POS(',',fldItemStr);
  51.         fieldName:= COPY(fldItemStr,1,item-1);
  52.         IF write THEN NEWFIELD(kRec, fieldName, '0', 4, 0)
  53.         ELSE fldCount:= fldCount +1;
  54.         DELETE(fldItemStr,1,item);
  55.     END;
  56.     IF write THEN NEWFIELD(kRec, fldItemStr, '0', 4, 0)
  57.     ELSE fldCount:= fldCount +1;
  58. END;
  59.  
  60. FUNCTION needSetUp : BOOLEAN;
  61. VAR
  62.     flag : ARRAY[1..8] OF BOOLEAN; {result flags}
  63.     recHan, layerHan : HANDLE;
  64.     i, classIndex, counter, recCount : INTEGER;
  65.     nameStr : STRING;
  66. BEGIN
  67.     {*** Initialize result flags ***}
  68.     FOR i:=1 TO 7 DO flag[i]:= TRUE;
  69.     flag[8]:= FALSE;
  70.  
  71.     {***  CHECK FOR EXISTING DATALABEL ELEMENTS  ***}
  72.     {*** Check for Layer ***}
  73.     layerHan:= FLayer;
  74.     WHILE layerHan<>NIL DO
  75.     BEGIN
  76.         IF GetLName(layerHan) = kLegendLayerName THEN flag[1]:= FALSE;
  77.         {*** The layer already exists ***}
  78.         layerHan:= NextLayer(layerHan);
  79.     END;
  80.  
  81.     {*** Check for Class ***}
  82.     classIndex:= ClassNum;
  83.     counter:=0;
  84.     FOR counter:=1 TO classIndex DO IF ClassList(counter) = kLabelKeyClassName THEN flag[2]:= FALSE;
  85.     {*** The class already exists ***}
  86.     {*** Check for Record Instances ***}
  87.     recCount:= NUMRECORDS(NIL);
  88.     FOR i:= 1 TO recCount DO
  89.     BEGIN
  90.         recHan:= GETRECORD(NIL,i);
  91.         nameStr:= GetName(recHan);
  92.         IF nameStr = kRec THEN flag[3]:= FALSE;
  93.         IF nameStr = kIDRec THEN flag[4]:= FALSE;
  94.         IF nameStr = kDLinkRec THEN flag[5]:= FALSE;
  95.     END;
  96.  
  97.     {*** Check for Key Symbol ***}
  98.     IF (COUNT(N=kLegendSymName)<>0) THEN flag[6]:= FALSE;
  99.     {*** Check for Key Labels ***}
  100.     IF (COUNT((L=kLegendLayerName) & (C=kLabelKeyClassName))<>0) THEN flag[7]:= FALSE;
  101.  
  102.     
  103.     {*** Check if set up is needed ***}
  104.     FOR i:=1 TO 7 DO IF flag[i] THEN flag[8]:= TRUE;
  105.     needSetUp:= flag[8];
  106. END;
  107.  
  108. BEGIN
  109.     PushAttrs;
  110.     IF NOT(needSetUp) THEN
  111.     BEGIN
  112.             
  113.         ANGLEVAR;
  114.         userLayerHan:= ActLayer;
  115.         userLayerName:= GetLName(userLayerHan);
  116.         GROUP;
  117.         selGroupHan:= FSActLayer;
  118.         SetDSelect(selGroupHan);
  119.         LAYER(kLegendLayerName);
  120.         keyHan:= GETOBJECT(kLegendSymName);
  121.         DBRef:=CONCAT('(''',kIDRec,'''.''',kIDFld,''')');
  122.         nextID:=EVALSTR(keyHan,DBRef);
  123.         GETSYMLOC(keyHan,x1,y1);
  124.         DSelectObj(L=kLegendLayerName);
  125.         SelectObj(C=kLabelKeyClassName);
  126.         DOMENUTEXT('Show/Snap Others');
  127.         DOMENUTEXT('Copy');
  128.         DSELECTALL;
  129.         LAYER(userLayerName);
  130.         SetSelect(selGroupHan);
  131.         symHan:= FInGroup(selGroupHan);
  132.         WHILE symHan <> NIL DO            {***SYMBOL LOOP***}
  133.         BEGIN
  134.             strID:= GetName(symHan);
  135.             IF (strID='') | (strID='none') THEN
  136.             BEGIN
  137.                 SETNAME(symHan,nextID);
  138.                 n:= STR2NUM(nextID)+1;
  139.                 nextID:= NUM2STR(0,n);
  140.                 SETRFIELD(keyHan,kIDRec,kIDFld,nextID);
  141.             END;
  142.             symRot:=GETSYMROT(symHan);
  143.             SETRECORD(symHan,kRec);
  144.             GETSYMLOC(symHan,x2,y2);
  145.             NAMECLASS('tmp');
  146.             DOMENUTEXT('Paste In Place');
  147.             MoveObjs(x2-x1,y2-y1,FALSE,FALSE);
  148.             NAMEOBJECT('tempLocus');
  149.             LOCUS(x2,y2);
  150.             locHan:= GetObject('tempLocus');
  151.             Rotate(#symRot);
  152.             DELOBJECT(locHan);
  153.             tHan:=FSACTLAYER;
  154.             WHILE tHan <> NIL DO          {***TEXT LABEL LOOP***}
  155.             BEGIN
  156.                 strItem:=GETTEXT(tHan);
  157.                 strID:= GetName(symHan);
  158.                 SETRECORD(tHan,kDLinkRec);
  159.                 SETRFIELD(tHan,kDLinkRec,kDLinkID,strID);
  160.                 SETRFIELD(tHan,kDLinkRec,kDLinkFldName,strItem);
  161.                 SETCLASS(tHan,'tmp');
  162.                 tHan:= NEXTSOBJ(tHan);
  163.             END;
  164.             tHan:=FSACTLAYER;
  165.             WHILE tHan <> NIL DO
  166.             BEGIN
  167.                 DSelectObj(C='tmp');
  168.                 SetSelect(tHan);
  169.                 Rotate(#-symRot);
  170.     {**  MAYBE THIS WILL GET FIXED BEFORE RELEASE !!!!}
  171.                 IF symRot = 90 THEN Rotate(#180);
  172.                 IF kLabelUpdate THEN
  173.                 BEGIN
  174.                     strItem:=GETTEXT(tHan);
  175.                     DBRef := CONCAT('(''',kRec,'''.''',strItem,''')');
  176.                     strItem := EvalStr(symHan, DBRef);
  177.                     IF (strItem <> kEmptyValue) THEN setText(tHan,strItem);
  178.                 END;
  179.                 SelectObj(C='tmp');
  180.                 tHan:= NEXTSOBJ(tHan);
  181.             END;                       {***OF TEXT LABEL LOOP***}
  182.     
  183.             NAMECLASS('None');
  184.             DSelectObj(C='tmp');
  185.             DelClass('tmp');
  186.             symHan:= NEXTSOBJ(symHan);
  187.         
  188.         END;                         {***OF SYMBOL LOOP***}
  189.         SetSelect(selGroupHan);
  190.         UNGROUP;
  191.         
  192.     END
  193.     ELSE
  194.     BEGIN
  195.     
  196.         SYSBEEP;
  197.         ALRTDIALOG('This command needs certain elements. Please run the command
  198.         Set up Data Labels╔');
  199.         
  200.     END;
  201. PopAttrs;
  202.  
  203. END;
  204. RUN(MakeLinks);
  205.