frmproductionembryoinedit.frm

企业ERP系统 采用VB+SQL2000实现。 有客户合约

            Left            =   3900
            TabIndex        =   9
            Top             =   720
            Width           =   915
         End
         Begin VB.Label Label50 
            Caption         =   "合同編號"
            Height          =   315
            Left            =   180
            TabIndex        =   8
            Top             =   300
            Width           =   795
         End
      End
   End
End
Attribute VB_Name = "frmProductionEmbryoInEdit"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Public newItem As Boolean 'true表示增加
Dim oldAmount As Integer
Private Sub ActiveBar21_ToolClick(ByVal Tool As ActiveBar2LibraryCtl.Tool)
    Select Case Tool.Name
            Case "cmdSave":
                 Save newItem
           Case "cmdCancel":
                Unload Me
            Case "cmdDel":
                DelOperatorInf
    End Select
End Sub
Private Sub Form_Load()
    Me.Move (Screen.Width - Me.Width) \ 2, (Screen.Height - Me.Height) \ 2
    If newItem Then
        ActiveBar21.Bands("toolbar").Tools.item("cmdDel").Enabled = False
    End If
    Initcbb txtwidth, "Width", "tFabricProduct where FabricCode='" & txtFabricCode & "'"
    Initcbb txtGreige, "Greige", "tFabricProduct where FabricCode='" & txtFabricCode & "'"
    InitTitle
End Sub
Private Sub InitTitle()
    Label50.Caption = "合同編號"
    Label7.Caption = "供應商"
    Label22.Caption = "布名"
    Label40.Caption = "布號"
    Label3.item(3).Caption = "胚組織"
    Label1.Caption = "加工廠"
    Label15.Caption = "進胚數量"
    Label3.item(4).Caption = "幅寬"
    Label10.Caption = "進胚日期"
    Label13.Caption = "擬投胚單"
    Label23.Caption = "查驗情況"
    Me.Caption = "進胚記錄明細"
End Sub
Private Sub DelOperatorInf()
    Dim strSql As String
    On Error GoTo errHandle
    If MsgBox("确定要刪除？", vbQuestion + vbYesNo, "询问") = vbNo Then
        Exit Sub
    Else
        strSql = "delete from tProductionEmbryoIn where id=" & txtId
        objDatabase.ExecCmd strSql
        MsgBox "刪除成功!", vbInformation, "提示"
        spModiEmbryoIn txtEmbryoContractNo, txtAmount
    End If
        frmProductionEmbryoIn.FillMshf1 ("select * from tProductionEmbryoIn where EmbryoContractNo='" & txtEmbryoContractNo & "'")
        frmProductionEmbryoContractMain.FillMshf1 ("select * from tProductionEmbryoContract")
    Unload Me
    Exit Sub
errHandle:
   objDatabase.DatabaseError
    
End Sub
Private Sub spModiEmbryoIn(ByVal spEmbryoContractNo As String, ByVal spAmount As String)
Dim mycomm As ADODB.Command
Set mycomm = New ADODB.Command
With mycomm
    .ActiveConnection = Cn
    .CommandText = "pModiEmbryoIn"
    .CommandType = 4
    .Prepared = True
    .Parameters.Append .CreateParameter("@iEmbryoContractNo", adVarChar, adParamInput, 20, spEmbryoContractNo)
    .Parameters.Append .CreateParameter("@iModiAmount", adBigInt, adParamInput, 8, spAmount)
    .Parameters.Append .CreateParameter("@iFlag", adBoolean, adParamInput, 1, 0)
    .Execute
End With
End Sub
Public Sub InitInfo(strId As String)
    If newItem = False Then
    Dim rs As ADODB.Recordset
      SystemExecuteStart Me
     ' On Error GoTo errLabel
      Set rs = New ADODB.Recordset
      With rs
        .CursorLocation = adUseClient
        .CursorType = adOpenDynamic
        .LockType = adLockOptimistic
        Set .ActiveConnection = Cn
      End With
      Dim strSql As String
        strSql = "select * from tProductionEmbryoIn where id=" & strId
        rs.Open strSql
        If Not rs.EOF Then
            DtpFoundDate.Value = NullValue(rs.Fields!Founddate)
            txtGreige = NullValue(rs.Fields!Greige)
            txtwidth = NullValue(rs.Fields!Width)
            txtRemark = NullValue(rs.Fields!Remark)
            txtAmount = NullValue(rs.Fields!Amount)
            txtEmbryoPlan = NullValue(rs.Fields!EmbryoPlan)
            txtId = NullValue(rs.Fields!ID)
            oldAmount = NullValue(rs.Fields!Amount)
        End If
      rs.Close
      Set rs = Nothing
      SystemExecuteEnd Me
    Exit Sub
    End If
