home *** CD-ROM | disk | FTP | other *** search
/ PC & Mediji 1997 January / PCM_9701.iso / programi / minicad / minicad.1 / DRAWMTRX.MPC < prev    next >
Encoding:
Text File  |  1996-02-13  |  4.0 KB  |  145 lines
  1. PROCEDURE DrawMatrix;
  2. LABEL 1,2;
  3. CONST
  4. kLayerName = 'Adjacency Matrix';
  5. kSpaceSymName = 'Space Name Box';
  6. kRelationSymName = 'Relationship Box';
  7. kWorksheetName='Area Worksheet';
  8. kSpaceRec = 'Space';
  9. kSpaceFld = 'Name';
  10. kAdjacentRec = 'Adjacency';
  11. kAdjacentFld = 'Code';
  12. kNameColumn = 1;
  13. kMaxArray = 20;
  14. VAR
  15. WSH,snbHan,rbHan : HANDLE;
  16. snbHEIGHT, snbWIDTH : REAL;
  17. rbHEIGHT, rbWIDTH, mX, mY : REAL;
  18. X1, Y1, X2, Y2, curSY, curSX, curRY, curRX : REAL;
  19. startRow,numRows,numCols,numNames,r,i,blankOffset : INTEGER;
  20. str,worksheetName,spaceName : STRING;
  21.  
  22. PROCEDURE CenterDialog(dX1,dX2 : INTEGER; VAR x1,x2 : INTEGER);
  23. VAR
  24. scrX1,scrY1,scrX2,scrY2,w : INTEGER;
  25. BEGIN
  26. GetScreen(scrX1,scrY1,scrX2,scrY2);
  27. w := dX2 - dX1;
  28. x1 := ((scrX1 + scrX2) DIV 2) - (w DIV 2);
  29. x2 := x1 + w;
  30. END;
  31.  
  32. FUNCTION PermissionDeniedToDelete : BOOLEAN;
  33. VAR
  34.     result, finished, cancel : BOOLEAN;
  35.     item, x1, x2 : INTEGER;
  36.     layerHan : HANDLE;
  37. BEGIN
  38.     finished := FALSE;
  39.     cancel:= FALSE;
  40.     layerHan := GetObject(kLayerName);
  41.     LAYER(kLayerName);
  42.     IF FActLayer <> Nil THEN BEGIN
  43.     {IF ( NumObj ( layerHan ) ) <> 0 THEN BEGIN}
  44.         CenterDialog(0,320,x1,x2);
  45.         BeginDialog(1,1,x1,189,x2,323);
  46.             AddButton('Delete',1,1,211,82,275,105);
  47.             AddButton('Cancel',2,1,128,82,192,105);
  48.             AddField('Existing items in layer',3,1,49,24,208,42);
  49.             AddField( Concat( ' ╘',kLayerName,'╒ will be deleted.' ), 4,1,49,47,277,65);
  50.         EndDialog;
  51.         GetDialog(1);
  52.         REPEAT DialogEvent(item);
  53.             IF item = 2 THEN BEGIN
  54.                 finished := TRUE;
  55.                 cancel := TRUE;
  56.             END;
  57.             IF item = 1 THEN finished := TRUE;
  58.         UNTIL finished;
  59.         CLRDIALOG;
  60.         IF cancel THEN result := TRUE
  61.         ELSE BEGIN
  62.             DoMenuText('Active Only');
  63.             SelectObj(L=kLayerName);
  64.             DeleteObjs;
  65.         END;
  66.     END;
  67.     PermissionDeniedToDelete := result;
  68. END;
  69.  
  70. BEGIN
  71.     PUSHATTRS;
  72.     ANGLEVAR;
  73.     IF PermissionDeniedToDelete THEN GoTo 1;
  74. {** Try named worksheet CONST}
  75.     WSH:=GETOBJECT(kWorksheetName);
  76. {** Try active worksheet}
  77.     IF (WSH=NIL) THEN WSH:=ActSSheet;
  78. {** Try getting worksheet name from user}
  79.     IF (WSH=NIL) THEN BEGIN
  80.          worksheetName:=STRDIALOG('Enter the name of the worksheet to be sorted.','Worksheet 1');
  81.         WSH:=GETOBJECT(worksheetName);
  82.     END;
  83. {** If no worksheet then punch out with dialog╔}
  84.     IF ((WSH=NIL)|(GetType(WSH)<>18)) THEN BEGIN
  85.         SYSBEEP;
  86.         ALRTDIALOG('I can╒t find a worksheet by that name.');
  87.         GOTO 1;
  88.     END;
  89.     SelectSS(WSH);
  90.     SprdSize(WSH,numRows,numCols);
  91. {** Check if array limit is big enough}
  92.     IF numCols > kMaxArray THEN BEGIN
  93.         str:= CONCAT('Increase CONST kMaxArray to at least ',numCols,'.');
  94.         ALRTDIALOG(str);
  95.         GOTO 1;
  96.     END;
  97.     SETCURSOR(WATCHC);
  98.     snbHan:=GetObject(kSpaceSymName);
  99.     snbHEIGHT:= HHeight(snbHan);
  100.     snbWIDTH:= HWidth(snbHan);
  101.     rbHan:=GetObject(kRelationSymName);
  102.     rbHEIGHT:= HHeight(rbHan);
  103.     rbWIDTH:= HWidth(rbHan);
  104. {** Get number of names }
  105.     numNames:= 0;
  106.     IF GETCELLSTR(WSH,1,1) = 'Name' THEN startRow:= 2
  107.     ELSE startRow:= 1;
  108.     IF GETCELLSTR(WSH,1,1) = '' THEN startRow:= 2;
  109.     FOR r:= startRow TO numRows DO
  110.         IF CELLHASSTR(WSH,r,kNameColumn) THEN numNames:= numNames +1;
  111.     curSY:= snbHEIGHT * (numNames/2);
  112.     curSX:= -(snbWIDTH + ((rbWidth/2)*(numNames-2)))/2;
  113.     curRY:= curSY-snbHEIGHT;
  114.     curRX:= curSX + snbWIDTH - (rbWidth/2);
  115.     blankOffset:= 0;
  116.     FOR r:= startRow TO numRows DO BEGIN
  117.         IF CELLHASSTR(WSH,r,kNameColumn) THEN BEGIN
  118.             spaceName:= GETCELLSTR(WSH,r,kNameColumn);
  119.             Symbol(kSpaceSymName,curSX,curSY,#0);
  120.             SetRecord(LNewObj,kSpaceRec);
  121.             SetRField(LNewObj,kSpaceRec,kSpaceFld,spaceName);
  122.             IF ((r - blankOffset) <= numNames) THEN Symbol(kRelationSymName,curRX,curRY,#0);
  123.             mX:= curRX;
  124.             mY:= curRY;
  125. {** Insert relationship boxes}
  126.             FOR i:= 2 TO (r-blankOffset)-1 DO BEGIN
  127.                 IF (r-blankOffset) > numNames THEN GOTO 2;
  128.                 mX:= mX+(rbWIDTH/2);
  129.                 mY:= mY+(rbHEIGHT/2);
  130.                 Symbol(kRelationSymName,mX,mY,#0);
  131.             2:END;
  132.             curSY:= curSY-snbHEIGHT;
  133.             curRY:= curRY-rbHEIGHT;
  134.         END
  135. {** Increment blank space counter }
  136.         ELSE blankOffset:= blankOffset + 1;
  137.         snbHan:=LNewObj;
  138.         SETDSELECT(snbHan);
  139.         CLOSESS(WSH);
  140.     END;
  141.  
  142.     1:POPATTRS;
  143. END;
  144. RUN(DrawMatrix);
  145.