frm_sbgl_sbwx.frm

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

            Picture         =   "Frm_Sbgl_Sbwx.frx":1697
            Key             =   ""
         EndProperty
         BeginProperty ListImage3 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "Frm_Sbgl_Sbwx.frx":2CF1
            Key             =   ""
         EndProperty
         BeginProperty ListImage4 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "Frm_Sbgl_Sbwx.frx":434B
            Key             =   ""
         EndProperty
         BeginProperty ListImage5 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "Frm_Sbgl_Sbwx.frx":59A5
            Key             =   ""
         EndProperty
         BeginProperty ListImage6 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "Frm_Sbgl_Sbwx.frx":6FFF
            Key             =   ""
         EndProperty
         BeginProperty ListImage7 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "Frm_Sbgl_Sbwx.frx":8659
            Key             =   ""
         EndProperty
         BeginProperty ListImage8 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "Frm_Sbgl_Sbwx.frx":9CB3
            Key             =   ""
         EndProperty
         BeginProperty ListImage9 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "Frm_Sbgl_Sbwx.frx":B30D
            Key             =   ""
         EndProperty
         BeginProperty ListImage10 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "Frm_Sbgl_Sbwx.frx":C967
            Key             =   ""
         EndProperty
         BeginProperty ListImage11 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "Frm_Sbgl_Sbwx.frx":DFC1
            Key             =   ""
         EndProperty
      EndProperty
   End
End
Attribute VB_Name = "Frm_Sbgl_Sbwx"
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 Str1 As String
Dim Str2 As String '定义字符变量
Dim rs3 As New ADODB.Recordset
Dim Str_Data As String
Dim StrData As String

Sub view_data()     '定义显示数据的过程
  If Adodc1.Recordset.RecordCount > 0 Then
     With Dgr_Sbwx
        If .Columns(0) <> "" Then Text1(0).Text = .Columns(0) Else Text1(0).Text = ""
        If .Columns(1) <> "" Then Cbx_Sbbh.Text = .Columns(1) Else Cbx_Sbbh.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 Dtp_Qsrq.Value = .Columns(5) Else Dtp_Qsrq.Value = Date
        If .Columns(6) <> "" Then Dtp_Jzrq.Value = .Columns(6) Else Dtp_Jzrq.Value = Date
        If .Columns(7) <> "" Then Text1(4).Text = .Columns(7) Else Text1(4).Text = ""
     End With
  End If
End Sub

Private Sub Cbx_Sbbh_Click()
rs3.Open "select * from tb_SCGL_scsb where scsb_sbbh='" + Cbx_Sbbh.Text + "'", cnn, adOpenKeyset
If rs3.RecordCount > 0 Then
  Text1(1).Text = rs3.Fields("scsb_sbmc")
  Text1(2).Text = rs3.Fields("scsb_sybm")
  Text1(3).Text = rs3.Fields("scsb_sblx")
  StrData = rs3.Fields("scsb_syrq")
  Str_Data = Val(Left(rs3.Fields("scsb_syrq"), 4) + Right(Left(rs3.Fields("scsb_syrq"), 7), 2) + Right(rs3.Fields("scsb_syrq"), 2))
End If
rs3.Close
End Sub

Private Sub Cbx_Sbbh_GotFocus()
Cbx_Sbbh.BackColor = &HFFFF80
End Sub

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

Private Sub Cbx_Sbbh_LostFocus()
On Error Resume Next
Cbx_Sbbh.BackColor = &HFFFFFF
rs3.Open "select * from tb_SCGL_scsb where scsb_sbbh='" + Cbx_Sbbh.Text + "'", cnn, adOpenKeyset
If rs3.RecordCount > 0 Then
  Text1(1).Text = rs3.Fields("scsb_sbmc")
  Text1(2).Text = rs3.Fields("scsb_sybm")
  Text1(3).Text = rs3.Fields("scsb_sblx")
  StrData = rs3.Fields("scsb_syrq")
  Str_Data = Val(Left(rs3.Fields("scsb_syrq"), 4) + Right(Left(rs3.Fields("scsb_syrq"), 7), 2) + Right(rs3.Fields("scsb_syrq"), 2))
