home *** CD-ROM | disk | FTP | other *** search
/ Chip 1998 March / Chip_1998-03_cd.bin / tema / MINICAD / MC7DEMO / MINICAD.1 / EDIT_DL.MPC < prev    next >
Text File  |  1997-04-30  |  5KB  |  181 lines
  1. PROCEDURE EditLinks;
  2. LABEL 1,2,3;
  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. kShowHelp=TRUE;
  34.  
  35. VAR
  36. g,tHan,symHan:HANDLE;
  37. x,y:REAL;
  38. str,linkID,linkField,DBRef:STRING;
  39. ctr:INTEGER;
  40. done,quit,go,firstTimeThru:BOOLEAN;
  41.     
  42. PROCEDURE ParseStr(write : BOOLEAN);
  43. VAR
  44. fldCount, item : INTEGER;
  45. fldItemStr, fieldName : STRING;
  46. BEGIN
  47.     fldCount:=0;
  48.     fldItemStr:= kFldItems;
  49.     WHILE(POS(',',fldItemStr) <> 0) DO
  50.     BEGIN
  51.         item:= POS(',',fldItemStr);
  52.         fieldName:= COPY(fldItemStr,1,item-1);
  53.         IF write THEN NEWFIELD(kRec, fieldName, '0', 4, 0)
  54.         ELSE fldCount:= fldCount +1;
  55.         DELETE(fldItemStr,1,item);
  56.     END;
  57.     IF write THEN NEWFIELD(kRec, fldItemStr, '0', 4, 0)
  58.     ELSE fldCount:= fldCount +1;
  59. END;
  60.  
  61. FUNCTION needSetUp : BOOLEAN;
  62. VAR
  63. flag : ARRAY[1..8] OF BOOLEAN; {result flags}
  64. recHan, layerHan : HANDLE;
  65. i, classIndex, counter, recCount : INTEGER;
  66. nameStr : STRING;
  67. BEGIN
  68.     {*** Initialize result flags ***}
  69. FOR i:=1 TO 7 DO flag[i]:= TRUE;
  70. flag[8]:= FALSE;
  71.  
  72.     {***  CHECK FOR EXISTING DATALABEL ELEMENTS  ***}
  73.     {*** Check for Layer ***}
  74. layerHan:= FLayer;
  75. WHILE layerHan<>NIL DO
  76. BEGIN
  77.     IF GetLName(layerHan) = kLegendLayerName THEN flag[1]:= FALSE;
  78.     {*** The layer already exists ***}
  79.     layerHan:= NextLayer(layerHan);
  80. END;
  81.  
  82.     {*** Check for Class ***}
  83. classIndex:= ClassNum;
  84. counter:=0;
  85. FOR counter:=1 TO classIndex DO IF ClassList(counter) = kLabelKeyClassName THEN flag[2]:= FALSE;
  86.     {*** The class already exists ***}
  87.     {*** Check for Record Instances ***}
  88. recCount:= NUMRECORDS(NIL);
  89. FOR i:= 1 TO recCount DO
  90. BEGIN
  91. recHan:= GETRECORD(NIL,i);
  92. nameStr:= GetName(recHan);
  93. IF nameStr = kRec THEN flag[3]:= FALSE;
  94. IF nameStr = kIDRec THEN flag[4]:= FALSE;
  95. IF nameStr = kDLinkRec THEN flag[5]:= FALSE;
  96. END;
  97.  
  98.     {*** Check for Key Symbol ***}
  99. IF (COUNT(N=kLegendSymName)<>0) THEN flag[6]:= FALSE;
  100.     {*** Check for Key Labels ***}
  101. IF (COUNT((L=kLegendLayerName) & (C=kLabelKeyClassName))<>0) THEN flag[7]:= FALSE;
  102.  
  103.     
  104.     {*** Check if result dialog is needed ***}
  105. FOR i:=1 TO 7 DO IF flag[i] THEN flag[8]:= TRUE;
  106. needSetUp:= flag[8];
  107. END;
  108.  
  109. BEGIN
  110. PushAttrs;
  111. IF needSetUp THEN BEGIN
  112. SYSBEEP;
  113. ALRTDIALOG('This command needs certain elements. Please run the command
  114. Set up Data Labels╔');
  115. GOTO 1;
  116. END;
  117. firstTimeThru:= TRUE;
  118. tHan:=FSACTLAYER;
  119. go:= FALSE;
  120. quit:= FALSE;
  121. 2:done:=FALSE;
  122. IF kShowHelp THEN MESSAGE('Select a data label for editing. Press any key to exit.');
  123. SetCursor(ArrowC);
  124. WHILE NOT done DO
  125. BEGIN
  126.     IF (tHan <> NIL) AND (firstTimeThru) THEN GOTO 3;
  127.     REPEAT
  128.         IF KEYDOWN(ctr) THEN done := TRUE;
  129.     UNTIL MOUSEDOWN(x,y) OR done;
  130.     IF (NOT done) THEN tHan:=PICKOBJECT(x,y);
  131.     3:firstTimeThru:= FALSE;
  132.     IF (tHan<>NIL) AND (GETTYPE(tHan)=10) AND (EVALSTR(tHan,(R IN ['Links']))='True') THEN
  133.         BEGIN
  134.             IF done THEN GOTO 1;
  135.             IF kShowHelp THEN MESSAGE('Data label selected.');
  136.             IF g <> NIL THEN SETDSELECT(g);
  137.             SETSELECT(tHan);
  138.             REDRAW;
  139.             IF tHan <> NIL THEN g:= tHan;
  140.             str:= GETTEXT(tHan);
  141.             SetCursor(TextBarC);
  142.             str:=STRDIALOG('Enter the text to be replaced.',str);
  143.             IF DIDCANCEL THEN BEGIN
  144.             IF kShowHelp THEN MESSAGE('Data link unchanged.')
  145.             GOTO 2;
  146.             END
  147.             ELSE
  148.             BEGIN
  149.             IF kShowHelp THEN MESSAGE('Updating database╔');
  150.             SetText(tHan,Str);
  151.             REDRAW;
  152. DBRef:=CONCAT('(''',kDLinkRec,'''.''',kDLinkID,''')'); 
  153.             linkID:=EVALSTR(tHan,DBRef);
  154. DBRef:=CONCAT('(''',kDLinkRec,'''.''',kDLinkFldName,''')');
  155.             linkField:=EVALSTR(tHan,DBRef);
  156.             symHan:= GetObject(linkID);
  157.             SETRFIELD(symHan,kRec,linkField,str);
  158.             GOTO 2;
  159.             END;
  160.         END
  161.     ELSE
  162.         BEGIN
  163.             SYSBEEP;
  164.             IF g <> NIL THEN SETDSELECT(g);
  165.             IF tHan <> NIL THEN SETSELECT(tHan);
  166.             REDRAW;
  167.             IF tHan <> NIL THEN g:= tHan;
  168.             IF done THEN
  169.             BEGIN
  170.                 quit:=YNDIALOG('Data label not selected. Exit?');
  171.                 IF quit THEN GOTO 1
  172.                 ELSE GOTO 2;
  173.             END
  174.             ELSE IF kShowHelp THEN MESSAGE('Data label not selected.');
  175.         END;
  176. END;
  177. 1:PopAttrs;
  178. CLRMESSAGE;
  179. END;
  180. RUN(EditLinks);
  181.