frmsuanfa1.frm

基于vb6.0和sql数据库的车间调度管理系统

         For j = 1 To nn
           pg(h1, j) = pg(ss + 2, j)
         Next j
      End If
   End If

          i = i + 2
  Loop
  End Sub
'交叉操作 采用lox法线性顺序交叉
Public Sub crossover()
   Dim cro() As Integer
   Dim i As Integer, j As Integer, k As Integer
   Dim flag As Boolean, flag1 As Boolean
   Dim f1 As Single '父染色体一的适值
   Dim f2 As Single '父染色体二的适值
   Dim fn As Single '后代染色体的适值
   Dim h1 As Integer '交叉染色体的号码
   Dim h2 As Integer '交叉染色体的号码
   Dim g1 As Integer '断点一
   Dim g2 As Integer '断点二
   Dim t As Integer
   Dim www As Integer
   Dim f3 As Single
   k = ss * pc '它记录了发生交叉的染色体的个数
   ReDim pran(ss) '它记录了每条染色体的交叉随机数
   ReDim cro(k + 1) As Integer
   Randomize
   For i = 1 To ss
      pran(i) = Rnd
   Next i
      j = 0
'      flag1 = False
      i = 1
   Do Until i > ss Or j >= k
       If pran(i) < pc Then
          j = j + 1
           cro(j) = i
       End If
       i = i + 1
   Loop
   
   i = 2
   '染色体交叉
   k = j
  Do Until i > k
     h1 = cro(i - 1)
     h2 = cro(i)
     g1 = Int((nn * Rnd) + 1) '产生一个1到nn的随机数
     g2 = Int((nn * Rnd) + 1)
      If g1 > g2 Then
         t = g1
         g1 = g2
         g2 = t
      End If
      '顺序交叉
      Dim w1 As Integer
      Dim w2 As Integer
      For j = g1 To g2
          pg(ss + 1, j) = pg(h1, j)
      Next j
      w1 = g1
      w2 = g2
      www = 0
    For t = 1 To nn
       '看基因pg(h2, t)是否在染色体中
       If Not find(ss + 1, w1, w2, pg(h2, t)) Then
          If findqq(ss + 1, w1, w2, pg(h2, t)) Then
                w2 = w2 + 1
                If w2 > nn Then
                  For j = w1 To w2 - 1
                     pg(ss + 1, j - 1) = pg(ss + 1, j)
                  Next j
                  w1 = w1 - 1
                  w2 = w2 - 1
                  pg(ss + 1, w2) = pg(h2, t)
                Else
                 pg(ss + 1, w2) = pg(h2, t)
                End If
          Else
             www = www + 1
                If www >= w1 Then
                    If findhj(ss + 1, w1, w2, pg(h2, t)) Then
                         For j = w2 To w1 Step -1
                          pg(ss + 1, j + 1) = pg(ss + 1, j)
                         Next j
                         w2 = w2 + 1
                         w1 = w1 + 1
                         pg(ss + 1, www) = pg(h2, t)
                    Else
                     w2 = w2 + 1
                     pg(ss + 1, w2) = pg(h2, t)
                     www = www - 1
                    End If

                Else
                 pg(ss + 1, www) = pg(h2, t)
                End If
          End If
       End If
    Next t
        f1 = fit(h1, 2)
        f2 = fit(h2, 2)
        f3 = fit(ss + 1, 2)
        fn = ddd(f1, f2, f3)
        If fn = f1 And fn <> f3 Then
            For t = 1 To nn
               If pg(ss + 1, t) = 0 Then Stop
               pg(h1, t) = pg(ss + 1, t)
            Next t
        ElseIf fn = f2 And fn <> f3 Then
           For t = 1 To nn
               If pg(ss + 1, t) = 0 Then Stop
               pg(h2, t) = pg(ss + 1, t)
            Next t
       End If
           For t = 1 To nn
              pg(ss + 1, t) = 0
           Next t
       i = i + 2
  Loop
End Sub
'此函数为解码函数
'根据染色体解码,参数n为第几条染色体，str代表初始种群还是新生种群
Public Sub ft(n As Integer, str As Integer)
    Dim i As Integer, j As Integer, k As Integer, h As Integer
    Dim m As Integer '代表工序所对应的机器号
