frmworkshop.frm

采用面向负荷控制技术

        rs0.Close
    Else
        sql = "全部设备"
    End If
    Call initdevice(sql)
ElseIf Label2(1).Caption = "选择产品" Then
    sql = "select father, pargroupamount from t_bom where fname='" & cbo_select.Text & "'"
    'sql = "select prodrawingnumber, pargroupamount from t_spbillofmaterial where pardrawingnumber='" & cbo_select.Text & "'"
    rs0.Open sql, mconn, adOpenKeyset, adLockPessimistic
    sql = rs0(0): sno = rs0(1)
    rs0.Close
    Me.MousePointer = vbHourglass
    bom = showbom(sql, cbo_select.Text, tv, sno)
    Me.MousePointer = vbDefault
End If
End Sub

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

sql = "select * from device"
rs0.CursorLocation = adUseClient
rs0.Open sql, mconn, adOpenKeyset, adLockPessimistic
rs0.AddNew
For i = 0 To rs0.Fields.Count - 2
   rs0.Fields(i) = Trim(d_txt(i).Text)
Next
rs0.Update
rs0.Close
End Sub


Private Sub cmd_Del_Click()
Dim sql As String, yn As Integer
Dim rs0 As New ADODB.Recordset

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"
rs0.CursorLocation = adUseClient
rs0.Open sql, mconn, adOpenKeyset, adLockPessimistic
If rs0("disquantited") > 0 Or rs0("occupied") > 0 Then
    MsgBox "尚有任务未完成，不能删除该设备", vbOKOnly
    rs0.Close
    Exit Sub
End If
yn = MsgBox("", vbYesNo)
If yn = vbYes Then
    rs0.Delete
End If
rs0.Close
End Sub

Private Sub cmd_exit_Click()
Set mrs = Nothing
Set mconn = Nothing
fMainForm.mnusysworkshop.Enabled = True
Unload Me
End Sub

Private Sub cmd_show_Click()
'Select Case cmd_show.Caption
'    Case "显示工艺"
'        Call GetDeviceProcess(cmd_show.Tag)
'    Case "显示工艺路线矩阵"
'        msgPMat.Visible = True
'        dgd_workshop.Visible = False
'        Call ShowProcessMatrix(cmd_show.Tag)
'End Select
If (Label2(1).Caption = "选择设备类型") Then
    Me.Tag = "负荷中心工艺信息"
    Me.Tag = Me.Tag & "|" & d_txt(8).Text
ElseIf Label2(1).Caption = "选择产品" Then
    Me.Tag = "产品工艺信息"
    Me.Tag = Me.Tag & "|" & bom_txt(3).Text
End If

frmProcess.Show vbModal
End Sub

Private Sub dgd_workshop_Click()
Select Case cmd_show.Caption
    Case "显示工艺路线矩阵"
        cmd_show.Tag = mrs("son")
        cmd_show.Enabled = True
    Case "显示工艺"
        'cmd_show.Enabled = True
End Select


End Sub


Private Sub cmdReject_Click()
Dim sql As String
Dim i As Integer, j As Integer
Dim rs0 As New ADODB.Recordset
sql = "select workcode,ordercode,prodrawingnumber,drawingno,processno,pargroupamount,planquantity  from t_myplantask where note like '-1%'"

rs0.CursorLocation = adUseClient
rs0.Open sql, mconn, adOpenKeyset, adLockPessimistic
'mshdgd_task.caption="任务列表"
mshdgd_task.FormatString = "<工作号|<订单号|<父  件  图  号|<产  品  图  号|<工序号|< 台份数量|<计划数量"
' rs("finishdate")计划完工日期
If rs0.RecordCount = 0 Then
    MsgBox "", vbOKOnly
    rs0.Close
    Exit Sub
End If
If (rs0.RecordCount > 0) Then
  rs0.MoveFirst
  For i = 1 To rs0.RecordCount
    mshdgd_task.AddItem ""
    mshdgd_task.row = i
    For j = 0 To rs0.Fields.Count - 1
        mshdgd_task.col = j
        If Not IsNull(rs0(j)) Then
            mshdgd_task.Text = rs0(j)
        Else
            mshdgd_task.Text = "$"
        End If
    Next j
    rs0.MoveNext
  Next i
