form4.frm

集装箱的装箱问题 给定一个集装箱

Attribute VB_Exposed = False
'****************************************************************************
'人人为我，我为人人
'作者：龙骑士(725989)
'发布日期：2007/03/07
'描    述：集装箱装箱计算源代码
'网    站：http://www.Mndsoft.com/  (VB6源码博客)
'网    站：http://www.VbDnet.com/   (VB.NET源码博客,主要基于.NET2005)
'e-mail  ：[e-mail]
'e-mail  ：[e-mail]
'OICQ    ：88382850
'          如果您有新的好的代码别忘记给枕善居哦!
'****************************************************************************
Private containers(), bales() As String
Private m_count As Integer
Private dt_x As Boolean      '是否使用了缓冲器空间
Public Sub getcount()
k = CInt(ListView2.ListItems.Count)
I = 0
For Each check In Check1
    If check.Value = 1 Then I = I + 1
Next
j = 0
For Each check In Check2
    If check.Value = 1 Then j = j + 1
Next
m_count = k * I * j
Label6.Caption = Replace(Label6.Caption, "X", CStr(k * I * j))

End Sub

Private Sub Command1_Click()
'打开临时文件
Open App.Path + "\temps.txt" For Output As #1
Open App.Path + "\errs.txt" For Output As #2
'循环容器
pro_index = 1
For I = 1 To CInt(ListView2.ListItems.Count)
    
    container_index = I
    '循环优先策略
    For Each checks1 In Check1
        If checks1.Value = 1 Then
            order_flag = CInt(checks1.Index)
            pro_str2 = " |优先策略:" + checks1.Caption
            '循环工作面策略
            For Each checks2 In Check2
                If checks2.Value = 1 Then
                    If checks2.Index = 0 Then
                        WF_flag = 0 '深度搜索
                    Else
                        WF_flag = 1 '浅度搜索
                    End If
                    pro_str3 = " |工作面策略:" + checks2.Caption
                    '循环剩余空间策略
                        For Each checks3 In Option2
                            If checks3.Value = True Then
                                If checks3.Index = 0 Then
                                    SR_flag = 0 '深度搜索
                                Else
                                    SR_flag = 1 '浅度搜索
                                End If
                                pro_str4 = " |剩余空间策略:" + checks3.Caption
                                PRO_STR1 = "PRO_NUM|" + CStr(pro_index) + "|容器:" + ListView2.ListItems(I).SubItems(1)
                                Print #1, PRO_STR1 + pro_str2 + pro_str3 + pro_str4
                                '开始实际计算
                                Get_Container '向中间数组加载数据
                                Get_Bale
                                OrderBales order_flag '重排货物列表
                                '计算
                                ''Debug.Print "WF_flag=" + CStr(WF_flag)
                                ''Debug.Print "SR_flag=" + CStr(SR_flag)
                                ''Debug.Print "order_flag=" + CStr(order_flag)
                                ''Debug.Print "container_index=" + CStr(container_index)
                                Select Case WF_flag
                                Case 0
                                    
                                    a = Tests2(SR_flag, container_index)
                                Case 1
                                    a = Tests(SR_flag, container_index)
                                End Select
                                
                                ProgressBar1.Value = 100 * pro_index / m_count
                                
                                pro_index = pro_index + 1
                                DoEvents
                            End If
                        Next
                End If
            Next
        End If
    Next
Next I
'关闭文件
Close
Command1.Enabled = False
Command2.Enabled = True
End Sub
'========================================================================
Private Sub Command2_Click()
Form5.Show 1
End Sub

Private Sub Form_Load()
Command2.Enabled = False
End Sub
'充填中间数组
Private Function Get_Container() As Boolean
ReDim containers(1 To CInt(ListView2.ListItems.Count), 0 To 7)
For I = 1 To CInt(ListView2.ListItems.Count)
    For j = 0 To 6
        containers(I, j) = ""
    Next j
Next I
I = 1
For Each items In ListView2.ListItems
    containers(I, 0) = "0"
    containers(I, 1) = items.SubItems(1) '名称
    containers(I, 2) = items.SubItems(2) '长
    containers(I, 3) = items.SubItems(3) '宽
    containers(I, 4) = items.SubItems(4) '高
    containers(I, 5) = CStr(CDbl(items.SubItems(2)) * CDbl(items.SubItems(3)) * CDbl(items.SubItems(4))) '体积
    containers(I, 7) = CStr(items.Index)
    I = I + 1
Next
End Function
Private Function Get_Bale() As Boolean
ReDim bales(1 To CInt(ListView3.ListItems.Count), 0 To 8)
For I = 1 To CInt(ListView3.ListItems.Count)
    For j = 0 To 7
        bales(I, j) = ""
    Next j