'   Dim m1 As Integer'代表第一台机器的第几到工序
'   Dim m2 As Integer'代表第二台机器的第几到工序
'   Dim m3 As Integer '代表第三台机器的第几到工序
    Dim pre1 As Single
    Dim flag As Boolean
    Dim lg As Single
    '初始化任务量为0
    
        For j = 1 To mm
            min(j) = 0
        Next j
   
        For j = 1 To mm
         For k = 1 To hh
          mach(j, k).gx = 0
           mach(j, k).start = 0
           mach(j, k).stop = 0
         Next k
      Next j
    Select Case str
    Case 1
        For j = 1 To nn
                  '求出机器号
                    m = A(2, p(n, j))
 
                    min(m) = min(m) + 1
                    mach(m, min(m)).gx = p(n, j)
                    pre1 = precede(p(n, j))
                    If mach(m, min(m) - 1).stop < pre1 Then
                        mach(m, min(m)).start = pre1
                        mach(m, min(m)).stop = mach(m, min(m)).start + A(3, p(n, j))
                    Else
                    '查找本道工序应插入的最好地方
                       flag = False
                       k = 1
                      Do Until flag Or k > min(m)
                         If mach(m, k).start > pre1 And mach(m, k).start - mach(m, k - 1).stop > A(3, p(n, j)) Then
                             If pre1 < mach(m, k - 1).stop Then
                                flag = True
                             ElseIf mach(m, k).start - pre1 > A(3, p(n, j)) Then
                                flag = True
                             Else
                                k = k + 1
                             End If
                         Else
                            k = k + 1
                         End If
                      Loop
                      '如果找到插入点则作如下操作
                      If Not flag Then
                         mach(m, min(m)).start = mach(m, min(m) - 1).stop
                         mach(m, min(m)).stop = mach(m, min(m)).start + A(3, p(n, j))
                      Else
                         For h = min(m) To k Step -1
                             mach(m, h).gx = mach(m, h - 1).gx
                             mach(m, h).start = mach(m, h - 1).start
                             mach(m, h).stop = mach(m, h - 1).stop
                         Next h
                              mach(m, k).gx = p(n, j)
                             If pre1 > mach(m, k - 1).stop Then
                                mach(m, k).start = per1
                             Else
                                 mach(m, k).start = mach(m, k - 1).stop
                             End If
                             mach(m, k).stop = mach(m, k).start + A(3, p(n, j))
                      End If
                   End If
                    
            Next j
     Case 2
             For j = 1 To nn
                  '求出机器号
                    m = A(2, pg(n, j))
                    min(m) = min(m) + 1
                    mach(m, min(m)).gx = pg(n, j)
                    pre1 = precede(pg(n, j))
                    If mach(m, min(m) - 1).stop < pre1 Then
                        mach(m, min(m)).start = pre1
                        mach(m, min(m)).stop = mach(m, min(m)).start + A(3, pg(n, j))
                    Else
                    '查找本道工序应插入的最好地方
                       flag = False
                       k = 1
                      Do Until flag Or k > min(m)
                         If mach(m, k).start > pre1 And mach(m, k).start - mach(m, k - 1).stop > A(3, pg(n, j)) Then
                             If pre1 < mach(m, k - 1).stop Then
                                flag = True
                             ElseIf mach(m, k).start - pre1 > A(3, pg(n, j)) Then
                                flag = True
                             Else
                                k = k + 1
                             End If
                         Else
                            k = k + 1
                         End If
                      Loop
                      '如果找到插入点则作如下操作
                      If Not flag Then
                         mach(m, min(m)).start = mach(m, min(m) - 1).stop
                         mach(m, min(m)).stop = mach(m, min(m)).start + A(3, pg(n, j))
                      Else
                         For h = min(m) To k Step -1
                             mach(m, h).gx = mach(m, h - 1).gx
                             mach(m, h).start = mach(m, h - 1).start
                             mach(m, h).stop = mach(m, h - 1).stop
                         Next h
                             If pre1 > mach(m, k - 1).stop Then
                                mach(m, k).start = per1
                             Else
                                 mach(m, k).start = mach(m, k - 1).stop
                             End If
                             mach(m, k).stop = mach(m, k).start + A(3, pg(n, j))
                      End If
                   End If
                    
            Next j

     End Select