End If
rs3.Close

Dim rs4 As New ADODB.Recordset
rs4.Open "select * from tb_SCGL_scsb where scsb_sbbh='" + Cbx_Sbbh.Text + "'", cnn, adOpenKeyset
If rs4.RecordCount <= 0 Then
  MsgBox "该设备不是本公司的，请核实！", , "信息提示"
  Cbx_Sbbh.SetFocus
End If
rs4.Close

Dim rs5 As New ADODB.Recordset
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_Sbwx_Click()
view_data
End Sub

Private Sub Dtp_Jzrq_GotFocus()
Dtp_Jzrq.CalendarBackColor = &HFFFF80
End Sub

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

Private Sub Dtp_Jzrq_LostFocus()
Dtp_Jzrq.CalendarBackColor = &HFFFFFF
Str1 = Val(Left(Dtp_Qsrq.Value, 4) + Right(Left(Dtp_Qsrq.Value, 7), 2) + Right(Dtp_Qsrq.Value, 2))
Str2 = Val(Left(Dtp_Jzrq.Value, 4) + Right(Left(Dtp_Jzrq.Value, 7), 2) + Right(Dtp_Jzrq.Value, 2))
If Str2 < Str1 Then
  MsgBox "维修截止日期不能小于维修开始时间！", , "信息提示"
  Exit Sub
  Dtp_Jzrq.SetFocus
End If
End Sub

Private Sub Dtp_Qsrq_GotFocus()
Dtp_Qsrq.CalendarBackColor = &HFFFF80
End Sub

Private Sub Dtp_Qsrq_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = 13 Then Dtp_Jzrq.SetFocus
End Sub

Private Sub Dtp_Qsrq_LostFocus()
Dtp_Qsrq.CalendarBackColor = &HFFFFFF
Str1 = Val(Left(Dtp_Qsrq.Value, 4) + Right(Left(Dtp_Qsrq.Value, 7), 2) + Right(Dtp_Qsrq.Value, 2))
If Str_Data > Str1 Then
   MsgBox "维修日期不能小于启用日期！", , "信息提示"
   Dtp_Qsrq.Value = StrData
   Dtp_Qsrq.SetFocus
   Exit Sub
End If
End Sub

