frm_sbgl_sbbf.frm

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

rs5.Open "select * from tb_SCGL_sbbf where sbbf_sbbh='" + Cbx_Sbbh + "'", cnn, adOpenKeyset
If rs5.RecordCount > 0 Then
  MsgBox "该设备已经报废，请核实！", , "信息提示"
  Cbx_Sbbh.SetFocus
End If
rs5.Close

End Sub

Private Sub Dgr_Sbbf_Click()
view_data
End Sub



''Private Sub Dtp_Bfrq_GotFocus()
''Dtp_Bfrq.CalendarBackColor = &HFFFF80
''End Sub
''
''Private Sub Dtp_Bfrq_KeyDown(KeyCode As Integer, Shift As Integer)
''If KeyCode = 13 Then Text1(4).SetFocus
''End Sub
''
''Private Sub Dtp_Bfrq_LostFocus()
''Dtp_Bfrq.CalendarBackColor = &HFFFFFF
''Str1 = Val(Left(Format(Dtp_Qyrq.Value, "short date"), 4) + Right(Left(Format(Dtp_Qyrq.Value, "short date"), 7), 2) + Right(Format(Dtp_Qyrq.Value, "short date"), 2))
''Str2 = Val(Left(Format(Dtp_Bfrq.Value, "short date"), 4) + Right(Left(Format(Dtp_Bfrq.Value, "short date"), 7), 2) + Right(Format(Dtp_Bfrq.Value, "short date"), 2))
''If Str2 < Str1 Then
''  MsgBox "报废日期不能小于启用时间！", , "信息提示"
''  Exit Sub
''  Dtp_Bfrq.SetFocus
''End If
''End Sub

''Private Sub Dtp_Qyrq_GotFocus()
''Dtp_Qyrq.CalendarBackColor = &HFFFF80
''End Sub
''
''Private Sub Dtp_Qyrq_KeyDown(KeyCode As Integer, Shift As Integer)
''If KeyCode = 13 Then Dtp_Bfrq.SetFocus
''End Sub
''
''Private Sub Dtp_Qyrq_LostFocus()
''Dtp_Qyrq.CalendarBackColor = &HFFFFFF
''End Sub

Private Sub Form_Activate()
  Adodc1.ConnectionString = PublicStr
  If sql <> "" Then
     Adodc1.RecordSource = sql & " order by sbbf_id"
     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_Sbbf.Columns(0).Caption = "设备报废编号"
  Dgr_Sbbf.Columns(1).Caption = "设备编号"
  Dgr_Sbbf.Columns(2).Caption = "设备名称"
  Dgr_Sbbf.Columns(3).Caption = "使用部门"
  Dgr_Sbbf.Columns(4).Caption = "设备类型"
  Dgr_Sbbf.Columns(5).Caption = "设备启用日期"
  Dgr_Sbbf.Columns(6).Caption = "设备报废日期"
  Dgr_Sbbf.Columns(7).Caption = "备注信息"
End Sub

Private Sub Form_Load()
  '向设备编号中添加数据项
  Dim rs2 As New ADODB.Recordset
  rs2.Open "select * from tb_SCGL_scsb", cnn, adOpenKeyset
  If rs2.RecordCount > 0 Then
    For i = 0 To rs2.RecordCount - 1
         Cbx_Sbbh.AddItem Trim(rs2.Fields("scsb_sbbh"))
         rs2.MoveNext
    Next i
  End If
  rs2.Close
  Cbx_Sbbh.Text = "请选择设备编号"
  
  tlbState Toolbar1, False
  view_data
  '设置DataGrid标题
  Call Dgr_Title
  '设置控件状态
  For i = 0 To 4
      Text1(i).Enabled = False
  Next i
  Cbx_Sbbh.Enabled = False
  Dtp_Qyrq.Enabled = False
  Dtp_Bfrq.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 Exit Sub
  Text1(Index + 1).SetFocus
End If
End Sub