End Sub
'此函数为解码函数
'根据染色体解码,参数n为第几条染色体，str代表初始种群还是新生种群
Public Sub ft1(n As Integer, str As Integer)
    Dim j As Integer
    Dim m As Integer '代表工序所对应的机器号
     '初始化设备加工时间
        For j = 1 To mm
            min(j) = 0
        Next j
    Select Case str
    Case 1
        For j = 1 To nn
            '求出机器号
            m = p(n, j)
            min(m) = min(m) + A(j, m)
        Next j
     Case 2
             For j = 1 To nn
                    '求出机器号
                    m = pg(n, j)
                    min(m) = min(m) + A(j, m)
            Next j
     Case 3
          For j = 1 To nn
                    '求出机器号
                    m = pnew(n, j)
                    
                    min(m) = min(m) + A(j, m)
                    If min(m) = 0 Then Stop
          Next j
     End Select

End Sub
'求最大的机器加工时间
Public Function fmax() As Single
     Dim i As Integer
     fmax = min(1)
     For i = 2 To mm
        If fmax < min(i) Then
           fmax = min(i)
        End If
     Next i
End Function
'求最大的机器加工时间
Public Function fmax1(j As Integer) As Single
     Dim i As Integer
     fmax1 = 1
     For i = 2 To j
        If fnew(fmax1) < fnew(i) Then
           fmax1 = i
        End If
     Next i
End Function

' 此函数为计算适值函数，他将染色体翻译成解,并求出解的适值
Public Sub translate(str As Integer)
   Dim i As Integer, j As Integer, k As Integer, h As Integer
   Dim m As Integer '代表工序所对应的机器号
   Dim imax As Single
   Dim lg As Single
     '初始化适值
      For j = 1 To ss
         f(j) = 0
      Next j
      '初始化
'      For j = 1 To mm
'         For k = 1 To hh
'          mach(j, k).gx = 0
'           mach(j, k).start = 0
'           mach(j, k).stop = 0
'         Next k
'      Next j
   '解码
       For i = 1 To ss
              'ft为解码函数
              Call ft(i, str)
              imax = mach(1, min(1)).stop
              For j = 2 To mm
                If imax < mach(j, min(j)).stop Then imax = mach(j, min(j)).stop
              Next j
            f(i) = 1 / imax
       Next i
End Sub
'参数n代表工序号，返回本道工序的约束工序的最迟完成时间
'本函数来求工序n的约束工序的最迟完成时间
Public Function precede(n As Integer) As Single
    Dim i As Integer, k As Integer, j As Integer
    i = 1
    precede = 0
    'b(n,i)为工序n的约束工艺
    Do Until i > ll Or B(n, i) = 0
     '找出生产b(n,i)工序的机器号k
       k = A(2, B(n, i))
         For j = min(k) To 1 Step -1
            If mach(k, j).gx = B(n, i) Then
              If precede < mach(k, j).stop Then
                precede = mach(k, j).stop
              End If
            End If
         Next j
              i = i + 1
   Loop
    
End Function

'参数说明a为代表工艺、加工机器，及加工施加的数组，其大小为a(n,3),
'b为表示工艺间约束关系的二维数组，它为b(n,m);
'size设定初始种群的大小，n即可代表共艺数，又可代表染色体长度
Public Sub popsize(size As Integer)
   Dim s() As Integer '表示当前可调度工艺
   Dim i As Integer
   Dim k As Integer
   Dim h As Integer
   Dim j As Integer
   Dim imax As Integer
   ReDim s(nn)
   Randomize
   
 '生成初始种群
  For h = 1 To size
   '初始化d(n)
   
    i = 1
    Do Until i > nn
       If B(i, 1) = 0 Then
          D(i) = 0
       Else
          D(i) = 1
       End If
       i = i + 1
    Loop
   '初始化s(n)
    i = 1
    k = 1
   Do Until i > nn
      If D(i) = 0 Then
         s(k) = i
         D(i) = 2
         k = k + 1
       End If
       i = i + 1
   Loop
       k = k - 1
   '生成初始种群中的一条染色体
   For j = 1 To nn
       '计算k割可调度工序的随机数
        For i = 1 To k
           ran(i) = Rnd()
        Next i
       'imax为可放入染色体中工序的序号
         imax = big(k)
         p(h, j) = s(imax)
         If k <> imax Then
            s(imax) = s(k)
         End If
        
         '设置每个工序的约束状态
         Call change(h, j)
          '设置可调度工艺序列s
         i = 1
         Do Until i > nn
           If D(i) = 0 Then
                s(k) = i
                D(i) = 2
                k = k + 1
           End If
           i = i + 1
         Loop
         k = k - 1
    Next j
 Next h