Next I
I = 1
For Each items In ListView3.ListItems
    bales(I, 0) = "0"
    bales(I, 1) = items.SubItems(1) '名称
    bales(I, 2) = items.SubItems(2) '长
    bales(I, 3) = items.SubItems(3) '宽
    bales(I, 4) = items.SubItems(4) '高
    bales(I, 5) = CStr(CDbl(items.SubItems(2)) * CDbl(items.SubItems(3)) * CDbl(items.SubItems(4))) '体积
    bales(I, 6) = ""
    bales(I, 7) = items.SubItems(6)
    bales(I, 8) = CStr(items.Index)
    I = I + 1
Next
End Function
'优先级排序
Private Sub OrderBales(ByVal types As Integer)
Dim tmps(1 To 8)
Select Case types
Case 0 '宽度排大先
    For I = 1 To UBound(bales, 1) - 1
        For j = I + 1 To UBound(bales, 1)
            If CDbl(bales(j, 3)) > CDbl(bales(I, 3)) Then
                For z = 1 To 8
                    tmps(z) = bales(I, z)
                    bales(I, z) = bales(j, z)
                    bales(j, z) = tmps(z)
                Next z
            End If
            
        Next j
    Next I
Case 1 '长度排长先
    For I = 1 To UBound(bales, 1) - 1
        For j = I + 1 To UBound(bales, 1)
            If CDbl(bales(j, 2)) > CDbl(bales(I, 2)) Then
                For z = 1 To 8
                    tmps(z) = bales(I, z)
                    bales(I, z) = bales(j, z)
                    bales(j, z) = tmps(z)
                Next z
            End If
            
        Next j
    Next I
Case 2 '体积排大先
    For I = 1 To UBound(bales, 1) - 1
        For j = I + 1 To UBound(bales, 1)
            If CDbl(bales(j, 5)) > CDbl(bales(I, 5)) Then
                For z = 1 To 8
                    tmps(z) = bales(I, z)
                    bales(I, z) = bales(j, z)
                    bales(j, z) = tmps(z)
                Next z
            End If
            
        Next j
    Next I
Case 3 '数量排多先
    For I = 1 To UBound(bales, 1) - 1
        For j = I + 1 To UBound(bales, 1)
            If CInt(bales(j, 7)) > CInt(bales(I, 7)) Then
                For z = 1 To 8
                    tmps(z) = bales(I, z)
                    bales(I, z) = bales(j, z)
                    bales(j, z) = tmps(z)
                Next z
            End If
        Next j
    Next I
End Select
End Sub

