frmgeneralpartplan1.frm

采用面向负荷控制技术

         Loop
       End If

     
  Set DataGrid3.DataSource = rss
  Call first(DataGrid3)
  Call initial(DataGrid3, "设备负荷表")
End Sub

Private Sub Comexit_Click()
  On Error Resume Next
   rs2.Close
   Set rs2 = Nothing
 Unload Me
End Sub

Private Sub Comexit2_Click()
  Unload Me
End Sub

Private Sub comshchjh_Click() '将大纲计划生成零件计划
  Dim i As Integer
  Dim j As Integer
  Dim dgrs As New ADODB.Recordset
  Dim sql As String
  Dim dgsql As String
  Dim rs3 As New ADODB.Recordset
  Screen.MousePointer = vbHourglass
  Dim finpro As String
  Dim remaint  As Integer

 '2.大纲计划
           If myrs.State = adStateOpen Then myrs.Close
             myrs.ActiveConnection = "dsn=dbw;uid=sa"
             myrs.CursorLocation = adUseClient
             myrs.CursorType = adOpenKeyset
             myrs.LockType = adLockOptimistic
             myrs.Source = "DELETE FROM t_spbillofmaterials"
             myrs.Open
            If myrs.State = adStateOpen Then myrs.Close
             myrs.ActiveConnection = "dsn=dbw;uid=sa"
             myrs.CursorLocation = adUseClient
             myrs.CursorType = adOpenKeyset
             myrs.LockType = adLockOptimistic
             myrs.Source = "t_spbillofmaterials"
             myrs.Open
            
         On Error Resume Next
         If rs.RecordCount <> 0 Then '如果大纲记录不为零则生成零件记录
             rs.MoveFirst
             Do Until rs.EOF
                 On Error Resume Next
                 Call Main1(rs("workcode"), rs("ordercode"), rs("locomotivetype"), rs("drawingnumber"), rs("amount"), rs("note"))
                 If Not bool Then
                      rs("added") = "是"
                      rs.Update
                 End If
                 rs.MoveNext
              Loop
            If myrs.RecordCount <> 0 Then
               myrs.MoveFirst
               mark = myrs.Bookmark
               Do Until myrs.EOF
                    Call ff(myrs("workcode"), myrs("ordercode"), myrs("locomotivetype"), myrs("drawingnumber"), myrs("planquantity"), myrs("pargroupamount"), myrs("note"))
                    myrs.Bookmark = mark
                    myrs.MoveNext
                    mark = myrs.Bookmark
               Loop
            End If
        End If
    '显示本月零部件计划
  
     sql = "select * from t_spgeneralpartplan" & _
         "  where added='否' order by ordercode"
        If rs2.State = adStateOpen Then rs2.Close
        rs2.ActiveConnection = "dsn=dbw;uid=sa"
        rs2.Source = sql
        rs2.CursorLocation = adUseClient
        rs2.CursorType = adOpenDynamic
        rs2.LockType = adLockOptimistic
        rs2.Open
        
        sql = "select * from t_myplantask" & _
         "  where added='否' order by ordercode"
        Set rs3 = Nothing
        rs3.ActiveConnection = "dsn=dbw;uid=sa"
        rs3.Source = sql
        rs3.CursorLocation = adUseClient
        rs3.CursorType = adOpenDynamic
        rs3.LockType = adLockOptimistic
        rs3.Open
        If rs3.RecordCount <> 0 Then rs3.MoveFirst
        Set DataGrid4.DataSource = rs3
        Call first(DataGrid4)
        Call initial(DataGrid4, "工艺零件计划")
        If rs2.RecordCount <> 0 Then
         rs2.MoveFirst
        Do Until rs2.EOF
           Set dgrs = Nothing
           dgrs.ActiveConnection = "dsn=dbw;uid=sa"
           dgrs.CursorLocation = adUseClient
           dgrs.CursorType = adOpenKeyset
           dgrs.LockType = adLockOptimistic
           dgrs.Source = "select distinct processnumber  from t_subprocessplan where drawingnumber='" & Trim$(rs2("drawingnumber")) & "'"
           dgrs.Open
             If dgrs.RecordCount <> 0 Then
                dgrs.MoveFirst
                Do Until dgrs.EOF
                    rs3.AddNew
                    rs3("workcode") = CStr(rs2("workcode"))
                    rs3("ordercode") = CStr(rs2("ordercode"))
                    rs3("prodrawingnumber") = CStr(rs2("prodrawingnumber"))
                    rs3("drawingno") = CStr(rs2("drawingnumber"))
                    rs3("processno") = CStr(dgrs("processnumber"))
                    rs3("pargroupamount") = CInt(rs2("pargroupamount"))
                    rs3("planquantity") = CInt(rs2("planquantity"))
                    rs3("orderdate") = CDate(rs2("acceptdate"))
                    rs3("senddate") = CDate(rs2("senddate"))
                    
                    finpro = CStr(dgrs("processnumber"))
                    
                    remaint = GetRemainTime1(finpro, rs2("drawingnumber"))
                    rs3("hcq") = Round((Date - rs2("senddate") - remaint), 2)
                    If remaint = 0 Then
                        rs3("ljb") = 0
                    Else
                        rs3("ljb") = Round(((Date - rs2("senddate")) / remaint), 2)
                    End If
                    rs3("producttime") = CSng(GetTime1(rs2("drawingnumber")))
                    rs3("note") = CStr(rs2("note"))
                    rs3.Update
                    dgrs.MoveNext
                Loop
             End If
             rs2.MoveNext
       Loop
      End If
      Set rs3 = Nothing
      DataGrid4.Visible = False
      Screen.MousePointer = vbDefault
        Set DataGrid2.DataSource = rs2
        Call initial(DataGrid2, "零件表")
        DataGrid2.Refresh
        Call first(DataGrid2)
    
