frm_kcgl_wlrk.frm

PMS是一个生产管理系统,功能强大,供大家享用,希望大家支持!!

         BeginProperty ListImage4 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "Frm_Kcgl_Wlrk.frx":434B
            Key             =   ""
         EndProperty
         BeginProperty ListImage5 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "Frm_Kcgl_Wlrk.frx":59A5
            Key             =   ""
         EndProperty
         BeginProperty ListImage6 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "Frm_Kcgl_Wlrk.frx":6FFF
            Key             =   ""
         EndProperty
         BeginProperty ListImage7 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "Frm_Kcgl_Wlrk.frx":8659
            Key             =   ""
         EndProperty
         BeginProperty ListImage8 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "Frm_Kcgl_Wlrk.frx":9CB3
            Key             =   ""
         EndProperty
         BeginProperty ListImage9 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "Frm_Kcgl_Wlrk.frx":B30D
            Key             =   ""
         EndProperty
         BeginProperty ListImage10 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "Frm_Kcgl_Wlrk.frx":C967
            Key             =   ""
         EndProperty
         BeginProperty ListImage11 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "Frm_Kcgl_Wlrk.frx":DFC1
            Key             =   ""
         EndProperty
      EndProperty
   End
End
Attribute VB_Name = "Frm_Kcgl_Wlrk"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim i As Integer, Myval As Integer     '定义整型变量
Public blnadd1 As Boolean
Dim Mystr As String   '定义字符变量存储编号信息
Dim rs3 As New ADODB.Recordset
Dim rs4 As New ADODB.Recordset
Dim rs5 As New ADODB.Recordset
Dim rs6 As New ADODB.Recordset
Dim rs7 As New ADODB.Recordset
Dim Myrs As New ADODB.Recordset
Dim Mytotal As String
Dim MyBh, MySl As String  '定义字符变量存储物料编号和数量

Sub view_data()     '定义显示数据的过程
  If Adodc1.Recordset.RecordCount > 0 Then
     With Dgr_Wlrk
        If .Columns(0) <> "" Then Text1(0).Text = .Columns(0) Else Text1(0).Text = ""
        If .Columns(1) <> "" Then Cbx_wlbh.Text = .Columns(1) Else Cbx_wlbh.Text = ""
        If .Columns(2) <> "" Then Text1(1).Text = .Columns(2) Else Text1(1).Text = ""
        If .Columns(3) <> "" Then Text1(2).Text = .Columns(3) Else Text1(2).Text = ""
        If .Columns(4) <> "" Then Text1(3).Text = .Columns(4) Else Text1(3).Text = ""
        If .Columns(5) <> "" Then Text1(4).Text = .Columns(5) Else Text1(4).Text = ""
        If .Columns(6) <> "" Then Dtp_Rkrq.Value = .Columns(6) Else Dtp_Rkrq.Value = Date
        If .Columns(7) <> "" Then Text1(5).Text = .Columns(7) Else Text1(5).Text = ""
     End With
  End If
End Sub

'Private Sub Cbx_Wlbh_Change()
'rs3.Open "select * from tb_SCGL_wlxx where wlxx_id='" + Cbx_wlbh + "'", cnn, adOpenKeyset
'If rs3.RecordCount > 0 Then
'  Text1(1).Text = rs3.Fields("wlxx_wlmc")
'  Text1(2).Text = rs3.Fields("wlxx_wlgg")
'  Text1(3).Text = rs3.Fields("wlxx_wldw")
'End If
'rs3.Close
'
'Myrs.Open "select * from tb_SCGL_wlxx where wlxx_id ='" + Cbx_wlbh + "'", cnn, adOpenKeyset
'If Myrs.RecordCount <= 0 Then
'   MsgBox "请输入正确的物料编号信息！", , "信息提示"
'   Cbx_wlbh.ListIndex = 0
'   Cbx_wlbh.SetFocus
'   Myrs.Close
'   Exit Sub
'End If
'Myrs.Close
'End Sub

Private Sub Cbx_wlbh_Click()
rs3.Open "select * from tb_SCGL_wlxx where wlxx_id='" + Cbx_wlbh + "'", cnn, adOpenKeyset
If rs3.RecordCount > 0 Then
  Text1(1).Text = rs3.Fields("wlxx_wlmc")
  Text1(2).Text = rs3.Fields("wlxx_wlgg")
  Text1(3).Text = rs3.Fields("wlxx_wldw")
End If
rs3.Close

