frmworkshop.frm

采用面向负荷控制技术

sql = "select * from device where deviceno='" & dno & "'"
mrs.CursorLocation = adUseClient
mrs.Open sql, mconn, adOpenKeyset, adLockPessimistic
If mrs.RecordCount = 0 Then
    MsgBox "no record in device,", vbOKOnly
    mrs.Close
    Exit Sub
End If
mrs.MoveFirst
Set itmX = LVDevice.ListItems.Add(, , CStr(mrs("deviceno")))
itmX.Icon = iconno   '设置 ImageList1 中的一个图标。
itmX.SmallIcon = iconno   '设置 ImageList2 中的一个图标。

If Not IsNull(mrs("model")) Then
   itmX.SubItems(1) = CStr(mrs("model"))
End If
   
If Not IsNull(mrs("orderdate")) Then
   itmX.SubItems(2) = mrs("orderdate")
End If
If Not IsNull(mrs("status")) Then
  itmX.SubItems(3) = CStr(mrs("status"))
End If
If Not IsNull(mrs("operatorstatus")) Then
  itmX.SubItems(4) = CStr(mrs("operatorstatus"))
End If
If Not IsNull(mrs("qualitystatus")) Then
  itmX.SubItems(5) = CStr(mrs("qualitystatus"))
End If
mrs.Close
End Sub
Sub initdevice(param As String)
Dim Device(10) As String, sql As String
Dim i As Integer
Dim sPre As String, model As String
Dim rs0 As New ADODB.Recordset
Set rs0 = Nothing

'sql = "select * from device "
sql = "SELECT device.*, t_submachineload.drawingnumber as partdrawno,t_submachineload.processnumber as partgongxu,"
sql = sql & "t_submachineload.timeoccupy as occupied,t_submachineload.quantity as disquantited  FROM Device LEFT OUTER JOIN "
sql = sql & "t_submachineload ON device.deviceno = t_submachineload.machinenumber"
If param <> "全部设备" Then
    sql = sql & " where device.model='" & param & "'"
End If
Set mrs = Nothing
mrs.CursorLocation = adUseClient
mrs.Open sql, mconn, adOpenKeyset, adLockPessimistic
If mrs.RecordCount = 0 Then
    MsgBox "Device empty", vbOKOnly
    mrs.Close
    Exit Sub
End If
Device(1) = "名称"
Device(0) = "编号"
Device(2) = "产品图号"
Device(3) = "工序号"
Device(4) = "占用时间"
Device(5) = "派工数量"
sPre = "无"
   '为 ColumnHeader 对象创建对象变量。
   Dim clmX As ColumnHeader
   LVDevice.ColumnHeaders.Clear
   For i = 0 To 5
      Set clmX = LVDevice.ColumnHeaders.Add(, , Device(i), LVDevice.Width / 4)
   Next
   LVDevice.BorderStyle = ccFixedSingle '设置 BorderStyle 属性。
   LVDevice.View = lvwReport '设置 View 属性为报表型。
   Dim itmX As ListItem
    mrs.MoveFirst
    i = 1
    LVDevice.ListItems.Clear
   While Not mrs.EOF
      Set itmX = LVDevice.ListItems.Add(, , CStr(mrs("deviceno")))
      itmX.Icon = i  '设置 ImageList1 中的一个图标。
      itmX.SmallIcon = i  '设置 ImageList2 中的一个图标。
      If Not IsNull(mrs("devicename")) Then
         itmX.SubItems(1) = CStr(mrs("devicename"))
      Else
         itmX.SubItems(1) = sPre
      End If
      If Not IsNull(mrs("partdrawno")) Then
        itmX.SubItems(2) = mrs("partdrawno")
      Else
         itmX.SubItems(2) = sPre
      End If
      If Not IsNull(mrs("partgongxu")) Then
        itmX.SubItems(3) = mrs("partgongxu")
      Else
         itmX.SubItems(3) = sPre
      End If
      If Not IsNull(mrs("occupied")) Then
        itmX.SubItems(4) = CStr(mrs("occupied"))
      Else
         itmX.SubItems(4) = sPre
      End If
      If Not IsNull(mrs("disquantited")) Then
        itmX.SubItems(5) = CStr(mrs("disquantited"))
      Else
         itmX.SubItems(5) = CStr(sPre)
      End If
      mrs.MoveNext  '移动到下一条记录。
      i = i + 1
      If i > imlD.ListImages.Count Then
      i = 1
      End If
    Wend
    mrs.Close
End Sub
Sub initdevice_old(param As String)
Dim sql As String, rs0 As New ADODB.Recordset, model As String
If param <> "全部设备" Then
    sql = "select model from deviceclass where name='" & cbo_select.Text & "'"
    rs0.CursorLocation = adUseClient
    rs0.Open sql, mconn, adOpenKeyset, adLockPessimistic
    rs0.MoveFirst
    model = rs0(0)
    rs0.Close