Private Sub Form_Activate()
  Adodc1.ConnectionString = PublicStr
  If sql <> "" Then
     Adodc1.RecordSource = sql & " order by sbwx_wxbh"
     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_Sbwx.Columns(0).Caption = "设备维修编号"
  Dgr_Sbwx.Columns(1).Caption = "设备编号"
  Dgr_Sbwx.Columns(2).Caption = "设备名称"
  Dgr_Sbwx.Columns(3).Caption = "使用部门"
  Dgr_Sbwx.Columns(4).Caption = "设备类型"
  Dgr_Sbwx.Columns(5).Caption = "维修起始日期"
  Dgr_Sbwx.Columns(6).Caption = "维修截止日期"
  Dgr_Sbwx.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_Qsrq.Enabled = False
  Dtp_Jzrq.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 = 3 Then
     Dtp_Qsrq.SetFocus
     Exit Sub
  End If
  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_sbwx  where sbwx_wxbh like+ '%'+'" + Mystr + "'+'%' order by sbwx_wxbh", cnn, adOpenKeyset
       If rs1.RecordCount > 0 Then
          If rs1.EOF = False Then rs1.MoveLast
          Text1(0).Text = "WX" + Mystr + "D" + Format(Val(Right(Trim(rs1.Fields("sbwx_wxbh")), 3)) + 1, "###000") '编号自动加1
       Else
          Text1(0).Text = "WX" + Mystr + "D001"
       End If
       rs1.Close     '关闭数据集对象
       '设置控件状态
       For i = 1 To 4
         Text1(i).Enabled = True
         Text1(i).Text = ""
       Next i
       For i = 1 To 3
         Text1(i).Locked = True
       Next i
       Dtp_Qsrq.Enabled = True
       Dtp_Jzrq.Enabled = True
       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
         tlbState Toolbar1, True
          view_data
         For i = 1 To 4
             Text1(i).Enabled = True
         Next i
          For i = 1 To 3
             Text1(i).Locked = True
          Next i
          Cbx_Sbbh.Enabled = True
          Dtp_Qsrq.Enabled = True
          Dtp_Jzrq.Enabled = True
          Cbx_Sbbh.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_Sbgl_Sbwx.Show 1
               Adodc1.Refresh
               Set Dgr_Sbwx.DataSource = Adodc1
               Call Dgr_Title
       Else
         MsgBox "系统没有要删除的数据！", , "提示窗口"
       End If
    Case "save"   '保存
      On Error GoTo SaveErr     '出现错误转向错误处理
     Str1 = Val(Left(Dtp_Qsrq.Value, 4) + Right(Left(Dtp_Qsrq.Value, 7), 2) + Right(Dtp_Qsrq.Value, 2))
     Str2 = Val(Left(Dtp_Jzrq.Value, 4) + Right(Left(Dtp_Jzrq.Value, 7), 2) + Right(Dtp_Jzrq.Value, 2))
     If Str2 < Str1 Then
         MsgBox "维修截止日期不能小于维修开始时间！", , "信息提示"
         Exit Sub
         Dtp_Jzrq.SetFocus
     End If
      If blnadd1 = False Then
        Set rs1 = New ADODB.Recordset
        rs1.Open "select * from  tb_SCGL_sbwx where sbwx_wxbh='" + Text1(0) + "'order by sbwx_wxbh", cnn, adOpenStatic
        If rs1.RecordCount > 0 Then
           Myval = MsgBox("您确实要修改这条数据吗？", vbYesNo)
           If Myval = vbYes Then
              cnn.Execute ("update tb_SCGL_sbwx set sbwx_sbbh='" + Cbx_Sbbh.Text + "',sbwx_sbmc='" + Text1(1).Text + "',sbwx_sybm='" + Text1(2).Text + _
              "',sbwx_sblx='" + Text1(3).Text + "',sbwx_qsrq='" + str(Dtp_Qsrq.Value) + "',sbwx_jzrq='" + str(Dtp_Jzrq.Value) + "',sbwx_bz='" + Text1(4).Text + _
              "' where sbwx_wxbh='" + Text1(0) + "'")
'              Unload Me
'              Adodc1.Refresh
'              Frm_Sbgl_Sbwx.Show 1
               Adodc1.Refresh
               Set Dgr_Sbwx.DataSource = Adodc1
               Call Dgr_Title
           End If
        End If
        rs1.Close
      Else
        Set rs1 = New ADODB.Recordset
        rs1.Open "tb_SCGL_sbwx", cnn, adOpenKeyset, adLockOptimistic
        '添加新纪录
          Dim rs4 As New ADODB.Recordset
        rs4.Open "select * from tb_SCGL_sbwx where sbwx_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 + "'")
        Else
           cnn.Execute ("insert into tb_SCGL_sbwx (sbwx_wxbh,sbwx_sbbh,sbwx_sbmc,sbwx_sybm,sbwx_sblx,sbwx_qsrq,sbwx_jzrq,sbwx_bz) values ('" + Text1(0).Text + "','" + Cbx_Sbbh.Text + "','" + Text1(1).Text + "','" + Text1(2).Text + "','" + Text1(3).Text + "','" + str(Dtp_Qsrq.Value) + "','" + str(Dtp_Jzrq.Value) + "','" + Text1(4).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_Qsrq.Enabled = False
         Dtp_Jzrq.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_Qsrq.Enabled = False
        Dtp_Jzrq.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_sbwx"
      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