frmsuanfa.frm

采用面向负荷控制技术

sql = "select * from t_spgeneralpartplan order by drawingnumber"
mrs.Open sql, mconn, adOpenKeyset, adLockPessimistic
If mrs.RecordCount > 0 Then
    mrs.MoveFirst
    While Not mrs.EOF
        '获得已完工工序，对finpro()赋值
        ReDim finpro(1)
        finpro(0) = mrs("state")
        remaint = GetRemainTime(finpro, mrs("drawingnumber"))
        sql = mrs("senddate") - Date
        If remaint <> 0 Then
            
        mrs("bufftime") = (mrs("senddate") - Date) / remaint
        End If
        mrs.Update
        mrs.MoveNext
    Wend
End If
mrs.Close
End Sub

Sub ShowResult()
Dim sql As String
Set mrs = Nothing
sql = "select drawingnumber as 图号,state as 下道工序,planquantity as 计划数量,senddate as 交货日期,"
Select Case Me.Tag
    Case "buff"
        sql = sql & " bufftime as 缓冲期 "
    Case "ljb"
        sql = sql & " bufftime as 临界比 "
    
End Select
 sql = sql & " from t_spgeneralpartplan order by bufftime"
mrs.Open sql, mconn, adOpenKeyset, adLockPessimistic
If mrs.RecordCount = 0 Then
    Set dgd_show.DataSource = Nothing
    dgd_show.Refresh
Else
    mrs.MoveFirst
    Set dgd_show.DataSource = mrs
    dgd_show.Refresh
End If
End Sub

'根据已完工工序，获得未完工工序所需时间
Function GetRemainTime(finishedprocess() As String, drawno As String)
Dim sql As String, tt As Integer
Dim rs As New ADODB.Recordset
sql = "select * from t_subpmreference where drawingnumber='" & drawno & "'"
'派工时工序固定从小到大，不能改变顺序
sql = sql & " and processnumber>=" & finishedprocess(0)
'若允许随机排序，须减去数组finishedprocess()中的工序
rs.CursorLocation = adUseClient
rs.Open sql, mconn, adOpenKeyset, adLockPessimistic
If rs.RecordCount = 0 Then
    GetRemainTime = 0
Else
    tt = 0
    rs.MoveFirst
    While Not rs.EOF
        tt = rs("elapsetime") + tt
        rs.MoveNext
    Wend
    GetRemainTime = tt
End If
rs.Close

End Function





Private Sub Comexit_Click()
  Unload Me
End Sub

Private Sub Comexit1_Click()
 Unload Me
End Sub

Private Sub Comfind_Click()
   Dim number As Integer
   Dim str As String
   If cmbmachine.Text = "" Then
      MsgBox "请您选择设备", vbExclamation + vbInformation
      Exit Sub
    End If
    number = InStr(1, cmbmachine.Text, "/", vbTextCompare)
    str = Left(Trim$(cmbmachine.Text), number - 1)
    Set rs = Nothing
    rs.ActiveConnection = "dsn=dlrwdb;uid=scl;uid=scl"
    rs.CursorLocation = adUseClient
    rs.CursorType = adOpenKeyset
    rs.LockType = adLockOptimistic
    rs.Source = "select * from t_subdaytaskplan where machinecode='" & str & "'"
    rs.Open
    If rs.RecordCount = 0 Then
       MsgBox "此设备上委派任务", vbExclamation + vbInformation
    End If
    Set DataGrid2.DataSource = rs
    Call first(DataGrid2)
    Call initial(DataGrid2, "日生产计划")
    
End Sub