Myrs.Open "select * from tb_SCGL_wlxx where wlxx_id ='" + Cbx_wlbh + "'", cnn, adOpenKeyset
If Myrs.RecordCount <= 0 Then
   MsgBox "请输入正确的物料编号信息！", , "信息提示"
   Cbx_wlbh.ListIndex = 0
   Cbx_wlbh.SetFocus
   Myrs.Close
   Exit Sub
End If
Myrs.Close
End Sub

Private Sub Cbx_wlbh_GotFocus()
Cbx_wlbh.BackColor = &HFFFF80
End Sub

Private Sub Cbx_wlbh_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = 13 Then Text1(1).SetFocus
End Sub

Private Sub Cbx_wlbh_LostFocus()
Cbx_wlbh.BackColor = &HFFFFFF
rs3.Open "select * from tb_SCGL_wlxx where wlxx_id='" + Cbx_wlbh + "'", cnn, adOpenKeyset
If rs3.RecordCount > 0 Then
  Text1(1).Text = rs3.Fields("wlxx_wlmc")
  Text1(2).Text = rs3.Fields("wlxx_wlgg")
  Text1(3).Text = rs3.Fields("wlxx_wldw")
End If
rs3.Close

Myrs.Open "select * from tb_SCGL_wlxx where wlxx_id ='" + Cbx_wlbh + "'", cnn, adOpenKeyset
If Myrs.RecordCount <= 0 Then
   MsgBox "请输入正确的物料编号信息！", , "信息提示"
   Cbx_wlbh.ListIndex = 0
   Cbx_wlbh.SetFocus
   Myrs.Close
   Exit Sub
End If
Myrs.Close

End Sub

Private Sub Dgr_Wlrk_Click()
view_data
End Sub

Private Sub Dtp_Rkrq_GotFocus()
Dtp_Rkrq.CalendarBackColor = &HFFFF80
End Sub

Private Sub Dtp_Rkrq_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = 13 Then Text1(5).SetFocus
End Sub

Private Sub Dtp_Rkrq_LostFocus()
Dtp_Rkrq.CalendarBackColor = &HFFFFFF
End Sub

Private Sub Form_Activate()
  Adodc1.ConnectionString = PublicStr
  If sql <> "" Then
     Adodc1.RecordSource = sql & " order by wlrk_rkid"
     Adodc1.Refresh
     Call view_data     '调用过程
     If Adodc1.Recordset.RecordCount = 0 Then
        MsgBox "没有找到符合条件的记录！", , "提示窗口"
     End If
  End If
 Call Dgr_Title
 End Sub

Sub Dgr_Title()
  Dgr_Wlrk.Columns(0).Caption = "物料入库编号"
  Dgr_Wlrk.Columns(1).Caption = "物料编号"
  Dgr_Wlrk.Columns(2).Caption = "物料名称"
  Dgr_Wlrk.Columns(3).Caption = "物料规格"
  Dgr_Wlrk.Columns(4).Caption = "物料单位"
  Dgr_Wlrk.Columns(5).Caption = "入库数量"
  Dgr_Wlrk.Columns(6).Caption = "入库日期"
  Dgr_Wlrk.Columns(7).Caption = "备注信息"
End Sub

Private Sub Form_Load()
  '向设备编号中添加数据项
  Dim rs2 As New ADODB.Recordset
  rs2.Open "select * from tb_SCGL_wlxx", cnn, adOpenKeyset
  If rs2.RecordCount > 0 Then
    Cbx_wlbh.Clear
    For i = 0 To rs2.RecordCount - 1
         Cbx_wlbh.AddItem Trim(rs2.Fields("wlxx_id"))
         rs2.MoveNext
    Next i
  End If
  rs2.Close
  Cbx_wlbh.Text = "请选择物料编号"
  
  tlbState Toolbar1, False
  view_data
  '设置DataGrid标题
  Call Dgr_Title
  '设置控件状态
  For i = 0 To 5
      Text1(i).Enabled = False
  Next i
  Dtp_Rkrq.Enabled = False
  Cbx_wlbh.Enabled = False
  End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
sql = ""
End Sub

Private Sub Text1_GotFocus(Index As Integer)
  Text1(Index).BackColor = &HFFFF80
  Text1(Index).SelStart = 0
  Text1(Index).SelLength = Len(Text1(Index))
End Sub

Private Sub text1_KeyPress(Index As Integer, KeyAscii As Integer)
If KeyAscii = 13 Then
'  If Index = 4 Then
''     Dtp_Rkrq.SetFocus
'     Exit Sub
'  End If
  If Index = 5 Then Exit Sub
  Text1(Index + 1).SetFocus
End If
End Sub

