VB开发的ERP系统

              End If
             Cw_DataEnvi.DataConnect.CommitTrans
   
            '刷新当前网格
            Sqlstr = "SELECT Tr_Weigh.*,Tr_NowAccount.VoucherId as VoucherId FROM Tr_Weigh left outer join Tr_NowAccount on Tr_Weigh.WeighId=Tr_NowAccount.ChildId where Tr_NowAccount.VoucherNum=1  and Tr_Weigh.WeighId='" & dbl_RecordAutoCode & "' order by Tr_Weigh.WeighTime"
            Set Cxnrrec = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
   
            With CzxsGrid
                Call Jltcwg(Cxnrrec, .Row)
            End With
   
        End If
     
        '保存记录成功,函数返回真值
        Bclrsj = True
        Exit Function
        
    End With
 
Swcwcl:

     Cw_DataEnvi.DataConnect.RollbackTrans

     Tsxx = "存盘过程中出现错误,程序自动恢复保存前状态!"
     Call Xtxxts(Tsxx, 0, 1)

     Exit Function
     
End Function

Private Function Cshlrxx(lrztxx As Integer) As Boolean              '初始化录入字段信息

    TextChangeLock = True       '关闭文本框Chang事件
    
    If lrztxx = 1 Then
    
        '增加新记录时将文本框清空
        For jsqte = 0 To Max_Text_Index
            If Len(Trim(Textstr(jsqte, 1))) <> 0 Then
                LrText(jsqte).Text = ""
                LrText(jsqte).Tag = ""
            End If
            TextValiJudgeLock(jsqte) = True
        Next jsqte
       
        '[>>
        JiText(1).Text = "____-__-__ __:__"
        JiText(0).Text = Format(Xtrq, "yyyy-mm-dd hh:mm")
        '<<]
    Else
    
        '修改记录时根据记录关键字(编码)从数据表中读入其他字段内容
        With RecTemp
            Sqlstr = "Select * From Tr_Weigh Where  WeighId='" & Trim(CzxsGrid.TextMatrix(CzxsGrid.Row, 0)) & "'"

            Set RecTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
       
            '记录如存在则读入其内容,否则提示记录已被其他人删除
            If Not RecTemp.EOF Then
                LrText(0).Tag = Trim(RecTemp.Fields("VehicleNum") & " ")          '车号
                LrText(0).Text = Trim(RecTemp.Fields("VehicleNum") & " ")
                JiText(0).Text = Format(Trim(RecTemp.Fields("WeighTime")), "yyyy-mm-dd hh:mm")  '要求检斤时间
                If IsNull(Trim(RecTemp.Fields("WeighEndTime"))) Then                            '检斤完毕时间
                    JiText(1).Text = "____-__-__ __:__"
                Else
                    JiText(1).Text = Format(Trim(RecTemp.Fields("WeighEndTime")), "yyyy-mm-dd hh:mm")
                End If
                If Not IsNull(RecTemp.Fields("WeighMan")) Then                                   '检斤负责人
                    LrText(1).Text = Trim(RecTemp.Fields("WeighMan") & "")
                Else
                    LrText(1).Text = ""
                End If
                    LrText(2).Text = Val(Trim(RecTemp.Fields("Quantity") & ""))
                dbl_RecordAutoCode = RecTemp.Fields("WeighId")
            Else
                Tsxx = "该记录已经被其他人删除,请刷新当前数据!"
                Call Xtxxts(Tsxx, 0, 4)
                Call Cancel
                TextChangeLock = False
                Exit Function
            End If
        End With
    End If
    
    Cshlrxx = True
    TextChangeLock = False
    
End Function

Private Sub Scdqjl()                 '删 除 当 前 记 录

    Dim yhAnswer As Integer
    Dim Str_Parent As String
    Dim Sqlstr As String
    Dim Ts_temp1 As New ADODB.Recordset
    Dim Findrc As New ADODB.Recordset
    
    '判断用户是否有此功能执行权限,如有则写上机日志(进入)
    If Not Security_Log(Str_RightEdit, Xtczybm, 1, True) Then
        Exit Sub
    End If
    
    '非数据行不能删除
    If CzxsGrid.Row < CzxsGrid.FixedRows Then
        Exit Sub
    End If
  
    '用户确认是否删除记录
    Tsxx = "请确认是否删除当前记录?"
    yhAnswer = Xtxxts(Tsxx, 2, 2)
    
    If yhAnswer = 2 Then
        Exit Sub
    End If

    On Error GoTo Cwcl
  
    Cw_DataEnvi.DataConnect.BeginTrans

    '[>>以下需自定义部分
    Cw_DataEnvi.DataConnect.Execute "delete Tr_Weigh where WeighId = '" + Trim(CzxsGrid.TextMatrix(CzxsGrid.Row, 0)) + "'"
    Cw_DataEnvi.DataConnect.Execute "delete Tr_NowAccount where ChildId = '" + Trim(CzxsGrid.TextMatrix(CzxsGrid.Row, 0)) + "'and VoucherNum=1 "
  
    '以上为自定义部分<<]
  
    Cw_DataEnvi.DataConnect.CommitTrans

    CzxsGrid.RemoveItem CzxsGrid.Row

    Exit Sub
  
