home *** CD-ROM | disk | FTP | other *** search
/ Chip 1998 March / Chip_1998-03_cd.bin / tema / MINICAD / MC7DEMO / MINICAD.1 / GRIDNTRY.MPC < prev    next >
Text File  |  1997-04-30  |  6KB  |  203 lines
  1. PROCEDURE EnterPoints;
  2. LABEL 1,2;
  3. CONST
  4.     kPromptString = '           Click at upper left corner start point╔ ';
  5.     kBaseElev = 0.0;
  6.     kLocus3DType = 9;
  7.     kMaxCoord = 536870912.0; { MaxLongInt = (2**31) / 4 }
  8. VAR
  9.     frac,dispAcc,red,green,blue : LONGINT;
  10.     unitMrk,sqrUnitMrk : STRING;
  11.     str1, str2, rowStr, colStr, location  : STRING;
  12.     index, count, r, c, format, counter, badFld, ck : INTEGER;
  13.     x, y, curX, curY, curZ, colNum, rowNum : REAL;
  14.     numRows, numCols, gridFreq, total : REAL;
  15.     locusX,locusY,locusZ,upi : REAL;
  16.     item, Dlogx1, DLogy1, Dlogx2, DLogy2 : INTEGER;
  17.     cancel,finished,gridDone,outOfBounds : BOOLEAN;
  18.     locHandle : HANDLE;
  19.  
  20. {***************************************************}
  21. {*         Proc EnterPoints by Frank Brault        *}
  22. {***************************************************}
  23.  
  24. PROCEDURE CenterDialog(dX1,dX2 : INTEGER; VAR x1,x2 : INTEGER);
  25. VAR
  26.     scrX1,scrY1,scrX2,scrY2,w : INTEGER;
  27. BEGIN
  28.     GetScreen(scrX1,scrY1,scrX2,scrY2);
  29.     w := dX2 - dX1;
  30.     x1 := ((scrX1 + scrX2) DIV 2) - (w DIV 2);
  31.     x2 := x1 + w;
  32. END;
  33.  
  34. PROCEDURE LowDialog(width,height : INTEGER; VAR x1,y1,x2,y2 : INTEGER);
  35. CONST
  36.     kScreenSpace = 16;
  37. VAR
  38.     scrX1,scrY1,scrX2,scrY2 : INTEGER;
  39. BEGIN
  40.     GetScreen(scrX1,scrY1,scrX2,scrY2);
  41.     x1 := ((scrX1 + scrX2) DIV 2) - (width DIV 2);
  42.     x2 := x1 + width;
  43.     y2 := scrY2 - kScreenSpace;
  44.     y1 := y2 - height;
  45. END;
  46.  
  47. PROCEDURE alertUser(fldNum : INTEGER);
  48.  BEGIN
  49.     SysBeep;
  50.     finished := FALSE;
  51.     selField(fldNum);    
  52. END;
  53.  
  54. BEGIN
  55.     Absolute;
  56.     PushAttrs;
  57.     gridDone := FALSE;
  58.     locHandle := FSACTLAYER;
  59.     IF locHandle <> NIL THEN BEGIN
  60.         IF (GetType(locHandle) = kLocus3DType) THEN gridDone := 
  61. YNDialog('Shall I start accepting heights at the selected 3D Locus?');
  62.         IF gridDone THEN GOTO 1;
  63.     END;
  64.     DSelectAll;
  65.     FOR index := Len(kPromptString) DOWNTO 1 DO BEGIN
  66.         count := Len(kPromptString) - index;
  67.         str1 := Copy(kPromptString, index, count);
  68.         Message(str1);
  69.     END;
  70.     SetCursor(lgCrossC);
  71.     GetPt(x, y);
  72.     SetCursor(arrowC);
  73.     ClrMessage;
  74.     CenterDialog(0,320,Dlogx1,Dlogx2);
  75.     BeginDialog(1,1,Dlogx1,167,Dlogx2,373);
  76.         AddButton('OK',1,1,239,167,303,190);
  77.         AddButton('Cancel',2,1,158,168,222,191);
  78.         AddField('__________________________________',3,1,14,22,306,40);
  79.         AddField('Point Entry Grid Setup Dialog',4,1,14,14,217,32);
  80.         AddField('Number Of Grid Rows :',5,1,35,54,193,72);
  81.         AddField('Number Of Grid Columns :',6,1,14,87,193,105);
  82.         AddField('Grid Spacing :',7,1,93,119,189,137);
  83.         AddField('',8,2,210,57,285,72);
  84.         AddField('',9,2,210,88,285,103);
  85.         AddField('',10,2,210,120,285,135);
  86.     EndDialog;
  87.     GetDialog(1);
  88.     finished := FALSE;
  89.     cancel:= FALSE;
  90.     REPEAT DialogEvent(item);
  91.         IF item = 2 THEN
  92.         BEGIN
  93.             finished := TRUE;
  94.             cancel := TRUE;
  95.         END;
  96.         IF item = 1 THEN BEGIN
  97.             finished := TRUE;
  98. {** Check for unusable field entries }
  99.             badFld := 0;
  100.             FOR ck := 8 TO 10 DO BEGIN
  101.          IF (str2Num(GetField(ck)) <= 0) THEN badFld := ck;
  102.             IF NOT(ValidNumStr(GetField(ck), numRows)) THEN badFld := ck;
  103.             END;
  104.         IF (badFld <> 0) THEN alertUser(badFld);
  105.             
  106.         END;
  107.     UNTIL finished;
  108.     IF cancel THEN GOTO 2;
  109.     numRows := Str2Num(GetField(8));
  110.     numCols := Str2Num(GetField(9));
  111.     gridFreq := Str2Num(GetField(10));
  112.     total := numRows * numCols;
  113.     CLRDIALOG;
  114.     
  115. {** Check the grid position against the drawing space limits. }
  116.     GetUnits(frac,dispAcc,format,upi,unitMrk,sqrUnitMrk);
  117.     IF ABS((y - gridFreq)*frac) > kMaxCoord THEN outOfBounds := TRUE;
  118.     IF ABS((y - (numRows * gridFreq)) * frac) > kMaxCoord THEN outOfBounds := TRUE;
  119.     IF ABS((x + gridFreq) * frac) > kMaxCoord THEN outOfBounds := TRUE;
  120.     IF ABS((x + (numCols * gridFreq)) * frac) > kMaxCoord THEN outOfBounds := TRUE;
  121.  
  122.     IF outOfBounds THEN BEGIN
  123.         SYSBEEP;
  124.         ALRTDIALOG('Change the scale to a higher ratio to enter these points within the drawing bounds.'); 
  125.         GOTO 2;
  126.     END;
  127.     MESSAGE('One moment please╔');
  128.     SetCursor(WATCHC);
  129.     fPenFore(red,green,blue);
  130.     PenFore(65535,0,0);
  131. {** Enter the Grid }
  132.     curZ := kBaseElev;
  133.     FOR r := 0 TO (numRows - 1) DO BEGIN
  134.         curY := y - (r * gridFreq);
  135.         FOR c := 0 TO (numCols - 1) DO BEGIN
  136.             curX := x + (c * gridFreq);
  137.             Locus3D(curX,curY,curZ);
  138.         END;
  139.     END;
  140.     PenFore(red,green,blue);
  141.     DoMenuText('Fit To Objects');
  142.     1:locHandle := FSActLayer;
  143.     ClrMessage;
  144.     SetCursor(ARROWC);
  145.     DSelectAll;
  146.     SetSelect(locHandle);
  147.     ReDrawAll;
  148.     LowDialog(560,42,Dlogx1,DLogy1,Dlogx2,DLogy2);
  149.     BeginDialog(2,1,Dlogx1,DLogy1,Dlogx2,DLogy2);
  150.         AddButton('Next',1,1,486,10,550,33);
  151.         AddButton('Done',2,1,405,10,469,33);
  152.         AddField('Current Location:',3,1,9,11,133,29);
  153.         AddField('Unknown',4,1,135,11,254,29);
  154.         AddField('╞ Height:',5,1,258,11,323,29);
  155.         AddField('',6,2,331,11,381,26);
  156.     EndDialog;
  157.     GetDialog(2);
  158.     finished := FALSE;
  159.     cancel:= FALSE;
  160.     counter := 1;
  161.     GetLocus3D(locHandle,locusX,locusY,locusZ);
  162.     IF Not(gridDone) THEN SetField(4,'Row 1, Col 1');
  163.     SetField(6,Num2StrF(locusZ));
  164.     SelField(6);
  165.     REPEAT DialogEvent(item);
  166.         IF item = 2 THEN
  167.         BEGIN
  168.             finished := TRUE;
  169.             cancel := TRUE;
  170.         END;
  171.         IF item = 1 THEN BEGIN
  172.             IF ValidNumStr(GetField(6),curZ) THEN BEGIN
  173.                 Move3DObj(locHandle,0,0,-(locusZ) + curZ);
  174.                 SetPenFore(locHandle,0,0,0);
  175.                 SetDSelect(locHandle);
  176.                 locHandle := NextObj(locHandle);
  177.                 IF locHandle = NIL THEN BEGIN
  178.                     finished := TRUE;
  179.                     cancel := TRUE;
  180.                 END;
  181.             END;
  182.             SetSelect(locHandle);
  183.             IF Not(gridDone) Then Begin
  184.                 counter:= counter + 1;
  185.                 If ((counter Mod numCols) <> 0) then colNum := counter Mod numCols Else colNum := numCols;
  186.                 If colNum = numCols Then rowNum := (counter Div numCols) Else rowNum := (counter Div numCols)+1);
  187.                 rowStr := Num2Str(0,rowNum);
  188.                 colStr := Num2Str(0,colNum);
  189.                 location := Concat('Row ', rowStr, ', Col ',colStr);
  190.                 SetField(4,location);
  191.             END;
  192.             GetLocus3D(locHandle,locusX,locusY,locusZ);
  193.             SetField(6,Num2StrF(locusZ));
  194.             SelField(6);
  195.             RedrawAll;
  196.         END;
  197.     UNTIL finished;
  198.     ClrDialog;
  199.     IF cancel THEN GOTO 2;
  200.     2:PopAttrs;
  201. END;
  202. RUN(EnterPoints);
  203.