home *** CD-ROM | disk | FTP | other *** search
/ QBasic & Borland Pascal & C / Delphi5.iso / Delphi.5 / Samples / sourceD5 / browutil.exe / BROWSER / COMPFILE.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  2000-01-03  |  10.1 KB  |  332 lines
  1. unit CompFile;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  7.   ExtCtrls, Grids, DBGrids, StdCtrls, ComCtrls, FileCtrl;
  8.  
  9. type
  10.   TFrmCompareFile = class(TForm)
  11.     Panel1: TPanel;
  12.     BtnClose: TButton;
  13.     BtnCompare: TButton;
  14.     RichEdit1: TRichEdit;
  15.     RichEdit2: TRichEdit;
  16.     StringGrid1: TStringGrid;
  17.     Panel2: TPanel;
  18.     GroupBox1: TGroupBox;
  19.     FileListBox1: TFileListBox;
  20.     Splitter1: TSplitter;
  21.     GroupBox2: TGroupBox;
  22.     FileListBox2: TFileListBox;
  23.     Panel4: TPanel;
  24.     Panel3: TPanel;
  25.     Edit1: TEdit;
  26.     Button1: TButton;
  27.     Edit2: TEdit;
  28.     Button2: TButton;
  29.     DirectoryListBox1: TDirectoryListBox;
  30.     ChkIgnoreLines: TCheckBox;
  31.     procedure BtnCloseClick(Sender: TObject);
  32.     procedure Button1Click(Sender: TObject);
  33.     procedure BtnCompareClick(Sender: TObject);
  34.     procedure Button2Click(Sender: TObject);
  35.     procedure FormClose(Sender: TObject; var Action: TCloseAction);
  36.     procedure FormCreate(Sender: TObject);
  37.     procedure Edit1Change(Sender: TObject);
  38.     procedure FileListBox1Change(Sender: TObject);
  39.     procedure FileListBox2Change(Sender: TObject);
  40.     procedure FileListBox1Enter(Sender: TObject);
  41.     procedure FileListBox1Exit(Sender: TObject);
  42.     procedure FileListBox2Enter(Sender: TObject);
  43.     procedure FileListBox2Exit(Sender: TObject);
  44.     procedure Edit1Enter(Sender: TObject);
  45.     procedure Edit1Exit(Sender: TObject);
  46.     procedure Edit1KeyDown(Sender: TObject; var Key: Word;
  47.       Shift: TShiftState);
  48.     procedure Edit2KeyDown(Sender: TObject; var Key: Word;
  49.       Shift: TShiftState);
  50.   private
  51.     { Private declarations }
  52.     lTextDeleting, lFileLstChg, lEditBox : Boolean;
  53.     procedure ResourceToText(sResFile, sOutFile : String);
  54.     procedure SearchFile(FileListBox : TFileListBox; sFile : String; Edit : TEdit);
  55.   public
  56.     { Public declarations }
  57.   end;
  58.  
  59. var
  60.   FrmCompareFile: TFrmCompareFile;
  61.  
  62. implementation
  63.  
  64. uses Menu, GenFunc;
  65.  
  66. {$R *.DFM}
  67.  
  68. procedure TFrmCompareFile.BtnCloseClick(Sender: TObject);
  69. begin
  70.   Close;
  71. end;
  72.  
  73. procedure TFrmCompareFile.Button1Click(Sender: TObject);
  74. begin
  75.   FrmMenu.OpenDialog1.Title := 'Select file';
  76.   FrmMenu.OpenDialog1.Filter := 'Any file (*.*)|*.*';
  77.   if FrmMenu.OpenDialog1.Execute then
  78.     Edit1.Text := FrmMenu.OpenDialog1.FileName;
  79. end;
  80.  
  81. procedure TFrmCompareFile.BtnCompareClick(Sender: TObject);
  82. const
  83.   CF_Source = 'Source.txt';
  84.   CF_Target = 'Target.txt';
  85. var
  86.   I, nMaxLine : Integer;
  87.   sSource, sTarget : String;
  88. begin
  89.   if not FileExists(Edit1.Text) and (not FileExists(Edit2.Text)) then begin
  90.     MessageBeep(mb_Ok);
  91.     ShowMessage('Please select file / file does not exists');
  92.     Abort;
  93.   end;
  94.   sSource := Edit1.Text;
  95.   sTarget := Edit2.Text;
  96.   if (UpperCase(ExtractFileExt(sSource)) = '.DFM') then begin
  97.     sSource := sTempDrive + CF_Source;
  98.     ResourceToText(Edit1.Text,sSource);
  99.   end;
  100.   if (UpperCase(ExtractFileExt(sTarget)) = '.DFM') then begin
  101.     sTarget := sTempDrive + CF_Target;
  102.     ResourceToText(Edit2.Text,sTarget);
  103.   end;
  104.   StringGrid1.SetFocus;
  105.   RichEdit1.Lines.LoadFromFile(sSource);
  106.   RichEdit2.Lines.LoadFromFile(sTarget);
  107.   if (RichEdit1.Lines.Count > RichEdit2.Lines.Count) then
  108.     nMaxLine := RichEdit1.Lines.Count
  109.   else
  110.     nMaxLine := RichEdit2.Lines.Count;
  111.   StringGrid1.RowCount := nMaxLine+1;
  112.   StringGrid1.Cells[1,0] := sSource;
  113.   StringGrid1.Cells[2,0] := sTarget;
  114.   for I := 0 to nMaxLine do begin
  115.     Application.ProcessMessages;
  116.     StringGrid1.Cells[0,I+1] := IntToStr(I+1);
  117.     StringGrid1.Cells[1,I+1] := '';
  118.     StringGrid1.Cells[2,I+1] := '';
  119.     StringGrid1.Cells[3,I+1] := '';
  120.     if ChkIgnoreLines.Checked and (RichEdit1.Lines.Strings[I] = '')
  121.       and (RichEdit2.Lines.Strings[I] = '') then
  122.       Continue;
  123.     if (I <= RichEdit1.Lines.Count) then
  124.       StringGrid1.Cells[1,I+1] := RichEdit1.Lines.Strings[I];
  125.     if (I <= RichEdit2.Lines.Count) then
  126.       StringGrid1.Cells[2,I+1] := RichEdit2.Lines.Strings[I];
  127.     if (I <= RichEdit1.Lines.Count) and (I <= RichEdit2.Lines.Count) then begin
  128.         if (RichEdit1.Lines.Strings[I] <> RichEdit2.Lines.Strings[I]) then
  129.           StringGrid1.Cells[3,I+1] := RichEdit1.Lines.Strings[I];
  130.       end
  131.     else
  132.       begin
  133.         if (I <= RichEdit1.Lines.Count) and (I > RichEdit2.Lines.Count) then
  134.           StringGrid1.Cells[3,I+1] := RichEdit1.Lines.Strings[I]
  135.         else
  136.           if (I > RichEdit1.Lines.Count) and (I <= RichEdit2.Lines.Count) then
  137.             StringGrid1.Cells[3,I+1] := RichEdit2.Lines.Strings[I];
  138.       end;
  139.   end;
  140. end;
  141.  
  142. procedure TFrmCompareFile.Button2Click(Sender: TObject);
  143. begin
  144.   FrmMenu.OpenDialog1.Title := 'Select file';
  145.   FrmMenu.OpenDialog1.Filter := 'Any file (*.*)|*.*';
  146.   if FrmMenu.OpenDialog1.Execute then
  147.     Edit2.Text := FrmMenu.OpenDialog1.FileName;
  148. end;
  149.  
  150. procedure TFrmCompareFile.FormClose(Sender: TObject;
  151.   var Action: TCloseAction);
  152. begin
  153.   Action := caFree;
  154. end;
  155.  
  156. procedure TFrmCompareFile.FormCreate(Sender: TObject);
  157. begin
  158.   StringGrid1.ColWidths[1] := (StringGrid1.Width + StringGrid1.DefaultColWidth) div 3;
  159.   StringGrid1.ColWidths[2] := (StringGrid1.Width + StringGrid1.DefaultColWidth) div 3;
  160.   StringGrid1.ColWidths[3] := (StringGrid1.Width + StringGrid1.DefaultColWidth) div 3;
  161. end;
  162.  
  163. procedure TFrmCompareFile.Edit1Change(Sender: TObject);
  164. begin
  165.   if lFileLstChg then
  166.     Exit;
  167.   try
  168.     DirectoryListBox1.Directory := ExtractFilePath(TEdit(Sender).Text);
  169.   except
  170.     ;
  171.   end;
  172. {  try
  173.     if (UpperCase(FileListBox1.Directory) <> UpperCase(ExtractFilePath(TEdit(Sender).Text))) then
  174.       FileListBox1.Directory := ExtractFilePath(TEdit(Sender).Text);
  175.   except
  176.     ;
  177.   end;}
  178. //  FileListBox1.Mask := '*' + ExtractFileExt(Edit1.Text);
  179.   if (TEdit(Sender).Name = 'Edit1') then
  180.     SearchFile(FileListBox1,ExtractFileName(TEdit(Sender).Text),TEdit(Sender))
  181.   else
  182.     SearchFile(FileListBox2,ExtractFileName(TEdit(Sender).Text),TEdit(Sender));
  183. end;
  184.  
  185. procedure TFrmCompareFile.FileListBox1Change(Sender: TObject);
  186. begin
  187.   if (UpperCase(Edit1.Text) <> UpperCase(FileListBox1.FileName)) and
  188.     not lEditBox then
  189.     Edit1.Text := FileListBox1.FileName;
  190. end;
  191.  
  192. procedure TFrmCompareFile.FileListBox2Change(Sender: TObject);
  193. begin
  194.   if (UpperCase(Edit2.Text) <> UpperCase(FileListBox2.FileName)) and
  195.     not lEditBox then
  196.     Edit2.Text := FileListBox2.FileName;
  197. end;
  198.  
  199. procedure TFrmCompareFile.FileListBox1Enter(Sender: TObject);
  200. begin
  201.   lFileLstChg := True;
  202. end;
  203.  
  204. procedure TFrmCompareFile.FileListBox1Exit(Sender: TObject);
  205. begin
  206.   lFileLstChg := False;
  207. end;
  208.  
  209. procedure TFrmCompareFile.FileListBox2Enter(Sender: TObject);
  210. begin
  211.   lFileLstChg := True;
  212. end;
  213.  
  214. procedure TFrmCompareFile.FileListBox2Exit(Sender: TObject);
  215. begin
  216.   lFileLstChg := False;
  217. end;
  218.  
  219. procedure TFrmCompareFile.Edit1Enter(Sender: TObject);
  220. begin
  221.   if (TEdit(Sender).Name = 'Edit1') then
  222.     DirectoryListBox1.FileList := FileListBox1
  223.   else
  224.     DirectoryListBox1.FileList := FileListBox2;
  225.   lEditBox := True;
  226. end;
  227.  
  228. procedure TFrmCompareFile.Edit1Exit(Sender: TObject);
  229. begin
  230.   lEditBox := False;
  231.   lTextDeleting := False;
  232. end;
  233.  
  234. procedure TFrmCompareFile.ResourceToText(sResFile, sOutFile : String);
  235. var
  236.   StreamIn, Streamout : TMemoryStream;
  237. begin
  238.   StreamIn := TMemoryStream.Create;
  239.   StreamOut := TMemoryStream.Create;
  240.   StreamIn.LoadFromFile(sResFile);
  241.   ObjectResourceToText(StreamIn,StreamOut);
  242.   StreamOut.SaveToFile(sOutFile);
  243.   StreamIn.Free;
  244.   StreamOut.Free;
  245. end;
  246.  
  247. procedure TFrmCompareFile.SearchFile(FileListBox : TFileListBox; sFile : String; Edit : TEdit);
  248. var
  249.   I, nStart : Integer;
  250.   sDeli : String;
  251. begin
  252.   if lTextDeleting then
  253.     Exit;
  254.   try
  255.     for I := 1 to DirectoryListBox1.Items.Count - 1 do begin
  256.       if (Copy(UpperCase(DirectoryListBox1.Items.Strings[I]),1,Length(sFile)) = UpperCase(sFile)) and
  257.         (sFile <> '') then begin
  258.         DirectoryListBox1.ItemIndex := I;
  259.         if (Copy(DirectoryListBox1.Directory,Length(DirectoryListBox1.Directory),1) <> '\') then
  260.           sDeli := '\'
  261.         else
  262.           sDeli := '';
  263.         DirectoryListBox1.Directory := DirectoryListBox1.Directory + sDeli + DirectoryListBox1.Items.Strings[I];
  264.         nStart := Edit.SelStart;
  265.         Edit.Text := DirectoryListBox1.Directory;
  266.         Edit.SelStart := nStart;
  267.         Edit.SelLength := Length(Edit.Text);
  268.         Break;
  269.       end;
  270.     end;
  271.   except
  272.     ;
  273.   end;
  274.   try
  275.     for I := 0 to FileListBox.Items.Count - 1 do begin
  276.       if (Copy(UpperCase(FileListBox.Items.Strings[I]),1,Length(sFile)) = UpperCase(sFile)) and
  277.         (sFile <> '') then begin
  278.         FileListBox.ItemIndex := I;
  279.         nStart := Edit.SelStart;
  280.         if (Copy(FileListBox.Directory,Length(FileListBox.Directory),1) <> '\') then
  281.           sDeli := '\'
  282.         else
  283.           sDeli := '';
  284.         Edit.Text := FileListBox.Directory + sDeli + FileListBox.Items.Strings[I];
  285.         Edit.SelStart := nStart;
  286.         Edit.SelLength := Length(Edit.Text);
  287.         Break;
  288.       end;
  289.     end;
  290.   except
  291.     ;
  292.   end;
  293. end;
  294.  
  295. procedure TFrmCompareFile.Edit1KeyDown(Sender: TObject; var Key: Word;
  296.   Shift: TShiftState);
  297. begin
  298.   lTextDeleting := (Key = 8) or (Key = 46);
  299.   if (Key = 38) then begin
  300.     lEditBox := False;
  301.     if ((FileListBox1.ItemIndex - 1) >= 0) then
  302.       FileListBox1.ItemIndex := FileListBox1.ItemIndex - 1;
  303.     lEditBox := True;
  304.   end;
  305.   if (Key = 40) then begin
  306.     lEditBox := False;
  307.     if ((FileListBox1.ItemIndex + 1) <= FileListBox1.Items.Count) then
  308.       FileListBox1.ItemIndex := FileListBox1.ItemIndex + 1;
  309.     lEditBox := True;
  310.   end;
  311. end;
  312.  
  313. procedure TFrmCompareFile.Edit2KeyDown(Sender: TObject; var Key: Word;
  314.   Shift: TShiftState);
  315. begin
  316.   lTextDeleting := (Key = 8) or (Key = 46);
  317.   if (Key = 38) then begin
  318.     lEditBox := False;
  319.     if ((FileListBox2.ItemIndex - 1) >= 0) then
  320.       FileListBox2.ItemIndex := FileListBox2.ItemIndex - 1;
  321.     lEditBox := True;
  322.   end;
  323.   if (Key = 40) then begin
  324.     lEditBox := False;
  325.     if ((FileListBox2.ItemIndex + 1) <= FileListBox2.Items.Count) then
  326.       FileListBox2.ItemIndex := FileListBox2.ItemIndex + 1;
  327.     lEditBox := True;
  328.   end;
  329. end;
  330.  
  331. end.
  332.