home *** CD-ROM | disk | FTP | other *** search
/ Chip 1998 March / Chip_1998-03_cd.bin / tema / MINICAD / MC7DEMO / MINICAD.1 / SORTWKS.MPC < prev    next >
Text File  |  1997-04-30  |  7KB  |  237 lines
  1.  
  2.  
  3.  
  4.  
  5.  
  6. {***************************************************}
  7. {*        Proc SortWorksheet by Frank Brault       *}
  8. {*           Deihl Graphsoft, Inc. ⌐ 1995          *}
  9. {***************************************************}
  10.  
  11.  
  12.  
  13.  
  14.  
  15.  
  16. PROCEDURE SortWorksheet;
  17. LABEL 1;
  18. CONST
  19. kWorksheetName='Edit this!';
  20. kMaxCols = 4094;
  21. kMaxArray = 20;
  22. VAR
  23. WH: HANDLE;
  24. str,worksheetName : STRING;
  25. first,largest,current : INTEGER;
  26. numRows,numFlds,sortCol,doFirstRow: INTEGER;
  27. item, x1, x2, lenCheck, blankCell : INTEGER;
  28. TA,TD,NA,ND : BOOLEAN;
  29. cancel,finished,test : BOOLEAN;
  30.  
  31. PROCEDURE switch(VAR first,second:INTEGER);
  32. VAR
  33.     temporary:ARRAY[1..kMaxArray] OF STRING;
  34.     i : INTEGER;
  35. BEGIN
  36. {** Exchanges row first and row second in worksheet}
  37.     FOR i:=1 TO numFlds DO BEGIN
  38.         temporary[i]:=GETCELLSTR(WH,first,i);
  39.         LOADCELL(first,i,GETCELLSTR(WH,second,i));
  40.         LOADCELL(second,i,temporary[i]);
  41.     END;
  42. END;
  43.  
  44. PROCEDURE CenterDialog(dX1,dX2 : INTEGER; VAR x1,x2 : INTEGER);
  45. VAR
  46.     scrX1,scrY1,scrX2,scrY2,w : INTEGER;
  47. BEGIN
  48. {** calculates horizontal center for dialog}
  49.     GetScreen(scrX1,scrY1,scrX2,scrY2);
  50.     w := dX2 - dX1;
  51.     x1 := ((scrX1 + scrX2) DIV 2) - (w DIV 2);
  52.     x2 := x1 + w;
  53. END;
  54.  
  55. PROCEDURE Toggle(first,second : INTEGER);
  56. BEGIN
  57. {** Toggles dialog radio btn prs}
  58.     SetItem(first,TRUE);
  59.     SetItem(second,FALSE);
  60. END;
  61.  
  62. FUNCTION ValidColNum(s1 : STRING; VAR colNum : INTEGER) : BOOLEAN;
  63. VAR
  64.     i,n,o : INTEGER;
  65.     s2 : STRING;
  66.     test : BOOLEAN;
  67.     value : REAL;
  68. BEGIN
  69. {** Returns true if s1 is valid column letter or number}
  70.     test:= ValidNumStr(s1,value);
  71.     IF test THEN n:= value
  72.     ELSE BEGIN
  73.         n:= 0;
  74.         FOR i:= 1 TO LEN(s1) DO BEGIN
  75.             s2:=COPY(s1,i,1);
  76.             o:= ORD(s2);
  77. {** If lower case then convert to upper case}
  78.             IF ((96 < o) AND (o < 123)) THEN o:= o - 32;
  79.             n:= (26 * n) + (o - 64);
  80.         END;
  81.     END;
  82. {** If result is within range then function returns TRUE}
  83.     IF ((0 < n) AND (n < kMaxCols)) THEN BEGIN
  84.         colNum:= n;
  85.         ValidColNum:=TRUE;
  86.     END
  87.     ELSE ValidColNum:= FALSE;
  88. END;
  89.  
  90.  
  91. {*******************  MAIN  *******************}
  92. BEGIN
  93.     PUSHATTRS;
  94. {** Initialize dialog result variables}
  95.     doFirstRow:= 0;
  96.     TA:= FALSE;
  97.     TD:= FALSE;
  98.     NA:= FALSE;
  99.     ND:= FALSE;;
  100.     CENTERDIALOG(0,276,x1,x2);
  101.     BEGINDIALOG(1,1,x1,120,x2,395);
  102.         ADDBUTTON('OK',1,1,188,219,252,242);
  103.         ADDBUTTON('Cancel',2,1,108,219,172,242);
  104.         ADDFIELD('____________________________',3,1,15,24,256,42);
  105.         ADDFIELD('Sort rows in active worksheet.',4,1,23,17,249,35);
  106.         ADDFIELD('Sort by Column:',5,1,42,62,154,80);
  107.         ADDFIELD('',6,2,160,61,209,76);
  108.         ADDBUTTON('Don╒t sort first row.',7,2,35,169,198,187);
  109.         ADDBUTTON('Text',8,3,35,105,88,123);
  110.         ADDBUTTON('Numeric',9,3,35,129,116,147);
  111.         ADDBUTTON('Ascending',10,3,140,105,242,123);
  112.         ADDBUTTON('Descending',11,3,140,129,233,147);
  113.     ENDDIALOG;
  114.     GetDialog(1);
  115.     SetItem(7,TRUE);
  116.     SetItem(8,TRUE);
  117.     SetItem(10,TRUE);
  118.     finished := FALSE;
  119.     cancel:= FALSE;
  120.     REPEAT
  121.         DialogEvent(item);
  122.         IF item = 7 THEN SetItem(7,NOT(ItemSel(7)));
  123.         IF item = 8 THEN Toggle(8,9);
  124.         IF item = 9 THEN Toggle(9,8);
  125.         IF item = 10 THEN Toggle(10,11);
  126.         IF item = 11 THEN Toggle(11,10);
  127.         IF item = 2 THEN
  128.         BEGIN
  129.             finished := TRUE;
  130.             cancel := TRUE;
  131.         END;
  132.         IF item = 1 THEN BEGIN
  133. {** Check for valid worksheet column}
  134.             test:=validColNum(GETFIELD(6),sortCol);
  135.             IF test THEN finished:=TRUE
  136.             ELSE BEGIN
  137.                 SYSBEEP;
  138.                 SelField(6);
  139.             END;
  140.             IF ItemSel(7) THEN doFirstRow:=1;
  141.             IF (ItemSel(8) AND ItemSel(10)) THEN TA:= TRUE;
  142.             IF (ItemSel(8) AND ItemSel(11)) THEN TD:= TRUE;
  143.             IF (ItemSel(9) AND ItemSel(10)) THEN NA:= TRUE;
  144.             IF (ItemSel(9) AND ItemSel(11)) THEN ND:= TRUE;
  145.         END;
  146.     UNTIL finished;
  147.     CLRDIALOG;
  148.     IF cancel THEN GOTO 1;
  149.     SETCURSOR(WATCHC);
  150. {** Try active worksheet}
  151.     WH:=ActSSheet;
  152. {** Try named worksheet CONST}
  153.     IF (WH=NIL) THEN WH:=GETOBJECT(kWorksheetName);
  154. {** Try getting worksheet name from user}
  155.     IF (WH=NIL) THEN BEGIN
  156.          worksheetName:=STRDIALOG('Enter the name of the worksheet to be sorted.','Worksheet 1');
  157.         WH:=GETOBJECT(worksheetName);
  158.     END;
  159. {** If no worksheet then punch out with dialog╔}
  160.     IF ((WH=NIL)|(GetType(WH)<>18)) THEN BEGIN
  161.         SYSBEEP;
  162.         ALRTDIALOG('I can╒t find a worksheet by that name.');
  163.         GOTO 1;
  164.     END;
  165.     SelectSS(WH);
  166.     SprdSize(WH,numRows,numFlds);
  167. {** Check if array limit is big enough}
  168.     IF numFlds > kMaxArray THEN BEGIN
  169.         str:= CONCAT('Increase CONST kMaxArray to at least ',numFlds,'.');
  170.         ALRTDIALOG(str);
  171.         GOTO 1;
  172.     END;
  173. {** Load 0 values into blank sort column cells so there is a numeric value to compare}
  174.     IF NA | ND THEN BEGIN
  175.     MESSAGE('One moment please╔');
  176.     blankCell := 0;
  177.         FOR first:=(1+doFirstRow) TO numRows DO BEGIN
  178.             lenCheck := LEN(GETCELLSTR(WH,first,sortCol));
  179.             IF lenCheck < 1 THEN BEGIN
  180.                 LOADCELL(first,sortCol,'0');
  181.                 blankCell := blankCell + 1;
  182.             END;
  183.         END;
  184.     END;
  185. {** NA = Sort numeric ascending}
  186.     IF NA THEN BEGIN
  187.         FOR first:=(1+doFirstRow) TO numRows-1 DO BEGIN
  188.             largest:= first;
  189.             FOR current:=first TO numRows DO BEGIN
  190.                 IF STR2NUM(GETCELLSTR(WH,current,sortCol)) < STR2NUM(GETCELLSTR(WH,largest,sortCol)) THEN largest:= current;
  191.             END;
  192.             switch(largest,first);
  193.             MESSAGE('Row ',first,' of ',numRows,' completed╔')
  194.         END;
  195. {** Load blanks back into sort column cells}
  196.         FOR first:=(1+doFirstRow) TO (1+doFirstRow + blankCell-1)  DO LOADCELL(first,sortCol,'');
  197.     END;
  198. {** ND = Sort numeric descending}
  199.     IF ND THEN BEGIN
  200.         FOR first:=(1+doFirstRow) TO numRows-1 DO BEGIN
  201.             largest:= first;
  202.             FOR current:=first TO numRows DO BEGIN
  203.                 IF STR2NUM(GETCELLSTR(WH,current,sortCol)) > STR2NUM(GETCELLSTR(WH,largest,sortCol)) THEN largest:= current;
  204.             END;
  205.             switch(largest,first);
  206.             MESSAGE('Row ',first,' of ',numRows,' completed╔')
  207.         END;
  208. {** Load blanks back into sort column cells}
  209.         FOR first:= numRows DOWNTO (numRows - blankCell + 1)  DO LOADCELL(first,sortCol,'');
  210.     END;
  211. {** TA = Sort text ascending}
  212.     IF TA THEN BEGIN
  213.         FOR first:=(1+doFirstRow) TO numRows-1 DO BEGIN
  214.             largest:= first;
  215.             FOR current:=first TO numRows DO BEGIN
  216.                 IF GETCELLSTR(WH,current,sortCol) < GETCELLSTR(WH,largest,sortCol) THEN largest:= current;
  217.             END;
  218.             switch(largest,first);
  219.             MESSAGE('Row ',first,' of ',numRows,' completed╔')
  220.         END;
  221.     END;
  222. {** TD = Sort text descending}
  223.     IF TD THEN BEGIN
  224.         FOR first:=(1+doFirstRow) TO numRows-1 DO BEGIN
  225.             largest:= first;
  226.             FOR current:=first TO numRows DO BEGIN
  227.                 IF GETCELLSTR(WH,current,sortCol) > GETCELLSTR(WH, largest, sortCol) THEN largest:= current;
  228.             END;
  229.             switch(largest,first);
  230.             MESSAGE('Row ',first,' of ',numRows,' completed╔')
  231.         END;
  232.     END;
  233. 1:POPATTRS;
  234. CLRMESSAGE;
  235. END; {of MAIN}
  236. RUN(SortWorksheet);
  237.