Private Sub Text1_LostFocus(Index As Integer)
  Text1(Index).BackColor = &HFFFFFF
  If Index = 4 Then
    If Not IsNumeric(Text1(4).Text) Then
       MsgBox "请输入正确的数量信息", , "信息提示"
       Text1(4).SetFocus
       Text1(4).Text = ""
       Exit Sub
    End If
    If Text1(4).Text = "" Then
      MsgBox "入库数量不能为空！", , "信息提示"
      Text1(4).Text = ""
      Text1(4).SetFocus
      Exit Sub
    End If
  End If
End Sub

Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)
  Select Case Button.key
    Case "add"   '添加
       blnadd1 = True
       tlbState Toolbar1, True
       '自动创建编号
       Mystr = Left(Date, 4) + Right(Left(Date, 7), 2) + Right(Date, 2)
       Dim rs1 As New ADODB.Recordset
       rs1.Open "select * from tb_SCGL_wlrk  where wlrk_rkid like+ '%'+'" + Mystr + "'+'%' order by wlrk_rkid", cnn, adOpenKeyset
       If rs1.RecordCount > 0 Then
          If rs1.EOF = False Then rs1.MoveLast
          Text1(0).Text = "WLRK" + Mystr + "D" + Format(Val(Right(Trim(rs1.Fields("wlrk_rkid")), 3)) + 1, "###000") '编号自动加1
       Else
          Text1(0).Text = "WLRK" + Mystr + "D001"
       End If
       rs1.Close     '关闭数据集对象
       '设置控件状态
       For i = 1 To 5
         Text1(i).Enabled = True
         Text1(i).Text = ""
       Next i
       For i = 1 To 3
         Text1(i).Locked = True
       Next i
       Dtp_Rkrq.Enabled = False
       Dtp_Rkrq.Value = Date
       Cbx_wlbh.Enabled = True
       Cbx_wlbh.SetFocus
       For i = 8 To 11
             Toolbar1.Buttons(i).Enabled = False
         Next i
    Case "modify"    '修改
       If Adodc1.Recordset.RecordCount > 0 Then
         blnadd1 = False
         tlbState Toolbar1, True
          view_data
         For i = 1 To 5
             Text1(i).Enabled = True
         Next i
          For i = 1 To 3
             Text1(i).Locked = True
          Next i
          Dtp_Rkrq.Enabled = True
          Cbx_wlbh.Enabled = True
          Cbx_wlbh.SetFocus
         For i = 8 To 11
             Toolbar1.Buttons(i).Enabled = False
         Next i
       Else
         MsgBox "系统没有要修改的数据！", , "生产管理系统"
       End If
    Case "delete"    '删除
       If Adodc1.Recordset.RecordCount > 0 Then
              Adodc1.Recordset.Delete
              Unload Me
              Adodc1.Refresh
              Frm_Kcgl_Wlrk.Show 1
       Else
         MsgBox "系统没有要删除的数据！", , "提示窗口"
       End If
    Case "save"   '保存
      On Error GoTo SaveErr     '出现错误转向错误处理
      If blnadd1 = False Then
        Set rs1 = New ADODB.Recordset
        rs1.Open "select * from tb_SCGL_wlrk where wlrk_rkid='" + Text1(0).Text + "'", cnn, adOpenKeyset
        If rs1.RecordCount > 0 Then
           Myval = MsgBox("您确实要修改这条数据吗？", vbYesNo)
           If Myval = vbYes Then
              MyBh = rs1.Fields("wlrk_wlbh")
              MySl = rs1.Fields("wlrk_rksl")
             rs7.Open "select * from tb_SCGL_wlkc where wlkc_wlbh='" + MyBh + "'", cnn, adOpenKeyset
             If rs7.RecordCount > 0 Then
                MySl = Val(rs7.Fields("wlkc_kcsl")) - Val(MySl)
                cnn.Execute ("update tb_SCGL_wlkc set wlkc_kcsl='" + MySl + "'where wlkc_wlbh='" + MyBh + "'")
             End If
             rs7.Close
             cnn.Execute ("update tb_SCGL_wlrk set wlrk_wlbh='" + Cbx_wlbh.Text + "',wlrk_wlmc='" + Text1(1).Text + "',wlrk_wlgg='" + Text1(2).Text + _
              "',wlrk_jldw='" + Text1(3).Text + "',wlrk_rksl='" + Text1(4) + "',wlrk_rkrq='" + str(Dtp_Rkrq.Value) + "',wlrk_bz='" + Text1(5) + "' where wlrk_rkid='" + Text1(0) + "'")
              rs7.Open "select * from tb_SCGL_wlkc where wlkc_wlbh='" + Cbx_wlbh.Text + "'", cnn, adOpenKeyset
              If rs7.RecordCount > 0 Then
                 cnn.Execute ("update tb_SCGL_wlkc set wlkc_kcsl='" + str(Val(rs7.Fields("wlkc_kcsl")) + Val(Text1(4).Text)) + "' where wlkc_wlbh='" + Cbx_wlbh.Text + "'")
              Else
                 cnn.Execute ("insert into tb_SCGL_wlkc values('" + Cbx_wlbh.Text + "','" + Text1(1).Text + "','" + Text1(2).Text + "','" + Text1(3).Text + "','" + Text1(4).Text + "' )")
              End If
              rs7.Close
              Adodc1.Refresh
              Set Dgr_Wlrk.DataSource = Adodc1
              Call Dgr_Title
           End If
        End If
        rs1.Close
      Else
        Set rs6 = New ADODB.Recordset
        rs6.Open "tb_SCGL_cprk", cnn, adOpenKeyset, adLockOptimistic
        '添加新纪录
        cnn.Execute ("insert into tb_SCGL_wlrk (wlrk_rkid,wlrk_wlbh,wlrk_wlmc,wlrk_wlgg,wlrk_jldw,wlrk_rksl,wlrk_rkrq,wlrk_bz) values ('" + Text1(0).Text + "','" + Cbx_wlbh.Text + "','" + Text1(1).Text + "','" + Text1(2).Text + "','" + Text1(3).Text + "',' " + Text1(4).Text + " ','" + str(Dtp_Rkrq.Value) + "','" + Text1(5).Text + "')")
        rs5.Open "select * from tb_SCGL_wlkc where wlkc_wlbh='" + Cbx_wlbh.Text + "'", cnn, adOpenKeyset
        If rs5.RecordCount > 0 Then
          Mytotal = Val(Text1(4).Text) + rs5.Fields("wlkc_kcsl")
          cnn.Execute ("update tb_SCGL_wlkc set wlkc_kcsl='" + str(Mytotal) + "' where wlkc_wlbh='" + Cbx_wlbh.Text + "'")
        Else
          cnn.Execute ("insert into tb_SCGL_wlkc (wlkc_wlbh,wlkc_wlmc,wlkc_wlgg,wlkc_wldw,wlkc_kcsl) values('" + Cbx_wlbh.Text + "','" + Text1(1).Text + "','" + Text1(2).Text + "','" + Text1(3).Text + "','" + Text1(4).Text + "')")
        End If
        rs5.Close
        Adodc1.Refresh
        Set Dgr_Wlrk.DataSource = Adodc1
        Call Dgr_Title
      End If
      Call Dgr_Title
      For i = 0 To 5
         Text1(i).Enabled = False
      Next i
         Dtp_Rkrq.Enabled = False
         Cbx_wlbh.Enabled = False
         tlbState Toolbar1, False
      For i = 8 To 11
          Toolbar1.Buttons(i).Enabled = True
      Next i
      Exit Sub
