type
  TDiff = record
    Character: Char;
    CharStatus: Char;  //Possible values: [+, -, =]
  end;
 
  TStringComparer = class
  ……………
  public
    class function Compare(aString1, aString2: string): TList<TDiff>;
  end;

procedure TForm1.Button1Click(Sender: TObject);
var
  Differences: TList<TDiff>;
  Diff: TDiff;
begin
  //Yes, I know...this method could be refactored ;-)
  Differences:= TStringComparer.Compare(Edit1.Text, Edit2.Text);
  try
    RichEdit1.Clear;
    RichEdit1.SelStart:= RichEdit1.GetTextLen;
    for Diff in Differences do
      if Diff.CharStatus = '+' then
      begin
        RichEdit1.SelAttributes.Color:= clBlue;
        RichEdit1.SelText := Diff.Character;
      end
      else if Diff.CharStatus = '-' then
      begin
        RichEdit1.SelAttributes.Color:= clRed;
        RichEdit1.SelText:= Diff.Character;
      end
      else
      begin
        RichEdit1.SelAttributes.Color:= clDefault;
        RichEdit1.SelText:= Diff.Character;
      end;
  finally
    Differences.Free;
  end;
end;

unit StringComparison;
 
interface
 
uses
  Math, Generics.Collections;
 
type
  TDiff = record
    Character: Char;
    CharStatus: Char;  //Possible values: [+, -, =]
  end;
 
  TStringComparer = class
  strict private
    type TIntArray = array of array of Integer;
    class function LCSMatrix(X, Y: string): TIntArray;
    class procedure ComputeDifferences(aLCSMatrix: TIntArray;
                                       X, Y: string;
                                       i, j: Integer;
                                       aDifferences: TList<TDiff>);
  public
    class function Compare(aString1, aString2: string): TList<TDiff>;
  end;
 
implementation
 
{ TStringComparer }
 
class function TStringComparer.LCSMatrix(X, Y: string): TIntArray;
var
  m, n,
  i, j: Integer;
begin
  m:= Length(X);
  n:= Length(Y);
 
  //We need one extra column and one extra row to be filled with zeroes
  SetLength(Result, m + 1, n + 1);
 
  //First column filled with zeros
  for i := 0 to m do
    Result[i, 0] := 0;
 
  //First row filled with zeros
  for j:= 0 to n do
    Result[0, j]:= 0;
 
  //Storing the lengths of the longest common subsequences
  //between prefixes of X and Y
  for i:= 1 to m do
    for j:= 1 to n do
      if X[i] = Y[j] then
        Result[i, j] := Result[i-1, j-1] + 1
      else
        Result[i, j]:= Max(Result[i, j-1], Result[i-1, j]);
end;
 
class procedure TStringComparer.ComputeDifferences(aLCSMatrix: TIntArray;
                                                   X, Y: string;
                                                   i, j: Integer;
                                                   aDifferences: TList<TDiff>);
var
  CharDiff: TDiff;
begin
  if (i > 0) and (j > 0) and (X[i] = Y[j]) then
  begin
    ComputeDifferences(aLCSMatrix, X, Y, i-1, j-1, aDifferences);
    CharDiff.Character:= X[i];
    CharDiff.CharStatus:= '=';   //The character did not change
    aDifferences.Add(CharDiff);
  end
  else
    if (j > 0) and ((i = 0) or (aLCSMatrix[i,j-1] >= aLCSMatrix[i-1,j])) then
    begin
      ComputeDifferences(aLCSMatrix, X, Y, i, j-1, aDifferences);
      CharDiff.Character:= Y[j];
      CharDiff.CharStatus:= '+'; //The character was added
      aDifferences.Add(CharDiff);
    end
    else if (i > 0) and ((j = 0) or (aLCSMatrix[i,j-1] < aLCSMatrix[i-1,j])) then
    begin
      ComputeDifferences(aLCSMatrix, X, Y, i-1, j, aDifferences);
      CharDiff.Character:= X[i];
      CharDiff.CharStatus:= '-'; //The character was removed
      aDifferences.Add(CharDiff);
    end;
end;
 
//This is a factory method
class function TStringComparer.Compare(aString1, aString2: string): TList<TDiff>;
var
  Matrix: TIntArray;
begin
  Result:= TList<TDiff>.Create;
  Matrix:= LCSMatrix(aString1, aString2);
  ComputeDifferences(Matrix,
                     aString1, aString2,
                     Length(aString1), Length(aString2),
                     Result);
end;
 
end.