frm_sbgl_sbda.frm

来自「PMS是一个生产管理系统,功能强大,供大家享用,希望大家支持!!」· FRM 代码 · 共 893 行 · 第 1/3 页

     Call view_data     '调用过程
     If Adodc1.Recordset.RecordCount = 0 Then
        MsgBox "没有找到符合条件的记录！", , "提示窗口"
     End If
  End If
 Call Dgr_Title
 End Sub

Sub Dgr_Title()
  Dgr_Scsb.Columns(0).Caption = "设备编号"
  Dgr_Scsb.Columns(1).Caption = "设备名称"
  Dgr_Scsb.Columns(2).Caption = "使用部门"
  Dgr_Scsb.Columns(3).Caption = "设备类型"
  Dgr_Scsb.Columns(4).Caption = "设备状态"
  Dgr_Scsb.Columns(5).Caption = "设备启用日期"
  Dgr_Scsb.Columns(6).Caption = "设备购买价值"
  Dgr_Scsb.Columns(7).Caption = "摊销时间"
  Dgr_Scsb.Columns(8).Caption = "备注信息"
End Sub

Private Sub Form_Load()
  '向使用部门中添加数据项
  Dim rs2 As New ADODB.Recordset
  rs2.Open "select * from tb_SCGL_cjsz", cnn, adOpenKeyset
  If rs2.RecordCount > 0 Then
    For i = 0 To rs2.RecordCount - 1
         Cbx_bm.AddItem Trim(rs2.Fields("cjsz_cjmc"))
         rs2.MoveNext
    Next i
  End If
  rs2.Close
  
  '向设备类型中添加数据项
  rs2.Open "select * from tb_SCGL_sblx ", cnn, adOpenKeyset
  If rs2.RecordCount > 0 Then
    For i = 0 To rs2.RecordCount - 1
      Cbx_Sblx.AddItem Trim(rs2.Fields("sblx_lxmc"))
      rs2.MoveNext
    Next i
  End If
  rs2.Close
   
  '向设备状态中添加数据项
  rs2.Open "select * from tb_SCGL_sbzt ", cnn, adOpenKeyset
  If rs2.RecordCount > 0 Then
    For i = 0 To rs2.RecordCount - 1
      Cbx_Sbzt.AddItem Trim(rs2.Fields("sbzt_ztmc"))
      rs2.MoveNext
    Next i
  End If
  rs2.Close
  
  '向摊销时间中添加数据项
  rs2.Open "select * from tb_SCGL_sbtx", cnn, adOpenKeyset
  If rs2.RecordCount > 0 Then
    For i = 0 To rs2.RecordCount - 1
      Cbx_Txsj.AddItem Trim(rs2.Fields("sbtx_txnx"))
      rs2.MoveNext
    Next i
  End If
  rs2.Close
   
  tlbState Toolbar1, False
  view_data
  '设置DataGrid标题
  Call Dgr_Title
  '设置控件状态
  For i = 0 To 3
      Text1(i).Enabled = False
  Next i
  Cbx_bm.Enabled = False
  Cbx_Sblx.Enabled = False
  Cbx_Sbzt.Enabled = False
  Cbx_Txsj.Enabled = False
  Dtp_Qyrq.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 = 1 Then
     Cbx_bm.SetFocus
     Exit Sub
  End If
  If Index = 2 Then
     Cbx_Txsj.SetFocus
     Exit Sub
  End If
  If Index = 3 Then Exit Sub
  Text1(Index + 1).SetFocus
End If
End Sub

Private Sub Text1_LostFocus(Index As Integer)
  Text1(Index).BackColor = &HFFFFFF
  If Index = 2 Then
     If Not IsNumeric(Text1(2).Text) Then
         MsgBox "请输入正确的购买价值信息", , "信息提示"
         Text1(2).SetFocus
         Text1(2).Text = ""
         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_scsb  where scsb_sbbh like+ '%'+'" + Mystr + "'+'%' order by scsb_sbbh", cnn, adOpenKeyset
       If rs1.RecordCount > 0 Then
          If rs1.EOF = False Then rs1.MoveLast
          Text1(0).Text = "Sb" + Mystr + "D" + Format(Val(Right(Trim(rs1.Fields("scsb_sbbh")), 3)) + 1, "###000") '编号自动加1
       Else
          Text1(0).Text = "Sb" + Mystr + "D001"
       End If
       rs1.Close     '关闭数据集对象
       '设置控件状态
       For i = 1 To 3
         Text1(i).Enabled = True
         Text1(i).Text = ""
       Next i
       Cbx_bm.Enabled = True
       Cbx_Sblx.Enabled = True
       Cbx_Sbzt.Enabled = True
       Cbx_Txsj.Enabled = True