End If
rs0.Close

End Sub

Private Sub cmdFresh_Click()
Call Initdgdtask(optRej.Value)
End Sub

Private Sub Form_Unload(Cancel As Integer)
    Call cmd_exit_Click
End Sub

Private Sub LVDevice_ColumnClick(ByVal ColumnHeader As MSComctlLib.ColumnHeader)
bflag = Not bflag
If bflag Then
    LVDevice.SortOrder = lvwAscending
Else
    LVDevice.SortOrder = lvwDescending
End If
LVDevice.Refresh
End Sub

Private Sub LVDevice_ItemClick(ByVal Item As MSComctlLib.ListItem)
Dim i As Integer
Dim rs0 As New ADODB.Recordset
Dim sql As String
cmd_show.Enabled = True
frm_d.Visible = True
frm_dc.Visible = False
sql = "select * from device where deviceno='" & LVDevice.SelectedItem.Text & "'"
rs0.CursorLocation = adUseClient
rs0.Open sql, mconn, adOpenKeyset, adLockPessimistic
rs0.MoveFirst
    For i = 0 To rs0.Fields.Count - 2
    d_txt(i) = rs0.Fields(i)
    Next i

End Sub

Private Sub LVDevice_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim sstr As String
If Button = vbRightButton Then
    'PopupMenu mnuLVD
End If

End Sub

Private Sub LVDeviceClass_ColumnClick(ByVal ColumnHeader As MSComctlLib.ColumnHeader)
'bcflag = Not bcflag
'If bcflag Then
'    LVDeviceClass.SortOrder = lvwAscending
'Else
'    LVDeviceClass.SortOrder = lvwDescending
'End If
'LVDeviceClass.Refresh
End Sub

Private Sub LVDeviceClass_ItemClick(ByVal Item As MSComctlLib.ListItem)
Dim i As Integer, str0
Dim rs0 As New ADODB.Recordset
Dim sql As String
frm_d.Visible = False
frm_dc.Visible = True
sql = LVDeviceClass.SelectedItem.Text
str0 = Split(sql, "@")
sql = "select * from deviceclass where model='" & str0(0) & "'"
rs0.CursorLocation = adUseClient
rs0.Open sql, mconn, adOpenKeyset, adLockPessimistic
rs0.MoveFirst
For i = 0 To rs0.Fields.Count - 2
dc_txt(i) = rs0.Fields(i)
Next i
rs0.Close
sql = str0(0)
Call initdevice(sql)
End Sub

Private Sub LVDeviceClass_MouseDown1(Button As Integer, Shift As Integer, X As Single, Y As Single)

'If Button = vbRightButton Then
'    PopupMenu mnuLVDC
'End If
'MsgBox "LVDCselecteditem is : " & LVDeviceClass.SelectedItem, vbOKOnly
'MsgBox "LVDselecteditem is : " & LVDevice.SelectedItem, vbOKOnly
End Sub

Private Sub Form_Load()
Dim sql As String, rs0 As New ADODB.Recordset

mconn.Open gConnstr, "sa"
Me.WindowState = 2
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
Toolbar1.Buttons(1).Value = tbrPressed
frm_dc.Visible = True
frm_d.Visible = False
frm_product.Visible = False
tv.Visible = False
cmd_add.Enabled = False
cmd_del.Enabled = False
cmd_show.Enabled = False
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
optRej.Value = False
optAll.Value = True
Call initdevice(sql)
Call Initdgdtask(optRej.Value)
End Sub

Sub InitDeviceClass_old(param As String)
Dim sql As String, i As Integer
Set mrs = Nothing
sql = "select *  from deviceclass "
If param <> "全部设备" Then
    sql = sql & " where name='" & param & "' "
End If
sql = sql & " order by model"

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 = "数量"
End If

End Sub
Sub InitDeviceClass(param As String)
Dim DeviceClassName(4) As String, sql As String
Dim i As Integer

Set mrs_c = Nothing
sql = "select *  from deviceclass "
If param <> "全部设备" Then
    sql = sql & " where name='" & param & "' "
End If
sql = sql & " order by model"
mrs_c.CursorLocation = adUseClient
mrs_c.Open sql, mconn, adOpenKeyset, adLockPessimistic
If mrs_c.RecordCount = 0 Then
    MsgBox "DeviceClass empty", vbOKOnly
    mrs_c.Close
    Exit Sub