End If
sql = "SELECT device.*, t_submachineload.drawingnumber,t_submachineload.processnumber,"
sql = sql & "t_submachineload.timeoccupy,t_submachineload.quantity FROM Device LEFT OUTER JOIN "
sql = sql & "t_submachineload ON device.deviceno = t_submachineload.machinenumber"
If param <> "全部设备" Then
    sql = sql & " where device.model='" & model & "'"
End If
Set mrs = Nothing
mrs.CursorLocation = adUseClient
mrs.Open sql, mconn, adOpenKeyset, adLockPessimistic
If mrs.RecordCount = 0 Then
    Set dgd_workshop.DataSource = Nothing
    dgd_workshop.Refresh
Else
    mrs.MoveFirst
    Set dgd_workshop.DataSource = mrs
    dgd_workshop.Refresh
    dgd_workshop.Columns.Item(0).Caption = "设备编号"
    dgd_workshop.Columns(0).Width = 0.7 * (dgd_workshop.Width + 600) / 3
    dgd_workshop.Columns.Item(1).Caption = "设备名称"
    dgd_workshop.Columns(1).Width = 0.7 * (dgd_workshop.Width + 600) / 3
    dgd_workshop.Columns.Item(2).Caption = "设备类型"
    dgd_workshop.Columns(2).Width = 0.7 * (dgd_workshop.Width + 600) / 6
    dgd_workshop.Columns.Item(3).Caption = "购买日期"
    dgd_workshop.Columns.Item(4).Caption = "设备状态"
    dgd_workshop.Columns.Item(5).Caption = "操作员情况"
    dgd_workshop.Columns.Item(6).Caption = "产品质量状态"
    dgd_workshop.Columns.Item(7).Caption = "产品图号"
    dgd_workshop.Columns.Item(8).Caption = "工序号"
    dgd_workshop.Columns.Item(9).Caption = "占用时间"
    dgd_workshop.Columns.Item(10).Caption = "派工数量"
End If

End Sub


Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)
Dim sql As String, rs0 As New ADODB.Recordset, i As Integer
Select Case Button.Key
    Case "device"
        For i = 1 To Toolbar1.Buttons.Count
            If Toolbar1.Buttons(i).Value = tbrPressed Then
                Toolbar1.Buttons(i).Value = tbrUnpressed
            End If
        Next
        Toolbar1.Buttons(1).Value = tbrPressed
        LVDeviceClass.Visible = True
        LVDevice.Visible = True
        tv.Visible = False
        frm_product.Visible = False
        frm_dc.Visible = True
        cmd_show.Caption = "显示工艺"
        'cmd_show.Visible = True
        cmd_show.Enabled = False
        Label2(1).Caption = "选择设备类型"
        sql = "select name from deviceclass "
        rs0.CursorLocation = adUseClient
        rs0.Open sql, mconn, adOpenKeyset, adLockPessimistic
        rs0.MoveFirst
        sql = rs0(0)
        cbo_select.Clear
        While Not rs0.EOF
            cbo_select.AddItem rs0(0)
            rs0.MoveNext
        Wend
        rs0.Close
        cbo_select.AddItem "全部设备"
        cbo_select.Text = sql

        Call InitDeviceClass(cbo_select.Text)
        sql = "select model from deviceclass where name='" & cbo_select.Text & "'"
        rs0.Open sql, mconn, adOpenKeyset, adLockPessimistic
        sql = rs0(0)
        rs0.Close
        Call initdevice(sql)
    Case "product"
        For i = 1 To Toolbar1.Buttons.Count
            If Toolbar1.Buttons(i).Value = tbrPressed Then
                Toolbar1.Buttons(i).Value = tbrUnpressed
            End If
        Next
        Toolbar1.Buttons(2).Value = tbrPressed
        LVDeviceClass.Visible = False
        LVDevice.Visible = False
        tv.Visible = True
        frm_product.Visible = True
        frm_d.Visible = False
        frm_dc.Visible = False
        Label2(1).Caption = "选择产品"
        Call initprodrawno
        cmd_show.Caption = "显示工艺"
        'cmd_show.Visible = True
        cmd_show.Enabled = False
        
    Case "quit"
        Call cmd_exit_Click
End Select
End Sub
Sub alter_material()

End Sub
Sub add_machineload()
Call insert_machineload
Call alter_material




End Sub
Sub insert_machineload(dno As String, pno As String, drawno As String, tocu As Single, quantity As Integer)
Dim sql As String, rs0 As New ADODB.Recordset
sql = "select * from t_submachineload"
rs0.CursorLocation = adUseClient
rs0.Open sql, mconn, adOpenKeyset, adLockPessimistic
rs0.AddNew
rs0("machinenumber") = dno
rs0("processnumber") = pno
rs0("drawingnumber") = drawno
rs0("timeoccupy") = tocu
rs0("quantity") = quantity
rs0.Update
rs0.Close

End Sub

Sub GetLoad(dev As String, ByRef pload() As Single)
'返回设备总负载,pload(0)为sum occupied,pload(1)为sum disquantited
Dim sql As String, sumocc As Single, sumquan As Single
Dim rs As New ADODB.Recordset