'       Dtp_Qyrq.Enabled = True
       Dtp_Qyrq.Value = Date
       Text1(1).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 3
             Text1(i).Enabled = True
         Next i
         tlbState Toolbar1, True
         Cbx_bm.Enabled = True
         Cbx_Sblx.Enabled = True
         Cbx_Sbzt.Enabled = True
         Cbx_Txsj.Enabled = True
'         Dtp_Qyrq.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
              Adodc1.Recordset.Delete
              Unload Me
              Adodc1.Refresh
              Frm_Sbgl_Sbda.Show 1
       Else
         MsgBox "系统没有要删除的数据！", , "提示窗口"
       End If
    Case "save"   '保存
      If Text1(1) = "" Then
         MsgBox "系统不允许设备名称为空！", , "提示窗口"
         Exit Sub
      End If
      If Text1(2) = "" Then
         MsgBox "系统不允许购买价值为空！", , "提示窗口"
         Exit Sub
      End If
      If Not IsNumeric(Text1(2).Text) Then
         MsgBox "请在购买价值中输入数字！", , "提示窗口"
         Text1(2).Text = ""
         Text1(2).SetFocus
         Exit Sub
      End If
      On Error GoTo SaveErr     '出现错误转向错误处理
      If blnadd1 = False Then
        Set rs1 = New ADODB.Recordset
        rs1.Open "select * from  tb_SCGL_scsb where scsb_sbbh='" + Text1(0) + "'order by scsb_sbbh", cnn, adOpenStatic
        If rs1.RecordCount > 0 Then
             Myrs.Open "select * from tb_SCGL_sbbf where sbbf_sbbh='" + Text1(0).Text + "'", cnn, adOpenKeyset
              If Myrs.RecordCount > 0 Then
                 MsgBox "该设备已经报废！不能修改！", , "信息提示"
                  '设置控件状态
                  For i = 0 To 3
                     Text1(i).Enabled = False
                  Next i
                  Cbx_bm.Enabled = False
                  Cbx_Sblx.Enabled = False
                  Cbx_Sbzt.Enabled = False
                  Cbx_Txsj.Enabled = False
                  tlbState Toolbar1, False
                  Myrs.Close
                 Exit Sub
              End If
              Myrs.Close
           Myval = MsgBox("您确实要修改这条数据吗？", vbYesNo)
           If Myval = vbYes Then
              cnn.Execute ("update tb_SCGL_scsb set scsb_sbmc='" + Text1(1).Text + "',scsb_sybm='" + Cbx_bm.Text + "',scsb_sblx='" + Cbx_Sblx.Text + _
              "',scsb_sbzt='" + Cbx_Sbzt.Text + "',scsb_syrq='" + str(Dtp_Qyrq.Value) + "',scsb_gmjz='" + Text1(2) + "',scsb_txsj='" + str(Cbx_Txsj.Text) + _
              "',scsb_bz='" + Text1(3) + "'where scsb_sbbh='" + Text1(0) + "'")
               Adodc1.Refresh
               Set Dgr_Scsb.DataSource = Adodc1
               Call Dgr_Title
           End If
        End If
        rs1.Close
      Else
        If Cbx_Sbzt.Text = "报废" Then
           MsgBox "不能将新增设备设置为'报废'！", , "信息提示"
           Cbx_Sbzt.ListIndex = 0
           Cbx_Sbzt.SetFocus
           Exit Sub
        End If
        Set rs1 = New ADODB.Recordset
        rs1.Open "tb_SCGL_scsb", cnn, adOpenKeyset, adLockOptimistic
        '添加新纪录
        cnn.Execute ("insert into tb_SCGL_scsb (scsb_sbbh,scsb_sbmc,scsb_sybm,scsb_sblx,scsb_sbzt,scsb_syrq,scsb_gmjz,scsb_txsj,scsb_bz) values ('" + Text1(0).Text + "','" + Text1(1).Text + "','" + Cbx_bm.Text + "','" + Cbx_Sblx.Text + "','" + Cbx_Sbzt.Text + "','" + str(Dtp_Qyrq.Value) + "','" + Text1(2).Text + "','" + str(Cbx_Txsj.Text) + "','" + Text1(3).Text + "')")
           '更新数据库
        Adodc1.Refresh
        rs1.Close
      End If
      Call Dgr_Title
      For i = 0 To 3
        Text1(i).Enabled = False
      Next i
         Cbx_bm.Enabled = False
         Cbx_Sblx.Enabled = False
         Cbx_Sbzt.Enabled = False
         Cbx_Txsj.Enabled = False
'         Dtp_Qyrq.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 3
         Text1(i).Enabled = False
      Next i
        Cbx_bm.Enabled = False
         Cbx_Sblx.Enabled = False
         Cbx_Sbzt.Enabled = False
         Cbx_Txsj.Enabled = False
'         Dtp_Qyrq.Enabled = False
      tlbState Toolbar1, False
      For i = 8 To 11
          Toolbar1.Buttons(i).Enabled = True
      Next i
    Case "find"
      Tb = "tb_SCGL_scsb"
      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