home *** CD-ROM | disk | FTP | other *** search
/ Chip 1998 March / Chip_1998-03_cd.bin / tema / MINICAD / MC7DEMO / MINICAD.1 / UPDATEDL.MPC < prev    next >
Encoding:
Text File  |  1997-04-30  |  3.4 KB  |  133 lines
  1. PROCEDURE UpdateLinks;
  2. LABEL 1,2;
  3. CONST
  4.  
  5. {DATA LABEL LAYER, CLASS, RECORD & FIELD NAMES}
  6.  
  7.     kLegendLayerName = 'Legend';
  8.     kLegendSymName ='Key Symbol';
  9.     kLabelKeyClassName ='Key Labels';
  10.     kIDStart = 1000;
  11.     kIDRec = 'Key Symbol Data';
  12.     kIDFld = 'Next ID';
  13.     kDLinkRec ='Links';
  14.     kDLinkID ='Linked to';
  15.     kDLinkFldName ='Item';
  16.     kRec ='Instruments';
  17.     kFldItems = 'Focus,Color,Dimmer,Unit Number,Circuit,Channel,Lamp,Type,Position,Template,Ganged with,Remarks,Frame Size';
  18.  
  19. {***** DATA LABEL OPTIONS *****}
  20.  
  21. kUnlinkCreate = TRUE;
  22. kUnlinkUpdate = TRUE;
  23. kLinkUpdateFound = TRUE;
  24. kLinkUpdateNew = TRUE;
  25. kLinkDeleteBefore = TRUE;
  26. kLinkCreateNew = TRUE;
  27. kLinkCreateMissing = TRUE;
  28. kLabelUpdate = TRUE;
  29. kLabelDeleteOrphan = TRUE;
  30.  
  31. {***** OTHER LOCAL CONSTANTS *****}
  32.  
  33. kTextType = 10;
  34.  
  35. VAR
  36. tHan,linkHan,symHan: HANDLE;
  37. str,contents,size:STRING;
  38. textStr,item,linkField,DBRef,linkID:STRING;
  39.  
  40. PROCEDURE ParseStr(write : BOOLEAN);
  41. VAR
  42. fldCount, item : INTEGER;
  43. fldItemStr, fieldName : STRING;
  44. BEGIN
  45.     fldCount:=0;
  46.     fldItemStr:= kFldItems;
  47.     WHILE(POS(',',fldItemStr) <> 0) DO
  48.     BEGIN
  49.         item:= POS(',',fldItemStr);
  50.         fieldName:= COPY(fldItemStr,1,item-1);
  51.         IF write THEN NEWFIELD(kRec, fieldName, '0', 4, 0)
  52.         ELSE fldCount:= fldCount +1;
  53.         DELETE(fldItemStr,1,item);
  54.     END;
  55.     IF write THEN NEWFIELD(kRec, fldItemStr, '0', 4, 0)
  56.     ELSE fldCount:= fldCount +1;
  57. END;
  58.  
  59. FUNCTION needSetUp : BOOLEAN;
  60. VAR
  61. flag : ARRAY[1..8] OF BOOLEAN; {result flags}
  62. recHan, layerHan : HANDLE;
  63. i, classIndex, counter, recCount : INTEGER;
  64. nameStr : STRING;
  65. BEGIN
  66.     {*** Initialize result flags ***}
  67. FOR i:=1 TO 7 DO flag[i]:= TRUE;
  68. flag[8]:= FALSE;
  69.  
  70.     {***  CHECK FOR EXISTING DATALABEL ELEMENTS  ***}
  71.     {*** Check for Layer ***}
  72. layerHan:= FLayer;
  73. WHILE layerHan<>NIL DO
  74. BEGIN
  75.     IF GetLName(layerHan) = kLegendLayerName THEN flag[1]:= FALSE;
  76.     {*** The layer already exists ***}
  77.     layerHan:= NextLayer(layerHan);
  78. END;
  79.  
  80.     {*** Check for Class ***}
  81. classIndex:= ClassNum;
  82. counter:=0;
  83. FOR counter:=1 TO classIndex DO IF ClassList(counter) = kLabelKeyClassName THEN flag[2]:= FALSE;
  84.     {*** The class already exists ***}
  85.     {*** Check for Record Instances ***}
  86. recCount:= NUMRECORDS(NIL);
  87. FOR i:= 1 TO recCount DO
  88. BEGIN
  89. recHan:= GETRECORD(NIL,i);
  90. nameStr:= GetName(recHan);
  91. IF nameStr = kRec THEN flag[3]:= FALSE;
  92. IF nameStr = kIDRec THEN flag[4]:= FALSE;
  93. IF nameStr = kDLinkRec THEN flag[5]:= FALSE;
  94. END;
  95.  
  96.     {*** Check for Key Symbol ***}
  97. IF (COUNT(N=kLegendSymName)<>0) THEN flag[6]:= FALSE;
  98.     {*** Check for Key Labels ***}
  99. IF (COUNT((L=kLegendLayerName) & (C=kLabelKeyClassName))<>0) THEN flag[7]:= FALSE;
  100.  
  101.     
  102.     {*** Check if set up is needed ***}
  103. FOR i:=1 TO 7 DO IF flag[i] THEN flag[8]:= TRUE;
  104. needSetUp:= flag[8];
  105. END;
  106.  
  107. BEGIN
  108. PushAttrs;
  109. IF needSetUp THEN BEGIN
  110. SYSBEEP;
  111. ALRTDIALOG('This command needs certain elements. Please run the command
  112. Set up Data Labelsâ•”');
  113. GOTO 1;
  114. END;
  115. SETCURSOR(WATCHC);
  116. DSelectObj(NOT(R IN [kDLinkRec]));
  117. tHan := LSActLayer;
  118. WHILE tHan <> NIL DO
  119. BEGIN
  120. IF GETTYPE(tHan) <> kTextType THEN GOTO 2;
  121. DBRef:=CONCAT('(''',kDLinkRec,'''.''',kDLinkID,''')');
  122. linkID:=EVALSTR(tHan,DBRef);
  123. DBRef:=CONCAT('(''',kDLinkRec,'''.''',kDLinkFldName,''')');
  124. linkField:=EVALSTR(tHan,DBRef);
  125. symHan:= GetObject(linkID);
  126. DBRef:=CONCAT('(''',kRec,'''.''',linkField,''')');
  127. str:=EVALSTR(symHan,DBRef);
  128. SETTEXT(tHan,str);
  129. 2:tHan :=PrevSObj(tHan);
  130. END;
  131. 1:PopAttrs
  132. END;
  133. RUN(UpdateLinks);