End If
DeviceClassName(0) = "型号"
DeviceClassName(1) = "名称"
DeviceClassName(2) = "数量"
DeviceClassName(3) = "使用年限"
LVDeviceClass.ColumnHeaders.Clear
  Dim clmX As ColumnHeader
For i = 0 To 3
   Set clmX = LVDeviceClass.ColumnHeaders.Add(, , DeviceClassName(i))
Next
   
LVDeviceClass.BorderStyle = ccFixedSingle '设置 BorderStyle 属性。
LVDeviceClass.View = lvwReport '设置 View 属性为小图标。
Dim itmX As ListItem
 mrs_c.MoveFirst
 For i = 0 To mrs_c.Fields.Count - 2
 dc_txt(i) = mrs_c.Fields(i)
 Next i
 i = 1
 LVDeviceClass.ListItems.Clear
   While Not mrs_c.EOF
      Set itmX = LVDeviceClass.ListItems.Add(, , CStr(mrs_c("model") & "@" & CStr(mrs_c("name"))))
      'itmX.Icon = i   '设置 ImageList1 中的一个图标。
      itmX.SmallIcon = i   '设置 ImageList2 中的一个图标。
      'If Not IsNull(mrs_c("name")) Then
      '   itmX.SubItems(1) = CStr(mrs_c("name"))
      'End If
      itmX.SubItems(1) = ""
      itmX.SubItems(2) = ""
      itmX.SubItems(3) = ""
      'If Not IsNull(mrs_c("amount")) Then
      '  itmX.SubItems(2) = mrs_c("amount")
      'End If
      'If Not IsNull(mrs_c("limit")) Then
      '  itmX.SubItems(3) = mrs_c("limit")
      'End If
      mrs_c.MoveNext  '移动到下一条记录。
      i = i + 1
      If i > imlDC.ListImages.Count Then
        i = 1
      End If
    Wend
    mrs_c.Close
End Sub
Sub AddDevice(devicemodel As String)
Dim sql As String, dno As String, brq As String, Sta As Integer, note As String
Dim i As Integer, OpStatus As Integer, DVQuality As Integer, ll As String
Dim str0

dno = devicemodel & "-%"

sql = "select * from device where deviceno like '" & dno & "' order by deviceno"
mrs.CursorLocation = adUseClient
mrs.Open sql, mconn, adOpenKeyset, adLockPessimistic
If mrs.RecordCount = 0 Then
    dno = devicemodel & "-01"
Else
    mrs.MoveLast
    str0 = Split(mrs("deviceno"), "-")
    i = val(str0(UBound(str0))) + 1
    ll = IIf((Len(CStr(i)) = 2), CStr(i), "0" & CStr(i))
    dno = devicemodel & "-" & ll
End If
i = (mrs.RecordCount + 1) Mod gIconAmount
mrs.Close

Sta = 8
OpStatus = 8
DVQuality = 8
note = " "
brq = Year(Date) & "-"
brq = brq & IIf((Len(Month(Date)) = 2), Month(Date), "0" & Month(Date)) & "-"
brq = brq & IIf((Len(Day(Date)) = 2), Day(Date), "0" & Day(Date))
Call InsertDevice(dno, devicemodel, brq, Sta, OpStatus, DVQuality, note)
Call DisplayDevice(dno, i)

End Sub

Sub InsertDevice(dno As String, dmo As String, rq As String, st As Integer, ost As Integer, dvq As Integer, bz As String)
Dim sql As String
Set mrs = Nothing
sql = "select * from device"
mrs.CursorLocation = adUseClient
mrs.Open sql, mconn, adOpenKeyset, adLockPessimistic
mrs.AddNew
mrs("deviceno") = Trim(dno)
mrs("model") = Trim(dmo)
mrs("orderdate") = Trim(rq)
mrs("status") = st
mrs("operatorstatus") = ost
mrs("qualitystatus") = dvq
mrs("note") = bz
mrs.Update
mrs.Close
End Sub
Sub DisplayDevice(dno As String, iconno As Integer)
Dim sql As String, itmX As ListItem
Dim i As Integer