'小工作面
Private Function Tests(ByVal S_type As Integer, ByVal C_index As Integer) As Boolean
'S_type 剩余空间搜索策略, C_index 容器在容器数组中的索引
    '================定义变量===================
    Dim Max_X, Max_Y, Max_Z, WFace_X, WFace_Y, WFace_Z, CON_V, Bales_V, CON_EFF As Double
    Dim Bales_X, Bales_Y, Bales_Z As Double '货物的尺寸
    Dim CON_N, T_Flag_Ok, SNum, TempIndex, TempsIndexs, Bales_N, Bales_Whirl As Integer
    Dim Con_Index_Num, Bales_Index As String
    Dim I As Integer
    Dim Start_X, Start_Y, Start_Z, SMax_X As Double
    '工作面起点坐标
    Dim Re_X1, Re_Y1, Re_Z1, Re_X2, Re_Y2, Re_Z2, Re_X3, Re_Y3, Re_Z3 As Double '当前工作面剩余空间的尺寸
    Dim S_Start_X1, S_Start_Y1, S_Start_Z1, S_Start_X2, S_Start_Y2, S_Start_Z2, S_Start_X3, S_Start_Y3, S_Start_Z3 As Double '剩余空间起点坐标
    Dim W_Z_N, W_Y_N, W_Z_CON, Can_Count As Integer
    '===========================================
    '================初始化参数=================
    '读容器尺寸
    Max_X = CDbl(containers(C_index, 2))
    Max_Y = CDbl(containers(C_index, 3))
    Max_Z = CDbl(containers(C_index, 4))
    Con_Index_Num = containers(C_index, 7) '容器在LISTVIEW2中的LISTITEM编号
    CON_V = 0 '容器总体积
    CON_N = 1 '使用的容器数量
    T_Flag_Ok = 0 '装载完毕标志 0 未完成 1完成
    Bales_V = 0 '货物总体积
    '读取货物总体积
    For I = 1 To UBound(bales, 1)
        Bales_V = Bales_V + CDbl(bales(I, 5)) * CInt(bales(I, 7))
    Next I
    '===========================================
    '================开始装箱计算===============
    Do '容器循环
        SNum = 0 '工作面编号
        '当前工作面起点坐标
        Start_X = 0
        Start_Y = 0
        Start_Z = 0
        dt_x = False
        '设置工作空间最大尺寸等于容器尺寸
        WFace_X = Max_X
        WFace_Y = Max_Y
        WFace_Z = Max_Z
        SMax_X = Max_X ' X方向上可用的最大尺寸
        '工作面循环开始
        Do
            '设置参数
            TempIndex = 0 '选择的货物在货物数组中的索引
            '设置当前工作面可用空间尺寸
            WFace_Y = Max_Y
            WFace_Z = Max_Z
            WFace_X = SMax_X
            '选择箱子先进行装载
            For I = 1 To UBound(bales, 1) '遍历货物数组搜寻可以放入工作面空间的货物
                If CInt(bales(I, 7)) > 0 And CDbl(bales(I, 3)) < WFace_Y And CDbl(bales(I, 4)) < WFace_Z Then '是否可装载，并且剩余数量大于0
                    '选中进行装箱的货物的尺寸
                    Bales_X = CDbl(bales(I, 2))
                    Bales_Y = CDbl(bales(I, 3))
                    Bales_Z = CDbl(bales(I, 4))
                    '选中进行装箱的货物数量
                    Bales_N = CInt(bales(I, 7))
                    Bales_Index = bales(I, 8) '选中的货物在LISTVIEW3中的LISTITEM编号
                    Bales_Whirl = 0 '设置货物是否水平旋转标志 0 未旋转 1 旋转90度 Bales_X、Bales_Y互换
                    '缓冲器调节长度
                    '如果货物长度大于工作面可用长度但小于工作面可用长度加缓冲器的长度
                    If Bales_X > WFace_X And Bales_X < WFace_X + 100 And dt_x = False And hc Then  'New Code
                        dt_x = True '缓冲器已使用
                        WFace_X = WFace_X + 100 '设置工作面可用长度等于工作面可用长度加缓冲器长度
                        TempIndex = I '设置货物在货物数组中的索引编号
                        Exit For '退出选择货物循环
                    ElseIf Bales_X < WFace_X Then '货物长度小于工作面可用长度
                        TempIndex = I
                        Exit For
                    End If
                End If
            Next I
            '如果没有合适装载尺寸的货物，货物水平旋转
            If TempIndex = 0 Then
                For I = 1 To UBound(bales, 1)
                    If CInt(bales(I, 7)) > 0 And CDbl(bales(I, 2)) < WFace_Y And CDbl(bales(I, 4)) < WFace_Z Then  '是否未装载，并且剩余数量大于0 Bales(i, 0) = 0 And
                        Bales_Y = CDbl(bales(I, 2))
                        Bales_X = CDbl(bales(I, 3))
                        Bales_Z = CDbl(bales(I, 4))
                        Bales_N = CInt(bales(I, 7))
                        Bales_Index = bales(I, 8)
                        Bales_Whirl = 1
                        '缓冲器调节长度
                        If Bales_X > WFace_X And Bales_X < WFace_X + 100 And dt_x = False And hc Then  'New Code
                            dt_x = True
                            WFace_X = WFace_X + 100
                            TempIndex = I
                            'Text2.Text = Text2.Text + CStr(tempindex) + vbCrLf
                            Exit For
                        ElseIf Bales_X < WFace_X Then
                            TempIndex = I
                            'Text2.Text = Text2.Text + CStr(tempindex) + vbCrLf
                            Exit For
                        End If
                    End If
                Next I
            End If
            '如果还没有可装载的货物
            If TempIndex = 0 Then
                '判断是否装箱完成
                TempsIndexs = 0
                For I = 1 To UBound(bales, 1)
                    If CInt(bales(I, 7)) > 0 Then '是否未装载，并且剩余数量大于0 Bales(i, 0) = 0 And
                        TempsIndexs = I
                        Exit For
                    End If
                Next I
                If TempsIndexs = 0 Then
                    Tests = True '装箱成功
                    T_Flag_Ok = 1
                    Exit Do '装箱成功
                Else
                    '当前容器剩余空间无法放下合适的箱子,使用下一个容器
                    Exit Do '退出工作面循环
                End If
            End If
            SNum = SNum + 1 '设置工作面编号
            

     '宽度方向上可装入的数量
     W_Y_N = Int(WFace_Y / Bales_Y)
    '垂直方向上可装入的数量
    W_Z_N = Int(WFace_Z / Bales_Z)
    '工作面可装入箱子的数量是否小于箱子总数
    If W_Y_N * W_Z_N > Bales_N Then
        Can_Count = Bales_N '已装载的箱子数
    Else
        Can_Count = W_Y_N * W_Z_N
    End If
    If (Can_Count Mod W_Y_N) > 0 Then '在Z方向需装载的行数
        If Can_Count < W_Y_N Then
            W_Z_CON = 1
        Else
            W_Z_CON = Int(Can_Count / W_Y_N) + 1
        End If
    Else