errLabel:
        SystemExecuteEnd Me
        objDatabase.DatabaseError
End Sub
Private Sub Save(Optional blModi As Boolean)
    Dim strSql As String
    Dim rs As ADODB.Recordset
    Set rs = New ADODB.Recordset
    With rs
      .CursorLocation = adUseClient
      .CursorType = adOpenDynamic
      .LockType = adLockOptimistic
      Set .ActiveConnection = Cn
    End With
    If txtEmbryoPlan = "" Then
       MsgBox "請將擬投胚單填寫完整 ", vbInformation + vbOKOnly, " 提示"
       txtEmbryoPlan.SetFocus
       Exit Sub
    End If
    If IsNumeric(txtAmount) = False Then
       MsgBox "請正確填寫進坯數量 ", vbInformation + vbOKOnly, " 提示"
       txtAmount.SetFocus
       Exit Sub
    End If
        On Error GoTo errHandle
        If blModi Then
        strSql = "select * from tProductionEmbryoIn"
        rs.Open strSql
            If MsgBox("是否增加？", vbQuestion + vbYesNo, "询问") = vbNo Then
                rs.Close
                Set rs = Nothing
                Exit Sub
            End If
            oldAmount = CInt(txtAmount)
            rs.AddNew '新建
        Else
            strSql = "select LeftAmount from tproductionEmbryoContract where EmbryoContractNo='" & txtEmbryoContractNo & "'"
            rs.Open strSql
            oldAmount = CInt(txtAmount) - oldAmount
            If oldAmount < 0 Then
                If rs.Fields!leftAmount <= Abs(oldAmount) Then
                    If MsgBox("您的修改將導制存坯數量成負，真要要修改嗎？", vbQuestion + vbYesNo, "警告") = vbNo Then
                        rs.Close
                        Set rs = Nothing
                    Exit Sub
                    End If
                End If
            End If
            rs.Close
            strSql = "select * from tProductionEmbryoIn where id=" & txtId
            rs.Open strSql
            If rs.EOF Then '修改
                MsgBox "没有可修改的信息!", vbExclamation, "修改"
                rs.Close
                Set rs = Nothing
                txtEmbryoPlan.SetFocus
                Exit Sub
            End If
            If MsgBox("是否修改记录？", vbYesNo + vbQuestion, "修改") = vbNo Then
                rs.Close
                Set rs = Nothing
                Exit Sub
            End If
        End If
        rs.Fields!EmbryoContractNo = Trim$(txtEmbryoContractNo)
        rs.Fields!Founddate = DtpFoundDate.Value
        rs.Fields!SuppliersName = Trim$(txtSuppliersName)
        rs.Fields!FabricCode = Trim$(txtFabricCode)
        rs.Fields!FabricName = Trim$(txtFabricName)
        rs.Fields!Greige = Trim$(txtGreige)
        rs.Fields!Width = Trim$(txtwidth)
        rs.Fields!Remark = Trim$(txtRemark)
        rs.Fields!Amount = Trim$(txtAmount)
        rs.Fields!FactoryName = Trim$(txtFactoryName)
        rs.Fields!EmbryoPlan = Trim$(txtEmbryoPlan)
        rs.Update
        MsgBox "操作成功！", vbInformation, "恭喜"
        rs.Close
        spModiEmbryoIn txtEmbryoContractNo, oldAmount
        Set rs = Nothing
        frmProductionEmbryoIn.FillMshf1 ("select * from tProductionEmbryoIn where EmbryoContractNo='" & txtEmbryoContractNo & "'")
        frmProductionEmbryoContractMain.FillMshf1 ("select * from tProductionEmbryoContract")
        Unload Me
        Exit Sub
errHandle:
    Set rs = Nothing
    objDatabase.DatabaseError
End Sub

Private Sub txtAmount_KeyPress(KeyAscii As Integer)
If KeyAscii <> 8 And KeyAscii <> 13 And KeyAscii <> 46 Then
   If KeyAscii < 48 Or KeyAscii > 57 Then
            KeyAscii = 0
   End If
End If
End Sub