Cwcl:

    Cw_DataEnvi.DataConnect.RollbackTrans
    
    If Err.Number = -2147217873 Then                '(-2147217873 为SQL Server 2000通过建立外键产生的错误号)
        Tsxx = "该编码已经被使用,不能删除!"
        Call Xtxxts(Tsxx, 0, 1)
        Exit Sub
    Else
        Tsxx = "出现未知情况,该编码不能被删除!"
        Call Xtxxts(Tsxx, 0, 1)
        Exit Sub
    End If
    
End Sub

'*******************以下区域为编写自定义过程区域**********************
 '判断各状态的时间
 Function JiTextptpd() As Boolean
    Dim Sqlstr As String
    Dim jsqte As Long
    Dim str_TempSql As String
    Dim arrVar_TableCon()
    Dim arrVar_TableCon1()
    Dim arr_Var_TableCon2()
    Dim arrVar_TableCon3()
    Dim rs_Tmp As New ADODB.Recordset
    Dim Findrec As New ADODB.Recordset
On Error GoTo Pdbz
If Lrzt = 1 Then '各状态增加时的判断
        '先查询出同车号各状态正在进行的记录并找出最大时间与填入记录进行判断
        str_tmp = "select * from Tr_NowAccount where VehicleNum='" & Trim(LrText(0).Text) & "'and LimitMark=0 order by BeginTime      "
        Set rs_Tmp = Nothing
        Set rs_Tmp = Cw_DataEnvi.DataConnect.Execute(str_tmp)
        If Not rs_Tmp.RecordCount = 0 Then
            ReDim arrVar_TableCon(rs_Tmp.RecordCount - 1, 2)
        End If
        k = 0
        Do While Not rs_Tmp.EOF()
            arrVar_TableCon(k, 0) = Trim(rs_Tmp.Fields("NowStatus"))                              '目前状态
            arrVar_TableCon(k, 1) = Format(Trim(rs_Tmp.Fields("BeginTime")), "yyyy-mm-dd hh:mm")  '要求时间
            arrVar_TableCon(k, 2) = Format(Trim(rs_Tmp.Fields("EndTime")), "yyyy-mm-dd hh:mm")    '完毕时间
            rs_Tmp.MoveNext
            k = k + 1
        Loop
        If Not rs_Tmp.RecordCount = 0 Then

            If JiText(0).Text < arrVar_TableCon(UBound(arrVar_TableCon, 1), 2) Then
                If Trim(JiText(1).Text) = "____-__-__ __:__" Then
                    Tsxx = "检斤完毕时间不能为空"
                    Call Xtxxts(Tsxx, 0, 1)
                    JiText(1).SetFocus
                    JiTextptpd = False
                    Exit Function
                End If
            End If
            For i = LBound(arrVar_TableCon, 1) To UBound(arrVar_TableCon, 1)
                If i = UBound(arrVar_TableCon, 1) Then
                    If JiText(0).Text >= arrVar_TableCon(i, 1) Then
                        Tsxx = "此车号正处于" & arrVar_TableCon(i, 0) & "状态，不能进行其他处理！"
                        Call Xtxxts(Tsxx, 0, 1)
                        JiText(0).SetFocus
                        JiTextptpd = False
                        Exit Function
                    End If
                End If
                If JiText(1).Text <> "____-__-__ __:__" Then
                    If JiText(1).Text >= arrVar_TableCon(i, 1) Then
                        Tsxx = "此车号正处于" & arrVar_TableCon(i, 0) & "状态，请重新输入时间！"
                        Call Xtxxts(Tsxx, 0, 1)
                         JiText(1).SetFocus
                        JiTextptpd = False
                        Exit Function
                    End If
                End If
            Next i
        End If
         '查询出各状态同车号已完成的记录并找出最大时间与填入的记录进行判断
        str_tmp = "select * from Tr_NowAccount where VehicleNum='" & Trim(LrText(0).Text) & "'and LimitMark=1 order by BeginTime      "
        Set rs_Tmp = Nothing
        Set rs_Tmp = Cw_DataEnvi.DataConnect.Execute(str_tmp)
        If Not rs_Tmp.RecordCount = 0 Then
            ReDim arrVar_TableCon2(rs_Tmp.RecordCount - 1, 2)
        End If
        k = 0
        Do While Not rs_Tmp.EOF()
            arrVar_TableCon2(k, 0) = Trim(rs_Tmp.Fields("NowStatus"))
            arrVar_TableCon2(k, 1) = Format(Trim(rs_Tmp.Fields("BeginTime")), "yyyy-mm-dd hh:mm")
            arrVar_TableCon2(k, 2) = Format(Trim(rs_Tmp.Fields("EndTime")), "yyyy-mm-dd hh:mm")
            rs_Tmp.MoveNext
            k = k + 1
        Loop
        If Not rs_Tmp.RecordCount = 0 Then
            If JiText(0).Text < arrVar_TableCon2(UBound(arrVar_TableCon2, 1), 2) Then
                If Trim(JiText(1).Text) = "____-__-__ __:__" Then
                    Tsxx = "检斤完毕时间不能为空"
                    Call Xtxxts(Tsxx, 0, 1)
                    JiText(1).SetFocus
                    JiTextptpd = False
                    Exit Function
                End If
            End If
            For i = LBound(arrVar_TableCon2, 1) To UBound(arrVar_TableCon2, 1)
                If JiText(0).Text >= arrVar_TableCon2(i, 1) And JiText(0).Text <= arrVar_TableCon2(i, 2) Then
                    Tsxx = "此车号在" & arrVar_TableCon2(i, 1) & "至" & arrVar_TableCon2(i, 2) & ",处于" & arrVar_TableCon2(i, 0) & "状态，请重新输入时间！"
                    Call Xtxxts(Tsxx, 0, 1)
                    JiText(0).SetFocus
                    JiTextptpd = False
                    Exit Function
                End If
                If JiText(1).Text >= arrVar_TableCon2(i, 1) And JiText(1).Text <= arrVar_TableCon2(i, 2) Then
                    Tsxx = "此车号在" & arrVar_TableCon2(i, 1) & "至" & arrVar_TableCon2(i, 2) & ",处于" & arrVar_TableCon2(i, 0) & "状态，请重新输入时间！"
                    Call Xtxxts(Tsxx, 0, 1)
                    JiText(1).SetFocus
                    JiTextptpd = False
                    Exit Function
                End If
                If JiText(0) <= arrVar_TableCon2(i, 1) And JiText(1).Text >= arrVar_TableCon2(i, 2) Then
                        Tsxx = "此车号在" & arrVar_TableCon2(i, 1) & "至" & arrVar_TableCon2(i, 2) & ",处于" & arrVar_TableCon2(i, 0) & "状态，请重新输入时间！"
                        Call Xtxxts(Tsxx, 0, 1)
                        JiText(1).SetFocus
                        JiTextptpd = False
                        Exit Function
                End If
            Next i
        End If
        
        
        