comshchjh.Enabled = False
End Sub

Private Sub DTPicker1_Change()
    DataGrid2.Refresh
End Sub

Private Sub Form_Load()
 
 'Set conn = Nothing
 'conn.Open "dsn=dbw,UId=sa"
 Set rss = Nothing
  rss.ActiveConnection = "dsn=dbw;uid=sa"
  rss.CursorLocation = adUseClient
  rss.CursorType = adOpenKeyset
  rss.LockType = adLockOptimistic
  rss.Source = "t_submachineload"
  rss.Open
  Set DataGrid3.DataSource = rss
  Call first(DataGrid3)
  Call initial(DataGrid3, "设备负荷表")

 
 Dim sql As String
 DataGrid4.Visible = False
 sql = "select * from t_spgeneralpartplan where added='否'"
 
If rs2.State = adStateOpen Then rs2.Close
rs2.ActiveConnection = "dsn=dbw;uid=sa"
rs2.Source = sql
rs2.CursorLocation = adUseClient
rs2.CursorType = adOpenDynamic
rs2.LockType = adLockOptimistic
rs2.Open
Set DataGrid2.DataSource = rs2
    DataGrid2.Refresh
comshchjh.Enabled = False  '把生成零件计划按钮设成不可用
Call first(DataGrid2)
Call initial(DataGrid2, "零件表")
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    Call Comexit_Click
   If myrs.State = adStateOpen Then myrs.Close
        myrs.ActiveConnection = "dsn=dbw;uid=sa"
        myrs.CursorLocation = adUseClient
        myrs.CursorType = adOpenKeyset
        myrs.LockType = adLockOptimistic
        myrs.Source = "DELETE FROM t_spbillofmaterials"
        myrs.Open

    End Sub

Private Sub Form_Unload(Cancel As Integer)
   Call Comexit_Click
  If myrs.State = adStateOpen Then myrs.Close
  myrs.ActiveConnection = "dsn=dbw;uid=sa"
  myrs.CursorLocation = adUseClient
  myrs.CursorType = adOpenKeyset
  myrs.LockType = adLockOptimistic
  myrs.Source = "DELETE FROM t_spbillofmaterials"
  myrs.Open
 
End Sub
Private Sub SSTab1_Click(PreviousTab As Integer)

  If SSTab1.TabIndex = 0 Then
        Set rs2 = Nothing
        rs2.ActiveConnection = "dsn=dbw;uid=sa"
       
        rs2.CursorLocation = adUseClient
        rs2.CursorType = adOpenDynamic
        rs2.LockType = adLockOptimistic
        rs2.Source = "select * from t_spgeneralpartplan where added='否'"
        rs2.Open
        Set DataGrid2.DataSource = rs2
            DataGrid2.Refresh
        Call first(DataGrid2)
        Call initial(DataGrid2, "零件表")
End If

End Sub

'drawingnumber为产品名称，quantitys为计划数量，pcocdssquatos为产品定额，manchine1 为设备的占用时间，manchine2为设备工作效率，
Public Sub mpop(quantitys As Integer, processquatos As Single, mach1() As Single, mach2() As Single)
    Dim i As Integer, j As Integer, k As Integer, l As Integer, m As Integer
    Dim min, ave As Single
    m = UBound(mach1)
    ReDim c(m)
    For i = 1 To m
      c(i) = 0       '初始化每台设备的任务量为0
    Next i
       
   For i = 1 To quantitys '将n个任务依次分配到m太设备上
      k = 1
      min = mach1(1) + processquatos / mach2(1)
      For j = 2 To m       '找出设备占用时间最小的，并将任务分配给他
         ave = mach1(j) + processquatos / mach2(j)
         If (ave < min) Then
            min = ave
            k = j
         End If
       Next j
       mach1(k) = min
       c(k) = c(k) + 1
     Next i
End Sub
'根据已完工工序，获得未完工工序所需时间
Function GetRemainTime1(finishedprocess As String, drawno As String)
Dim tt As Integer
Dim rsf As New ADODB.Recordset
rsf.ActiveConnection = "dsn=dbw;uid=sa"
rsf.CursorLocation = adUseClient
rsf.CursorType = adOpenDynamic
rsf.LockType = adLockOptimistic
rsf.Source = "SELECT *  FROM t_machineprocess where drawingnumber='" & drawno & "'" & _
" and processnumber>=" & finishedprocess
rsf.Open
If rsf.RecordCount = 0 Then
    GetRemainTime1 = 0
Else
    tt = 0
    rsf.MoveFirst
    While Not rsf.EOF
        tt = rsf("timeoccupy") + tt
        rsf.MoveNext
    Wend
    GetRemainTime1 = tt
End If
rsf.Close

End Function
'根据已完工工序，获得未完工工序所需时间
Function GetTime1(drawno As String)
Dim tt As Integer
Dim rsf As New ADODB.Recordset
rsf.ActiveConnection = "dsn=dbw;uid=sa"
rsf.CursorLocation = adUseClient
rsf.CursorType = adOpenDynamic
rsf.LockType = adLockOptimistic
rsf.Source = "select *  from t_subprocessplan  where drawingnumber='" & drawno & "'"
rsf.Open
'若允许随机排序，须减去数组finishedprocess()中的工序
If rsf.RecordCount = 0 Then
    GetTime1 = 0
Else
    tt = 0
    rsf.MoveFirst
    While Not rsf.EOF
        tt = rsf("elapsetime") + tt
        rsf.MoveNext
    Wend
    GetTime1 = tt
End If
rsf.Close

End Function