unit fCompareFiles; {$mode objfpc}{$H+} interface uses LResources, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls, ComCtrls, Buttons, SynEdit, EditBtn; type { TfrmCompareFiles } TfrmCompareFiles = class(TForm) edtFileNameLeft: TFileNameEdit; edtFileNameRight: TFileNameEdit; pnlLeft: TPanel; Splitter1: TSplitter; pnlRight: TPanel; pnlLeftBox: TPanel; pnlRightBox: TPanel; lstRight: TSynEdit; lstLeft: TSynEdit; pnlStatusBar: TStatusBar; pnlButtons: TPanel; btnCompare: TButton; btnNextDiff: TButton; btnPrevDiff: TButton; chbBinMode: TCheckBox; btnClose: TButton; chbKeepScrolling: TCheckBox; procedure btnCompareClick(Sender: TObject); procedure FormCreate(Sender: TObject); procedure lstLeftSpecialLineColors(Sender: TObject; Line: Integer; var Special: Boolean; var FG, BG: TColor); procedure lstLeftStatusChange(Sender: TObject; Changes: TSynStatusChanges); procedure lstRightSpecialLineColors(Sender: TObject; Line: Integer; var Special: Boolean; var FG, BG: TColor); procedure lstRightStatusChange(Sender: TObject; Changes: TSynStatusChanges); procedure btnCloseClick(Sender: TObject); private { Private declarations } public { Public declarations } end; procedure ShowCmpFiles(const sFile1, sFile2:String); implementation uses uCompareFiles, uLng, uGlobs; procedure ShowCmpFiles(const sFile1, sFile2:String); begin with TfrmCompareFiles.Create(Application)do begin try edtFileNameLeft.Text:=sFile1; edtFileNameRight.Text:=sFile2; ShowModal; finally Free; end; end; end; procedure TfrmCompareFiles.FormCreate(Sender: TObject); begin lstLeft.Font.Name:= gEditorFontName; lstLeft.Font.Style:= gEditorFontStyle; lstLeft.Font.Size:= gEditorFontSize; lstRight.Font.Name:= gEditorFontName; lstRight.Font.Size:= gEditorFontSize; lstRight.Font.Style:= gEditorFontStyle; end; procedure TfrmCompareFiles.btnCompareClick(Sender: TObject); var iChanges : integer; begin if chbBinMode.Checked then iChanges := CompareFiles(edtFileNameLeft.Text, edtFileNameRight.Text, lstLeft.Lines, lstRight.Lines, cmInternalBin) else iChanges := CompareFiles(edtFileNameLeft.Text, edtFileNameRight.Text, lstLeft.Lines, lstRight.Lines, cmInternalText); { CompareFiles(edtFileNameLeft.Text, edtFileNameRight.Text, lstLeft.Items, lstRight.Items, cmInternalText);} pnlStatusBar.Panels[0].Text := rsCompareDiffs + ' ' + IntToStr(iChanges); end; procedure TfrmCompareFiles.lstLeftSpecialLineColors(Sender: TObject; Line: Integer; var Special: Boolean; var FG, BG: TColor); var i:PtrInt; begin i:=PtrInt(lstLeft.Lines.Objects[Line-1]); if i = 0 then Exit; Special:=True; if chbBinMode.Checked then begin FG:=clRed; Exit; end; if i=1 then FG:=clRed else FG:=clGreen; end; procedure TfrmCompareFiles.lstLeftStatusChange(Sender: TObject; Changes: TSynStatusChanges); begin if (chbKeepScrolling.Checked) then begin lstRight.TopLine := lstLeft.TopLine; lstLeft.Invalidate; end; end; procedure TfrmCompareFiles.lstRightSpecialLineColors(Sender: TObject; Line: Integer; var Special: Boolean; var FG, BG: TColor); var i:PtrInt; begin i:=PtrInt(lstRight.Lines.Objects[Line-1]); if i = 0 then Exit; Special:=True; if chbBinMode.Checked then begin FG:=clRed; Exit; end; if i=1 then FG:=clRed else FG:=clGreen; end; procedure TfrmCompareFiles.lstRightStatusChange(Sender: TObject; Changes: TSynStatusChanges); begin if (chbKeepScrolling.Checked) then begin lstLeft.TopLine := lstRight.TopLine; lstRight.Invalidate; end; end; procedure TfrmCompareFiles.btnCloseClick(Sender: TObject); begin inherited; Close(); end; initialization {$I fcomparefiles.lrs} end.