Else  '修改

            '先查询出同车号各状态正在进行的记录并找出最大时间与填入记录进行判断
            str_tmp = "select * from Tr_NowAccount where VehicleNum='" & Trim(LrText(0).Text) & "'and LimitMark=0 order by BeginTime      "
            Set rs_Tmp = Nothing
            Set rs_Tmp = Cw_DataEnvi.DataConnect.Execute(str_tmp)
            If Not rs_Tmp.RecordCount = 0 Then
                ReDim arrVar_TableCon(rs_Tmp.RecordCount - 1, 3)
            End If
            k = 0
            Do While Not rs_Tmp.EOF()
                arrVar_TableCon(k, 0) = Trim(rs_Tmp.Fields("NowStatus"))
                arrVar_TableCon(k, 1) = Format(Trim(rs_Tmp.Fields("BeginTime")), "yyyy-mm-dd hh:mm")
                arrVar_TableCon(k, 2) = Format(Trim(rs_Tmp.Fields("EndTime")), "yyyy-mm-dd hh:mm")
                arrVar_TableCon(k, 3) = rs_Tmp.Fields("VoucherId")
                rs_Tmp.MoveNext
                k = k + 1
            Loop
            If Not rs_Tmp.RecordCount = 0 Then
                For i = LBound(arrVar_TableCon, 1) To UBound(arrVar_TableCon, 1)
                    If i = UBound(arrVar_TableCon, 1) Then
                        If JiText(0).Text >= arrVar_TableCon(i, 1) And arrVar_TableCon(i, 3) <> CzxsGrid.TextMatrix(CzxsGrid.Row, 1) Then
                            Tsxx = "此车号正处于" & arrVar_TableCon(i, 0) & "状态，请重新输入时间！"
                            Call Xtxxts(Tsxx, 0, 1)
                            JiText(0).SetFocus
                            JiTextptpd = False
                            Exit Function
                        End If
                        If JiText(1).Text <> "____-__-__ __:__" Then
                            If JiText(1).Text >= arrVar_TableCon(i, 1) And arrVar_TableCon(i, 3) <> CzxsGrid.TextMatrix(CzxsGrid.Row, 1) Then
                                Tsxx = "此车号正处于" & arrVar_TableCon(i, 0) & "状态，请重新输入时间！"
                                Call Xtxxts(Tsxx, 0, 1)
                                 JiText(1).SetFocus
                                JiTextptpd = False
                                Exit Function
                            End If
                        End If
                    End If
                Next i
                str_tmp = "select * from Tr_Weigh where WeighId='" & dbl_RecordAutoCode & "'and result=0 order by WeighEndTime      "
                Set Findrec = Nothing
                Set Findrec = Cw_DataEnvi.DataConnect.Execute(str_tmp)
                If Findrec.RecordCount = 0 Then
                    If JiText(1).Text = "____-__-__ __:__" Then
                        Tsxx = "检斤完毕时间不能为空"
                        Call Xtxxts(Tsxx, 0, 1)
                        JiText(1).SetFocus
                        JiTextptpd = False
                        Exit Function
                    End If
                End If
            End If