home *** CD-ROM | disk | FTP | other *** search
/ Chip 1997 April / Chip_1997-04_cd.bin / tema / 602propc / disk12 / data.12 / WINTEXT / MAKRA / SOURCES / COMPARE.TXT < prev    next >
Encoding:
Text File  |  1996-12-17  |  6.5 KB  |  298 lines
  1.                                                                                                                                                                                                  //*************************************************************
  2. **********
  3. //*
  4. //*       Nßzev makra:   Porovnßvßnφ dvou soubor∙
  5. //*             Autor:   Software602 a.s.
  6. //*   Datum vytvo°enφ:   17.12.1996
  7. //*
  8. //*     Nßzev souboru:   
  9. //*    Nßzev programu:   
  10. //*              Tisk:    
  11. //*
  12. //*             Popis:   Makro hledß prvnφ rozdφl ve dvou 
  13. otev°en²ch
  14. //*                      dokumentech
  15. //*
  16. //*************************************************************
  17. *****mt***
  18. Program Porovnßnφ;
  19.  
  20. const
  21.   MAXLEN            = 200;
  22.   MAXSTR            =  15;
  23.   ERR_NONE          =   0;
  24.   ERR_WND_CLOSED_1  =  -1;
  25.   ERR_WND_CLOSED_2  =  -2;
  26.   ERR_DOC_FREE      =  -3;
  27.  
  28.  
  29. var
  30.   oldPos1, oldPos2 : integer;        // pozice caretu p°i 
  31. startu makra
  32.   endPos           : integer;        // konec dokumentu
  33.   title1, title2   : string[127];    // titulek dokument∙
  34.   err              : integer;
  35.   difference, line : integer;
  36.   wnd              : short;          // aktivnφ okno
  37.   text1, text2     : array[1..MAXSTR] of string[MAXLEN];
  38.   countLn1,countLn2: short;
  39.   other1,other2    : short;
  40.  
  41.  
  42. procedure PrepareMDI;
  43. var
  44.   ePos1, ePos2 : integer;
  45.   cursorPos : boolean;
  46. begin
  47.   wnd := 1;
  48.   WindowsTile;
  49.   cursorPos := Yesno_box('Compare', 'Kontrolovat od pozice 
  50. kurzoru?');
  51.  
  52.   { prvnφ dokument : }
  53.   oldPos1 := GetCaretPos;
  54.   CaretEnd; ePos1 := GetCaretPos;
  55.   if (cursorPos) then begin
  56.     CaretHome;
  57.     CharRight(oldPos1);
  58.     LeftOfLine;
  59.   end
  60.   else
  61.     CaretHome;
  62.   title1 := GetDocWndTittle;
  63.  
  64.   { druh² dokument : }
  65.   NextWindow;
  66.   oldPos2 := GetCaretPos;
  67.   CaretEnd; ePos2 := GetCaretPos;
  68.   CaretHome;
  69.   if (cursorPos) then begin
  70.     CharRight(oldPos1);
  71.     LeftOfLine;
  72.   end;
  73.   title2 := GetDocWndTittle;
  74.  
  75.   { zjiÜt∞nφ konce dokumentu : }
  76.   if (ePos2 < ePos1) then
  77.     endPos := ePos2
  78.   else
  79.     endPos := ePos1;
  80. end;
  81.  
  82.  
  83. function SetWindow(newWin:integer):boolean;
  84. var result : boolean;
  85. begin
  86.   case (newWin) of
  87.     1: begin result := SwitchToWindow(title1, false); wnd := 
  88. 1; end;
  89.     2: begin result := SwitchToWindow(title2, false); wnd := 
  90. 2; end;
  91.     else: result := false;
  92.   end;
  93.   SetWindow := result;
  94. end;
  95.  
  96.  
  97. procedure ChewError;
  98. var
  99.   msg : string[MAXLEN];
  100. begin
  101.   msg := '';
  102.   case (err) of
  103.     ERR_WND_CLOSED_1: msg := "Nepoda°ilo se aktivovat okno 
  104. "+title1+"!";
  105.     ERR_WND_CLOSED_2: msg := "Nepoda°ilo se aktivovat okno 
  106. "+title2+"!";
  107.     ERR_DOC_FREE: msg := "Dokument je prßzdn²!";
  108.     else: msg := "Neznßmß chyba: " + int2str(err);
  109.   end;  { case }
  110.   if (msg <> '') then
  111.     Info_box('Chyba', msg);
  112. end;
  113.  
  114.  
  115. function GetString(window:short):short;
  116. var
  117.   p,p2:integer;
  118.   i:short;
  119.   konec : boolean;
  120.  
  121. begin
  122.   i := 1;
  123.   konec := false;
  124.  
  125.   while ((i <= MAXSTR) and not(konec)) do begin
  126.     LeftOfLine;
  127.     p := GetCaretPos;
  128.     RightOfLine;
  129.     p2 := GetCaretPos;
  130.     konec := (p2 = endPos);
  131.     case (window) of
  132.       1: text1[i] := GetText(p,p2);
  133.       2: text2[i] := GetText(p,p2);
  134.     end; { case }
  135.     inc(i);
  136.     case (window) of
  137.       1: if (LineDown) then other1 := 1 else begin
  138.            other1 := 0;
  139.            konec := true;
  140.          end;
  141.       2: if (LineDown) then other2 := 1 else begin
  142.            other2 := 0;
  143.            konec := true;
  144.          end;
  145.     end;
  146.   end; { while }
  147.  
  148.   GetString := (i-1);
  149. end;
  150.  
  151.  
  152. function GetDifference(var ln:integer):integer;
  153. var
  154.   i, j, result : integer;
  155.   konec, diff : boolean;
  156.   len : integer;
  157.   s1, s2 : string[MAXLEN];
  158.   s : string[MAXLEN+MAXLEN];
  159.  
  160. begin
  161.   j := 1;
  162.   diff := false;
  163.   result := 0;
  164.  
  165.   while (j <= MAXSTR) and not(diff) do begin
  166.     i := 1;
  167.     konec := false;
  168.     s1 := text1[j];
  169.     s2 := text2[j];
  170.     if (StrLength(s1) < StrLength(s2)) then
  171.       len := StrLength(s2)
  172.     else
  173.       len := StrLength(s1);
  174.     if (s1 <> s2) and not((StrLength(s1) = 0) and 
  175. (StrLength(s2) = 0))
  176.     then begin
  177.       while not(konec) and (i <= len) do begin
  178.         if (s1[i] <> s2[i]) then begin
  179.           konec := true;
  180.           diff := true;
  181.           result := i;
  182.           s := s1 + #13#10 + s2;
  183.           info_box('RozdφlnΘ °et∞zce', s);
  184.         end
  185.         else inc(i);
  186.       end;  { while }
  187.     end; { if }
  188.     if not(diff) then inc(j);
  189.   end; { while }
  190.  
  191.   if (diff) then ln := j else ln := 0;
  192.   GetDifference := result;
  193. end;
  194.  
  195.  
  196. procedure Compare;
  197. var
  198.   konec        : boolean;
  199.   pos          : integer;
  200.   tmp          : short;
  201.  
  202. begin
  203.   konec := false;
  204.   err := ERR_NONE;
  205.   difference := 0;
  206.   pos := GetCaretPos;
  207.  
  208.   if (pos = endPos) then begin
  209.     err := ERR_DOC_FREE;
  210.     konec := true;
  211.   end;
  212.  
  213.   while not(konec) and (pos < endPos) do begin
  214.     { 1 }
  215.     if not(SetWindow(1)) then begin
  216.       konec := true;
  217.       err := ERR_WND_CLOSED_1;
  218.     end
  219.     else countLn1 := GetString(wnd);
  220.  
  221.     { 2 }
  222.     if not(SetWindow(2)) then begin
  223.       konec := true;
  224.       err := ERR_WND_CLOSED_2;
  225.     end
  226.     else countLn2 := GetString(wnd);
  227.  
  228.     { compare : }
  229.     if not(konec) then begin
  230.       difference := GetDifference(line);
  231.       if (difference <> 0) then begin
  232.         /* nalezen rozdφl : */
  233.         LeftOfLine;
  234.         SetWindow(2);
  235.         konec := true;
  236.       end;
  237.     end; { !konec }
  238.  
  239.     pos := GetCaretPos;
  240.   end;  { while }
  241.  
  242. end;
  243.  
  244.  
  245. procedure SetPosInLine(p:integer);
  246. var pos1, pos2, len : integer;
  247. begin
  248.   RightOfLine;
  249.   pos1 := GetCaretPos;
  250.   LeftOfLine;
  251.   pos2 := GetCaretPos;
  252.   len := pos1 - pos2;
  253.   if (len > p) then
  254.     CharRight(p)
  255.   else
  256.     RightOfLine;
  257. end;
  258.  
  259.  
  260. procedure SetPosDiff;
  261. var
  262.   i : short;
  263. begin
  264.   i := 1;
  265.   { 2 }
  266.   if not(wnd = 2) then SetWindow(2);
  267.   LineUp(countLn2-line+other2);
  268.   SetPosInLine(difference-1);
  269.   { 1 }
  270.   SetWindow(1);
  271.   LineUp(countLn1-line+other1);
  272.   SetPosInLine(difference-1);
  273. end;
  274.  
  275.  
  276. begin
  277.   if (CountWindows <> 2) then
  278.     Info_box('Zprßva', 'PoΦet otev°en²ch dokument∙ musφ b²t 
  279. roven 2 !')
  280.   else begin
  281.     PrepareMDI;
  282.     Compare;
  283.     if (difference <> 0) then begin
  284.       SetPosDiff;
  285.       //Info_box('Zprßva', 'Nalezen rozdφl.')
  286.     end
  287.     else begin
  288.       SetWindow(2); CaretHome; CharRight(oldPos2);
  289.       SetWindow(1); CaretHome; CharRight(oldPos1);
  290.       if (err <> ERR_NONE) then
  291.         ChewError
  292.       else
  293.         Info_box('Zprßva', 'Dokumenty jsou shodnΘ.');
  294.     end;
  295. //    DocMaximize;
  296.   end;
  297. end.
  298.