SaveErr:    '错误处理
      MsgBox Err.Description, , "信息提示"
    Case "cancel"
      view_data
      For i = 0 To 5
         Text1(i).Enabled = False
      Next i
        Dtp_Rkrq.Enabled = False
        Cbx_wlbh.Enabled = False
      tlbState Toolbar1, False
      For i = 8 To 11
          Toolbar1.Buttons(i).Enabled = True
      Next i
    Case "find"
      Tb = "tb_SCGL_wlrk"
      Load Frm_Cxct
      Frm_Cxct.Show 1
    Case "first"     '移到第一条记录
      If Adodc1.Recordset.BOF = False Then Adodc1.Recordset.MoveFirst
      Call view_data     '调用过程
      Call Dgr_Title
    Case "previous"     '移到上一条记录
      If Adodc1.Recordset.RecordCount > 0 Then
         If Adodc1.Recordset.BOF = False Then Adodc1.Recordset.MovePrevious
         If Adodc1.Recordset.BOF = True Then Adodc1.Recordset.MoveFirst
      End If
      Call view_data     '调用过程
      Call Dgr_Title
    Case "next"    '移到下一条记录
      If Adodc1.Recordset.RecordCount > 0 Then
         If Adodc1.Recordset.EOF = False Then Adodc1.Recordset.MoveNext
         If Adodc1.Recordset.EOF = True Then Adodc1.Recordset.MoveLast
      End If
      Call view_data     '调用过程
      Call Dgr_Title
    Case "last"     '移到最后一条记录
      If Adodc1.Recordset.EOF = False Then Adodc1.Recordset.MoveLast
      Call view_data     '调用过程
      Call Dgr_Title
    Case "close"
      Unload Me
  End Select
End Sub