Date: 02-16-2022
Return to Index
created by gbSnippets
Sub ShowDifference(ByVal txt1 As String, ByVal txt2 As String)
'Credit: Rod Stephens
' Costs for adding or replacing lines.
#Register None
Register i1 As Long
Register i2 As Long
Local i,j, len1,len2,num_moves, dist_repl, dist_add1, dist_add2 As Long
Dim move_sequence() As Long
' Split the strings into arrays of lines.
' We add a vbCrLf at the front so we get an
' extra blank string in array entry 0.
If IgnoreCase Then txt1 = LCase$(txt1) : txt2 = LCase$(txt2)
Dim lines1 (1 To ParseCount(txt1,$CrLf)) As String
Dim lines2 (1 To ParseCount(txt2,$CrLf)) As String
Dim NLines1 (1 To UBound(lines1)) As String
Dim NLines2 (1 To UBound(lines2)) As String
Parse txt1$, lines1(), $CrLf
Parse txt2$, lines2(), $CrLf
Parse TextLeft, Nlines1(), $CrLf
Parse TextRight, Nlines2(), $CrLf
If IgnoreTrailing Then
For i = 1 To UBound(lines1) : lines1(i) = RTrim$(lines1(i)) : Next i
For i = 1 To UBound(lines2) : lines2(i) = RTrim$(lines2(i)) : Next i
End If
' Allocate space for the distances
' and moves arrays.
len1 = UBound(lines1)
len2 = UBound(lines2)
Dim distances(0 To len1, 0 To len2) As Long
Dim moves(0 To len1, 0 To len2) As Long
' Initialize the arrays.
moves(0, 0) = %move_NoChange
For i1 = 1 To len1
distances(i1, 0) = distances(i1 - 1, 0) + %COST_ADD1
moves(i1, 0) = %move_Add1
Next i1
For i2 = 1 To len2
distances(0, i2) = distances(0, i2 - 1) + %COST_ADD2
moves(0, i2) = %move_Add2
Next i2
' Fill in the rest of the arrays.
For i1 = 1 To len1
For i2 = 1 To len2
' See how much it would cost to start
' from the (i1 - 1, i2 - 1) entry.
If lines1(i1) = lines2(i2) Then
dist_repl = distances(i1 - 1, i2 - 1)
Else
dist_repl = distances(i1 - 1, i2 - 1) + %COST_REPL
End If
' See how much it would cost to start
' from the (i1 - 1, i2) and (i1, i2 - 1)
' entries.
dist_add1 = distances(i1 - 1, i2) + %COST_ADD1
dist_add2 = distances(i1, i2 - 1) + %COST_ADD2
' See which method is cheapest.
If (dist_repl <= dist_add1) And (dist_repl <= dist_add2) Then
distances(i1, i2) = dist_repl
If lines1(i1) = lines2(i2) Then
moves(i1, i2) = %move_NoChange
Else
moves(i1, i2) = %move_Replace
End If
ElseIf (dist_add1 <= dist_repl) And (dist_add1 <= dist_add2) Then
distances(i1, i2) = dist_add1
moves(i1, i2) = %move_Add1
Else
distances(i1, i2) = dist_add2
moves(i1, i2) = %move_Add2
End If
Next i2
Next i1
' Make a list of the moves we took
' (in reverse order).
i1 = len1
i2 = len2
Do While (i1 > 0) Or (i2 > 0)
' Save the move.
num_moves = num_moves + 1
ReDim Preserve move_sequence(1 To num_moves)
move_sequence(num_moves) = moves(i1, i2)
' Go to the previous position in the array.
Select Case moves(i1, i2)
Case %move_NoChange
i1 = i1 - 1
i2 = i2 - 1
Case %move_Replace
i1 = i1 - 1
i2 = i2 - 1
Case %move_Add1
i1 = i1 - 1
Case %move_Add2
i2 = i2 - 1
End Select
Loop
' Use the moves to build the result string.
i1 = 1
i2 = 1
ReDim LeftColor(1 To num_moves), RightColor(1 To num_moves)
ListView Reset hDlg, %IDC_ListViewL
ListView Reset hDlg, %IDC_ListViewR
For i = 1 To num_moves
ListView Insert Item hDlg, %IDC_ListViewL,i,0,Format$(i,"0000")
ListView Insert Item hDlg, %IDC_ListViewR,i,0,Format$(i,"0000")
Next i
Statusbar Set Text hDlg, %IDC_StatusBar, 1, 0, "Moves = " + Str$(num_moves)
For i = num_moves To 1 Step -1
j = num_moves - i + 1
Select Case move_sequence(i)
Case %move_Add1
ListView Set Text hDlg, %IDC_ListViewL,j,2,Nlines1(i1)
ListView Set Text hDlg, %IDC_ListViewR,j,2,""
RightColor(j) = RGB(230,230,230)
LeftColor(j) = UniqueColor
i1 = i1 + 1
Case %move_Add2
ListView Set Text hDlg, %IDC_ListViewL,j,2,""
ListView Set Text hDlg, %IDC_ListViewR,j,2,Nlines2(i2)
RightColor(j) = UniqueColor
LeftColor(j) = RGB(230,230,230)
i2 = i2 + 1
Case %move_Replace
ListView Set Text hDlg, %IDC_ListViewL,j,2,Nlines1(i1)
ListView Set Text hDlg, %IDC_ListViewR,j,2,Nlines2(i2)
RightColor(j) = DiffColor
LeftColor(j) = DiffColor
i1 = i1 + 1
i2 = i2 + 1
Case %move_NoChange
ListView Set Text hDlg, %IDC_ListViewL,j,2,Nlines1(i1)
ListView Set Text hDlg, %IDC_ListViewR,j,2,Nlines2(i2)
RightColor(j) = %White
LeftColor(j) = %White
i1 = i1 + 1
i2 = i2 + 1
End Select
Next i
End Sub
'gbs_01138
'Date: 03-10-2012
http://www.garybeene.com/sw/gbsnippets.htm