home *** CD-ROM | disk | FTP | other *** search
/ Chip 1998 March / Chip_1998-03_cd.bin / tema / MINICAD / MC7DEMO / MINICAD.1 / FINDTEXT.MPC < prev    next >
Text File  |  1997-04-30  |  9KB  |  359 lines
  1.  
  2.  
  3.  
  4.  
  5.  
  6. {***************************************************}
  7. {*      Proc Find/Replace Text by Frank Brault     *}
  8. {*           Deihl Graphsoft, Inc. ⌐ 1995          *}
  9. {***************************************************}
  10.  
  11.  
  12.  
  13.  
  14.  
  15.  
  16. {*Design Limits:
  17. Target strings containing 255 characters or more are not searched.
  18. Any wrapping accomplished manually by reshaping the handles of text blocks is not retained when a string is replaced.
  19. Worksheet function replaces strings found in cells using default text formating. Does NOT search names.
  20. Also, a SELECTED ONLY check box would be nice. *}
  21.  
  22. PROCEDURE ReplaceTxt;
  23. LABEL 1,2;
  24. VAR
  25.     h,i,layerHandleT : HANDLE;
  26.     Sr,x,y,strTooLongCount : REAL;
  27.     Oldstring,Newstring,Chkstring,Wrkstring1,Wrkstring2,Nchkstring : STRING;
  28.     S1,S2,S3,S4,Sn,CountStr,layerName : STRING;
  29.     indx1,lenold,lennew,lenwrk1,lenchk,lenrem, f,f1,f2,f3,tn,c,r,c1,r1,ca : INTEGER;
  30.     finished,cancel,te,db,ws,cs : BOOLEAN;
  31.     item,x1,x2,count,counter : INTEGER;
  32.     numOfNames,n1,objType : INTEGER;
  33.     nameStr : 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 Replace(VAR Oldstring,Newstring,Chkstring,Nchkstring: STRING;
  46.          VAR f,lenold,lennew,lenwrk1,count: INTEGER);
  47. LABEL 3;
  48. BEGIN
  49.     f := 0;
  50.     indx1 := POS(Oldstring,Chkstring);
  51.     IF (LEN(Chkstring) > 254) THEN BEGIN
  52.     strTooLongCount := strTooLongCount + 1;
  53.     indx1 := 0;
  54.     END;
  55.     IF Newstring = '' THEN
  56.     BEGIN
  57.         WHILE indx1 <> 0 DO
  58.         BEGIN
  59.             DELETE (Chkstring,indx1,lenold);
  60.             IF Chkstring = '' THEN
  61.             BEGIN
  62.                 f := 1;
  63.                 count := count + 1;
  64.                 Nchkstring := '';
  65.                 GOTO 3;
  66.             END;
  67.             indx1 := POS(Oldstring,Chkstring);
  68.             f := 1;
  69.             count := count + 1;
  70.         END;
  71.         Nchkstring := Chkstring;
  72.         GOTO 3;
  73.     END;
  74.     WHILE indx1 <> 0 DO
  75.     BEGIN
  76.         f3 := 0;
  77.         If f = 1 THEN
  78.         BEGIN
  79.             lennew := LEN(Newstring);
  80.             indx1 := indx1 + lenwrk1 + lennew;
  81.         END;
  82.         lenchk := LEN(Chkstring);
  83.         IF lenold = lenchk THEN Nchkstring := Newstring
  84.         ELSE
  85.         BEGIN
  86.             lenwrk1 := indx1 - 1;
  87.             DELETE(Chkstring,indx1,lenold);
  88.             IF indx1 = 1 THEN
  89.             BEGIN
  90.                 f3 := 1;
  91.                 Wrkstring2 := Chkstring;
  92.                 Nchkstring := CONCAT(Newstring,Wrkstring2);
  93.             END
  94.             ELSE
  95.             BEGIN
  96.                 Wrkstring1 := COPY(Chkstring,1,lenwrk1);
  97.                 IF lenchk = indx1 + lenold -1 THEN
  98.                     Nchkstring := CONCAT(Wrkstring1,Newstring)
  99.                 ELSE
  100.                 BEGIN
  101.                     f3 := 1;
  102.                     lenrem := lenchk - lenold - indx1 + 1;
  103.                     Wrkstring2 := COPY(Chkstring,indx1,lenrem);
  104.                     Nchkstring := CONCAT(Wrkstring1,Newstring,Wrkstring2);
  105.                 END;
  106.             END;
  107.         END;
  108.         Chkstring := Nchkstring;
  109.         IF f3 = 1 THEN indx1 := POS(Oldstring,Wrkstring2) ELSE indx1 := 0;
  110.         f := 1;
  111.         count := count + 1;
  112.     END;
  113. 3:END;
  114.  
  115. PROCEDURE SearchRecords;
  116. VAR
  117.     myS,recordName,fieldName,DBRef:STRING;
  118.     layerHandleR,handleToRecord,objectHandle:HANDLE;
  119.     myR:REAL;
  120.     i,j,k,l:INTEGER;
  121. BEGIN
  122.     layerHandleR:= FLayer;
  123.     WHILE (layerHandleR<>NIL) DO BEGIN
  124.         objectHandle:= FInLayer(layerHandleR);
  125.         WHILE (objectHandle<>NIL) DO BEGIN
  126.             i := NumRecords(objectHandle);
  127.             IF (i>0) THEN BEGIN
  128.                 FOR j := 1 to i DO BEGIN
  129.                     handleToRecord := GetRecord(objectHandle,j);
  130.                     recordName:= GetName(handleToRecord);
  131.                     k := NumFields(handleToRecord);
  132.                     FOR l := 1 to k DO BEGIN
  133.                         myS := GetFldName(handleToRecord,l);
  134.                         fieldName:= myS;
  135.                         myR := GetFldType(handleToRecord,l);
  136.                         myS := Num2Str(0,myR);
  137.                         DBRef:=CONCAT('(''',recordName,'''.''',fieldName,''')');
  138.                         myS:= EvalStr(ObjectHandle,DBRef); 
  139.                         Chkstring := myS;
  140.                         f := 0;
  141.                         Replace(Oldstring,Newstring,Chkstring,Nchkstring,f,lenold,lennew,lenwrk1,count);
  142.                         IF f = 1 THEN BEGIN
  143.                             IF Nchkstring = '' THEN 
  144.                             SetRField(ObjectHandle,recordName,fieldName,'0')
  145.                         ELSE SetRField(ObjectHandle,recordName,fieldName,Nchkstring);
  146.                         END;
  147.                     END; {of FOR l := 1 to k}
  148.                 END; {of FOR j := 1 to i}
  149.             END; {of IF Statement}
  150.             objectHandle:= NextObj(objectHandle);
  151.         END; {of Objects in Layer LOOP}
  152.         layerHandleR:= NextLayer(layerHandleR);
  153.     END; {of Layer LOOP}
  154. END; {of SearchRecords}
  155.  
  156.  
  157. BEGIN
  158.     PUSHATTRS;
  159.     CenterDialog(0,450,x1,x2);
  160.     BeginDialog(1,1,x1,40,x2,262);
  161.         AddButton('Change All',1,1,316,190,398,210);
  162.         AddButton('Cancel',2,1,225,190,285,210);
  163.         AddField('_______________________',3,1,140,16,300,34);
  164.         AddField('Find and Replace Dialog',4,1,140,10,300,24);
  165.         AddField('Search where:',5,1,30,50,129,67);
  166.         AddField('Replace with:',6,1,209,114,303,132);
  167.         AddField('Find what:',7,1,209,50,282,67);
  168.         AddField('Search String...',8,2,211,74,406,90);
  169.         AddField('Replace String...',9,2,211,140,406,155);
  170.         AddButton('Text Objects',10,2,30,84,137,104);
  171.         AddButton('Record Fields',11,2,30,112,166,132);
  172.         AddButton('Worksheets',12,2,30,140,141,160);
  173.     EndDialog;
  174.     GetDialog(1);
  175.     SelField(8);
  176.     finished := FALSE;
  177.     cancel:= FALSE;
  178.     REPEAT DialogEvent(item);
  179.         IF item > 2 THEN BEGIN
  180.             IF item > 9 THEN SetItem(item,NOT(ITEMSEL(item)));
  181.         END
  182.         ELSE
  183.         BEGIN
  184.         IF item = 2 THEN 
  185.             BEGIN
  186.                 finished := TRUE;
  187.                 cancel := TRUE;
  188.                 GOTO 1;
  189.             END;
  190.             IF item = 1 THEN
  191.             BEGIN
  192.                 IF NOT(ITEMSEL(10) OR ITEMSEL(11) OR ITEMSEL(12)) THEN
  193.                 BEGIN
  194.                     SYSBEEP;
  195.                     FOR counter := 1 TO 4 DO
  196.                     BEGIN
  197.                         SetItem(10,NOT(ITEMSEL(10)));
  198.                         SetItem(11,NOT(ITEMSEL(11)));
  199.                         SetItem(12,NOT(ITEMSEL(12)));
  200.                         WAIT(1);
  201.                     END;
  202.                     GOTO 1;
  203.                 END;
  204.                 IF Getfield(8) = 'Search String...' THEN
  205.                 BEGIN
  206.                     SYSBEEP;
  207.                     SelField(8);
  208.                     GOTO 1;
  209.                 END;
  210.                 IF Getfield(9) = 'Replace String...' THEN
  211.                 BEGIN
  212.                     SYSBEEP;
  213.                     SelField(9);
  214.                     GOTO 1;
  215.                 END
  216.                 ELSE finished := TRUE;
  217.             END;
  218.         1:END;
  219.     UNTIL finished;
  220.     Oldstring:=Getfield(8);
  221.     Newstring:=Getfield(9);
  222.     te:= ITEMSEL(10);
  223.     db:= ITEMSEL(11);
  224.     ws:= ITEMSEL(12);
  225.     CLRDIALOG;
  226.     IF cancel THEN GOTO 2;
  227.     SETCURSOR(WATCHC);
  228.     strTooLongCount:= 0;
  229.     lenold := LEN(Oldstring);
  230.     count := 0;
  231.     IF te THEN
  232.     BEGIN
  233.         DSelectObj(ALL);
  234.         SELECTOBJ(T=Text);
  235.         layerHandleT:= FLayer;
  236.         WHILE (layerHandleT <> NIL) DO BEGIN
  237.             layerName:= GetLName(layerHandleT);
  238.             Layer(layerName);
  239.             h := FSActLayer;
  240.             WHILE h <> NIL DO
  241.             BEGIN
  242.                 f := 0;
  243.                 Chkstring := GETTEXT(h);
  244.                 Replace(Oldstring,Newstring,Chkstring,Nchkstring,f,lenold,lennew,lenwrk1,count);
  245.                 IF f = 1 THEN
  246.                 BEGIN
  247.                     IF Nchkstring = '' THEN
  248.                     BEGIN
  249.                         i := h;
  250.                         h := NEXTSOBJ(h);
  251.                         DSELECTOBJ(T=Text);
  252.                         SETSELECT(i);
  253.                         DELETEOBJS;
  254.                         SELECTOBJ(T=Text);
  255.                     END
  256.                     ELSE
  257.                     BEGIN
  258.                         SETTEXT(h,Nchkstring);
  259.                         h := NEXTSOBJ(h);
  260.                     END;
  261.                 END
  262.                 ELSE h := NEXTSOBJ(h);
  263.             END;
  264.             layerHandleT:= NextLayer(layerHandleT);
  265.         END;
  266.     END;
  267.     DSelectObj(T=Text);;
  268.  
  269.     IF db THEN SearchRecords;
  270.  
  271.     IF ws THEN
  272.     BEGIN
  273.         
  274.         CENTERDIALOG(0,320,x1,x2);
  275.         BEGINDIALOG(2,1,x1,190,x2,318);
  276.             ADDBUTTON('Use Default',1,1,197,81,292,104);
  277.             ADDBUTTON('Cancel',2,1,118,82,182,105);
  278.             ADDFIELD('Default formatting is used when strings',3,1,18,21,302,39);
  279.             ADDFIELD('are replaced in worksheet cells.',4,1,18,44,246,62);
  280.         ENDDIALOG;
  281.         GetDialog(2);
  282.         finished := FALSE;
  283.         cancel:= FALSE;
  284.         REPEAT DialogEvent(item);
  285.             IF item = 2 THEN
  286.             BEGIN
  287.                 finished := TRUE;
  288.                 cancel := TRUE;
  289.             END;
  290.             IF item = 1 THEN finished := TRUE;
  291.         UNTIL finished;
  292.         CLRDIALOG;
  293.         IF cancel THEN GOTO 2;
  294.  
  295.         f2 := 0;
  296.         numOfNames:= NameNum;
  297.         FOR n1:= 1 TO numOfNames DO
  298.         BEGIN
  299.             nameStr:= NameList(n1);
  300.             h:= GetObject(nameStr);
  301.             objType:= GetType(h);
  302.             IF (objType = 18) THEN
  303.             BEGIN
  304.                 f1 := 0;
  305. {  Need a WSheetIsOpen Function !!!!!!!!!!!!!}
  306.                 f2 := 1;
  307.                 SelectSS(h);
  308.                 SprdSize(h,r,c);
  309.                 FOR r1 := 1 TO r DO
  310.                 BEGIN
  311.                     FOR c1 := 1 TO c DO
  312.                     BEGIN
  313.                         cs := CellHasStr(h,r1,c1);
  314.                         f := 0;
  315.                         IF cs THEN
  316.                         BEGIN
  317.                             Chkstring := GetCellStr(h,r1,c1);
  318.                             Replace(Oldstring,Newstring,Chkstring,Nchkstring,f,lenold,lennew,lenwrk1,count);
  319.                             IF f = 1 THEN
  320.                             BEGIN
  321.                                 f1 := 1;
  322.                                 ca := GetCAlign(h,r1,c1);
  323.                                 SprdAlign(ca);
  324. {  Need a GetCellTxtFormat Function !!!!!!!!!!!!!}
  325. {  Need a SetCellTxtFormat Function !!!!!!!!!!!!!}
  326.                                 LoadCell(r1,c1,Nchkstring);
  327.                             END;
  328.                         END;
  329.                     END;
  330.                 END;
  331.                 IF f1 = 1 THEN DoMenuText('WSRecalculate');
  332.             END;
  333.         END;
  334.         IF f2 = 1 THEN CloseSS(h);
  335.     END;
  336.     DSELECTALL;
  337.     IF strTooLongCount > 0 THEN BEGIN
  338.         IF strTooLongCount < 2 THEN ALRTDIALOG('One block of text was skipped because it╒s length was greater than 255 characters.')
  339.         ELSE BEGIN
  340. s1:=(Num2Str(0,strTooLongCount));
  341. s2:= CONCAT(s1,' blocks of text were skipped because their lengths were each greater than 255 characters.');
  342. ALRTDIALOG(s2);
  343. END;
  344.     END;
  345.     IF count = 0 THEN
  346.     BEGIN
  347.         SYSBEEP;
  348.         ALRTDIALOG('String not found.');
  349.         GOTO 2;
  350.     END;
  351.     CountStr := NUM2STR(0,count);
  352.     CountStr := CONCAT(CountStr,' OCCURRENCE(S) CHANGED.');
  353.     SYSBEEP;
  354.     ALRTDIALOG(countstr);
  355.     2:CLRMESSAGE;
  356.     POPATTRS;
  357. END;
  358. RUN(ReplaceTxt);
  359.