frm_kcgl_cprk.frm

生产管理系统 (VB+SQL Server 2000）在使用本系统的第二套、第三套、第四套、第五套程序时

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

Sub Dgr_Title()
  Dgr_Cprk.Columns(0).Caption = "产品入库单编号"
  Dgr_Cprk.Columns(1).Caption = "产品编号"
  Dgr_Cprk.Columns(2).Caption = "产品名称"
  Dgr_Cprk.Columns(3).Caption = "产品规格"
  Dgr_Cprk.Columns(4).Caption = "计量单位"
  Dgr_Cprk.Columns(5).Caption = "入库数量"
  Dgr_Cprk.Columns(6).Caption = "入库日期"
  Dgr_Cprk.Columns(7).Caption = "生产计划单"
  Dgr_Cprk.Columns(8).Caption = "备注信息"
End Sub

Private Sub Form_Load()
  '向设备编号中添加数据项
  Dim rs2 As New ADODB.Recordset
  rs2.Open "select * from tb_SCGL_cpxx order by cpxx_id", cnn, adOpenKeyset
  If rs2.RecordCount > 0 Then
    For i = 0 To rs2.RecordCount - 1
         Cbx_Cpbh.AddItem Trim(rs2.Fields("cpxx_id"))
         rs2.MoveNext
    Next i
  End If
  rs2.Close
  Cbx_Cpbh.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
  Dtp_Rkrq.Value = Date
  Cbx_Cpbh.Enabled = False
  Cbx_jhdbh.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
     Cbx_jhdbh.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
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_cprk  where cprk_id like+ '%'+'" + Mystr + "'+'%' order by cprk_id", cnn, adOpenKeyset
       If rs1.RecordCount > 0 Then
          If rs1.EOF = False Then rs1.MoveLast
          Text1(0).Text = "RKD" + Mystr + "D" + Format(Val(Right(Trim(rs1.Fields("cprk_id")), 3)) + 1, "###000") '编号自动加1
       Else
          Text1(0).Text = "RKD" + 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
       Cbx_Cpbh.Enabled = True
       Cbx_jhdbh.Enabled = True
       Cbx_Cpbh.SetFocus
       For i = 8 To 11
             Toolbar1.Buttons(i).Enabled = False
         Next i
    Case "modify"    '修改
       Myrs.Open "select * from tb_SCGL_scjhd where scjhd_id='" + Cbx_jhdbh.Text + "' and scjhd_wcf='是'", cnn, adOpenKeyset
       If Myrs.RecordCount > 0 Then
         MsgBox "该计划单已经完工,不能修改!", , "信息提示"
         Myrs.Close
         Exit Sub
       End If
       Myrs.Close
       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
          Cbx_Cpbh.Enabled = True
          Cbx_jhdbh.Enabled = True
          Cbx_Cpbh.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
         Myval = MsgBox("您确实要删除这条数据吗？", vbYesNo, "提示窗口")
            If Myval = vbYes Then
              rs5.Open "select * from tb_SCGL_scjhd where scjhd_id='" + Adodc1.Recordset.Fields("cprk_ddbh") + "'", cnn, adOpenKeyset
              If rs5.RecordCount > 0 Then
                 SL1 = Val(rs5.Fields("scjhd_jhsl")) + Val(Adodc1.Recordset.Fields("cprk_rksl"))
                 cnn.Execute ("update tb_SCGL_scjhd set scjhd_jhsl='" + str(SL1) + "' where scjhd_id='" + Adodc1.Recordset.Fields("cprk_ddbh") + "'")
                 If rs5.Fields("scjhd_wcf") = "是" Then
                    cnn.Execute ("update tb_SCGL_scjhd set scjhd_wcf='否' where scjhd_id='" + Adodc1.Recordset.Fields("cprk_ddbh") + "'")
                 End If
              End If
              rs5.Close
              Adodc1.Recordset.Delete
              Unload Me
              Adodc1.Refresh
              Frm_Kcgl_Cprk.Show 1
            End If
       Else
         MsgBox "系统没有要删除的数据！", , "提示窗口"
       End If
    Case "save"   '保存
''''''      On Error GoTo SaveErr     '出现错误转向错误处理
       If Not IsNumeric(Text1(4).Text) Then
         MsgBox " 请输入正确的数量信息！", , "信息提示"
         Exit Sub
       End If
       If Text1(3).Text = "" Then
         MsgBox "单位信息不能为空！", , "信息提示"
         Exit Sub
       End If
       If Dtp_Rkrq.Value < Date Then
          MsgBox "日期不能小于当前日期"
          Exit Sub
       End If
      If blnadd1 = False Then
        Set rs1 = New ADODB.Recordset
        rs1.Open "select * from  tb_SCGL_cprk where cprk_id='" + Text1(0) + "'order by cprk_id", cnn, adOpenStatic
        If rs1.RecordCount > 0 Then
           Myval = MsgBox("您确实要修改这条数据吗？", vbYesNo)
           If Myval = vbYes Then
              rs6.Open "select * from tb_SCGL_cprk where cprk_id='" + Text1(0).Text + "'", cnn, adOpenKeyset
              If rs6.RecordCount > 0 Then
                 Dim rs7 As New ADODB.Recordset
                 rs7.Open "select * from tb_SCGL_scjhd where scjhd_id='" + rs6.Fields("cprk_ddbh") + "'", cnn, adOpenKeyset
                 If rs7.RecordCount > 0 Then
                    SL2 = Val(rs7.Fields("scjhd_jhsl")) + Val(rs6.Fields("cprk_rksl"))
                    cnn.Execute ("update tb_SCGL_scjhd set scjhd_jhsl='" + SL2 + "' where scjhd_id='" + rs6.Fields("cprk_ddbh") + "'")
                    If rs7.Fields("scjhd_wcf") = "是" Then
                       cnn.Execute ("update tb_SCGL_scjhd set scjhd_wcf='否' where scjhd_id='" + rs6.Fields("cprk_ddbh") + "'")
                    End If
                 End If
                 rs7.Close
              End If
              rs6.Close
               rs5.Open "select * from tb_SCGL_scjhd where scjhd_id='" + Cbx_jhdbh.Text + "'", cnn, adOpenKeyset
               If rs5.RecordCount > 0 Then
                  Mytotal = Val(rs5.Fields("scjhd_jhsl"))
                     If Val(Text1(4).Text) > Mytotal Then
                        MsgBox "该计划单目前需要的产品数量为" + Mytotal + "请选择其他计划单，或更改入库数量！", , "信息提示"
                        Text1(4).SetFocus
                        rs5.Close
                        Exit Sub
                     Else
                        If Val(Text1(4).Text) = Mytotal Then
                             SL1 = Val(Mytotal) - Val(Text1(4).Text)
                             cnn.Execute ("update tb_SCGL_scjhd set scjhd_wcf='是', scjhd_jhsl='" + str(SL1) + "' where scjhd_id='" + Cbx_jhdbh.Text + "'")
                        Else
                            If Val(Text1(4).Text) < Mytotal Then
                                SL1 = Val(Mytotal) - Val(Text1(4).Text)
                                cnn.Execute ("update tb_SCGL_scjhd set scjhd_jhsl='" + str(SL1) + "' where scjhd_id='" + Cbx_jhdbh.Text + "'")
                            End If
                        End If
                     End If
               End If
               rs5.Close
               cnn.Execute ("update tb_SCGL_cprk set cprk_cpbh='" + Cbx_Cpbh.Text + "',cprk_cpmc='" + Text1(1).Text + "',cprk_cpgg='" + Text1(2).Text + _
              "',cprk_jldw='" + Text1(3).Text + "',cprk_rksl='" + Text1(4) + "',cprk_rkrq='" + str(Dtp_Rkrq.Value) + "',cprk_ddbh='" + Cbx_jhdbh.Text + _
              "',cprk_bz='" + Text1(5) + "' where cprk_id='" + Text1(0) + "'")
               Adodc1.Refresh
               Set Dgr_Cprk.DataSource = Adodc1
               Call Dgr_Title
           End If
        End If
        rs1.Close
      Else
        rs4.Open "select * from tb_SCGL_scjhd where scjhd_cpbh='" + Cbx_Cpbh.Text + "' order by scjhd_id", cnn, adOpenKeyset
        If rs4.RecordCount <= 0 Then
           Cbx_jhdbh.Clear
           MsgBox "该产品没有计划单信息", , "信息提示"
           rs4.Close
           Exit Sub
        End If
        rs4.Close
        rs5.Open "select * from tb_SCGL_scjhd where scjhd_id='" + Cbx_jhdbh.Text + "'", cnn, adOpenKeyset
        If rs5.RecordCount > 0 Then
            Mytotal = Val(rs5.Fields("scjhd_jhsl"))
            If Val(Text1(4).Text) > Mytotal Then
                MsgBox "该计划单目前需要的产品数量为" + Mytotal + "请选择其他计划单，或更改入库数量！", , "信息提示"
                Cbx_jhdbh.SetFocus
                rs5.Close
                Exit Sub
            Else
               If Val(Text1(4).Text) = Mytotal Then
                   SL1 = Val(Mytotal) - Val(Text1(4).Text)
                   cnn.Execute ("update tb_SCGL_scjhd set scjhd_wcf='是',scjhd_jhsl='" + str(SL1) + "' where scjhd_id='" + Cbx_jhdbh.Text + "'")
               Else
                 If Val(Text1(4).Text) < Mytotal Then
                    SL1 = Val(Mytotal) - Val(Text1(4).Text)
                    cnn.Execute ("update tb_SCGL_scjhd set scjhd_jhsl='" + str(SL1) + "' where scjhd_id='" + Cbx_jhdbh.Text + "'")
                 End If
               End If
            End If
        End If
        rs5.Close
        Set rs1 = New ADODB.Recordset
        rs1.Open "tb_SCGL_cprk", cnn, adOpenKeyset, adLockOptimistic
        '添加新纪录
        cnn.Execute ("insert into tb_SCGL_cprk (cprk_id,cprk_cpbh,cprk_cpmc,cprk_cpgg,cprk_jldw,cprk_rksl,cprk_rkrq,cprk_ddbh,cprk_bz) values ('" + Text1(0).Text + "','" + Cbx_Cpbh.Text + "','" + Text1(1).Text + "','" + Text1(2).Text + "','" + Text1(3).Text + "',' " + Text1(4).Text + " ','" + str(Dtp_Rkrq.Value) + "','" + Cbx_jhdbh.Text + "','" + Text1(5).Text + "')")
         Adodc1.Refresh
         Set Dgr_Cprk.DataSource = Adodc1
         Call Dgr_Title
      End If
      Call Dgr_Title
      For i = 0 To 5
         Text1(i).Enabled = False
      Next i
         Cbx_Cpbh.Enabled = False
         Cbx_jhdbh.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
        Cbx_Cpbh.Enabled = False
        Cbx_jhdbh.Enabled = False
      tlbState Toolbar1, False
      For i = 8 To 11
          Toolbar1.Buttons(i).Enabled = True
      Next i
    Case "find"
      Tb = "tb_SCGL_cprk"
      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