Private Sub Text1_LostFocus(Index As Integer)
  Text1(Index).BackColor = &HFFFFFF
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_sbbf  where sbbf_id like+ '%'+'" + Mystr + "'+'%' order by sbbf_id", cnn, adOpenKeyset
       If rs1.RecordCount > 0 Then
          If rs1.EOF = False Then rs1.MoveLast
          Text1(0).Text = "BF" + Mystr + "D" + Format(Val(Right(Trim(rs1.Fields("sbbf_id")), 3)) + 1, "###000") '编号自动加1
       Else
          Text1(0).Text = "BF" + Mystr + "D001"
       End If
       rs1.Close     '关闭数据集对象
       '设置控件状态
       For i = 1 To 4
         Text1(i).Enabled = True
         Text1(i).Text = ""
       Next i
       Dtp_Qyrq.Enabled = False
       Dtp_Bfrq.Enabled = False
       Dtp_Bfrq.Value = Date
       Cbx_Sbbh.Enabled = True
       Cbx_Sbbh.SetFocus
       For i = 8 To 11
             Toolbar1.Buttons(i).Enabled = False
         Next i
    Case "modify"    '修改
       If Adodc1.Recordset.RecordCount > 0 Then
         blnadd1 = False
          view_data
         For i = 1 To 4
             Text1(i).Enabled = True
         Next i
         tlbState Toolbar1, True
         Dtp_Qyrq.Enabled = True
         Dtp_Bfrq.Enabled = True
         Cbx_Sbbh.Enabled = True
         For i = 8 To 11
             Toolbar1.Buttons(i).Enabled = False
         Next i
       Else
         MsgBox "系统没有要修改的数据！", , "生产管理系统"
       End If
    Case "delete"    '删除
       If Adodc1.Recordset.RecordCount > 0 Then
         Myval = MsgBox("您删除该数据的同时将删除设备表中的数据，确定删除这条数据吗？", vbYesNo, "提示窗口")
            If Myval = vbYes Then
                Adodc1.Recordset.Delete
                Adodc2.RecordSource = "select * from tb_SCGL_scsb where scsb_sbbh='" + Cbx_Sbbh.Text + "'"
                Adodc2.Refresh
                If Adodc2.Recordset.RecordCount > 0 Then
                   Adodc2.Recordset.Delete
                   Adodc2.Refresh
                End If
                Unload Me
                Adodc1.Refresh
                Frm_Sbgl_Sbbf.Show 1
            End If
       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_sbbf where sbbf_id='" + Text1(0) + "'order by sbbf_id", cnn, adOpenStatic
        If rs1.RecordCount > 0 Then
           Myval = MsgBox("您确实要修改这条数据吗？", vbYesNo)
           If Myval = vbYes Then
              cnn.Execute ("update tb_SCGL_sbbf set sbbf_sbbh='" + Cbx_Sbbh.Text + "',sbbf_sbmc='" + Text1(1).Text + "',sbbf_sybm='" + Text1(3).Text + _
              "',sbbf_sblx='" + Text1(2).Text + "',sbbf_qyri='" + str(Dtp_Qyrq.Value) + "',sbbf_bfrq='" + str(Dtp_Bfrq.Value) + "',sbbf_bz='" + Text1(4).Text + _
              "' where sbbf_id='" + Text1(0) + "'")
'              Unload Me
'              Adodc1.Refresh
'              Frm_Sbgl_Sbbf.Show 1
               Adodc1.Refresh
               Set Dgr_Sbbf.DataSource = Adodc1
               Call Dgr_Title
           End If
        End If
        rs1.Close
      Else
        Set rs1 = New ADODB.Recordset
        rs1.Open "tb_SCGL_sbbf", cnn, adOpenKeyset, adLockOptimistic
        '添加新纪录
        cnn.Execute ("insert into tb_SCGL_sbbf (sbbf_id,sbbf_sbbh,sbbf_sbmc,sbbf_sybm,sbbf_sblx,sbbf_qyri,sbbf_bfrq,sbbf_bz) values ('" + Text1(0).Text + "','" + Cbx_Sbbh.Text + "','" + Text1(1).Text + "','" + Text1(2).Text + "','" + Text1(3).Text + "','" + str(Dtp_Qyrq.Value) + "','" + str(Dtp_Bfrq.Value) + "','" + Text1(4).Text + "')")
        Dim rs4 As New ADODB.Recordset
        rs4.Open "select * from tb_SCGL_scsb where scsb_sbbh='" + Cbx_Sbbh.Text + "'", cnn, adOpenStatic
        If rs4.RecordCount > 0 Then
           cnn.Execute ("update tb_SCGL_scsb set scsb_sbzt='报废' where scsb_sbbh='" + Cbx_Sbbh.Text + "'")
        End If
        rs4.Close
        Adodc1.Refresh
        rs1.Close
      End If
      Call Dgr_Title
      For i = 0 To 4
         Text1(i).Enabled = False
      Next i
         Dtp_Qyrq.Enabled = False
         Dtp_Bfrq.Enabled = False
         Cbx_Sbbh.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 4
         Text1(i).Enabled = False
      Next i
        Dtp_Qyrq.Enabled = False
        Dtp_Bfrq.Enabled = False
        Cbx_Sbbh.Enabled = False
      tlbState Toolbar1, False
      For i = 8 To 11
          Toolbar1.Buttons(i).Enabled = True
      Next i
    Case "find"
      Tb = "tb_SCGL_sbbf"
      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