附上vb.net代码和测试程序
窗体代码
Private oRand As Random = New Random Public Sub DrawRoute(oPictureBox As PictureBox, oToolRoute As CToolRoute) If oPictureBox.Image Is Nothing Then oPictureBox.Image = New Bitmap(oPictureBox.Width, oPictureBox.Height) End If Dim g As Graphics = Graphics.FromImage(oPictureBox.Image) g.Clear(Color.White) For i As Integer = 0 To oToolRoute.lstNode.Count - 1 Dim c As Color = If(IsNothing(oToolRoute.lstNode(i).oToolRoute), Color.Gray, oToolRoute.lstNode(i).oToolRoute.color) g.FillRectangle(New SolidBrush(c), i * 37, 0, 30, 30) g.DrawString(oToolRoute.lstNode(i).strToolName, DefaultFont, Brushes.AliceBlue, i * 37, 10) Next End Sub Private Function CreateToolRoute() As CToolRoute Dim oRoute As CToolRoute = New CToolRoute Dim iLast = -1 For i As Integer = 0 To oRand.Next(15) + 5 Dim o As New CToolRouteInfo oRoute.lstNode.Add(o) o.oToolRoute = oRoute Dim iIndex = oRand.Next(15) While iIndex = iLast iIndex = oRand.Next(15) End While o.strToolName = "项" & iIndex iLast = iIndex Next Return oRoute End Function Private Sub Form1_Shwon(sender As Object, e As EventArgs) Handles MyBase.Shown Test() End Sub Private Sub Test() Dim oRoute As CToolRoute = CreateToolRoute() oRoute.color = Color.DimGray DrawRoute(PictureBox1, oRoute) Dim oRoute2 As CToolRoute = CreateToolRoute() oRoute2.color = Color.SteelBlue DrawRoute(PictureBox3, oRoute2) Dim o1 As CToolRoute = New CToolRoute Dim o2 As CToolRoute = New CToolRoute CalMatrix(oRoute, oRoute2) End Sub Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load End Sub Private Sub DrawMatrix(oPictureBox As PictureBox, matrix As CToolRouteNode(,), Optional oToolRoute As CToolRoute = Nothing) If oPictureBox.Image Is Nothing Then oPictureBox.Image = New Bitmap(oPictureBox.Width, oPictureBox.Height) End If Dim g As Graphics = Graphics.FromImage(oPictureBox.Image) g.Clear(Color.White) For i As Integer = 0 To matrix.GetLength(0) - 1 For j As Integer = 0 To matrix.GetLength(1) - 1 If matrix(i, j) Is Nothing Then Continue For End If Dim c As Color = If(matrix(i, j).lstMinToolRoute.Count = 0, Color.Gray, matrix(i, j).lstMinToolRoute.Last.oToolRoute.color) g.FillRectangle(New SolidBrush(c), i * 37, j * 37, 30, 30) If i = 0 Or j = 0 Then Try g.DrawString(matrix(i, j).lstMinToolRoute.Last.strToolName, DefaultFont, Brushes.AliceBlue, i * 37, j * 37) Catch ex As Exception End Try Else g.DrawString(matrix(i, j).iMinChangeToolCount, DefaultFont, Brushes.AliceBlue, i * 37, j * 37) End If Next Next If IsNothing(oToolRoute) Then Return End If Dim lstPoints As List(Of Point) = New List(Of Point) For iIndex As Integer = 0 To oToolRoute.lstNode.Count - 1 Dim bFound As Boolean = False For i As Integer = matrix.GetLength(0) - 1 To 0 Step -1 If bFound Then Exit For End If For j As Integer = matrix.GetLength(1) - 1 To 0 Step -1 If matrix(i, j) Is Nothing OrElse iIndex + 1 <> matrix(i, j).lstMinToolRoute.Count Then Continue For End If Dim bSame As Boolean = True For n As Integer = 0 To matrix(i, j).lstMinToolRoute.Count - 1 If matrix(i, j).lstMinToolRoute.Count <= n OrElse oToolRoute.lstNode.Count <= n Then Exit For End If If Not matrix(i, j).lstMinToolRoute(n).strToolName = oToolRoute.lstNode(n).strToolName Then bSame = False Exit For End If Next If bSame Then lstPoints.Add(New Point(i * 37 + 15, j * 37 + 15)) bFound = True Exit For End If Next Next Next g.DrawLines(New Pen(Brushes.Red, 3), lstPoints.ToArray) End Sub ''' <summary> ''' 核心函数 求解最短公共超串 ''' </summary> ''' <param name="o1"></param> ''' <param name="o2"></param> ''' <returns></returns> Private Function CalMatrix(o1 As CToolRoute, o2 As CToolRoute) As CToolRoute Dim matrix As CToolRouteNode(,) ReDim matrix(o1.lstNode.Count, o2.lstNode.Count) matrix(0, 0) = New CToolRouteNode matrix(0, 0).iMinChangeToolCount = 0 matrix(0, 0).lstMinToolRoute = New List(Of CToolRouteInfo) Dim lastListNode As List(Of CToolRouteInfo) = New List(Of CToolRouteInfo) For Each oNode As CToolRouteInfo In o1.lstNode Dim o As New CToolRouteNode Dim i As Integer = o1.lstNode.IndexOf(oNode) o.iMinChangeToolCount = i + 1 o.lstMinToolRoute = lastListNode.FindAll(Function(m) True) o.lstMinToolRoute.Add(oNode) lastListNode = o.lstMinToolRoute matrix(i + 1, 0) = o Next lastListNode = New List(Of CToolRouteInfo) For Each oNode As CToolRouteInfo In o2.lstNode Dim o As New CToolRouteNode Dim i As Integer = o2.lstNode.IndexOf(oNode) o.iMinChangeToolCount = i + 1 o.lstMinToolRoute = lastListNode.FindAll(Function(m) True) o.lstMinToolRoute.Add(oNode) lastListNode = o.lstMinToolRoute matrix(0, i + 1) = o Next For i As Integer = 1 To o1.lstNode.Count For j As Integer = 1 To o2.lstNode.Count Dim o1Node As CToolRouteInfo = o1.lstNode(i - 1) Dim o2Node As CToolRouteInfo = o2.lstNode(j - 1) Dim strO1Name As String = o1Node.strToolName Dim strO2Name As String = o2Node.strToolName Dim oNode As New CToolRouteNode If strO1Name = strO2Name Then oNode.iMinChangeToolCount = matrix(i - 1, j - 1).iMinChangeToolCount + 1 oNode.lstMinToolRoute = matrix(i - 1, j - 1).lstMinToolRoute.FindAll(Function(o) True) oNode.lstMinToolRoute.Add(o1Node) oNode.lstMinToolRoute.Add(o2Node) Else Dim minNode As CToolRouteNode = If(matrix(i - 1, j).iMinChangeToolCount > matrix(i, j - 1).iMinChangeToolCount, matrix(i, j - 1), matrix(i - 1, j)) oNode.iMinChangeToolCount = minNode.iMinChangeToolCount + 1 oNode.lstMinToolRoute = minNode.lstMinToolRoute.FindAll(Function(o) True) If (matrix(i - 1, j).iMinChangeToolCount > matrix(i, j - 1).iMinChangeToolCount) Then oNode.lstMinToolRoute.Add(o2Node) Else oNode.lstMinToolRoute.Add(o1Node) End If End If matrix(i, j) = oNode Dim oMiddleResult As CToolRoute = New CToolRoute oMiddleResult.lstNode = oNode.lstMinToolRoute DrawRoute(PictureBox4, oMiddleResult) DrawMatrix(PictureBox2, matrix, oMiddleResult) Me.Refresh() Threading.Thread.Sleep(TextBox1.Text) Next Next Dim oResultToolRoute As CToolRoute = New CToolRoute oResultToolRoute.lstNode = matrix(matrix.GetLength(0) - 1, matrix.GetLength(1) - 1).lstMinToolRoute DrawMatrix(PictureBox2, matrix, oResultToolRoute) DrawRoute(PictureBox4, oResultToolRoute) Me.Refresh() Return oResultToolRoute End Function Public Class CToolRoute Public color As Color Public Property lstNode As List(Of CToolRouteInfo) = New List(Of CToolRouteInfo) End Class Public Class CToolRouteInfo Public Property oToolRoute As CToolRoute Public Property strToolName As String Public Property oNcInfo As CNcInfo End Class Public Class CToolRouteNode Public Property iMinChangeToolCount As Integer Public Property lstMinToolRoute As List(Of CToolRouteInfo) = New List(Of CToolRouteInfo) End Class下载地址
https://download.csdn.net/download/HaQiaME/12575385