pload(0) = 0
pload(1) = 0
sql = "select * from t_submachineload where machinenumber='" & dev & "'"
rs.CursorLocation = adUseClient
rs.Open sql, mconn, adOpenKeyset, adLockPessimistic
If rs.RecordCount > 0 Then
    rs.MoveFirst
    While Not rs.EOF
        pload(0) = pload(0) + rs("timeoccupy")
        pload(1) = pload(1) + rs("quantity")
        rs.MoveNext
    Wend
    
End If
rs.Close

End Sub
'得到设备的加工工艺表
Sub GetDeviceProcess(dno As String)
Dim sql As String
Dim rs As New ADODB.Recordset
sql = "select drawingnumber,partname,processnumber,processname from t_subpmreference where machinenumber='" & dno & "' order by " & "drawingnumber,processnumber"

Set mrs = Nothing
mrs.CursorLocation = adUseClient
mrs.Open sql, mconn, adOpenKeyset, adLockPessimistic
If mrs.RecordCount = 0 Then
    MsgBox "没有该设备的工艺信息", vbOKOnly
    mrs.Close
    Exit Sub
End If
mrs.MoveFirst
Set dgd_workshop.DataSource = mrs
dgd_workshop.Refresh
End Sub

'Sub GetProcessMatrix(pno As String, pm() As ProcessMatrix)
Sub GetProcessMatrix(pno As String)
Dim sql As String, i As Integer
Dim rs As New ADODB.Recordset

sql = "select processname,processnumber,machinenumber,elapsetime from t_subpmreference where drawingnumber='" & pno & "' order by processnumber"
Set mrs = Nothing
mrs.CursorLocation = adUseClient
mrs.Open sql, mconn, adOpenKeyset, adLockPessimistic
ReDim pm(1)
If mrs.RecordCount > 0 Then
    ReDim pm(mrs.RecordCount)
    i = 0
    mrs.MoveFirst
    While Not mrs.EOF
        pm(i).processname = mrs("processname") & "(" & mrs("processnumber") & ")"
        pm(i).deviceno = mrs("machinenumber")
        pm(i).otime = mrs("elapsetime")
        i = i + 1
        mrs.MoveNext
    Wend
End If

End Sub

'Sub ShowProcessMatrix(pm() As ProcessMatrix)
Sub ShowProcessMatrix(pno As String)
Dim FixedCol As String, FixedRow As String
Dim i As Integer, j As Integer, pcnt As Integer

Call GetProcessMatrix(pno)
FixedCol = ""
FixedRow = ""
For i = 0 To UBound(pm)
    FixedCol = "|" & FixedCol & pm(i).processname
    FixedRow = "|" & FixedRow & pm(i).deviceno
Next i
pcnt = GetDistinctStringAmount(FixedRow)
msgPMat.FormatString = FixedRow & ";" & FixedCol
For i = 1 To UBound(pm)
    For j = 1 To UBound(pm)
        msgPMat.TextMatrix(i, j) = pm((i - 1) * pcnt + j - 1).processname
    Next j
Next i

End Sub

Function GetDistinctStringAmount(pstr As String)
Dim str0, deststr() As String, flag As Boolean
Dim k As Integer, j As Integer, i As Integer
str0 = Split(pstr, "|")
ReDim deststr(1)
deststr(0) = str0(0)
k = 1
For j = 1 To UBound(str0) - 1
    flag = True
    For i = 0 To UBound(deststr) - 1
        If str0(j) = deststr(i) Then
            flag = False
            Exit For
        End If
    Next i
    If flag Then
         ReDim Preserve deststr(k + 1)
         k = k + 1
         deststr(k - 1) = str0(j)
         'ReDim Preserve deststr(UBound(deststr) + 1)
         'deststr(UBound(deststr) - 1) = str0(j)
    End If
Next j
GetDistinctStringAmount = k
'GetDistinctStringAmount = ubound(deststr)
End Function

Sub initprodrawno()
Dim sql As String
Dim rs0 As New ADODB.Recordset

'cmd_show.Caption = "显示工艺矩阵"
Me.MousePointer = ccHourglass
cbo_select.Clear
Set rs0 = Nothing
sql = "select distinct fname from t_bom "
'sql = "select distinct pardrawingnumber from t_spbillofmaterial "
rs0.CursorLocation = adUseClient
rs0.Open sql, mconn, adOpenKeyset, adLockPessimistic
rs0.MoveFirst
sql = rs0(0)
While Not rs0.EOF
    cbo_select.AddItem rs0(0)
    rs0.MoveNext
Wend
rs0.Close
cbo_select.Text = sql
Me.MousePointer = ccDefault
End Sub

Sub Initdgdtask_old()
Dim sql As String
Dim i As Integer, j As Integer
Dim rs0 As New ADODB.Recordset
sql = "select workcode,ordercode,prodrawingnumber,drawingnumber,state,endstate,pargroupamount,planquantity,acceptdate,senddate from t_spgeneralpartplan"
rs0.CursorLo