VB开发的ERP系统

            
            Cw_DataEnvi.DataConnect.CommitTrans

'            '将记录加入网格
            Call Cxnrtcwg
            Tsxx = "保存完毕!"
            Call Xtxxts(Tsxx, 0, 4)
            
            Call Cshlrxx(1)
            LrText(0).SetFocus

            '将网格按编码排序

            '<<]
    
        Else  '否则为修改记录
            On Error GoTo Swcwcl
            Cw_DataEnvi.DataConnect.BeginTrans
            If .State = 1 Then .Close
            .Open "SELECT * FROM Tr_Move WHERE MoveId= '" & dbl_RecordAutoCode & "'", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
     
            If Not .EOF Then
                .Fields("ParkCode") = Trim(LrText(2).Tag & "")
                If Trim(JiText(0).Text) <> "____-__-__ __:__" Then
                    .Fields("MoveTime") = Format(JiText(0).Text, "yyyy-mm-dd hh:mm")          '要求调车时间
                Else
                    .Fields("MoveTime") = Null
                End If
                If Trim(JiText(1).Text) <> "____-__-__ __:__" Then
                    .Fields("MoveEndTime") = Format(JiText(1).Text, "yyyy-mm-dd hh:mm")       '调车完毕时间
                Else
                    .Fields("MoveEndTime") = Null
                End If
                If Trim(LrText(3).Text) <> "" Then
                    .Fields("MoveMan") = Trim(LrText(3).Text & "")                            '调车负责人
                Else
                    .Fields("MoveMan") = ""
                End If
                If Trim(JiText(1).Text) <> "____-__-__ __:__" Then                            '调车状态
                    .Fields("Result") = 1
                Else
                    .Fields("Result") = 0
                End If
                .Update
            End If
            If Findrc.State = 1 Then Findrc.Close
                Findrc.Open "SELECT * FROM Tr_NowAccount where ChildId = '" & dbl_RecordAutoCode & "'and VoucherNum=10", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
                If Not Findrc.EOF Then
                    If Not IsNull(.Fields("MoveTime")) Then
                         Findrc.Fields("BeginTime") = Format(Trim(.Fields("MoveTime")), "yyyy-mm-dd hh:mm")  '各状态要求时间
                    Else
                         Findrc.Fields("BeginTime") = Format(Trim(.Fields("MoveTime")), "yyyy-mm-dd hh:mm")
                    End If
                    If Not IsNull(.Fields("MoveEndTime")) Then
                         Findrc.Fields("EndTime") = Format(Trim(.Fields("MoveEndTime")), "yyyy-mm-dd hh:mm") '各状态完毕时间
                    Else
                         Findrc.Fields("EndTime") = Format(Trim(.Fields("MoveTime")), "yyyy-mm-dd hh:mm")
                    End If
                    Findrc.Fields("MNumber") = Null
                    Findrc.Fields("ParkCode") = Trim(.Fields("ParkCode") & "")
                    If .Fields("Result") = True Then
                        Findrc.Fields("NowStatus") = "已调车"                                                 '目前状态
                        Findrc.Fields("LimitMark") = 1
                    Else
                        Findrc.Fields("NowStatus") = "调车"
                        Findrc.Fields("LimitMark") = 0
                    End If
                    
                    Findrc.Update
                End If
             Cw_DataEnvi.DataConnect.CommitTrans
   
            '刷新当前网格
             Call Cxnrtcwg
        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              '初始化录入字段信息
Dim str_tmp As String
Dim rs_Tmp As New ADODB.Recordset
    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_Move Where  MoveId='" & 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") & " ")
                If Trim(CzxsGrid.TextMatrix(CzxsGrid.Row, Sydz("002", GridStr(), szzls))) = "" Then
                    LrText(1).Text = ""
                Else
                    LrText(1).Text = CzxsGrid.TextMatrix(CzxsGrid.Row, Sydz("002", GridStr(), szzls))
                End If
                
                str_tmp = "select parkcode,parkname from tr_park where parkcode = '" & Trim(RecTemp.Fields("parkcode") & " ") & "'  order by parkcode  "
                Set rs_Tmp = Nothing
                Set rs_Tmp = Cw_DataEnvi.DataConnect.Execute(str_tmp)
                If Not rs_Tmp.RecordCount = 0 Then
                    LrText(2).Tag = Trim(rs_Tmp.Fields("parkcode") & " ")
                    LrText(2).Text = Trim(rs_Tmp.Fields("parkname") & " ")                     '现停车线号
                End If
                JiText(0).Text = Format(Trim(RecTemp.Fields("MoveTime")), "yyyy-mm-dd hh:mm")  '要求调车时间
                If IsNull(Trim(RecTemp.Fields("MoveEndTime"))) Then                            '调车完毕时间
                    JiText(1).Text = "____-__-__ __:__"
                Else
                    JiText(1).Text = Format(Trim(RecTemp.Fields("MoveEndTime")), "yyyy-mm-dd hh:mm")
                End If
                If Not IsNull(RecTemp.Fields("MoveMan")) Then                                  '调车负责人
                    LrText(3).Text = Trim(RecTemp.Fields("MoveMan") & "")
                Else
                    LrText(3).Text = ""
                End If
                dbl_RecordAutoCode = RecTemp.Fields("MoveId")
            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_Move where MoveId = '" + Trim(CzxsGrid.TextMatrix(CzxsGrid.Row, 0)) + "'"
    Cw_DataEnvi.DataConnect.Execute "delete Tr_NowAccount where ChildId = '" + Trim(CzxsGrid.TextMatrix(CzxsGrid.Row, 0)) + "'and VoucherNum=10 "
  
    '以上为自定义部分<<]
  
    Cw_DataEnvi.DataConnect.CommitTrans

    CzxsGrid.RemoveItem CzxsGrid.Row
    
    Call Cxnrtcwg
    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