VB.net 动态规划问题_背包算法_钢管算法

Public Class Form1
    Public 钢管原材料长度 As Double
    Public 每一刀切割损耗 As Double = 3
    Public 需要切割的总根数 As Integer = 0
    Public Function 下料算法(Str As String) As List(Of String)
        需要切割的总根数 = 0
        Dim ls As New List(Of Double)
        Str = Strings.Replace(Str, " ", "")
        Dim arr = Split(Str, vbLf)
        For Each i In arr
            If InStr(i, "*") Then
                For nnn As Integer = 1 To Split(i, "*")(1)
                    ls.Add(Split(i, "*")(0) + 每一刀切割损耗)
                    需要切割的总根数 += 1
                Next
            Else
                If Not i = "" Then
                    ls.Add(i + 每一刀切割损耗)
                    需要切割的总根数 += 1
                End If
            End If
        Next
        ls.Sort()
        Dim res As New List(Of String)
        Dim N As Integer = 0
        While ls.Count
            If ls.Count = 1 Then
                res.Add(ls(0))
                Exit While
            End If
            Dim dir = "long"
            Dim tmpsum As Double = 0
            Dim l = ls.Count - 1

            While tmpsum < 钢管原材料长度 And ls.Count >= 1
                If dir = "long" Then
                    tmpsum += ls(l)
                Else
                    tmpsum += ls(0)
                End If
                If tmpsum <= 钢管原材料长度 Then '=======================
                    If res.Count = N Then
                        res.Add("")

                    End If
                    If dir = "long" Then
                        res(N) += (ls(l)) & " "
                        ls.RemoveAt(l)
                    Else
                        res(N) += (ls(0)) & " "
                        ls.RemoveAt(0)
                    End If
                    l -= 1
                ElseIf dir = "long" Then
                    tmpsum -= ls(l) + 每一刀切割损耗
                    dir = "Short"
                Else
                    Exit While
                End If
            End While
            N += 1
        End While
        Return res
    End Function
    Public R As New Random
    Public Function 随机颜色() As Color
        Return Color.FromArgb(R.Next(0, 155), R.Next(0, 155), R.Next(0, 155))
    End Function
    Public 居中画字样式 As StringFormat
    Public 右下角画字样式 As StringFormat
    Public Function 随机颜色2() As Color
        Return Color.FromArgb(R.Next(200, 255), R.Next(200, 255), R.Next(200, 255))
    End Function
    Public ret As New List(Of String)
    Private Sub 计算ToolStripMenuItem_Click(sender As Object, e As EventArgs) Handles 计算.Click
        ret = 下料算法(RichTextBox1.Text) '得到切割数字
        Dim w As Double = PictureBox1.Width '获得宽度
        Dim h As Double = PictureBox1.Height / ret.Count '获得每个格子的高度，比如高度100，你要画10根管子，那么就是100÷10=10
        '绘图场景初始化，全部填充黑色
        g.Graphics.Clear(Color.Black)
        ListBox1.Items.Clear() '清空列表框
        Dim 总的浪费 As Double = 0 '计算浪费和
        For i = 0 To ret.Count - 1 '循环读取每一行
            Dim arr = Split(ret(i), " ") '循环读取每一次切割方案
            Dim 当前钢管用去的长度 As Double = 0 '表示这根钢管用去了多少长度，包含进了每一刀切割损耗
            '绘制钢管
            For n = 0 To arr.Count - 1
                If arr(n) <> "" Then
                    '计算当前钢管段坐标
                    Dim re = New RectangleF((当前钢管用去的长度 / 钢管原材料长度) * w, i * h, ((arr(n) - 每一刀切割损耗) / 钢管原材料长度) * w, h)
                    g.Graphics.FillRectangle(New SolidBrush(随机颜色()), re) '画上钢管
                    '画上钢管数值
                    g.Graphics.DrawString($"{arr(n) - 每一刀切割损耗}", Me.Font, Brushes.GhostWhite, re, 居中画字样式)
                    '要考虑每一刀切割损耗也加进去了，所以减掉
                    当前钢管用去的长度 += arr(n) - 每一刀切割损耗
                End If
            Next

            Dim 废料 = Math.Round(钢管原材料长度 - 当前钢管用去的长度, 2)
            总的浪费 += 废料
            '画上序号
            g.Graphics.DrawString($"{i + 1}", Me.Font, Brushes.Gold, 0, i * h)
            '右下角画上浪费
            g.Graphics.DrawString($"废{废料}", Me.Font, Brushes.Red, New RectangleF(0, i * h, w, h), 右下角画字样式)

            Dim t = Split(ret(i), " ")
            Dim str = ""
            For nnn = 0 To t.Count - 1
                If t(nnn) <> "" Then str += Strings.Right("     " & t(nnn) - 每一刀切割损耗, 6)
            Next
            Dim 切的刀数 As String = t.Count - 1
            If 切的刀数 = 0 Then 切的刀数 = 1
            ListBox1.Items.Add($"第{i + 1}根 浪费 [{Strings.Right("    " & 废料, 4)}] [{str}] 切{切的刀数 }刀")
        Next
        ListBox1.Items.Add($"废料[{总的浪费}]  原材料总数[ {ret.Count} ]   总切数量[ {需要切割的总根数} ]")
        g.Render()
    End Sub
    Public Property 路径 As String
    Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
        g = BufferedGraphicsManager.Current.Allocate(PictureBox1.CreateGraphics, PictureBox1.DisplayRectangle)

        居中画字样式 = New StringFormat()
        居中画字样式.LineAlignment = StringAlignment.Center
        居中画字样式.Alignment = StringAlignment.Center

        右下角画字样式 = New StringFormat()
        右下角画字样式.LineAlignment = StringAlignment.Far
        右下角画字样式.Alignment = StringAlignment.Far
        Try
            钢管原材料长度 = IO.File.ReadAllText("钢管原材料长度")
        Catch ex As Exception
            钢管原材料长度 = 6000 '默认值
        End Try
        Form2.NumericUpDown1.Value = 钢管原材料长度
    End Sub
    Public g As BufferedGraphics
    Private Sub 打印_Click(sender As Object, e As EventArgs) Handles 打印.Click
        Dim B As New Bitmap(PictureBox1.Width, PictureBox1.Height)
        g.Render(Graphics.FromImage(B))
        Dim puth As String = Guid.NewGuid.ToString
        B.Save(puth & ".bmp")
        Process.Start(puth & ".bmp")
    End Sub

    Private Sub 设置_Click(sender As Object, e As EventArgs) Handles 设置.Click
        Form2.ShowDialog()
    End Sub

    Private Sub 打印计算结果_Click(sender As Object, e As EventArgs) Handles 打印计算结果.Click
        Dim str = ""
        For Each i In ListBox1.Items
            str += i
            str += vbCrLf
        Next
        Dim puth As String = Guid.NewGuid.ToString
        IO.File.WriteAllText(puth & ".txt", str)
        Process.Start(puth & ".txt")
    End Sub

    Private Sub 清空内容_Click(sender As Object, e As EventArgs) Handles 清空内容.Click
        RichTextBox1.Text = ""
        g.Graphics.Clear(Color.Black)
        g.Render()
        ListBox1.Items.Clear()
    End Sub
End Class