home *** CD-ROM | disk | FTP | other *** search
/ PC World Komputer 1998 April A / Pcwk4a98.iso / PROGRAM / DELPHI16 / FC_WIN / FC_FORM.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1997-11-23  |  12.7 KB  |  413 lines
  1. unit Fc_form;
  2.  
  3. interface
  4.  
  5. uses
  6.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  7.   Forms, Dialogs, StdCtrls, Grids, Spin, Buttons, ExtCtrls;
  8.  
  9. type
  10.   TDateivergleich = class(TForm)
  11.     Grid: TStringGrid;
  12.     Panel1: TPanel;
  13.     UpBitBtn: TBitBtn;
  14.     HScrollBar: TScrollBar;
  15.     Panel2: TPanel;
  16.     VScrollBar: TScrollBar;
  17.     DownBitBtn: TBitBtn;
  18.     Panel3: TPanel;
  19.     procedure FormCreate(Sender: TObject);
  20.     procedure GridDrawCell(Sender: TObject; Col, Row: Longint; Rect: TRect; State: TGridDrawState);
  21.     procedure FormResize(Sender: TObject);
  22.     procedure DownBitBtnClick(Sender: TObject);
  23.     procedure UpBitBtnClick(Sender: TObject);
  24.     procedure HScrollBarChange(Sender: TObject);
  25.     procedure VScrollBarChange(Sender: TObject);
  26.   private
  27.     Datei : array[1..2] of Textfile;   { Die beiden Textdateien; Datei[1] wird in der ersten
  28.                                          Spalte von 'Grid' angezeigt, Datei[2] in der zweiten. }
  29.     Last  : array[1..2] of Integer;    { 'Last[i]' ist die letzte belegte Zeile in der Spalte
  30.                                          i von 'Grid'. Darin steht also die letzte aus Datei[i]
  31.                                          gelesene Zeile. }
  32.     sync : Integer;                    { Die letzte Zeile von 'Grid', in der die beiden Spalten
  33.                                          ⁿbereinstimmen. }
  34.     Nr: Integer;                       { Die aktuelle Zeilennummer (die in der Spalte 0 von 'Grid'
  35.                                          angezeigt wird. }
  36.     procedure SetGridWidth;
  37.     procedure ReadLines(col,n:Integer);
  38.     procedure InsertEmptyCells(col,row,num:Integer);
  39.     procedure Beenden;
  40.     function ReadUntilDiff : Boolean;
  41.     function SearchLines(c1, r1, c2, r2a, r2b, n: Integer): Integer;
  42.     function ReSync : Boolean;
  43.  
  44.     function Vorgaenger: Integer;
  45.     function Nachfolger: Integer;
  46.   public
  47.     procedure Dateien_vergleichen(const Name1,Name2:string);
  48.   end;
  49.  
  50. var
  51.   Dateivergleich: TDateivergleich;
  52.  
  53. implementation
  54.  
  55. {$R *.DFM}
  56.  
  57. procedure TDateivergleich.FormCreate(Sender: TObject);
  58. begin
  59.   Last[1] := 0;
  60.   Last[2] := 0;
  61.   sync := 0;
  62.   Nr := 0;
  63.   Grid.Canvas.Font := Grid.Font;
  64.   Grid.Cells[0,0] := 'Zeile';
  65.   Grid.Cells[1,0] := '';
  66.   Grid.Cells[2,0] := '';
  67.   SetGridWidth;
  68.   { Schalter und Scrollbars ausrichten }
  69.   Panel3.Width := Grid.ColWidths[0];
  70.   UpBitBtn.Align := alRight;
  71.   DownBitBtn.Align := alBottom;
  72.   HScrollBar.Align := alClient;
  73.   VScrollBar.Align := alClient;
  74. end;
  75.  
  76.  
  77. { ==================== Methoden zur Darstellung der Dateien ==================== }
  78.  
  79. procedure TDateivergleich.SetGridWidth;
  80. var
  81.   i, j: Integer;
  82. begin
  83.   i := Grid.Width - Grid.GridLineWidth;
  84.   j := Grid.Canvas.TextWidth(Grid.Cells[0,0]);
  85.   Grid.ColWidths[0] := j+2;
  86.   Grid.ColWidths[1] := (i-j-2) div 2;
  87.   Grid.ColWidths[2] := i - (j+2) - (i-j-2) div 2;
  88.   Grid.DefaultRowHeight := Grid.Canvas.TextHeight(Grid.Cells[0,0]);
  89. end;
  90.  
  91.  
  92. procedure TDateivergleich.FormResize(Sender: TObject);
  93. begin
  94.   SetGridWidth;
  95.   DownBitBtn.Enabled := Nachfolger>0;
  96.   UpBitBtn.Enabled   := (Grid.TopRow>1) and (Vorgaenger>0);
  97. end;
  98.  
  99.  
  100. { ---------- Zelle des Gitters 'Grid' zeichnen.
  101.              Besonderheit ist hier, da▀ eine Zeile hervorgehoben dargestellt wird, falls in
  102.              Spalte 0 entweder nichts steht oder der String mit einem 'x' beginnt.
  103.              Das 'x' in Spalte 0 wird nicht angezeigt. }
  104.  
  105. procedure TDateivergleich.GridDrawCell(Sender: TObject; Col, Row: Longint;
  106.   Rect: TRect; State: TGridDrawState);
  107. var
  108.   Highlight: Boolean;
  109. begin
  110.   Highlight := (Grid.Cells[0,Row]<>'') and (Grid.Cells[0,Row][1]='x');
  111.   with Grid.Canvas do begin
  112.     Brush.Style := bsSolid;
  113.     if Highlight then
  114.       Brush.Color := clTeal
  115.     else if gdFixed in State then
  116.       Brush.Color := clBtnFace
  117.     else
  118.       Brush.Color := clWindow;
  119.     FillRect(Rect);
  120.  
  121.     if Highlight then
  122.       Font.Color := clBlack
  123.     else
  124.       Font.Color := clGray;
  125.     if (Col=0) and (Row>0) then
  126.       TextOut (Rect.Left+1, Rect.Top, Copy(Grid.Cells[Col,Row],2,20))
  127.     else if Row=0 then
  128.       TextOut (Rect.Left+1, Rect.Top, Grid.Cells[Col,Row])
  129.     else
  130.       TextOut (Rect.Left+1, Rect.Top, Copy(Grid.Cells[Col,Row],HScrollBar.Position+1,255));
  131.  
  132.     if Col=1 then begin
  133.       Pen.Color := clBtnFace;
  134.       Pen.Style := psSolid;
  135.       Pen.Width := 2;
  136.       Rect.Right := Rect.Right - 1;
  137.       MoveTo (Rect.Right, Rect.Top);
  138.       LineTo (Rect.Right, Rect.Bottom);
  139.     end;
  140.   end;
  141. end;
  142.  
  143.  
  144. { ==================== Methoden zum Dateivergleich ==================== }
  145.  
  146. { ---------- Zeilen einlesen
  147.              Diese Methode liest 'n' Zeilen aus der Datei 'Datei[col]' ein und
  148.              fⁿgt sie in das Gitter ein. Entsprechend wird 'Last[col]' erh÷ht.
  149.              Falls Zeilen aus der ersten Datei gelesen werden, dann werden auch die
  150.              Zeilennummern in Spalte 0 "fortgeschrieben". }
  151.  
  152. procedure TDateivergleich.ReadLines(col,n:Integer);
  153. var
  154.   Line: string;
  155. begin
  156.   while not EoF(Datei[col]) and (n>0) do begin
  157.     Readln(Datei[col], Line);
  158.     Inc(Last[col]);
  159.     if Last[col]>=Grid.RowCount then
  160.       Grid.RowCount := Last[col]+1;
  161.     if Col=1 then begin
  162.       Inc(Nr);
  163.       { Beachten: Das erste Zeichen im String von Spalte 0 wird nicht angezeigt sondern dient
  164.         als Kennzeichnung, ob die Zeile hervorgehoben werden soll. A priori soll sie das nicht,
  165.         darum ist das erste Zeichen ' '. }
  166.       Grid.Cells[0,Last[col]] := ' '+IntToStr(Nr);
  167.     end;
  168.     Grid.Cells[col,Last[col]] := Line;
  169.     Dec(n);
  170.   end;
  171. end;
  172.  
  173.  
  174. { ---------- Vergleichsoperationen }
  175.  
  176. procedure TDateivergleich.InsertEmptyCells(col,row,num:Integer);
  177. var
  178.   i: Integer;
  179. begin
  180.   if Last[col]+num>=Grid.RowCount then
  181.     Grid.RowCount := Last[col]+num+1;
  182.   for i := Last[col] downto row do begin
  183.     Grid.Cells[col,i+num] := Grid.Cells[col,i];
  184.     Grid.Cells[col,i] := '';
  185.     if col=1 then begin
  186.       Grid.Cells[0,i+num] := Grid.Cells[0,i];
  187.       Grid.Cells[0,i] := 'x';
  188.     end;
  189.   end;
  190.   Inc(Last[col],num);
  191.   if Last[col]>=Grid.RowCount then
  192.     Grid.RowCount := Last[col]+1;
  193. end;
  194.  
  195.  
  196. { ---------- Vergleich beenden
  197.              Wenn aus irgendeinem Grund nicht mehr weiter syncronisier werden kann, dann schlie▀t
  198.              diese Methode den Dateivergleich ab: Alle Zeilen nach 'sync' werden als abweichend
  199.              markiert. }
  200.  
  201. procedure TDateivergleich.Beenden;
  202. var
  203.   p: Integer;
  204. begin
  205.   if not EoF(Datei[1]) then
  206.     ReadLines(1,30000);
  207.   if not EoF(Datei[2]) then
  208.     ReadLines(2,30000);
  209.   for p := sync+1 to Grid.RowCount do
  210.     Grid.Cells[0,p] := 'x' + Copy(Grid.Cells[0,p],2,20);
  211. end;
  212.  
  213.  
  214. { ---------- Solange Zeilenweise mit der Marke 'sync' weiterlaufen, bis eine Abweichung entdeckt
  215.              wird. 'sync' wird dann auf die letzte ⁿbereinstimmende Zeile gesetzt.
  216.              Falls ein Syncronisieren der Dateien sicher nicht m÷glich ist (weil mindestens
  217.              eine der Dateien endet), dann wird 'False' sonst 'True' zurⁿckgegeben. }
  218.  
  219. function TDateivergleich.ReadUntilDiff : Boolean;
  220. begin
  221.   result := False;
  222.   if (not EoF(Datei[1]) or (sync<Last[1])) and (not EoF(Datei[2]) or (sync<Last[2])) then begin
  223.     repeat
  224.       if sync=Last[1] then ReadLines(1,1);
  225.       if sync=Last[2] then ReadLines(2,1);
  226.       Inc(sync);
  227.     until (EoF(Datei[1]) and (sync=Last[1])) or (EoF(Datei[2]) and (sync=Last[2]))
  228.           or (Grid.Cells[1,sync]<>Grid.Cells[2,sync]);
  229.     { Jetzt gibt's zwei M÷glichkeiten
  230.       1) Es wurde eine Abweichung gefunden und es sind noch Zeilen in den Dateien, so das ein
  231.          Versuch zum Syncronisieren gestartet werden kann.
  232.       2) Die Schleife wurde beendet, aber weil in einer Datei keine Zeilen mehr sind. }
  233.     if (EoF(Datei[1]) and (sync=Last[1])) or (EoF(Datei[2]) and (sync=Last[2])) then begin
  234.       if Grid.Cells[1,sync]<>Grid.Cells[2,sync] then
  235.         Dec(sync);
  236.     end else begin
  237.       Dec(sync);
  238.       result := True;
  239.     end;
  240.   end;
  241. end;
  242.  
  243.  
  244. function TDateivergleich.SearchLines(c1, r1, c2, r2a, r2b, n: Integer): Integer;
  245. var
  246.   k: Integer;
  247. begin
  248.   repeat
  249.     k := 0;
  250.     while (k<n) and (Grid.Cells[c1,r1+k]=Grid.Cells[c2,r2a+k]) do
  251.       Inc(k);
  252.     Inc(r2a);
  253.   until (k=n) or (r2a>r2b);
  254.   if k=n then
  255.     result := r2a-1
  256.   else
  257.     result := -1;
  258. end;
  259.  
  260.  
  261. function TDateivergleich.ReSync : Boolean;
  262. const
  263.   k = 2;
  264.   inv : array[1..2] of Integer = (2, 1);
  265. var
  266.   M : array[1..2] of Integer;
  267.   Ende : array[1..2] of Boolean;
  268.   c, p: Integer;
  269. begin
  270.   result := True;
  271.   { Die beiden "Marker" M[1] und M[2] geben an, bis zu welcher Zeile im Gitter das Programm
  272.     schaut, um 'k' ⁿbereinstimmende Zeilen nach der Zeile 'sync' zu finden. }
  273.   M[1] := sync+k;
  274.   M[2] := sync+k;
  275.   { Im Gitter mⁿssen sich mindestens soviele Zeilen finden, wie die Marker angeben; ggf. mⁿssen
  276.     weitere Zeilen eingelesen werden. Es ist aber (durch vorangegangenes Einfⁿgen von Zeilen) auch
  277.     m÷glich, da▀ sich in einer oder beiden Spalten schon genug oder sogar mehr Zeilen befinden. }
  278.   if M[1]>Last[1] then ReadLines(1,M[1]-Last[1]);
  279.   if M[2]>Last[2] then ReadLines(2,M[2]-Last[2]);
  280.   { Wenn eine der Dateien nicht mehr genug Zeilen enthΣlt, dann mu▀ die Suche abgebrochen werden. }
  281.   if (M[1]>Last[1]) or (M[2]>Last[2]) then begin
  282.     result := False;
  283.     Exit;
  284.   end;
  285.  
  286.   Ende[1] := (M[1]=Last[1]) and EoF(Datei[1]);
  287.   Ende[2] := (M[2]=Last[2]) and EoF(Datei[2]);
  288.   if Ende[1] then c := 2 else c := 1;
  289.   p := -1;
  290.  
  291.   while (p<0) and (not Ende[1] or not Ende[2]) do begin
  292.     { Marker eine Zeile weitersetzen; ggf. eine Zeile einlesen. }
  293.     Inc(M[c]);
  294.     if M[c]>Last[c] then ReadLines(c,1);
  295.     { Testen, ob das Ende der Datei erreicht ist. }
  296.     Ende[c] := (M[c]=Last[c]) and EoF(Datei[c]);
  297.     { Prⁿfen, ob syncronisiert werden kann. }
  298.     p := SearchLines(c,M[c]-k+1, inv[c],sync+1,M[inv[c]]-k+1, k);
  299.     { Wenn das Ende der anderen Datei noch nicht erreicht ist: ▄bergeben }
  300.     if (p<0) and not Ende[inv[c]] then
  301.       c := inv[c];
  302.   end;
  303.  
  304.   if p>0 then begin
  305.     if M[c]-k+1-p>0 then
  306.       InsertEmptyCells(inv[c],p,M[c]-k+1-p);
  307.     for p := sync+1 to M[c]-k do
  308.       Grid.Cells[0,p] := 'x' + Copy(Grid.Cells[0,p],2,20);
  309.     sync := M[c];
  310.   end else begin
  311.     for p := sync+1 to Grid.RowCount do
  312.       Grid.Cells[0,p] := 'x' + Copy(Grid.Cells[0,p],2,20);
  313.   end;
  314. end;
  315.  
  316.  
  317. procedure TDateivergleich.Dateien_vergleichen(const Name1,Name2:string);
  318. var
  319.   weiter: Boolean;
  320. begin
  321.   Screen.Cursor := crHourglass;
  322.   try
  323.     AssignFile(Datei[1],Name1);
  324.     Reset(Datei[1]);
  325.     AssignFile(Datei[2],Name2);
  326.     Reset(Datei[2]);
  327.     Grid.Cells[1,0] := AnsiLowerCase(ExtractFileName(Name1));
  328.     Grid.Cells[2,0] := AnsiLowerCase(ExtractFileName(Name2));
  329.  
  330.     weiter := True;
  331.     while weiter and (not EoF(Datei[1]) or not EoF(Datei[2])) do begin
  332.       weiter := ReadUntilDiff;
  333.       if weiter and (not EoF(Datei[1]) or not EoF(Datei[2])) then
  334.         weiter := ReSync;
  335.     end;
  336.     if not weiter then
  337.       Beenden;
  338.  
  339.     CloseFile(Datei[1]);
  340.     CloseFile(Datei[2]);
  341.   finally
  342.     Screen.Cursor := crDefault;
  343.     if Grid.RowCount>2 then VScrollBar.Max := Grid.RowCount-2 else VScrollBar.Max := 1;
  344.   end;
  345. end;
  346.  
  347.  
  348. { ==================== Methoden zur Ereignisbehandlung ==================== }
  349.  
  350. function TDateivergleich.Nachfolger: Integer;
  351. var
  352.   r: Integer;
  353. begin
  354.   r := Grid.TopRow + Grid.VisibleRowCount div 2;
  355.   while (r<Grid.RowCount) and (Grid.Cells[0,r]<>'') and (Grid.Cells[0,r][1]='x') do
  356.     Inc(r);
  357.   while (r<Grid.RowCount) and ((Grid.Cells[0,r]='') or (Grid.Cells[0,r][1]=' ')) do
  358.     Inc(r);
  359.   if r<Grid.RowCount then result := r else result := -1;
  360. end;
  361.  
  362.  
  363. procedure TDateivergleich.DownBitBtnClick(Sender: TObject);
  364. var
  365.   r: Integer;
  366. begin
  367.   r := Nachfolger;
  368.   if r>0 then begin
  369.     r := r - Grid.VisibleRowCount div 2;
  370.     if r>1 then VScrollBar.Position := r else VScrollBar.Position := 1;
  371.   end;
  372. end;
  373.  
  374.  
  375. function TDateivergleich.Vorgaenger: Integer;
  376. var
  377.   r: Integer;
  378. begin
  379.   r := Grid.TopRow + Grid.VisibleRowCount div 2;
  380.   while (r>0) and (Grid.Cells[0,r]<>'') and (Grid.Cells[0,r][1]='x') do
  381.     Dec(r);
  382.   while (r>0) and ((Grid.Cells[0,r]='') or (Grid.Cells[0,r][1]=' ')) do
  383.     Dec(r);
  384.   result := r;
  385. end;
  386.  
  387.  
  388. procedure TDateivergleich.UpBitBtnClick(Sender: TObject);
  389. var
  390.   r: Integer;
  391. begin
  392.   r := Vorgaenger;
  393.   if r>0 then begin
  394.     r := r - Grid.VisibleRowCount div 2;
  395.     if r>1 then VScrollBar.Position := r else VScrollBar.Position := 1;
  396.   end;
  397. end;
  398.  
  399.  
  400. procedure TDateivergleich.HScrollBarChange(Sender: TObject);
  401. begin
  402.   Grid.Repaint;
  403. end;
  404.  
  405. procedure TDateivergleich.VScrollBarChange(Sender: TObject);
  406. begin
  407.   Grid.TopRow := VScrollBar.Position;
  408.   DownBitBtn.Enabled := Nachfolger>0;
  409.   UpBitBtn.Enabled   := (Grid.TopRow>1) and (Vorgaenger>0);
  410. end;
  411.  
  412. end.
  413.