home *** CD-ROM | disk | FTP | other *** search
/ Chip 2001 September / Chip_2001-09_cd1.bin / zkuste / delphi / kolekce / d56 / RMCTL.ZIP / rmDiff.pas < prev    next >
Pascal/Delphi Source File  |  2001-06-22  |  47KB  |  1,845 lines

  1. {================================================================================
  2. Copyright (C) 1997-2001 Mills Enterprise
  3.  
  4. Unit     : rmDiff
  5. Purpose  : This is used to do a textfile difference.
  6. Date     : 12-29-2000
  7. Author   : Ryan J. Mills
  8. Version  : 1.80
  9. Notes    : The original engine code came from the diff.c file found on the
  10.            ftp.cdrom.com site.  The original source can be found here:
  11.            ftp://ftp.cdrom.com/pub/algorithims/c/diff.c
  12.            The DiffMap code originally came from Bernie Caudry and Guy LeMar.
  13.            I've only modified the original DiffMap source to work with my rmDiff
  14.            components.  I would like to go back and rewrite the drawing and
  15.            mapping algorithms because I think they are unnecessarily complex.
  16.            It also doesn't use any resources where it should.
  17. ================================================================================}
  18.  
  19. unit rmDiff;
  20.  
  21. interface
  22.  
  23. {$I CompilerDefines.INC}
  24.  
  25. uses windows, Messages, controls, classes, stdctrls, Grids, extctrls, sysutils, Graphics,
  26.   rmListControl;
  27.  
  28. type
  29.   EDiffException = Exception;
  30.  
  31.   TrmDiffBlock = record
  32.     startLine: integer;
  33.     EndLine: integer;
  34.   end;
  35.  
  36.   TrmDiffObject = class(TObject)
  37.   private
  38.     fSource1, fSource2: TrmDiffBlock;
  39.   public
  40.     property Source1: TrmDiffBlock read fSource1 write fSource1;
  41.     property Source2: TrmDiffBlock read fSource2 write fSource2;
  42.   end;
  43.  
  44.   TrmDiffOption = (fdoCaseSensitive, fdoIgnoreCharacters, fdoIgnoreTrailingWhiteSpace, fdoIgnoreLeadingWhiteSpace);
  45.   TrmDiffOptions = set of TrmDiffOption;
  46.  
  47.   TrmDiffProgressEvent = procedure(PercentComplete: integer) of object;
  48.   TrmDiffMapClickEvent = procedure(Sender: TObject; IndicatorPos: integer) of object;
  49.  
  50.   TrmCustomDiffViewer = class;
  51.   TrmDiffMap = class;
  52.  
  53.   TrmCharacterSet = set of char;
  54.  
  55.   TrmCustomDiffEngine = class(TComponent)
  56.   private
  57.   { Private }
  58.     fSource1, fSource2: TStringList;
  59.     fDiffSource1, fDiffSource2 : TStringList;
  60.     fAttachedViewers : TList;
  61.     fSource1Count, fSource2Count: integer;
  62.     fBlankLines1, fBlankLines2: integer;
  63.     fOptions: TrmDiffOptions;
  64.     fOnDiffCompleted: TNotifyEvent;
  65.     fOnProgress: TrmDiffProgressEvent;
  66.     fMatchDepth: integer;
  67.     fIgnoreChars: TrmCharacterSet;
  68.     fMultiLineCommentOpen, fStringOpen: boolean;
  69.     function AtEOF: boolean;
  70.     procedure MoveDown(Amount1, Amount2: integer);
  71.     procedure CompareData;
  72.     procedure StartCompare;
  73.     procedure SetMatchDepth(const Value: integer);
  74.     procedure ClearData;
  75.     function RemoveCharacters(st:string):string;
  76.   protected
  77.   { protected }
  78.     function MatchLines(level1, level2, MatchDepth: integer): boolean; virtual;
  79.     procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  80.  
  81.     procedure DiffStarted; virtual;
  82.     procedure DiffFound(Source1, Source2: TrmDiffBlock); virtual;
  83.     procedure DiffCompleted; virtual;
  84.  
  85.     procedure AttachViewer(viewer:TrmCustomDiffViewer);
  86.     procedure RemoveViewer(viewer:TrmCustomDiffViewer);
  87.  
  88.     property MatchDepth: integer read fMatchDepth write SetMatchDepth default 3;
  89.     property DiffOptions: TrmDiffOptions read fOptions write fOptions;
  90.     property OnDiffCompleted: TNotifyEvent read fOnDiffCompleted write fOnDiffCompleted;
  91.     property OnDiffProgress: TrmDiffProgressEvent read fOnProgress write fOnProgress;
  92.     property DiffSource1 : TStringList read fDiffSource1;
  93.     property DiffSource2 : TStringList read fDiffSource2;
  94.     property IgnoreCharacters : TrmCharacterSet read fIgnoreChars write fIgnoreChars;
  95.   public
  96.   { Public }
  97.     constructor Create(AOwner: TComponent); override;
  98.     destructor Destroy; override;
  99.     procedure CompareFiles(file1, file2: string);
  100.     procedure CompareStreams(Strm1, Strm2: TStream);
  101.   end;
  102.  
  103.   TrmDiffEngine = class(TrmCustomDiffEngine)
  104.   public
  105.     property DiffSource1;
  106.     property DiffSource2;
  107.     property IgnoreCharacters;
  108.   published
  109.   { Published }
  110.     property MatchDepth;
  111.     property DiffOptions;
  112.     property OnDiffCompleted;
  113.     property OnDiffProgress;
  114.   end;
  115.  
  116.   TrmCustomDiffViewer = class(TCustomControl)
  117.   private
  118.   { Private }
  119.     fDiff: TrmCustomDiffEngine;
  120.     fDiffMap: TrmDiffMap;
  121.     fEBGColor: TColor;
  122.     fDBGColor: TColor;
  123.     fSimpleViewer: boolean;
  124.     fITColor: TColor;
  125.     fDColor: TColor;
  126.     fCTColor: TColor;
  127.  
  128.     procedure SetDBGColor(const Value: TColor);
  129.     procedure SetEBGColor(const Value: TColor);
  130.     procedure SetSimpleViewer(const Value: boolean);
  131.     procedure SetCTColor(const Value: TColor);
  132.     procedure SetDTColor(const Value: TColor);
  133.     procedure SetITColor(const Value: TColor);
  134.   protected
  135.   { protected }
  136.     procedure SetDiff(const Value: TrmCustomDiffEngine); virtual;
  137.     procedure SetDiffMap(const Value: TrmDiffMap); virtual;
  138.     procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  139.     property DiffEngine: TrmCustomDiffEngine read fDiff write SetDiff;
  140.     function GetMapData: string;
  141.     procedure MapClick(Sender: TObject; IndicatorPos: integer); virtual; Abstract;
  142.     property EmptyBGColor: TColor read fEBGColor write SetEBGColor default clBtnFace;
  143.     property DiffBGColor: TColor read fDBGColor write SetDBGColor default clYellow;
  144.     property ChangedTextColor: TColor read fCTColor write SetCTColor default clWindowText;
  145.     property DeletedTextColor: TColor read fDColor write SetDTColor default clWindowText;
  146.     property InsertedTextColor: TColor read fITColor write SetITColor default clWindowText;
  147.     property SimpleDiffViewer: boolean read fSimpleViewer write SetSimpleViewer default true;
  148.     property DiffMap: TrmDiffMap read fDiffMap write SetDiffMap;
  149.   public
  150.   { Public }
  151.     constructor Create(AOwner: TComponent); override;
  152.     procedure DiffferenceCompleted; virtual;
  153.   published
  154.   { Published }
  155.     property Align;
  156.     property Font;
  157.   end;
  158.  
  159.   TrmDiffViewer = class(TrmCustomDiffViewer)
  160.   private
  161.   { Private }
  162.     fDrawing: boolean;
  163.     fsource1: TrmListControl;
  164.     fsource2: TrmListControl;
  165.     fBevel: TBevel;
  166.     fPanel: TPanel;
  167.     fLabel1, fLabel2: TLabel;
  168.     fScrollInProgress: boolean;
  169.     fIHC: boolean;
  170.     fLockSelIndex: boolean;
  171.     procedure UpdateVScrollBar;
  172.     procedure UpdateHScrollBar;
  173.     procedure scrollChanged(Sender: TObject; ScrollBar: integer);
  174.     procedure Drawing(Sender: TObject; Canvas: TCanvas; Selected: boolean; var str: string);
  175.     procedure cmFontChanged(var Msg: TMessage); message cm_fontchanged;
  176.     procedure WMVScroll(var Msg: TWMVScroll); message WM_VSCROLL;
  177.     procedure WMHScroll(var Msg: TWMHScroll); message WM_HSCROLL;
  178.     procedure SetIHC(const Value: boolean);
  179.     procedure SetLockSelIndex(const Value: boolean);
  180.   protected
  181.   { protected }
  182.     procedure SetDiffMap(const Value: TrmDiffMap); override;
  183.     procedure Resize; override;
  184.     procedure CreateParams(var Params: TCreateParams); override;
  185.     procedure ResetIndex(Index, Pos: integer);
  186.     procedure MapClick(Sender: TObject; IndicatorPos: integer); override;
  187.   public
  188.   { Public }
  189.     procedure DiffferenceCompleted; override;
  190.  
  191.     constructor Create(AOwner: TComponent); override;
  192.     procedure Loaded; override;
  193.   published
  194.   { Published }
  195.     property TabStop;
  196.     property DiffEngine;
  197.     property EmptyBGColor;
  198.     property DiffBGColor;
  199.     property ChangedTextColor;
  200.     property DeletedTextColor;
  201.     property InsertedTextColor;
  202.     property DiffMap;
  203.     property SimpleDiffViewer;
  204.     property IndependantHorzControl: boolean read fIHC write SetIHC default False;
  205.     property LockSelectedIndex:boolean read fLockSelIndex write SetLockSelIndex default true;
  206.   end;
  207.  
  208.   TrmDiffMergeViewer = class(TrmCustomDiffViewer)
  209.   private
  210.   { Private }
  211.     fDrawing: boolean;
  212.     fsource1: TrmListControl;
  213.     fsource2: TrmListControl;
  214.     fMergeSource: TrmListControl;
  215.     fBevel, fBevel2: TBevel;
  216.     fPanel: TPanel;
  217.     fLabel1, fLabel2, fLabel3: TLabel;
  218.     fScrollInProgress: boolean;
  219.     fD1BGColor: TColor;
  220.     fD2BGColor: TColor;
  221.     fIHC: boolean;
  222.     procedure UpdateVScrollBar;
  223.     procedure UpdateHScrollBar;
  224.     procedure scrollChanged(Sender: TObject; ScrollBar: integer);
  225.     procedure Drawing(Sender: TObject; Canvas: TCanvas; Selected: boolean; var str: string);
  226.     procedure cmFontChanged(var Msg: TMessage); message cm_fontchanged;
  227.     procedure WMVScroll(var Msg: TWMVScroll); message WM_VSCROLL;
  228.     procedure WMHScroll(var Msg: TWMHScroll); message WM_HSCROLL;
  229.     procedure SetD1BGColor(const Value: TColor);
  230.     procedure SetD2BGColor(const Value: TColor);
  231.     procedure SetIHC(const Value: boolean);
  232.   protected
  233.   { protected }
  234.     procedure Resize; override;
  235.     procedure CreateParams(var Params: TCreateParams); override;
  236.     procedure ResetIndex(Index, Pos: integer);
  237.     procedure MapClick(Sender: TObject; IndicatorPos: integer); override;
  238.   public
  239.   { Public }
  240.     procedure DiffferenceCompleted; override;
  241.  
  242.     constructor Create(AOwner: TComponent); override;
  243.     procedure Loaded; override;
  244.     function CanChangeSource: boolean;
  245.     procedure CopySource(Source1: boolean);
  246.     procedure ClearSource;
  247.     procedure SaveMergeToFile(FileName: string);
  248.     procedure SaveMergeToStream(Strm: TStream);
  249.   published
  250.   { Published }
  251.     property DiffEngine;
  252.     property TabStop;
  253.     property IndependantHorzControl: boolean read fIHC write SetIHC default False;
  254.     property EmptyBGColor;
  255.     property ChangedTextColor;
  256.     property DeletedTextColor;
  257.     property InsertedTextColor;
  258.     property DiffMap;
  259.     property SimpleDiffViewer;
  260.     property Source1DiffBGColor: TColor read fD1BGColor write SetD1BGColor default clAqua;
  261.     property Source2DiffBGColor: TColor read fD2BGColor write SetD2BGColor default clYellow;
  262.   end;
  263.  
  264.   TrmDiffMap = class(TCustomControl)
  265.   private
  266.     { Private declarations }
  267.     FColorDeleted: TColor;
  268.     FColorInserted: TColor;
  269.     FColorModified: TColor;
  270.     FShowIndicator: Boolean;
  271.     FIndicatorPos: integer;
  272.     FIndicator: TBitmap;
  273.     FData: string;
  274.     FOnMapClick: TrmDiffMapClickEvent;
  275.     procedure DrawIndicator;
  276.     procedure SetIndicatorPos(Value: integer);
  277.     function MapHeight: integer;
  278.   protected
  279.     { Protected declarations }
  280.     procedure Paint; override;
  281.   public
  282.     { Public declarations }
  283.     constructor Create(AOwner: TComponent); override;
  284.     destructor Destroy; override;
  285.     procedure SetData(Value: string);
  286.     procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
  287.     property IndicatorPos: integer read FIndicatorPos write SetIndicatorPos;
  288.   published
  289.     { Published declarations }
  290.     property Color;
  291.     property Caption;
  292.     property Align;
  293.     property ColorDeleted: TColor read FColorDeleted write FColorDeleted;
  294.     property ColorInserted: TColor read FColorInserted write FColorInserted;
  295.     property ColorModified: TColor read FColorModified write FColorModified;
  296.     property ShowIndicator: Boolean read FShowIndicator write FShowIndicator;
  297.     property OnMapClick: TrmDiffMapClickEvent read FOnMapClick write FOnMapClick;
  298.   end;
  299.  
  300. implementation
  301.  
  302. uses rmLibrary, Forms;
  303.  
  304. {$R *.RES}
  305.  
  306. const
  307.   NormalLine = #1;
  308.   DeletedLine = #2;
  309.   InsertedLine = #3;
  310.   ChangedLine = #4;
  311.   EmptyLine = #5;
  312.   MergeLine1 = #6;
  313.   MergeLine2 = #7;
  314.  
  315.   TOP_MARGIN = 5;
  316.   BOTTOM_MARGIN = 5;
  317.  
  318. { TrmDiff }
  319.  
  320. constructor TrmCustomDiffEngine.Create;
  321. begin
  322.   inherited;
  323.   fSource1 := TStringList.Create;
  324.   fSource2 := TStringList.Create;
  325.   fDiffSource1 := TStringList.create;
  326.   fDiffSource2 := TStringList.create;
  327.   fAttachedViewers := TList.create;
  328.   fSource1Count := -1;
  329.   fSource2Count := -1;
  330.   fMatchDepth := 3;
  331.   fIgnoreChars := [#0..#32];
  332.   fMultiLineCommentOpen:=false;
  333.   fStringOpen:=false;
  334. end;
  335.  
  336. destructor TrmCustomDiffEngine.Destroy;
  337. begin
  338.   fSource1.Free;
  339.   fSource2.Free;
  340.   fDiffSource1.free;
  341.   fDiffSource2.free;
  342.   fAttachedViewers.Free;
  343.   inherited;
  344. end;
  345.  
  346. procedure TrmCustomDiffEngine.CompareFiles(file1, file2: string);
  347. begin
  348.   ClearData;   
  349.   fSource1.LoadFromFile(File1);
  350.   fSource2.LoadFromFile(File2);
  351.   StartCompare;
  352. end;
  353.  
  354. procedure TrmCustomDiffEngine.CompareStreams(Strm1, Strm2: TStream);
  355. begin
  356.   ClearData;   
  357.   fSource1.LoadFromStream(Strm1);
  358.   fSource2.LoadFromStream(Strm2);
  359.   StartCompare;
  360. end;
  361.  
  362. procedure TrmCustomDiffEngine.StartCompare;
  363. begin
  364.   fSource1Count := fSource1.Count;
  365.   fSource2Count := fSource2.count;
  366.  
  367.   DiffStarted;
  368.  
  369.   while not AtEOF do
  370.     CompareData;
  371.  
  372.   DiffCompleted;
  373. end;
  374.  
  375. procedure TrmCustomDiffEngine.CompareData;
  376. var
  377.   depth, level, tmp: integer;
  378.   db1, db2: TrmDiffBlock;
  379.   wEOF: boolean;
  380.   CheckDepth: integer;
  381. begin
  382.   while (not atEOF) and matchLines(0, 0, 0) do
  383.     MoveDown(1, 1);
  384.  
  385.   if AtEOF then
  386.     exit;
  387.  
  388.   wEOF := false;
  389.   depth := 0;
  390.   level := 0;
  391.  
  392.   if (fSource1Count = fSource1.count) and (fSource2Count = fSource2.count) then
  393.     checkdepth := 1
  394.   else
  395.     CheckDepth := fMatchDepth;
  396.   while true do
  397.   begin
  398.     try
  399.       if MatchLines(level, depth, CheckDepth) then
  400.         break;
  401.  
  402.       if (level <> depth) and (MatchLines(depth, level, CheckDepth)) then
  403.         break;
  404.  
  405.       if (level < depth) then
  406.         inc(level)
  407.       else
  408.       begin
  409.         inc(depth);
  410.         level := 0;
  411.       end;
  412.     except
  413.       wEOF := true;
  414.       level := fSource2.count - 1;
  415.       depth := fSource1.count - 1;
  416.     end;
  417.   end;
  418.  
  419.   if not wEOF then
  420.   begin
  421.     if MatchLines(level, depth, CheckDepth) then
  422.     begin
  423.       tmp := level;
  424.       level := depth;
  425.       depth := tmp;
  426.     end;
  427.   end;
  428.  
  429.   db1.startLine := fSource1Count - fSource1.count;
  430.   db1.endline := db1.startline + depth;
  431.  
  432.   db2.startLine := fSource2Count - fSource2.count;
  433.   db2.endline := db2.startline + level;
  434.  
  435.   try
  436.      DiffFound(db1, db2);
  437.   except
  438.       //Do Nothing
  439.   end;
  440. end;
  441.  
  442. function TrmCustomDiffEngine.AtEOF: boolean;
  443. begin
  444.   result := (fSource1.count = 0) or (fSource2.count = 0);
  445. end;
  446.  
  447. function TrmCustomDiffEngine.MatchLines(level1, level2, MatchDepth: integer): boolean;
  448. var
  449.   s1, s2: string;
  450.   loop: integer;
  451. begin
  452.   result := true;
  453.  
  454.   for loop := 0 to MatchDepth do
  455.   begin
  456.     if level1 + loop >= fSource1.count then
  457.       s1 := ''
  458.     else
  459.       s1 := fSource1[level1 + loop];
  460.  
  461.     if level2 + loop >= fSource2.count then
  462.       s2 := ''
  463.     else
  464.       s2 := fSource2[level2 + loop];
  465.  
  466.     if (fdoIgnoreCharacters in fOptions) and (fIgnoreChars <> []) then
  467.     begin
  468.       s1 := RemoveCharacters(s1);
  469.       s2 := RemoveCharacters(s2);
  470.     end;
  471.  
  472.     if ((fdoIgnoreTrailingWhiteSpace in fOptions) and
  473.        (fdoIgnoreLeadingWhiteSpace in fOptions)) then
  474.     begin
  475.       s1 := Trim(s1);
  476.       s2 := Trim(s2);
  477.     end
  478.     else
  479.     if fdoIgnoreTrailingWhiteSpace in fOptions then
  480.     begin
  481.       s1 := TrimRight(s1);
  482.       s2 := TrimRight(s2);
  483.     end
  484.     else if fdoIgnoreLeadingWhiteSpace in fOptions then
  485.     begin
  486.       s1 := TrimLeft(s1);
  487.       s2 := TrimLeft(s2);
  488.     end;
  489.  
  490.     if fdoCaseSensitive in fOptions then
  491.       result := result and (compareStr(s1, s2) = 0)
  492.     else
  493.       result := result and (compareStr(lowercase(s1), lowercase(s2)) = 0);
  494.  
  495.     if not result then
  496.       break;
  497.   end;
  498. end;
  499.  
  500. procedure TrmCustomDiffEngine.MoveDown(Amount1, Amount2: integer);
  501. begin
  502.   while Amount1 > 0 do
  503.   begin
  504.     dec(Amount1);
  505.     try
  506.        fDiffSource1.add(NormalLine + fSource1[0]);
  507.        fSource1.delete(0);
  508.     except
  509.       amount1 := 0;
  510.     end;
  511.   end;
  512.  
  513.   while Amount2 > 0 do
  514.   begin
  515.     dec(Amount2);
  516.     try
  517.        fDiffSource2.add(NormalLine + fSource2[0]);
  518.        fSource2.delete(0);
  519.     except
  520.       amount2 := 0;
  521.     end;
  522.   end;
  523.  
  524.   if assigned(fOnProgress) then
  525.   begin
  526.     try
  527.       fOnProgress(round((((fSource1Count + fSource2Count) - (fSource1.Count + fSource2.count)) / (fSource1Count + fSource2Count)) * 100));
  528.     except
  529.          //Do Nothing...
  530.     end;
  531.   end;
  532. end;
  533.  
  534. procedure TrmCustomDiffEngine.Notification(AComponent: TComponent;
  535.   Operation: TOperation);
  536. var
  537.    Index : integer;
  538. begin
  539.   inherited;
  540.   if operation = opremove then
  541.   begin
  542.     index := fAttachedViewers.indexof(AComponent);
  543.     if index <> -1 then
  544.        fAttachedViewers.Delete(index);
  545.   end;
  546. end;
  547.  
  548. procedure TrmCustomDiffEngine.SetMatchDepth(const Value: integer);
  549. begin
  550.   if (fMatchDepth <> value) and (value > 0) and (value < 100) then
  551.     fMatchDepth := Value;
  552. end;
  553.  
  554. { TrmCustomDiffViewer }
  555.  
  556. constructor TrmCustomDiffViewer.Create(AOwner: TComponent);
  557. begin
  558.   inherited Create(AOwner);
  559.   Height := 150;
  560.   width := 250;
  561.  
  562.   ControlStyle := ControlStyle - [csAcceptsControls];
  563.  
  564.   fEBGColor := clBtnFace;
  565.   fDBGColor := clYellow;
  566.  
  567.   fSimpleViewer := true;
  568. end;
  569.  
  570. procedure TrmCustomDiffViewer.Notification(AComponent: TComponent;
  571.   Operation: TOperation);
  572. begin
  573.   inherited;
  574.   if (operation = opRemove) then
  575.   begin
  576.     if (AComponent = fDiff) then
  577.       fDiff := nil;
  578.     if (AComponent = fDiffMap) then
  579.       fDiffMap := nil;
  580.   end;
  581. end;
  582.  
  583. procedure TrmCustomDiffViewer.SetDiff(const Value: TrmCustomDiffEngine);
  584. begin
  585.   if value <> fDiff then
  586.   begin
  587.     if assigned(fDiff) then
  588.       fDiff.RemoveViewer(self);
  589.  
  590.     fDiff := Value;
  591.     
  592.     if assigned(fDiff) then
  593.     begin
  594.       fDiff.FreeNotification(self);
  595.       fDiff.AttachViewer(self);
  596.     end
  597.   end;
  598. end;
  599.  
  600. procedure TrmCustomDiffViewer.SetDBGColor(const Value: TColor);
  601. begin
  602.   fDBGColor := Value;
  603.   Invalidate;
  604. end;
  605.  
  606. procedure TrmCustomDiffViewer.SetEBGColor(const Value: TColor);
  607. begin
  608.   fEBGColor := Value;
  609.   Invalidate;
  610. end;
  611.  
  612. procedure TrmCustomDiffViewer.SetSimpleViewer(const Value: boolean);
  613. begin
  614.   fSimpleViewer := Value;
  615.   invalidate;
  616. end;
  617.  
  618. procedure TrmCustomDiffViewer.SetCTColor(const Value: TColor);
  619. begin
  620.   fCTColor := Value;
  621.   invalidate;
  622. end;
  623.  
  624. procedure TrmCustomDiffViewer.SetDTColor(const Value: TColor);
  625. begin
  626.   fDColor := Value;
  627.   invalidate;
  628. end;
  629.  
  630. procedure TrmCustomDiffViewer.SetITColor(const Value: TColor);
  631. begin
  632.   fITColor := Value;
  633.   invalidate;
  634. end;
  635.  
  636. procedure TrmCustomDiffViewer.SetDiffMap(const Value: TrmDiffMap);
  637. begin
  638.   if fDiffMap <> Value then
  639.   begin
  640.     fDiffMap := value;
  641.     if assigned(fDiffMap) then
  642.     begin
  643.       fDiffMap.FreeNotification(self);
  644.       fDiffMap.SetData(GetMapData);
  645.       fDiffMap.OnMapClick := MapClick;
  646.     end;
  647.   end;
  648.  
  649. end;
  650.  
  651. function TrmCustomDiffViewer.GetMapData: string;
  652. var
  653.   loop: integer;
  654.   wstr: string;
  655. begin
  656.   wstr := '';
  657.   if assigned(DiffEngine) and (DiffEngine.fDiffSource1.count > 0) then
  658.   begin
  659.      setlength(wStr, DiffEngine.fDiffSource1.count);
  660.      for loop := 0 to DiffEngine.fDiffSource1.Count - 1 do
  661.      begin
  662.        case DiffEngine.fDiffSource1[loop][1] of
  663.          NormalLine: wstr[loop + 1] := NormalLine;
  664.          DeletedLine: wstr[loop + 1] := DeletedLine;
  665.          ChangedLine: wstr[loop + 1] := ChangedLine;
  666.          EmptyLine: wstr[loop + 1] := InsertedLine;
  667.        end;
  668.      end;
  669.   end;
  670.   result := wstr;
  671. end;
  672.  
  673. procedure TrmCustomDiffViewer.DiffferenceCompleted;
  674. begin
  675.    if assigned(fDiffMap) then
  676.       fDiffMap.SetData(GetMapData);  
  677. end;
  678.  
  679. { TrmDiffMergeViewer }
  680.  
  681. function TrmDiffMergeViewer.CanChangeSource: boolean;
  682. begin
  683.   result := (fMergeSource.items.count > 0) and (fMergeSource.Items[fMergeSource.itemindex][1] <> NormalLine);
  684. end;
  685.  
  686. procedure TrmDiffMergeViewer.ClearSource;
  687. var
  688.   oldIndex, oldScrollPos: integer;
  689. begin
  690.   oldindex := fMergeSource.ItemIndex;
  691.   oldScrollPos := fMergeSource.VScrollPos;
  692.   try
  693.     fMergeSource.Items[fMergeSource.ItemIndex] := EmptyLine + '';
  694.   finally
  695.     ResetIndex(OldIndex, OldScrollPos);
  696.   end;
  697.   invalidate;
  698. end;
  699.  
  700. procedure TrmDiffMergeViewer.cmFontChanged(var Msg: TMessage);
  701. begin
  702.   inherited;
  703.   fsource1.font.Assign(font);
  704.   fsource2.font.Assign(font);
  705.   fMergeSource.font.assign(font);
  706. end;
  707.  
  708. procedure TrmDiffMergeViewer.CopySource(Source1: boolean);
  709. var
  710.   wstr: string;
  711.   oldIndex, OldScrollPos: integer;
  712. begin
  713.   oldindex := fMergeSource.ItemIndex;
  714.   oldScrollPos := fMergeSource.VScrollPos;
  715.   try
  716.     if Source1 then
  717.     begin
  718.       wstr := fSource1.Items[fSource1.ItemIndex];
  719.       if wstr[1] <> emptyline then
  720.       begin
  721.         delete(wstr, 1, 1);
  722.         wstr := MergeLine1 + wstr;
  723.       end
  724.       else
  725.         wstr := EmptyLine + '';
  726.     end
  727.     else
  728.     begin
  729.       wstr := fSource2.Items[fSource2.ItemIndex];
  730.       if wstr[1] <> emptyline then
  731.       begin
  732.         delete(wstr, 1, 1);
  733.         wstr := MergeLine2 + wstr;
  734.       end
  735.       else
  736.         wstr := EmptyLine + '';
  737.     end;
  738.     fMergeSource.Items[fMergeSource.ItemIndex] := wstr;
  739.   finally
  740.     ResetIndex(oldIndex, OldScrollPos);
  741.     invalidate;
  742.   end;
  743. end;
  744.  
  745. constructor TrmDiffMergeViewer.Create(AOwner: TComponent);
  746. begin
  747.   inherited;
  748.   BevelEdges := [beLeft, beTop, beRight, beBottom];
  749.   BevelInner := bvLowered;
  750.   BevelOuter := bvLowered;
  751.   BevelKind := bkTile;
  752.  
  753.   fD1BGColor := clAqua;
  754.   fD2BGColor := clYellow;
  755.  
  756.   fDrawing := false;
  757.   fScrollInProgress := false;
  758.   fIHC := false;
  759.  
  760.   fPanel := TPanel.create(self);
  761.   with fPanel do
  762.   begin
  763.     Parent := self;
  764.     align := altop;
  765.     BevelInner := bvlowered;
  766.     BevelOuter := bvraised;
  767.   end;
  768.  
  769.   fLabel1 := TLabel.create(fPanel);
  770.   with fLabel1 do
  771.   begin
  772.     parent := fPanel;
  773.     align := alLeft;
  774.     AutoSize := false;
  775.     Caption := 'Source 1';
  776.     Alignment := taCenter;
  777.   end;
  778.  
  779.   fLabel2 := TLabel.create(fPanel);
  780.   with fLabel2 do
  781.   begin
  782.     parent := fPanel;
  783.     align := alLeft;
  784.     AutoSize := false;
  785.     Caption := 'Merged Source';
  786.     Alignment := taCenter;
  787.   end;
  788.  
  789.   fLabel3 := TLabel.create(fPanel);
  790.   with fLabel3 do
  791.   begin
  792.     parent := fPanel;
  793.     align := alClient;
  794.     AutoSize := false;
  795.     Caption := 'Source 2';
  796.     Alignment := taCenter;
  797.   end;
  798.  
  799.   fSource1 := TrmListControl.create(self);
  800.   with fSource1 do
  801.   begin
  802.     name := 'SourceList1';
  803.     parent := self;
  804.     align := alLeft;
  805.     font.assign(self.font);
  806.     enabled := false;
  807.     OnFormatDrawing := Drawing;
  808.     ShowVScrollBars := false;
  809.     ShowHScrollBars := false;
  810.   end;
  811.  
  812.   fBevel := TBevel.Create(self);
  813.   with fBevel do
  814.   begin
  815.     parent := self;
  816.     align := alLeft;
  817.     width := 2;
  818.   end;
  819.  
  820.   fMergeSource := TrmListControl.create(self);
  821.   with fMergeSource do
  822.   begin
  823.     name := 'MergedSourceList';
  824.     parent := self;
  825.     align := alLeft;
  826.     font.assign(self.font);
  827.     TabStop := true;
  828.     OnScroll := ScrollChanged;
  829.     OnFormatDrawing := Drawing;
  830.     ShowVScrollBars := false;
  831.     ShowHScrollBars := false;
  832.   end;
  833.  
  834.   fBevel2 := TBevel.Create(self);
  835.   with fBevel2 do
  836.   begin
  837.     parent := self;
  838.     align := alLeft;
  839.     width := 2;
  840.   end;
  841.  
  842.   fSource2 := TrmListControl.create(self);
  843.   with fSource2 do
  844.   begin
  845.     name := 'SourceList2';
  846.     parent := self;
  847.     align := alLeft;
  848.     enabled := false;
  849.     font.assign(self.font);
  850.     OnFormatDrawing := Drawing;
  851.     ShowVScrollBars := false;
  852.     ShowHScrollBars := false;
  853.   end;
  854. end;
  855.  
  856. procedure TrmDiffMergeViewer.CreateParams(var Params: TCreateParams);
  857. begin
  858.   inherited;
  859.   Params.style := Params.style or WS_VSCROLL;
  860.   if not fIHC then
  861.     Params.style := Params.style or WS_HSCROLL;
  862. end;
  863.  
  864. procedure TrmDiffMergeViewer.DiffferenceCompleted;
  865. var
  866.   loop: integer;
  867. begin
  868.   inherited;
  869.   fSource1.Items.BeginUpdate;
  870.   fSource2.Items.BeginUpdate;
  871.   fMergeSource.Items.BeginUpdate;
  872.   try
  873.     fSource1.Items.assign(DiffEngine.DiffSource1);
  874.     fSource2.Items.assign(DiffEngine.DiffSource2);
  875.     for loop := 0 to fSource1.Items.count - 1 do
  876.     begin
  877.       if fSource1.items[loop][1] = NormalLine then
  878.         fMergeSource.Items.Add(fSource1.items[loop])
  879.       else
  880.         fMergeSource.Items.Add(Emptyline + '')
  881.     end;
  882.     UpdateVScrollBar;
  883.     UpdateHScrollBar;
  884.   finally
  885.     fSource1.Items.EndUpdate;
  886.     fSource2.Items.EndUpdate;
  887.     fMergeSource.Items.EndUpdate;
  888.   end;
  889.   invalidate;
  890. end;
  891.  
  892. procedure TrmDiffMergeViewer.Drawing(Sender: TObject; Canvas: TCanvas; Selected: boolean;
  893.   var str: string);
  894. var
  895.   status: char;
  896. begin
  897.   status := str[1];
  898.   delete(str, 1, 1);
  899.  
  900.   Canvas.Font.Color := clWindowText;
  901.   case status of
  902.     NormalLine: Canvas.brush.color := clWindow;
  903.     ChangedLine, DeletedLine, InsertedLine:
  904.       begin
  905.         if Sender = fsource1 then
  906.           Canvas.Brush.Color := fD1BGColor
  907.         else if Sender = fsource2 then
  908.           Canvas.Brush.Color := fD2BGColor;
  909.  
  910.         Canvas.Font.Color := ChangedTextColor;
  911.  
  912.         if not SimpleDiffViewer then
  913.         begin
  914.           case status of
  915.             DeletedLine: Canvas.Font.Color := DeletedTextColor;
  916.             InsertedLine: Canvas.Font.Color := InsertedTextColor;
  917.           end;
  918.         end;
  919.       end;
  920.     EmptyLine: Canvas.Brush.Color := fEBGColor;
  921.     MergeLine1: Canvas.Brush.Color := fD1BGColor;
  922.     MergeLine2: Canvas.Brush.Color := fD2BGColor;
  923.   end;
  924.  
  925.   if (Selected) then
  926.   begin
  927.     Canvas.font.color := clHighlightText;
  928.     Canvas.Brush.Color := clHighlight;
  929.   end;
  930. end;
  931.  
  932. procedure TrmDiffMergeViewer.Loaded;
  933. begin
  934.   inherited;
  935.   fsource1.left := 0;
  936.   fBevel.left := fsource1.width;
  937.   fMergeSource.left := fBevel.left + fBevel.width;
  938.   fBevel2.left := fMergeSource.left + fMergeSource.width;
  939.   fSource2.left := fBevel2.left + fBevel2.width;
  940.   fPanel.height := Canvas.TextHeight('X') + 4;
  941.   Resize;
  942. end;
  943.  
  944. procedure TrmDiffMergeViewer.MapClick(Sender: TObject;
  945.   IndicatorPos: integer);
  946. begin
  947.    ResetIndex(IndicatorPos, IndicatorPos);
  948. end;
  949.  
  950. procedure TrmDiffMergeViewer.ResetIndex(Index, Pos: integer);
  951. begin
  952.   fMergeSource.VScrollPos := pos;
  953.   fMergeSource.ItemIndex := Index;
  954.   fSource1.VScrollPos := pos;
  955.   fSource1.ItemIndex := Index;
  956.   fSource2.VScrollPos := pos;
  957.   fSource2.ItemIndex := Index;
  958.   UpdateVScrollBar;
  959. end;
  960.  
  961. procedure TrmDiffMergeViewer.Resize;
  962. var
  963.   wcw: integer;
  964. begin
  965.   inherited;
  966.   wcw := ClientWidth div 3;
  967.   fLabel1.width := wcw;
  968.   fLabel2.width := wcw;
  969.   fLabel3.width := wcw;
  970.  
  971.   wcw := ClientWidth - (fBevel.width * 2);
  972.   fSource1.Width := wcw div 3;
  973.   fMergeSource.width := fSource1.Width;
  974.   fSource2.Width := fSource1.Width + (wcw mod 3);
  975.  
  976.   UpdateVScrollBar;
  977.   UpdateHScrollBar;
  978. end;
  979.  
  980. procedure TrmDiffMergeViewer.SaveMergeToFile(FileName: string);
  981. var
  982.   fstrm: TFileStream;
  983. begin
  984.   fstrm := TFileStream.create(filename, fmCreate);
  985.   try
  986.     SaveMergeToStream(fStrm);
  987.   finally
  988.     fstrm.free;
  989.   end;
  990. end;
  991.  
  992. procedure TrmDiffMergeViewer.SaveMergeToStream(Strm: TStream);
  993. var
  994.   wstr: string;
  995.   loop: integer;
  996. begin
  997.   if assigned(strm) then
  998.   begin
  999.     strm.Position := 0;
  1000.     for loop := 0 to fMergeSource.Items.count - 1 do
  1001.     begin
  1002.       wstr := fMergeSource.Items[loop] + #13#10;
  1003.       if wstr[1] <> emptyline then
  1004.       begin
  1005.         delete(wstr, 1, 1);
  1006.         Strm.Write(wstr, length(wstr));
  1007.       end;
  1008.     end;
  1009.   end
  1010.   else
  1011.     raise EStreamError.create('Stream not open for writing');
  1012. end;
  1013.  
  1014. procedure TrmDiffMergeViewer.scrollChanged(Sender: TObject; ScrollBar: integer);
  1015. begin
  1016.   if fScrollInProgress then exit;
  1017.   fScrollInProgress := true;
  1018.   try
  1019.     if fIHC and (ScrollBar = sb_Horz) then
  1020.       exit;
  1021.     if ScrollBar = SB_VERT then
  1022.     begin
  1023.       if fSource1.ItemIndex = fMergeSource.ItemIndex then
  1024.       begin
  1025.          fSource1.VScrollPos := fMergeSource.VScrollPos;
  1026.          fSource2.VScrollPos := fMergeSource.VScrollPos;
  1027.       end
  1028.       else
  1029.       begin
  1030.          fSource1.ItemIndex := fMergeSource.ItemIndex;
  1031.          fSource2.ItemIndex := fMergeSource.ItemIndex;
  1032.       end;
  1033.       UpdateVScrollBar;
  1034.       if assigned(DiffMap) then
  1035.          DiffMap.IndicatorPos := fMergeSource.ItemIndex;
  1036.     end
  1037.     else
  1038.     begin
  1039.       fSource1.HScrollPos := fMergeSource.HScrollPos;
  1040.       fSource2.HScrollPos := fMergeSource.HScrollPos;
  1041.       UpdateHScrollBar;
  1042.     end;
  1043.   finally
  1044.     fScrollInProgress := false;
  1045.   end;
  1046. end;
  1047.  
  1048. procedure TrmDiffMergeViewer.SetD1BGColor(const Value: TColor);
  1049. begin
  1050.   fD1BGColor := Value;
  1051.   invalidate;
  1052. end;
  1053.  
  1054. procedure TrmDiffMergeViewer.SetD2BGColor(const Value: TColor);
  1055. begin
  1056.   fD2BGColor := Value;
  1057.   invalidate;
  1058. end;
  1059.  
  1060. procedure TrmDiffMergeViewer.SetIHC(const Value: boolean);
  1061. begin
  1062.   if fIHC <> Value then
  1063.   begin
  1064.     fIHC := Value;
  1065.     fsource1.ShowHScrollBars := fIHC;
  1066.     fSource2.ShowHScrollBars := fIHC;
  1067.     fMergeSource.ShowHScrollBars := fIHC;
  1068.     RecreateWnd;
  1069.   end;
  1070. end;
  1071.  
  1072. procedure TrmDiffMergeViewer.UpdateHScrollBar;
  1073. var
  1074.   wScrollInfo: TScrollInfo;
  1075. begin
  1076.   if fIHC then
  1077.     exit;
  1078.  
  1079.   with wScrollInfo do
  1080.   begin
  1081.     cbSize := sizeof(TScrollInfo);
  1082.     fMask := SIF_POS or SIF_RANGE or SIF_DISABLENOSCROLL;
  1083.     nMin := 0;
  1084.     nMax := fMergeSource.HScrollSize;
  1085.     nPos := fMergeSource.HScrollPos;
  1086.   end;
  1087.  
  1088.   SetScrollInfo(Handle, SB_HORZ, wScrollInfo, True);
  1089. end;
  1090.  
  1091. procedure TrmDiffMergeViewer.UpdateVScrollBar;
  1092. var
  1093.   wScrollInfo: TScrollInfo;
  1094. begin
  1095.   with wScrollInfo do
  1096.   begin
  1097.     cbSize := sizeof(TScrollInfo);
  1098.     fMask := SIF_POS or SIF_RANGE or SIF_DISABLENOSCROLL;
  1099.     nMin := 0;
  1100.     nMax := fMergeSource.VScrollSize;
  1101.     nPos := fMergeSource.VScrollPos;
  1102.   end;
  1103.  
  1104.   SetScrollInfo(Handle, SB_VERT, wScrollInfo, True);
  1105. end;
  1106.  
  1107. procedure TrmDiffMergeViewer.WMHScroll(var Msg: TWMHScroll);
  1108. begin
  1109.   inherited;
  1110.   fMergeSource.Dispatch(msg);
  1111.   UpdateHScrollBar;
  1112. end;
  1113.  
  1114. procedure TrmDiffMergeViewer.WMVScroll(var Msg: TWMVScroll);
  1115. begin
  1116.   inherited;
  1117.   fMergeSource.Dispatch(msg);
  1118.   UpdateVScrollBar;
  1119. end;
  1120.  
  1121. { TrmDiffViewer }
  1122.  
  1123. procedure TrmDiffViewer.cmFontChanged(var Msg: TMessage);
  1124. begin
  1125.   inherited;
  1126.   fsource1.font.Assign(font);
  1127.   fsource2.font.Assign(font);
  1128. end;
  1129.  
  1130. constructor TrmDiffViewer.Create(AOwner: TComponent);
  1131. begin
  1132.   inherited;
  1133.   BevelEdges := [beLeft, beTop, beRight, beBottom];
  1134.   BevelInner := bvLowered;
  1135.   BevelOuter := bvLowered;
  1136.   BevelKind := bkTile;
  1137.  
  1138.   fDrawing := false;
  1139.   fScrollInProgress := false;
  1140.   fIHC := false;
  1141.   fLockSelIndex := true;
  1142.  
  1143.   fPanel := TPanel.create(self);
  1144.   with fPanel do
  1145.   begin
  1146.     Parent := self;
  1147.     align := altop;
  1148.     BevelInner := bvlowered;
  1149.     BevelOuter := bvraised;
  1150.   end;
  1151.  
  1152.   fLabel1 := TLabel.create(fPanel);
  1153.   with fLabel1 do
  1154.   begin
  1155.     parent := fPanel;
  1156.     align := alLeft;
  1157.     AutoSize := false;
  1158.     Caption := 'Source 1';
  1159.     Alignment := taCenter;
  1160.   end;
  1161.  
  1162.   fLabel2 := TLabel.create(fPanel);
  1163.   with fLabel2 do
  1164.   begin
  1165.     parent := fPanel;
  1166.     align := alClient;
  1167.     AutoSize := false;
  1168.     Caption := 'Source 2';
  1169.     Alignment := taCenter;
  1170.   end;
  1171.  
  1172.   fSource1 := TrmListControl.create(self);
  1173.   with fSource1 do
  1174.   begin
  1175.     name := 's1';
  1176.     parent := self;
  1177.     align := alLeft;
  1178.     font.assign(self.font);
  1179.     TabStop := true;
  1180.     OnScroll := ScrollChanged;
  1181.     OnFormatDrawing := Drawing;
  1182.     ShowVScrollBars := false;
  1183.     ShowHScrollBars := false;
  1184.   end;
  1185.  
  1186.   fBevel := TBevel.Create(self);
  1187.   with fBevel do
  1188.   begin
  1189.     parent := self;
  1190.     align := alLeft;
  1191.     width := 2;
  1192.   end;
  1193.  
  1194.   fSource2 := TrmListControl.create(self);
  1195.   with fSource2 do
  1196.   begin
  1197.     name := 's2';
  1198.     parent := self;
  1199.     align := alLeft;
  1200.     font.assign(self.font);
  1201.     TabStop := true;
  1202.     OnScroll := ScrollChanged;
  1203.     OnFormatDrawing := Drawing;
  1204.     ShowVScrollBars := false;
  1205.     ShowHScrollBars := false;
  1206.   end;
  1207. end;
  1208.  
  1209. procedure TrmDiffViewer.CreateParams(var Params: TCreateParams);
  1210. begin
  1211.   inherited;
  1212.   Params.style := Params.style or WS_VSCROLL;
  1213.   if not fIHC then
  1214.     Params.style := Params.style or WS_HSCROLL;
  1215. end;
  1216.  
  1217. procedure TrmDiffViewer.DiffferenceCompleted;
  1218. begin
  1219.   inherited;
  1220.   fSource1.Items.BeginUpdate;
  1221.   fSource2.Items.BeginUpdate;
  1222.   try
  1223.      fSource1.Items.assign(DiffEngine.DiffSource1);
  1224.      fSource2.Items.assign(DiffEngine.DiffSource2);
  1225.     UpdateVScrollBar;
  1226.     UpdateHScrollBar;
  1227.   finally
  1228.     fSource1.Items.EndUpdate;
  1229.     fSource2.Items.EndUpdate;
  1230.   end;
  1231.   invalidate;
  1232. end;
  1233.  
  1234. procedure TrmDiffViewer.Drawing(Sender: TObject; Canvas: TCanvas;
  1235.   Selected: boolean; var str: string);
  1236. var
  1237.   status: char;
  1238. begin
  1239.   status := str[1];
  1240.   delete(str, 1, 1);
  1241.  
  1242.   Canvas.Font.Color := clWindowText;
  1243.   case status of
  1244.     NormalLine: Canvas.brush.color := clWindow;
  1245.     ChangedLine, DeletedLine, InsertedLine:
  1246.       begin
  1247.         Canvas.Brush.Color := fDBGColor;
  1248.         Canvas.Font.Color := ChangedTextColor;
  1249.         if not SimpleDiffViewer then
  1250.         begin
  1251.           case status of
  1252.             DeletedLine: Canvas.Font.Color := DeletedTextColor;
  1253.             InsertedLine: Canvas.Font.Color := InsertedTextColor;
  1254.           end;
  1255.         end;
  1256.       end;
  1257.     EmptyLine: Canvas.Brush.Color := fEBGColor;
  1258.   end;
  1259.  
  1260.   if (Selected) then
  1261.   begin
  1262.     Canvas.font.color := clHighlightText;
  1263.     Canvas.Brush.Color := clHighlight;
  1264.   end;
  1265. end;
  1266.  
  1267. procedure TrmDiffViewer.Loaded;
  1268. begin
  1269.   inherited;
  1270.   fsource1.left := 0;
  1271.   fBevel.left := fsource1.width;
  1272.   fSource2.left := fBevel.left + fBevel.width;
  1273.   fPanel.height := Canvas.TextHeight('X') + 4;
  1274.   Resize;
  1275. end;
  1276.  
  1277. procedure TrmDiffViewer.MapClick(Sender: TObject; IndicatorPos: integer);
  1278. begin
  1279.    ResetIndex(IndicatorPos, IndicatorPos);
  1280. end;
  1281.  
  1282. procedure TrmDiffViewer.ResetIndex(Index, Pos: integer);
  1283. begin
  1284.   fSource1.VScrollPos := pos;
  1285.   fSource1.ItemIndex := Index;
  1286.   fSource2.VScrollPos := pos;
  1287.   fSource2.ItemIndex := Index;
  1288.   UpdateVScrollBar;
  1289. end;
  1290.  
  1291. procedure TrmDiffViewer.Resize;
  1292. var
  1293.   wcw: integer;
  1294. begin
  1295.   inherited;
  1296.   wcw := ClientWidth div 2;
  1297.   fLabel1.width := wcw;
  1298.   fLabel2.width := wcw;
  1299.  
  1300.   wcw := ClientWidth - fBevel.width;
  1301.   fSource1.Width := wcw div 2;
  1302.   fSource2.Width := fSource1.Width + (wcw mod 2);
  1303.  
  1304.   UpdateVScrollBar;
  1305.   UpdateHScrollBar;
  1306. end;
  1307.  
  1308. procedure TrmDiffViewer.scrollChanged(Sender: TObject; ScrollBar: integer);
  1309. begin
  1310.   if fScrollInProgress then exit;
  1311.   fScrollInProgress := true;
  1312.   try
  1313.     if fIHC and (ScrollBar = sb_Horz) then
  1314.       exit;
  1315.     if (sender = fsource1) then
  1316.     begin
  1317.       if ScrollBar = SB_VERT then
  1318.       begin
  1319.         if fLockSelIndex then
  1320.            fSource2.ItemIndex := fSource1.ItemIndex;
  1321.         fSource2.VScrollPos := fSource1.VScrollPos;
  1322.       end
  1323.       else
  1324.         fSource2.HScrollPos := fSource1.HScrollPos;
  1325.     end
  1326.     else if (sender = fSource2) then
  1327.     begin
  1328.       if ScrollBar = SB_VERT then
  1329.       begin
  1330.         if fLockSelIndex then
  1331.            fSource1.ItemIndex := fSource2.ItemIndex;
  1332.         fSource1.VScrollPos := fSource2.VScrollPos;
  1333.       end
  1334.       else
  1335.         fSource1.HScrollPos := fSource2.HScrollPos;
  1336.     end;
  1337.     if ScrollBar = SB_VERT then
  1338.       UpdateVScrollBar
  1339.     else
  1340.       UpdateHScrollBar;
  1341.   finally
  1342.     fScrollInProgress := false;
  1343.   end;
  1344. end;
  1345.  
  1346. procedure TrmDiffViewer.SetDiffMap(const Value: TrmDiffMap);
  1347. begin
  1348.   inherited;
  1349.   if assigned(DiffMap) then
  1350.      DiffMap.ShowIndicator := false;
  1351. end;
  1352.  
  1353. procedure TrmDiffViewer.SetIHC(const Value: boolean);
  1354. begin
  1355.   if fIHC <> Value then
  1356.   begin
  1357.     fIHC := Value;
  1358.     fsource1.ShowHScrollBars := fIHC;
  1359.     fSource2.ShowHScrollBars := fIHC;
  1360.     RecreateWnd;
  1361.   end;
  1362. end;
  1363.  
  1364. procedure TrmDiffViewer.SetLockSelIndex(const Value: boolean);
  1365. begin
  1366.   if fLockSelIndex <> Value then
  1367.   begin
  1368.      fLockSelIndex := Value;
  1369.      if fLockSelIndex then
  1370.      begin
  1371.         fsource2.VScrollPos := fsource1.VScrollPos;
  1372.         fsource2.ItemIndex := fsource1.itemIndex;
  1373.      end;
  1374.   end;
  1375. end;
  1376.  
  1377. procedure TrmDiffViewer.UpdateHScrollBar;
  1378. var
  1379.   wScrollInfo: TScrollInfo;
  1380. begin
  1381.   if fIHC then
  1382.     exit;
  1383.  
  1384.   with wScrollInfo do
  1385.   begin
  1386.     cbSize := sizeof(TScrollInfo);
  1387.     fMask := SIF_POS or SIF_RANGE or SIF_DISABLENOSCROLL;
  1388.     nMin := 0;
  1389.     nMax := fsource1.HScrollSize;
  1390.     nPos := fsource1.HScrollPos;
  1391.   end;
  1392.  
  1393.   SetScrollInfo(Handle, SB_HORZ, wScrollInfo, True);
  1394. end;
  1395.  
  1396. procedure TrmDiffViewer.UpdateVScrollBar;
  1397. var
  1398.   wScrollInfo: TScrollInfo;
  1399. begin
  1400.   with wScrollInfo do
  1401.   begin
  1402.     cbSize := sizeof(TScrollInfo);
  1403.     fMask := SIF_POS or SIF_RANGE or SIF_DISABLENOSCROLL;
  1404.     nMin := 0;
  1405.     nMax := fsource1.VScrollSize;
  1406.     nPos := fsource1.VScrollPos;
  1407.   end;
  1408.  
  1409.   SetScrollInfo(Handle, SB_VERT, wScrollInfo, True);
  1410. end;
  1411.  
  1412. procedure TrmDiffViewer.WMHScroll(var Msg: TWMHScroll);
  1413. begin
  1414.   inherited;
  1415.   if not fIHC then
  1416.   begin
  1417.     fsource1.Dispatch(msg);
  1418.     UpdateHScrollBar;
  1419.   end;
  1420. end;
  1421.  
  1422. procedure TrmDiffViewer.WMVScroll(var Msg: TWMVScroll);
  1423. begin
  1424.   inherited;
  1425.   fsource1.Dispatch(msg);
  1426.   UpdateVScrollBar;
  1427. end;
  1428.  
  1429. { TrmDiffMap }
  1430.  
  1431. constructor TrmDiffMap.Create(AOwner: TComponent);
  1432. begin
  1433.   inherited;
  1434.   width := 25;
  1435.   height := 200;
  1436.  
  1437.   FIndicator := TBitmap.Create;
  1438.   FIndicator.LoadFromResourceName(HInstance,'DIFFMAP_INDICATOR');
  1439.   FIndicator.Transparent := True;
  1440.  
  1441.   FColorDeleted := clRed;
  1442.   FColorInserted := clLime;
  1443.   FColorModified := clYellow;
  1444.  
  1445.   FShowIndicator := True;
  1446.  
  1447.   IndicatorPos := 0;
  1448. end;
  1449.  
  1450. destructor TrmDiffMap.Destroy;
  1451. begin
  1452.   FIndicator.Free;
  1453.   inherited;
  1454. end;
  1455.  
  1456. procedure TrmDiffMap.SetData(Value: string);
  1457. begin
  1458.   FData := copy(Value, 1, length(Value));
  1459.   refresh;
  1460. end;
  1461.  
  1462. procedure TrmDiffMap.SetIndicatorPos(Value: integer);
  1463. begin
  1464.   FIndicatorPos := Value;
  1465.   Refresh;
  1466. end;
  1467.  
  1468. procedure TrmDiffMap.Paint;
  1469. var
  1470.   i: Integer;
  1471.   j: Integer;
  1472.   NrOfDataRows: Integer;
  1473.   Ht: Integer;
  1474.   Ct: Integer;
  1475.   CurrIndex: Integer;
  1476.   PixelPos: Integer;
  1477.   PixelHt: Double; // amount of pixel height for each row - could be a rather small number
  1478.   PixelFrac: Double; // Faction part of pixel - left over from previous
  1479.   PixelPrevHt: Double; // logical height of previous mapped pixel (eg. .92)
  1480.   NrOfPixelRows: Double; // Number of rows that the current pixel is to represent.
  1481.   ExtraPixel: Double; // Left over pixel from when calculating number of rows for the next pixel.
  1482.                                // eg. 1/.3 = 3 rows, .1 remaining, next 1.1/.3 = 3 rows, .2 remain, next 1.2/.3 = 4 rows.
  1483.  
  1484.   DrawIt: Boolean; // Drawing flag for each column
  1485.   RowModified: Boolean;
  1486.   RowDeleted: Boolean;
  1487.   RowInserted: Boolean;
  1488.  
  1489.   ExitLoop: Boolean; // loop control
  1490.  
  1491.    // Draws the line between two points on the horizonatal line of i.
  1492.   procedure DrawLine(X1, X2: integer);
  1493.   var
  1494.     k: integer;
  1495.   begin
  1496.       // What colour?  Black or Background?
  1497.     if DrawIt then
  1498.     begin
  1499.       if RowModified then
  1500.       begin
  1501.         Canvas.Pen.Color := ColorModified;
  1502.       end
  1503.       else
  1504.       begin
  1505.         if RowInserted then
  1506.         begin
  1507.           Canvas.Pen.Color := ColorInserted;
  1508.         end
  1509.         else
  1510.         begin
  1511.           if RowDeleted then
  1512.           begin
  1513.             Canvas.Pen.Color := ColorDeleted;
  1514.           end;
  1515.         end;
  1516.       end;
  1517.     end
  1518.     else
  1519.     begin
  1520.       Canvas.Pen.Color := Color;
  1521.     end;
  1522.       // Draw the pixels for the map here
  1523.     for k := 0 to Round(NrOfPixelRows) - 1 do
  1524.     begin
  1525.       Canvas.MoveTo(X1, PixelPos + k);
  1526.       Canvas.LineTo(X2, PixelPos + k);
  1527.     end;
  1528.   end;
  1529.  
  1530. begin
  1531.   inherited;
  1532.   if csDesigning in ComponentState then
  1533.      exit;
  1534.  
  1535.   Ht := MapHeight;
  1536.   Ct := length(fData);
  1537.   
  1538.   if Ct < 1 then
  1539.   begin
  1540.     Ct := 1;
  1541.   end;
  1542.   PixelHt := Ht / Ct;
  1543.   CurrIndex := 1;
  1544.   NrOfPixelRows := 0.0;
  1545.   PixelPrevHt := 0.0;
  1546.   PixelPos := 5;
  1547.   ExtraPixel := 0.0;
  1548.  
  1549.   j := CurrIndex;
  1550.   while j < Ct do
  1551.   begin
  1552.     NrOfDataRows := 0;
  1553.     PixelPrevHt := PixelPrevHt - NrOfPixelRows; // remainder from prevous pixel row (+ or -)
  1554.     PixelFrac := frac(PixelPrevHt); // We want just the fractional part!
  1555.  
  1556.       // Calculate how high the pixel line is to be
  1557.     if PixelHt < 1.0 then
  1558.     begin
  1559.       NrOfPixelRows := 1.0; // Each Pixel line represents one or more rows of data
  1560.     end
  1561.     else
  1562.     begin
  1563.       NrOfPixelRows := Int(PixelHt + ExtraPixel); // We have several pixel lines for each row of data.
  1564.       ExtraPixel := frac(PixelHt + ExtraPixel); // save frac part for next time
  1565.     end;
  1566.  
  1567.       // Calculate the nr of data rows to be represented by the Pixel Line about to be drawn.
  1568.     ExitLoop := False;
  1569.     repeat
  1570.          // the '.../2.0' checks if half a Pixel Ht will fit, else leave remainder for next row.
  1571.       if (PixelFrac + PixelHt <= NrOfPixelRows) or
  1572.         (PixelFrac + PixelHt / 2.0 <= NrOfPixelRows) then
  1573.       begin
  1574.         PixelFrac := PixelFrac + PixelHt;
  1575.         inc(NrOfDataRows);
  1576.       end
  1577.       else
  1578.       begin
  1579.         ExitLoop := True;
  1580.       end;
  1581.     until (PixelFrac >= NrOfPixelRows) or (ExitLoop);
  1582.  
  1583.       // go through each data row, check if a file has been modified.
  1584.       // if any file has been modified then we add to the Mapping.
  1585.     if NrOfDataRows > 0 then
  1586.     begin
  1587.       DrawIt := False;
  1588.     end;
  1589.  
  1590.     RowModified := False;
  1591.     RowInserted := False;
  1592.     RowDeleted := False;
  1593.  
  1594.     for i := j to j + NrOfDataRows - 1 do
  1595.     begin
  1596.       if i < ct then
  1597.       begin
  1598.         case fData[i] of
  1599.           ChangedLine:
  1600.             begin
  1601.               DrawIt := True;
  1602.               RowModified := True;
  1603.             end;
  1604.           InsertedLine:
  1605.             begin
  1606.               DrawIt := True;
  1607.               RowInserted := True;
  1608.             end;
  1609.           DeletedLine:
  1610.             begin
  1611.               DrawIt := True;
  1612.               RowDeleted := True;
  1613.             end;
  1614.         end;
  1615.       end;
  1616.       inc(j);
  1617.     end;
  1618.  
  1619.  
  1620.       // Mapping is drawn here
  1621.     if ShowIndicator then
  1622.     begin
  1623.       DrawLine(FIndicator.Width, Width - FIndicator.Width);
  1624.     end
  1625.     else
  1626.     begin
  1627.       DrawLine(0, Width);
  1628.     end;
  1629.     inc(PixelPos, Trunc(NrOfPixelRows)); // the pixel pos on the map.
  1630.     PixelPrevHt := int(PixelPrevHt) + PixelFrac;
  1631.   end;
  1632.  
  1633.   if ShowIndicator then
  1634.      DrawIndicator;
  1635. end;
  1636.  
  1637. procedure TrmDiffMap.DrawIndicator;
  1638. var
  1639.   Y: integer;
  1640. begin
  1641.   Canvas.Pen.Color := clBlack;
  1642.   if length(fData) <> 0 then
  1643.   begin
  1644.     Y := TOP_MARGIN + Trunc((IndicatorPos / length(fData)) * MapHeight);
  1645.     Canvas.Draw(0, Y - (FIndicator.Height div 2), FIndicator);
  1646.   end;
  1647. end;
  1648.  
  1649. function TrmDiffMap.MapHeight: integer;
  1650. begin
  1651.   Result := Height - TOP_MARGIN - BOTTOM_MARGIN;
  1652. end;
  1653.  
  1654. procedure TrmDiffMap.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  1655. var
  1656.   NewRow: Integer;
  1657.   PixelHt: Double;
  1658. begin
  1659.   inherited;
  1660.   if Assigned(OnMapClick) and (length(fData) > 0) then
  1661.   begin
  1662.     PixelHt := MapHeight / length(fData); // This is how much of a pixel (or how many pixels), each row represents.
  1663.       // (the pixel clicked) + Half the Pixel Height + 1.0 / the pixel height
  1664.       // eg. Of 1000 rows, in the pixel area height of 500, then pixelHt = .5 (500/1000)
  1665.       //     Therefore, if pixel 100 is clicked we get - (100 + .25 + 1) / .5 = 51
  1666.       // Y-5, we subtract 5 as we start 5 pixels from the top of lblQuickPickArea.
  1667.     NewRow := Round(((Y - TOP_MARGIN) * 1.0 + PixelHt / 2.0 + 1.0) / PixelHt);
  1668.  
  1669.     if NewRow > length(fData) - 1 then
  1670.       NewRow := length(fData) - 1
  1671.     else
  1672.     begin
  1673.       if NewRow < 1 then
  1674.          NewRow := 1;
  1675.     end;
  1676.     OnMapClick(self, NewRow);
  1677.     IndicatorPos := NewRow;
  1678.   end;
  1679. end;
  1680.  
  1681. procedure TrmCustomDiffEngine.ClearData;
  1682. begin
  1683.   fDiffSource1.Clear;
  1684.   fDiffSource2.Clear;
  1685.   fSource1.Clear;
  1686.   fSource2.Clear;
  1687. end;
  1688.  
  1689. procedure TrmCustomDiffEngine.DiffStarted;
  1690. begin
  1691.   fBlankLines1 := 0;
  1692.   fBlankLines2 := 0;
  1693. end;
  1694.  
  1695. procedure TrmCustomDiffEngine.DiffFound(Source1, Source2: TrmDiffBlock);
  1696. var
  1697.   s1diff, s2diff: integer;
  1698. begin
  1699.   Source1.startline := source1.startline + fBlankLines1;
  1700.   Source1.Endline := source1.EndLine + fBlankLines1;
  1701.  
  1702.   Source2.startline := source2.startline + fBlankLines2;
  1703.   Source2.Endline := source2.Endline + fBlankLines2;
  1704.  
  1705.   s1diff := source1.endline - source1.startline;
  1706.   s2diff := source2.endline - source2.startline;
  1707.  
  1708.   if (s1diff = 0) and (s2diff > 0) then
  1709.   begin
  1710.     while s2diff > 0 do
  1711.     begin
  1712.       fDiffSource1.Add(EmptyLine + ' ');
  1713.       Inc(fBlankLines1);
  1714.  
  1715.       fDiffSource2.Add(InsertedLine + fSource2[0]);
  1716.       fSource2.delete(0);
  1717.       dec(s2Diff);
  1718.     end;
  1719.   end
  1720.   else if (s1diff > 0) and (s2diff = 0) then
  1721.   begin
  1722.     while s1diff > 0 do
  1723.     begin
  1724.       fDiffSource1.Add(DeletedLine + fSource1[0]);
  1725.       fSource1.delete(0);
  1726.  
  1727.       fDiffSource2.Add(Emptyline + '');
  1728.       Inc(fBlankLines2);
  1729.       dec(s1Diff);
  1730.     end;
  1731.   end
  1732.   else if (s1diff > 0) and (s2diff > 0) then
  1733.   begin
  1734.     if s1diff > s2diff then
  1735.     begin
  1736.       while s2diff > 0 do
  1737.       begin
  1738.         fDiffSource1.Add(ChangedLine + fSource1[0]);
  1739.         fSource1.delete(0);
  1740.  
  1741.         fDiffSource2.Add(ChangedLine + fSource2[0]);
  1742.         fSource2.delete(0);
  1743.         dec(s2Diff);
  1744.         dec(s1Diff);
  1745.       end;
  1746.  
  1747.       while s1Diff > 0 do
  1748.       begin
  1749.         fDiffSource1.Add(DeletedLine + fSource1[0]);
  1750.         fSource1.delete(0);
  1751.  
  1752.         fDiffSource2.Add(EmptyLine + ' ');
  1753.         Inc(fBlankLines2);
  1754.         dec(s1Diff);
  1755.       end;
  1756.     end
  1757.     else
  1758.     begin
  1759.       while s1diff > 0 do
  1760.       begin
  1761.         fDiffSource1.Add(ChangedLine + fSource1[0]);
  1762.         fSource1.delete(0);
  1763.  
  1764.         fDiffSource2.Add(ChangedLine + fSource2[0]);
  1765.         fSource2.delete(0);
  1766.         dec(s1Diff);
  1767.         dec(s2Diff);
  1768.       end;
  1769.  
  1770.       while s2Diff > 0 do
  1771.       begin
  1772.         fDiffSource2.Add(InsertedLine + fSource2[0]);
  1773.         fSource2.delete(0);
  1774.  
  1775.         fDiffSource1.Add(EmptyLine + ' ');
  1776.         Inc(fBlankLines1);
  1777.         dec(s2Diff);
  1778.       end;
  1779.     end;
  1780.   end
  1781.   else
  1782.     raise Exception.create('This should never happen');
  1783. end;
  1784.  
  1785. procedure TrmCustomDiffEngine.DiffCompleted;
  1786. var
  1787.    loop : integer;
  1788. begin
  1789.   while fSource1.count > 0 do
  1790.   begin
  1791.     fDiffSource1.add(NormalLine + fSource1[0]);
  1792.     fSource1.delete(0);
  1793.   end;
  1794.  
  1795.   while fSource2.count > 0 do
  1796.   begin
  1797.     fDiffSource2.add(NormalLine + fSource2[0]);
  1798.     fSource2.delete(0);
  1799.   end;
  1800.  
  1801.   while fDiffSource1.count < fDiffSource2.count do
  1802.     fDiffSource1.Add(EmptyLine + ' ');
  1803.  
  1804.   while fDiffSource2.count < fDiffSource1.count do
  1805.     fDiffSource2.Add(EmptyLine + ' ');
  1806.  
  1807.   for loop := 0 to fAttachedViewers.count-1 do
  1808.      TrmCustomDiffViewer(fattachedViewers[loop]).DiffferenceCompleted;
  1809.  
  1810.   if assigned(fOnDiffCompleted) then
  1811.      fOnDiffCompleted(self);
  1812. end;
  1813.  
  1814. procedure TrmCustomDiffEngine.AttachViewer(viewer: TrmCustomDiffViewer);
  1815. begin
  1816.    if fAttachedViewers.indexof(viewer) = -1 then
  1817.       fAttachedViewers.add(viewer);
  1818. end;
  1819.  
  1820. procedure TrmCustomDiffEngine.RemoveViewer(viewer: TrmCustomDiffViewer);
  1821. var
  1822.    index : integer;
  1823. begin
  1824.    index := fAttachedViewers.indexof(viewer);
  1825.    if index <> -1 then
  1826.       fAttachedViewers.Delete(index);
  1827. end;
  1828.  
  1829. function TrmCustomDiffEngine.RemoveCharacters(st: string): string;
  1830. var
  1831.    loop, len : integer;
  1832. begin
  1833.    len := length(st);
  1834.    result := '';
  1835.    loop := 0;
  1836.    while loop < len do
  1837.    begin
  1838.       inc(loop);
  1839.       if not (st[loop] in fIgnoreChars) then
  1840.          result := result + st[loop];
  1841.    end;
  1842. end;
  1843.  
  1844. end.
  1845.