Private Sub Comok_Click()
    Dim rs1 As New ADODB.Recordset  '用rs来对零件计划标排序并显示之
    'machine()代表机器编号，machine1()代表机器效率machine2()代表机器负荷
    Dim machine() As String, machine1() As Single, machine2() As Single
    Dim rs2 As New ADODB.Recordset '找出相应的产品对应的加工设备号
    Dim rs3 As New ADODB.Recordset '打开设备负荷表
    Dim rs4 As New ADODB.Recordset '打开日生产计划表
    Dim rs5 As New ADODB.Recordset '用来给设备负荷表里添加数据
    Dim m As Integer, i As Integer
    Dim quota As Single
 Select Case Cmbsuanfa.Text
 Case "占用时间最少"
    Set rs1 = Nothing
    rs1.ActiveConnection = "dsn=dlrwdb;uid=scl;uid=scl"
    rs1.CursorLocation = adUseClient
    rs1.CursorType = adOpenKeyset
    rs1.LockType = adLockOptimistic
    rs1.Source = "select * from t_spgeneralpartplan where added='否' "
    rs1.Open
    
    Do Until rs1.RecordCount = 0
            rs1.MoveFirst
         Do Until rs1.EOF
             Set rs2 = Nothing
             rs2.ActiveConnection = "dsn=dlrwdb;uid=scl;uid=scl"
             rs2.CursorLocation = adUseClient
             rs2.CursorType = adOpenKeyset
             rs2.LockType = adLockOptimistic
             rs2.Source = "select processquota from t_subprocessplan where drawingnumber='" & Trim$(rs1("drawingnumber")) & "' and  processnumber='" & Trim$(rs1("state")) & "'"
             rs2.Open
             '查找某设备的定额
            If rs2.RecordCount <> 0 Then
                rs2.MoveFirst
                quota = CSng(rs2("processquota"))
              
             Set rs2 = Nothing
             rs2.ActiveConnection = "dsn=dlrwdb;uid=scl;uid=scl"
             rs2.CursorLocation = adUseClient
             rs2.CursorType = adOpenKeyset
             rs2.LockType = adLockOptimistic
             rs2.Source = "select device.status,t_subpmreference.machinenumber from device,t_subpmreference where t_subpmreference.drawingnumber='" & Trim$(rs1("drawingnumber")) & "' and device.deviceno=t_subpmreference.machinenumber"
             rs2.Open
             m = rs2.RecordCount
             If m <> 0 Then
                      ReDim machine(m)
                      ReDim machine1(m)
                      ReDim machine2(m)
                      
                      rs2.MoveFirst
                      m = 1
                      Do Until rs2.EOF
                          Set rs3 = Nothing '提取每台设备的负荷,工作效率，及设备编号
                          rs3.ActiveConnection = "dsn=dlrwdb;uid=scl;uid=scl"
                          rs3.CursorLocation = adUseClient
                          rs3.CursorType = adOpenKeyset
                          rs3.LockType = adLockOptimistic
                          rs3.Source = "select sum(timeoccupy) as number from t_submachineload where machinenumber='" & Trim$(rs2("machinenumber")) & "'"
                          rs3.Open
                          
                          machine(m) = rs2("machinenumber") '提取设备编号
                          machine2(m) = rs2("status") '提取设备效率
                          If rs3.RecordCount <> 0 Then
                          rs3.MoveFirst
                        If rs3("number") <> "" Then
                          machine1(m) = rs3("number") '提取设备负荷
                        Else
                           machine1(m) = 0
                        End If
                        End If
                        m = m + 1
                       rs2.MoveNext
                    Loop
              
                Call mpop(rs1("planquantity"), quota, machine1(), machine2())    '调用过程进行任务分派
                Set rs5 = Nothing
                rs5.ActiveConnection = "dsn=dlrwdb;uid=scl;uid=scl"
                rs5.CursorLocation = adUseClient
                rs5.CursorType = adOpenKeyset
                rs5.LockType = adLockOptimistic
                rs5.Source = "t_submachineload"
                rs5.Open
                m = UBound(machine())
                For i = 1 To m  '向设备负荷表里添加新数据
                    If c(i) <> 0 Then
                      rs5.AddNew
                      rs5("machinenumber") = CStr(machine(i))
                      rs5("processnumber") = CStr(rs1("state"))
                      rs5("drawingnumber") = CStr(rs1("drawingnumber"))
                      rs5("quantity") = CInt(c(i))
                      rs5("timeoccupy") = (c(i) * quota) / machine1(i)
                      rs5.Update
                     End If
                 Next i
                  Set rs5 = Nothing
                  rs5.ActiveConnection = "dsn=dlrwdb;uid=scl;uid=scl"
                  rs5.CursorLocation = adUseClient
                  rs5.CursorType = adOpenKeyset
                  rs5.LockType = adLockOptimistic
                  rs5.Source = "t_subdaytaskplan"
                  rs5.Open
                 For i = 1 To m    '向任务表里添加新数据
                    If c(i) <> 0 Then
                    rs5.AddNew
                     rs5("workcode") = CStr(rs1("workcode"))
                     rs5("ordercode") = CStr(rs1("ordercode"))
                     rs5("drawingnumber") = CStr(rs1("drawingnumber"))
                     rs5("state") = rs1("state")
                     rs5("quantity") = c(i)
                     rs5("machinecode") = CStr(machine(i))
                     rs5.Update
                    End If
                 Next i
                 If (rs1("state") <> rs1("endstate")) Then  '修改零件计划表的任务状态
                     rs1("state") = rs1("state") + 5
                     rs1.Update
                 Else
                    rs1("added") = "是"
                    rs1.Update
                 End If
            End If
             rs1("state") = rs1("state") + 5
             rs1.Update
            End If
          rs1.MoveNext
        Loop
        Set rs1 = Nothing    '从新打开零件计划表，一边下一道工序的分派
        rs1.ActiveConnection = "dsn=dlrwdb;uid=scl;uid=scl"
        rs1.CursorLocation = adUseClient
        rs1.CursorType = adOpenKeyset
        rs1.LockType = adLockOptimistic
        rs1.Source = "select * from t_spgeneralpartplan where added='否' "
        rs1.Open
   Loop
   Case "缓冲时间"
        Call alg
        Set rs1 = Nothing    '从新打开零件计划表，一边下一道工序的分派
        rs1.ActiveConnection = "dsn=dlrwdb;uid=scl;uid=scl"
        rs1.CursorLocation = adUseClient
        rs1.CursorType = adOpenKeyset
        rs1.LockType = adLockOptimistic
        rs1.Source = "select * from t_spgeneralpartplan where added='否' order by bufftime "
        rs1.Open
   Case "临界比"
        Call ljb
        Set rs1 = Nothing    '从新打开零件计划表，一边下一道工序的分派
        rs1.ActiveConnection = "dsn=dlrwdb;uid=scl;uid=scl"
        rs1.CursorLocation = adUseClient
        rs1.CursorType = adOpenKeyset
        rs1.LockType = adLockOptimistic
        rs1.Source = "select * from t_spgeneralpartplan where added='否' order by bufftime "
        rs1.Open
