home *** CD-ROM | disk | FTP | other *** search
/ Chip 1998 March / Chip_1998-03_cd.bin / tema / MINICAD / MC7DEMO / MINICAD.1 / SETUP_DL.MPC < prev    next >
Text File  |  1997-04-30  |  10KB  |  329 lines
  1. PROCEDURE SetupLinks;
  2. {
  3. ⌐1997, Diehl Graphsoft, Inc.
  4. Developed by Frank Brault
  5. Last modified: 04/18/97
  6. }
  7. LABEL 1,2;
  8. CONST
  9.  
  10. {*** DATA LABEL LAYER, CLASS, RECORD & FIELD NAMES ***}
  11.  
  12.     kPlotLayerName = 'Light Plot';
  13.     kLegendLayerName = 'Legend';
  14.     kLegendSymName ='Key Symbol';
  15.     kLabelKeyClassName ='Key Labels';
  16.     kIDStart = 1000;
  17.     kIDRec = 'Key Symbol Data';
  18.     kIDFld = 'Next ID';
  19.     kDLinkRec ='Links';
  20.     kDLinkID ='Linked to';
  21.     kDLinkFldName ='Item';
  22.     kRec ='Instruments';
  23.     kFldItems = 'Focus,Color,Dimmer,Unit Number,Circuit,Channel,Lamp,Type,Position,Template,Ganged with,Remarks,Frame Size';
  24.     
  25.     {*** DATA LABEL OPTIONS ***}
  26.  
  27.     kFieldSeparator = ',';
  28.     kEmptyValue = '0';
  29.     kDefaultClass = 'None';
  30.     kTemporaryClass = 'tmp';
  31.     tempLocusName = 'tempLocus';
  32.     
  33.     kUnlinkCreate = TRUE;
  34.     kUnlinkUpdate = TRUE;
  35.     kLinkUpdateFound = TRUE;
  36.     kLinkUpdateNew = TRUE;
  37.     kLinkDeleteBefore = TRUE;
  38.     kLinkCreateNew = TRUE;
  39.     kLinkCreateMissing = TRUE;
  40.     kLabelUpdate = TRUE;
  41.     kLabelDeleteOrphan = TRUE;
  42.  
  43. VAR
  44.     tHan,linkHan,symHan,layerHan,recHan,keyHan,LegendLayerHan: HANDLE;
  45.     str1,str2,str3,str4,str5,str6,str7:STRING;
  46.     contents,size,symName,nextID:STRING;
  47.     DBRef,layerRef,classRef,recRef,fldRef,strRef : STRING;
  48.     textStr,linkItem,linkField,linkID:STRING;
  49.     fldItemStr,fldItem,fieldName,recordName,nameStr : STRING;
  50.     fldCount,i,j,dataLabelCount,recCount:INTEGER;
  51.     item,x1,x2,classIndex,counter : INTEGER;
  52.     tx,ty,tx1,ty1,tx2,ty2,myLayerScale : REAL;
  53.     cancel,finished,needDialog,hasAll : BOOLEAN;
  54.     flag : ARRAY[1..8] OF BOOLEAN; {result flags}
  55.  
  56. PROCEDURE CenterDialog(dX1,dX2 : INTEGER; VAR x1,x2 : INTEGER);
  57. VAR
  58.     scrX1,scrY1,scrX2,scrY2,w : INTEGER;
  59. BEGIN
  60.     GetScreen(scrX1,scrY1,scrX2,scrY2);
  61.     w := dX2 - dX1;
  62.     x1 := ((scrX1 + scrX2) DIV 2) - (w DIV 2);
  63.     x2 := x1 + w;
  64. END;
  65.  
  66. PROCEDURE ParseStr(write : BOOLEAN);
  67. BEGIN
  68.     fldCount:=0;
  69.     fldItemStr:= kFldItems;
  70.     WHILE(POS(',',fldItemStr) <> 0) DO
  71.     BEGIN
  72.         item:= POS(',',fldItemStr);
  73.         fieldName:= COPY(fldItemStr,1,item-1);
  74.         IF write THEN NEWFIELD(kRec, fieldName, kEmptyValue, 4, 0);
  75.         fldCount:= fldCount +1;
  76.         DELETE(fldItemStr,1,item);
  77.     END;
  78.     IF write THEN NEWFIELD(kRec, fldItemStr, kEmptyValue, 4, 0);
  79.     fldCount:= fldCount +1;
  80. END;
  81.  
  82.  
  83. BEGIN
  84. PushAttrs;
  85.     {*** Initialize result flags ***}
  86. FOR i:=1 TO 8 DO flag[i]:= FALSE;
  87.     {*** Check for at least one symbol ***}
  88. IF SymDefNum < 1 THEN
  89. BEGIN
  90.  AlrtDialog('There should be at least 1 symbol defined in this file before running this procedure.');
  91. GOTO 2;
  92. END;
  93.     {*** Check for active symbol definition ***}
  94. IF ActSymDef = NIL THEN
  95. BEGIN
  96.     CENTERDIALOG(0,320,x1,x2);
  97.     BEGINDIALOG(3,1,x1,185,x2,330);
  98.         ADDBUTTON('OK',1,1,237,101,301,124);
  99.         ADDBUTTON('Cancel',2,1,158,101,222,124);
  100.         ADDFIELD('There is no symbol currently selected.',3,1,18,29,288,47);
  101.         ADDFIELD('Data labels will use first symbol in file.',4,1,18,52,295,70);
  102.     ENDDIALOG;
  103.     GetDialog(3);
  104.     finished := FALSE;
  105.     cancel:= FALSE;
  106.     REPEAT DialogEvent(item);
  107.         IF item = 2 THEN
  108.         BEGIN
  109.             finished := TRUE;
  110.             cancel := TRUE;
  111.         END;
  112.     IF item = 1 THEN finished := TRUE;
  113.     UNTIL finished;
  114.     CLRDIALOG;
  115.     IF cancel THEN GOTO 2;
  116.     symHan:= FSymDef;
  117.     WHILE getType(SymHan) =11 DO symHan:= FInfolder(SymHan);
  118.     symName:= GetName(symHan);
  119.     SETACTSYMBOL(symName);
  120. END; {of IF ActSymDef = NIL}
  121.  
  122.     {***  CHECK FOR EXISTING DATALABEL ELEMENTS  ***}
  123.     {*** Check for Layer ***}
  124. layerHan:= FLayer;
  125. WHILE layerHan<>NIL DO
  126. BEGIN
  127.     IF GetLName(layerHan) = kLegendLayerName THEN
  128.     BEGIN
  129.         flag[1]:= TRUE;
  130.         LegendLayerHan:=layerHan;
  131.     {*** The layer already exists ***}
  132.     END;
  133.     layerHan:= NextLayer(layerHan);
  134. END;
  135.  
  136.     {*** Check for Class ***}
  137. classIndex:= ClassNum;
  138. counter:=0;
  139. FOR counter:=1 TO classIndex DO
  140. BEGIN
  141.     IF ClassList(counter) = kLabelKeyClassName THEN flag[2]:= TRUE;
  142.     {*** The class already exists ***}
  143. END;
  144.  
  145.     {*** Check for Record Instances ***}
  146. recCount:= NUMRECORDS(NIL);
  147. FOR i:= 1 TO recCount DO
  148. BEGIN
  149. recHan:= GETRECORD(NIL,i);
  150. nameStr:= GetName(recHan);
  151. IF nameStr = kRec THEN flag[3]:= TRUE;
  152. IF nameStr = kIDRec THEN flag[4]:= TRUE;
  153. IF nameStr = kDLinkRec THEN flag[5]:= TRUE;
  154. END;
  155.  
  156.     {*** Check for Key Symbol ***}
  157. IF (COUNT(N=kLegendSymName)<>0) THEN flag[6]:= TRUE;
  158.     {*** Check for Key Labels ***}
  159. IF (COUNT((L=kLegendLayerName) & (C=kLabelKeyClassName))<>0) THEN flag[7]:= TRUE;
  160. dataLabelCount:= COUNT((L=kLegendLayerName) & (C=kLabelKeyClassName));
  161.  
  162.     {*** Data Labels Results Dialog ***}
  163.     {*** Check if needed ***}
  164. needDialog:= FALSE;
  165. FOR i:=1 TO 8 DO IF flag[i] THEN needDialog:= TRUE;
  166. IF needDialog THEN BEGIN
  167. hasAll:= TRUE;
  168. FOR i:=1 TO 7 DO IF NOT(flag[i]) THEN hasAll:= FALSE;
  169. IF hasAll THEN BEGIN
  170. ALRTDIALOG('This file has all of the required elements for the
  171. Data Labels system.');
  172. GOTO 2;
  173. END;
  174.     {*** Load Dialog Strings ***}
  175. str1:= CONCAT('Layer: ''',kLegendLayerName,'''');
  176. str2:= CONCAT('Class: ''',kLabelKeyClassName,'''');
  177. str3:= CONCAT('Record: ''',kRec,'''');
  178. str4:= CONCAT('Record: ''',kIDRec,'''');
  179. str5:= CONCAT('Record: ''',kDLinkRec,'''');
  180. str6:= CONCAT('Symbol Key named: ''',kLegendSymName,'''');
  181. str7:= kLabelKeyClassName;
  182. IF flag[7] THEN
  183.  str7:= CONCAT(NUM2STR(0,dataLabelCount),' ''', str7,''' items');
  184. CENTERDIALOG(0,320,x1,x2);
  185. BEGINDIALOG(4,1,x1,130,x2,461);
  186. ADDBUTTON('Continue',1,1,225,285,311,308);
  187. ADDBUTTON('Cancel',2,1,145,285,209,308);
  188. ADDFIELD('________________',3,1,9,17,148,35);
  189. ADDFIELD('Data Labels Results',4,1,10,9,149,27);
  190. ADDFIELD('The checked items below are already',5,1,19,45,300,63);
  191. ADDFIELD('present. Continue to append missing',6,1,19,68,267,86);
  192. ADDFIELD('structures.',7,1,19,91,300,109);
  193. ADDBUTTON(str1,8,2,9,133,319,151);
  194. ADDBUTTON(str2,9,2,9,151,316,169);
  195. ADDBUTTON(str3,10,2,9,169,319,187);
  196. ADDBUTTON(str4,11,2,9,187,317,205);
  197. ADDBUTTON(str5,12,2,9,205,319,223);
  198. ADDBUTTON(str6,13,2,9,223,314,241);
  199. ADDBUTTON(str7,14,2,9,241,315,259);
  200. ENDDIALOG;
  201. GetDialog(4);
  202. SetItem(8,flag[1]);
  203. SetItem(9,flag[2]);
  204. SetItem(10,flag[3]);
  205. SetItem(11,flag[4]);
  206. SetItem(12,flag[5]);
  207. SetItem(13,flag[6]);
  208. SetItem(14,flag[7]);
  209. finished := FALSE;
  210. cancel:= FALSE;
  211. REPEAT DialogEvent(item);
  212. IF item = 1 THEN finished := TRUE;
  213. IF item = 2 THEN
  214. BEGIN
  215.  finished := TRUE;
  216.  cancel := TRUE;
  217. END;
  218. UNTIL finished;
  219. CLRDIALOG;
  220. IF cancel THEN GOTO 2;
  221. END;
  222. IF (GetLScale(LegendLayerHan) = 1.0) THEN SetScale(24);
  223.    {*** Parse field name string for field count ***}
  224. ParseStr(FALSE);
  225.  
  226.    {*** Data Labels Setup Dialog ***}
  227. IF (FLAG[7] = FALSE) THEN BEGIN
  228. str1:=CONCAT('(up to ',fldCount,')');
  229. CENTERDIALOG(0,342,x1,x2);
  230. BEGINDIALOG(1,1,x1,75,x2,431);
  231. ADDBUTTON('OK',1,1,255,294,319,317);
  232. ADDBUTTON('Cancel',2,1,175,294,239,317);
  233. ADDFIELD('_____________________',3,1,24,21,201,39);
  234. ADDFIELD('Data Labels Setup Dialog',4,1,23,14,200,31);
  235. ADDFIELD('This procedure places an instance of the',5,1,25,56,289,73);
  236. ADDFIELD('active symbol at the origin. The symbol',6,1,25,78,298,95);
  237. ADDFIELD('and labels may be moved if desired,',7,1,25,100,327,117);
  238. ADDFIELD('after the procedure.',8,1,25,122,171,139);
  239. ADDFIELD('Enter the number of labels to be placed',9,1,25,163,310,180);
  240. ADDFIELD(str1,10,1,248,185,410,202);
  241. ADDFIELD('with the legend symbol:',11,1,25,185,192,202);
  242. ADDFIELD('The procedure uses default field names.',12,1,25,207,309,224);
  243. ADDFIELD('(Change to Instrument field names if other labels are desired.)',13,1,25,251,316,268);
  244. ADDFIELD('3',14,2,201,182,233,202);
  245. ENDDIALOG;
  246. GetDialog(1);
  247. SelField(14);
  248. finished := FALSE;
  249. cancel:= FALSE;
  250. REPEAT DialogEvent(item);
  251.     IF item = 2 THEN
  252.     BEGIN
  253.         finished := TRUE;
  254.         cancel := TRUE;
  255.     END;
  256. IF item = 1 THEN finished := TRUE;
  257. UNTIL finished;
  258. str1:= GetField(14);
  259. CLRDIALOG;
  260. IF cancel THEN GOTO 2;
  261. dataLabelCount:=str2Num(str1);
  262. if dataLabelCount>fldCount THEN dataLabelCount:=fldCount;
  263. END;
  264. IF flag[1] = FALSE THEN Layer(kLegendLayerName);
  265.  
  266. IF flag[3] = FALSE THEN ParseStr(TRUE);
  267. IF flag[4] = FALSE THEN NewField(kIDRec,kIDFld,kEmptyValue,4,0);
  268. IF flag[5] = FALSE THEN BEGIN
  269.     NewField(kDLinkRec,kDLinkID,kEmptyValue,4,0);
  270.     NewField(kDLinkRec,kDLinkFldName,kEmptyValue,4,0);
  271. END;
  272.  
  273. IF flag[6] = FALSE THEN
  274. BEGIN
  275.     Layer(kLegendLayerName);
  276.     symHan:= ActSymDef;
  277.     symName:=GetName(symHan);
  278.     NameObject(kLegendSymName);
  279.     Symbol(symName, 0, 0, 0);
  280.     keyHan:=LNewObj;
  281.     SetRecord(keyHan,kIDRec);
  282.     SetRField(keyHan,kIDRec,kIDFld,NUM2STR(0,kIDStart+COUNT(ALL)));
  283.     i := NumRecords(keyHan);
  284.     IF (i>0) THEN BEGIN
  285.         FOR j := 1 to i DO BEGIN
  286.             recHan := GetRecord(keyHan,j);
  287.             recordName:= GetName(recHan);
  288.             IF recordName = kRec THEN flag[8]:=TRUE;
  289.     END; {of FOR j := 1 to i}
  290.     END; {of IF (i>0) Statement}
  291. END; {of IF flag[6] Statement}
  292.  
  293. IF flag[7] = FALSE THEN
  294. BEGIN
  295. tx:= 0;
  296. ty:= 0;
  297. TEXTJUST(2);
  298. TEXTSIZE(9);
  299. Layer(kLegendLayerName);
  300. NameClass(kLabelKeyClassName);
  301. recHan := GetObject(kRec);
  302.     FOR j := 1 to dataLabelCount DO BEGIN
  303.         TEXTORIGIN(tx,ty);
  304.         str1 := GetFldName(recHan,j);
  305.         BEGINTEXT;
  306.             str1
  307.         ENDTEXT;
  308.         tHan:= LNEWOBJ;
  309.         GetBBox(tHan,tx1,ty1,tx2,ty2);
  310.         ty:= ty2+((ty2-ty1)*.5));
  311.     END;
  312. END; {of IF flag[7] Statement}
  313.  
  314. IF flag[8] THEN BEGIN
  315. DelRecord(keyHan,kRec);
  316. END;
  317.  
  318. DoMenuText('Normal Scale');
  319. LAYER(kLegendLayerName);
  320. DSelectAll;
  321. LAYER(kPlotLayerName);
  322. DoMenuText('Show/Snap/Modify Others');
  323. ALRTDIALOG('Arrange the labels in the legend as desired, then
  324. place instruments in Light Plot layer.');
  325.  
  326. 2:PopAttrs;
  327. END;
  328. RUN(SetupLinks);
  329.