home *** CD-ROM | disk | FTP | other *** search
/ Chip 1998 March / Chip_1998-03_cd.bin / tema / MINICAD / MC7DEMO / MINICAD.1 / SORTINST.MPC < prev    next >
Text File  |  1997-04-30  |  8KB  |  253 lines
  1. PROCEDURE SortEnumerate;
  2. LABEL 1,2,3,4,5,6;
  3. CONST
  4.  
  5. {** DATA LABEL RECORD & FIELD NAMES }
  6.  
  7.     kRec ='Instruments';
  8.     kFld = 'Unit Number';
  9.     kDLinkRec ='Links';
  10.     kDLinkID ='Linked to';
  11.     kDLinkFldName ='Item';
  12.  
  13. {** OTHER LOCAL CONSTANTS }
  14.  
  15. kValidCoord = 25000000;
  16.  
  17. VAR
  18.     finished,cncl,allsel,flag,doUpdate : BOOLEAN;
  19.     item,x1,x2,count,sfield,numsel,c1,numfield,objtype : INTEGER;
  20.     prefix,suffix,stringnum,seqEntry,ln,it,n,startNumTxt,increTxt : STRING;
  21.     startnum,incre : REAL;
  22.     decimalPlaces : INTEGER;
  23.  
  24.     xMin,xCurrent,xc,yc,yMin,yCurrent : REAL;
  25.     j,k,numObjects : REAL;
  26.     objName,currentNumTxt,saveString,dbRef : STRING;
  27.     objectHan,saveHan,upDateHan : HANDLE;
  28.  
  29. {** GetUnits Placeholder Variables }
  30.     Frac,DisAcc : LONGINT;
  31.     Format : INTEGER;
  32.     UPI : REAL;
  33.     UMark,SqUMark : STRING;
  34.  
  35. PROCEDURE CenterDialog(dX1,dX2 : INTEGER; VAR x1,x2 : INTEGER);
  36. VAR
  37.     scrX1,scrY1,scrX2,scrY2,w : INTEGER;
  38. BEGIN
  39.     GetScreen(scrX1,scrY1,scrX2,scrY2);
  40.     w := dX2 - dX1;
  41.     x1 := ((scrX1 + scrX2) DIV 2) - (w DIV 2);
  42.     x2 := x1 + w;
  43. END;
  44.  
  45. {**PROCEDURE updateText(updateHan : HANDLE); }
  46. {**BEGIN }
  47. {**    SETTEXT(updateHan,CONCAT(prefix,currentNumTxt,suffix)); }
  48. {**END; }
  49.  
  50. BEGIN
  51.     CenterDialog(0,320,x1,x2);
  52.     BeginDialog(1,1,x1,30,x2,360);
  53.         AddButton('OK',1,1,222,294,286,317);
  54.         AddButton('Cancel',2,1,133,294,197,317);
  55.         AddField('___________________',3,1,76,14,243,32);
  56.         AddField('________________________________',4,1,23,170,298,188);
  57.         AddField('Sort/Enumerate Dialog',5,1,76,6,244,24);
  58.         AddField('Start Value:',6,1,139,43,223,60);
  59.         AddField('Increment:',7,1,143,77,223,94);
  60.         AddField('Prefix:',8,1,174,111,223,128);
  61.         AddField('Suffix:',9,1,175,145,223,162);
  62.         AddField(' ',10,2,227,43,280,60);
  63.         AddField(' ',11,2,227,77,280,94);
  64.         AddField('',12,2,227,111,280,128);
  65.         AddField('',13,2,227,145,280,162);
  66.         AddButton('Sort T to B',14,3,19,42,115,59);
  67.         AddButton('Sort B to T',15,3,19,76,115,93);
  68.         AddButton('Sort L to R',16,3,19,110,115,127);
  69.         AddButton('Sort R to L',17,3,19,144,115,161);
  70. {**        AddButton('Update Unit Number data labels.', 18,2,20,194,252,214); }
  71.         AddField('NOTE: Special version. Non╨data label symbols will be deselected.',19,1,20,233,300,283);
  72.     EndDialog;
  73.     GetDialog(1);
  74.     SelField(10);
  75. {**    SetItem(18,TRUE); }
  76.     finished := FALSE;
  77.     cncl:= FALSE;
  78.     sfield := 0;
  79.     REPEAT DialogEvent(item);
  80.         IF item > 2 THEN BEGIN
  81.             IF (item > 13) AND (item < 18) THEN BEGIN
  82.                 IF sfield <> 0 THEN SetItem(sfield,FALSE);
  83.                 SetItem(item,TRUE);        
  84.                 sfield := item;
  85.             END;
  86. {**            IF item = 18 THEN SETITEM(item,NOT(itemSel(item))); }
  87.         END
  88.         ELSE BEGIN
  89.             IF item = 2 THEN BEGIN
  90.                 finished := TRUE;
  91.                 cncl := TRUE;
  92.                 GOTO 5;
  93.             END;
  94.             IF item = 1 THEN BEGIN
  95.                 IF sfield = 0 THEN BEGIN
  96.                     SYSBEEP;
  97.                     GOTO 5;
  98.                 END;
  99.                 IF Getfield(10) = ' ' THEN BEGIN
  100.                     SYSBEEP;
  101.                     SelField(10);
  102.                     GOTO 5;
  103.                 END;
  104.                 IF Getfield(11) = ' ' THEN BEGIN
  105.                     SYSBEEP;
  106.                     SelField(11);
  107.                     GOTO 5;
  108.                 END;
  109.                 IF NOT ValidNumStr(Getfield(10),startnum) THEN BEGIN
  110.                     SYSBEEP;
  111.                     SelField(10);
  112.                 END;
  113.                 IF NOT ValidNumStr(Getfield(11),incre) THEN BEGIN
  114.                     SYSBEEP;
  115.                     SelField(11);
  116.                 END
  117.                 ELSE finished := TRUE;
  118.             END;
  119.         5:END;
  120.     UNTIL finished;
  121.     sfield:=sfield - 13;
  122.     {**doUpdate:= ItemSel(18);}
  123.     startNumTxt:= GetField(10);
  124.     increTxt:= GetField(11);
  125.     prefix:= GetField(12);
  126.     suffix:= GetField(13);
  127.     CLRDIALOG;
  128.     IF cncl THEN GOTO 6;
  129. {** Determine greatest decimal places for string increment }
  130.     decimalPlaces:=POS('.',startNumTxt);
  131.     IF decimalPlaces <> 0 THEN decimalPlaces:= (LEN(startNumTxt))-decimalPlaces;
  132.     x2:=POS('.',increTxt);
  133.     IF x2 <> 0 THEN x2:= (LEN(increTxt))-x2;
  134.     IF x2>decimalPlaces THEN decimalPlaces:=x2;
  135. {**************************************************}
  136.     SETCURSOR(WATCHC);
  137.     currentNumTxt:= startNumTxt;
  138.     IF len(currentNumTxt) = 1 THEN currentNumTxt:= CONCAT(' ',currentNumTxt);
  139.     DSelectObj(NOT((T=Symbol) & (R IN [kRec])));
  140. {** Someday this will be easier }
  141.     numObjects:= 0;
  142.     objectHan:=FSACTLAYER;
  143.     WHILE objectHan <> NIL DO BEGIN
  144.         numObjects:= numObjects + 1;
  145.         objectHan:= NEXTSOBJ(objectHan);
  146.     END;
  147.     GETUNITS(Frac,DisAcc,Format,UPI,UMark,SqUMark);
  148.     
  149.     IF sField = 1 THEN BEGIN
  150.         yCurrent:= kValidCoord/UPI;
  151.         FOR k:= 1 TO numObjects DO BEGIN
  152.             yMin:= -kValidCoord/UPI;
  153.             objectHan:=FSACTLAYER;
  154.             objName:= GETNAME(objectHan);
  155.             WHILE objectHan <> NIL DO BEGIN
  156.                 HCENTER(objectHan,xc,yc);
  157.                 IF (yc >= yCurrent) THEN GOTO 1;
  158.                 IF (yc <= yMin) THEN GOTO 1;
  159.                 yMin:= yc;
  160.                 objName:= GETNAME(objectHan);
  161.                 1:objectHan:=NEXTSOBJ(objectHan);
  162.             END;
  163.             saveHan:=  GETOBJECT(objName);
  164.             SETRFIELD(saveHan,kRec,kFld,CONCAT(prefix,currentNumTxt,suffix));
  165. {**            IF doUpdate THEN BEGIN }
  166. {**                DBRef:=CONCAT('(''',kDLinkRec,'''.''',kDLinkID,''')'); }
  167. {**                FOREACHOBJECT(updateText,(('Links'.'Linked To' = GETNAME(saveHan))&('Links'.'Item' = kFld)); }
  168. {**            END; }
  169.             currentNumTxt:=  NUM2STR(decimalPlaces,(str2Num(currentNumTxt) + str2Num(increTxt)));
  170.             IF len(currentNumTxt) = 1 THEN currentNumTxt:= CONCAT(' ',currentNumTxt);
  171.             yCurrent:= yMin;
  172.         END;
  173.     END;
  174.     
  175.     IF sField = 2 THEN BEGIN
  176.         yCurrent:= -kValidCoord/UPI;
  177.         FOR k:= 1 TO numObjects DO BEGIN
  178.             yMin:= kValidCoord/UPI;
  179.             objectHan:=FSACTLAYER;
  180.             objName:= GETNAME(objectHan);
  181.             WHILE objectHan <> NIL DO BEGIN
  182.                 HCENTER(objectHan,xc,yc);
  183.                 IF (yc <= yCurrent) THEN GOTO 2;
  184.                 IF (yc >= yMin) THEN GOTO 2;
  185.                 yMin:= yc;
  186.                 objName:= GETNAME(objectHan);
  187.                 2:objectHan:=NEXTSOBJ(objectHan);
  188.             END;
  189.             saveHan:=  GETOBJECT(objName);
  190.             SETRFIELD(saveHan,kRec,kFld,CONCAT(prefix,currentNumTxt,suffix));
  191. {**            IF doUpdate THEN BEGIN }
  192. {**                DBRef:=CONCAT('(''',kDLinkRec,'''.''',kDLinkID,''')'); }
  193. {**                FOREACHOBJECT(updateText,('Links'.'Linked to' = GETNAME(saveHan)); }
  194. {**            END; }
  195.             currentNumTxt:=  NUM2STR(decimalPlaces,(str2Num(currentNumTxt) + str2Num(increTxt)));
  196.             IF len(currentNumTxt) = 1 THEN currentNumTxt:= CONCAT(' ',currentNumTxt);
  197.             yCurrent:= yMin;
  198.         END;
  199.     END;
  200.     
  201.     IF sField = 3 THEN BEGIN
  202.         xCurrent:= -kValidCoord/UPI;
  203.         FOR k:= 1 TO numObjects DO BEGIN
  204.             xMin:= kValidCoord/UPI;
  205.             objectHan:=FSACTLAYER;
  206.             objName:= GETNAME(objectHan);
  207.             WHILE objectHan <> NIL DO BEGIN
  208.                 HCENTER(objectHan,xc,yc);
  209.                 IF (xc <= xCurrent) THEN GOTO 3;
  210.                 IF (xc >= xMin) THEN GOTO 3;
  211.                 xMin:= xc;
  212.                 objName:= GETNAME(objectHan);
  213.                 3:objectHan:=NEXTSOBJ(objectHan);
  214.             END;
  215.             saveHan:=  GETOBJECT(objName);
  216.             SETRFIELD(saveHan,kRec,kFld,CONCAT(prefix,currentNumTxt,suffix));
  217. {**            IF doUpdate THEN BEGIN }
  218. {**                DBRef:=CONCAT('(''',kDLinkRec,'''.''',kDLinkID,''')'); }
  219. {**                FOREACHOBJECT(updateText,('Links'.'Linked to' = GETNAME(saveHan)); }
  220. {**            END; }
  221.             currentNumTxt:=  NUM2STR(decimalPlaces,(str2Num(currentNumTxt) + str2Num(increTxt)));
  222.             IF len(currentNumTxt) = 1 THEN currentNumTxt:= CONCAT(' ',currentNumTxt);
  223.             xCurrent:= xMin;
  224.         END;
  225.     END;
  226.     IF sField = 4 THEN BEGIN
  227.         xCurrent:= kValidCoord/UPI;
  228.         FOR k:= 1 TO numObjects DO BEGIN
  229.             xMin:= -kValidCoord/UPI;
  230.             objectHan:=FSACTLAYER;
  231.             objName:= GETNAME(objectHan);
  232.             WHILE objectHan <> NIL DO BEGIN
  233.                 HCENTER(objectHan,xc,yc);
  234.                 IF (xc >= xCurrent) THEN GOTO 4;
  235.                 IF (xc <= xMin) THEN GOTO 4;
  236.                 xMin:= xc;
  237.                 objName:= GETNAME(objectHan);
  238.                 4:objectHan:=NEXTSOBJ(objectHan);
  239.             END;
  240.             saveHan:=  GETOBJECT(objName);
  241.             SETRFIELD(saveHan,kRec,kFld,CONCAT(prefix,currentNumTxt,suffix));
  242. {**            IF doUpdate THEN BEGIN }
  243. {**                DBRef:=CONCAT('(''',kDLinkRec,'''.''',kDLinkID,''')'); }
  244. {**                FOREACHOBJECT(updateText,('Links'.'Linked to' = '1003'); }
  245. {**            END; }
  246.             currentNumTxt:=  NUM2STR(decimalPlaces,(str2Num(currentNumTxt) + str2Num(increTxt)));
  247.             IF len(currentNumTxt) = 1 THEN currentNumTxt:= CONCAT(' ',currentNumTxt);
  248.             xCurrent:= xMin;
  249.         END;
  250.     END;
  251. 6:END;
  252. RUN(SortEnumerate);
  253.