End Select
        
End Sub

Private Sub Form_Load()
 Set rs = Nothing
  rs.ActiveConnection = "dsn=dlrwdb;uid=scl"
  rs.CursorLocation = adUseClient
  rs.CursorType = adOpenKeyset
  rs.LockType = adLockOptimistic
  rs.Source = "t_subdaytaskplan"
  rs.Open
  Set DataGrid1.DataSource = rs
  Call first(DataGrid1)
  Call initial(DataGrid1, "日生产计划")
   Frame2.Visible = False
End Sub

Private Sub TabStrip1_Click()
   If TabStrip1.SelectedItem.Index = 1 Then
      Frame2.Visible = False
      Set rs = Nothing
      rs.ActiveConnection = "dsn=dlrwdb;uid=scl;uid=scl"
      rs.CursorLocation = adUseClient
       rs.CursorType = adOpenKeyset
      rs.LockType = adLockOptimistic
      rs.Source = "t_subdaytaskplan"
      rs.Open
      Set DataGrid1.DataSource = rs
      Call first(DataGrid1)
      Call initial(DataGrid1, "日生产计划")
    Else
      Frame2.Visible = True
      
       Set rs = Nothing
       rs.ActiveConnection = "dsn=dlrwdb;uid=scl;uid=scl"
       rs.CursorLocation = adUseClient
       rs.CursorType = adOpenKeyset
       rs.LockType = adLockOptimistic
       rs.Source = "select distinct machinenumber,machinename  from t_submachine "
       rs.Open
       If rs.RecordCount <> 0 Then
         cmbmachine.Clear
         rs.MoveFirst
         Do Until rs.EOF
            cmbmachine.AddItem rs("machinenumber") & "/" & rs("machinename")
            rs.MoveNext
         Loop
        End If
    End If

End Sub