home *** CD-ROM | disk | FTP | other *** search
/ Chip 1998 March / Chip_1998-03_cd.bin / tema / MINICAD / MC7DEMO / MINICAD.1 / UPDATWKS.MPC < prev    next >
Text File  |  1997-04-30  |  3KB  |  115 lines
  1. PROCEDURE UpDateWorksheet;
  2. {
  3. ⌐1997, Diehl Graphsoft, Inc.
  4. Developed by Frank Brault
  5. Last modified: 04/18/97
  6. }
  7. LABEL 1;
  8. CONST
  9.     kSpaceSymName = 'Space Name Box';
  10.     kRelationSymName = 'Relationship Box';
  11.     kWorksheetName='Area Worksheet';
  12.     kWorksheetTextSize = 10;
  13.     kWorksheetFont = 3;
  14.     kSpaceRec = 'Space';
  15.     kSpaceFld = 'Name';
  16.     kAdjacentRec = 'Adjacency';
  17.     kAdjacentFld = 'Code';
  18. VAR
  19.     WSH : HANDLE;
  20.     startRow,numRows,numCols,numNames,r1,r2,i,c : INTEGER;
  21.     str,worksheetName,spaceName : STRING;
  22.     doAlert1,doAlert2 : BOOLEAN;
  23.  
  24. PROCEDURE ProcessNames(han : HANDLE);
  25. LABEL 2;
  26. VAR
  27.     emptyRow: BOOLEAN;
  28.     str1,str2,str3: STRING;
  29.     a1:REAL;
  30.  
  31. BEGIN
  32. {** Reject if not a named object}
  33.     str1:= GetName(han);
  34.     IF (str1 = 'none') THEN GoTo 2;
  35.     a1:= HArea(han);
  36.     
  37. {** Reject if area is 0}
  38.     IF (a1 = 0) THEN GoTo 2;
  39.     str3:= Num2Str(2,a1);
  40.     
  41. {** Find valid named object in worksheet}
  42. {** If match found then load actual area}
  43.     FOR r1:= startRow TO numRows DO
  44.     BEGIN
  45.         str2:= GetCellStr(WSH,r1,1);
  46.         IF (str1 = str2) THEN
  47.         BEGIN
  48.             LoadCell(r1,3,str3);
  49.             GOTO 2;
  50.         END;
  51.     END;
  52.     
  53. {** If we got here then there is a space on drawing not listed in worksheet}
  54.  
  55. {** Find an empty row}
  56. {** If empty row found then load name and actual area}
  57. {** If no empty rows found then set alert flag for end of procedure}
  58.     FOR r2:= startRow TO numRows DO
  59.     BEGIN
  60.         emptyRow:= TRUE;
  61.         FOR c:= 1 TO numCols DO IF CellHasStr(WSH,r2,c) THEN emptyRow:= FALSE;
  62.  
  63.         IF emptyRow THEN
  64.         BEGIN
  65.             LoadCell(r2,3,str3);
  66.             LoadCell(r2,1,str1);
  67.             GoTo 2;
  68.         END;
  69.  
  70.         IF r2 = numRows THEN
  71.         BEGIN
  72.             doAlert1:= TRUE;
  73.             GoTo 2;
  74.         END;
  75.     END;    
  76. 2:END;
  77.  
  78. BEGIN
  79.     PUSHATTRS;
  80.     TextFont(kWorksheetFont);
  81.     TextSize(kWorksheetTextSize);
  82.     doAlert1:= FALSE;
  83. {** Try named worksheet CONST}
  84.     WSH:=GETOBJECT(kWorksheetName);
  85. {** Try active worksheet}
  86.     IF (WSH=NIL) THEN WSH:=ActSSheet;
  87. {** Try getting worksheet name from user}
  88.     IF (WSH=NIL) THEN BEGIN
  89.          worksheetName:=STRDIALOG('Enter the name of the worksheet to be sorted.','Worksheet 1');
  90.         WSH:=GETOBJECT(worksheetName);
  91.     END;
  92. {** If no worksheet then punch out with dialog╔}
  93.     IF ((WSH=NIL)|(GetType(WSH)<>18)) THEN BEGIN
  94.         SYSBEEP;
  95.         ALRTDIALOG('I can╒t find a worksheet by that name.');
  96.         GOTO 1;
  97.     END;
  98.     SelectSS(WSH);
  99.     SprdSize(WSH,numRows,numCols);
  100.     IF GETCELLSTR(WSH,1,1) = 'Name' THEN startRow:= 2
  101.     ELSE startRow:= 1;
  102.     IF GETCELLSTR(WSH,1,1) = '' THEN startRow:= 2;
  103.     
  104.     FOREACHOBJECT(ProcessNames,V);
  105.     
  106.     IF doAlert1 THEN
  107.     BEGIN
  108.         ALRTDIALOG('Some new spaces were skipped. Insert blank row(s) and run the ╘Update Worksheet╒ command again.');
  109.     END;
  110.     
  111.     {CLRMESSAGE;}
  112.     1:POPATTRS;
  113. END;
  114. RUN(UpDateWorksheet);
  115.