⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 +

📁 VB开发的ERP系统
💻
📖 第 1 页 / 共 5 页
字号:
    
    
            '判断记录内容无误后,将记录内容写入数据表
            On Error GoTo Swcwcl

            Cw_DataEnvi.DataConnect.BeginTrans
   
            .AddNew
                .Fields("VehicleNum") = Trim(LrText(0).Text)          '车号
                .Fields("TypeCode") = Trim(LrText(1).Tag)             '车辆类型
                .Fields("NowGradeCode") = Trim(LrText(2).Tag)         '车辆等级
                .Fields("UseNatureCode") = Trim(LrText(3).Tag)        '车辆使用性质
                .Fields("SituationCode") = Trim(LrText(4).Tag)        '车辆状况
                .Fields("OwnerShipCode") = Trim(LrText(5).Tag)        '车辆所有权
                .Fields("SelfWeight") = Val(LrText(6).Text)           '自重
                .Fields("LoadWeight") = Val(LrText(7).Text)           '载重
                .Fields("FormerValue") = Val(LrText(8).Text)          '原值
                .Fields("YearOld") = Val(LrText(9).Text)              '年折旧率
                If Trim(LrText(10).Text) <> "" Then
                  .Fields("Outdays") = Format(Trim(LrText(10).Text), "yyyy-mm-dd")        '出厂日期
                Else
                  .Fields("Outdays") = Null
                End If
                .Fields("UseYear") = Val(LrText(11).Text)             '使用年限
                If Trim(LrText(12).Text) <> "" Then
                  .Fields("MadeIn") = Trim(LrText(12).Text)           '制造单位
                Else
                  .Fields("MadeIn") = Null
                End If
                If Trim(LrText(13).Text) <> "" Then
                  .Fields("RightUnit") = Trim(LrText(13).Text)        '产权单位
                Else
                  .Fields("RightUnit") = Null
                End If
                If Trim(LrText(14).Text) <> "" Then
                  .Fields("Remark") = Trim(LrText(14).Text)        '产权单位
                Else
                  .Fields("Remark") = Null
                End If
                If Chk_Scrap.Value = 1 Then                           '停用标记
                   .Fields("IfScrap") = 1
                Else
                   .Fields("IfScrap") = 0
                End If
                
            .Update
            
            Cw_DataEnvi.DataConnect.CommitTrans
   
            '将记录加入网格
            Sqlstr = "SELECT * FROM Tr_V_VehicleFile WHERE VehicleNum= '" + Trim(LrText(0).Text) + "'"
            Set Cxnrrec = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
            
            With CzxsGrid
                .AddItem ""
                .RowHeight(.Rows - 1) = Sjhgd
                .Select .Rows - 1, Qslz
                Call Jltcwg(Cxnrrec, .Rows - 1)
            End With
   
            Tsxx = "保存完毕!"
            Call Xtxxts(Tsxx, 0, 4)
            Int_Empty = 1
            Call Cshlrxx(1)
            For jsqte = 0 To Max_Text_Index
                LrText(jsqte).Enabled = True
                If Textboolean(jsqte, 1) Then
                  Ydcommand1(jsqte).Enabled = True
                End If
            Next jsqte
            LrText(0).SetFocus
            Int_Empty = 1
              Chk_Scrap.Value = 0
            Int_Empty = 0
            '将网格按编码排序
            With CzxsGrid
                .Col = Sydz("001", GridStr(), szzls)
                CzxsGrid.Sort = flexSortStringAscending
            End With
            '<<]
    
        Else  '否则为修改记录
 
        
            On Error GoTo Swcwcl
        
            Cw_DataEnvi.DataConnect.BeginTrans
         
            If .State = 1 Then
              Set Rec_CodeSet = Nothing
              .Close
            End If
            .Open "SELECT * FROM Tr_VehicleFile WHERE VehicleNum= '" + Trim(LrText(0).Text) + "'", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
             
            If Not .EOF Then
                .Fields("TypeCode") = Trim(LrText(1).Tag)             '车辆类型
                .Fields("NowGradeCode") = Trim(LrText(2).Tag)         '车辆等级
                .Fields("UseNatureCode") = Trim(LrText(3).Tag)        '车辆使用性质
                .Fields("SituationCode") = Trim(LrText(4).Tag)        '车辆状况
                .Fields("OwnerShipCode") = Trim(LrText(5).Tag)        '车辆所有权
                .Fields("SelfWeight") = Val(LrText(6).Text)           '自重
                .Fields("LoadWeight") = Val(LrText(7).Text)           '载重
                .Fields("FormerValue") = Val(LrText(8).Text)          '原值
                .Fields("YearOld") = Val(LrText(9).Text)              '年折旧率
                If Trim(LrText(10).Text) <> "" Then
                  .Fields("Outdays") = Format(Trim(LrText(10).Text), "yyyy-mm-dd")        '出厂日期
                Else
                  .Fields("Outdays") = Null
                End If
                .Fields("UseYear") = Val(LrText(11).Text)             '使用年限
                If Trim(LrText(12).Text) <> "" Then
                  .Fields("MadeIn") = Trim(LrText(12).Text)           '制造单位
                Else
                  .Fields("MadeIn") = Null
                End If
                If Trim(LrText(13).Text) <> "" Then
                  .Fields("RightUnit") = Trim(LrText(13).Text)        '产权单位
                Else
                  .Fields("RightUnit") = Null
                End If
                If Trim(LrText(14).Text) <> "" Then
                  .Fields("Remark") = Trim(LrText(14).Text)        '产权单位
                Else
                  .Fields("Remark") = Null
                End If
                If Chk_Scrap.Value = 1 Then                           '停用标记
                   .Fields("IfScrap") = 1
                Else
                   .Fields("IfScrap") = 0
                End If
                .Update
            End If
            
            Cw_DataEnvi.DataConnect.CommitTrans
            
            '刷新当前网格
            Sqlstr = "SELECT * FROM Tr_V_VehicleFile WHERE VehicleNum= '" + Trim(LrText(0).Text) + "'"
            Set Cxnrrec = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
            
            If Not Cxnrrec.EOF Then
                With CzxsGrid
                    Call Jltcwg(Cxnrrec, .Row)
                End With
            Else
                Tsxx = "该记录已经被其他人删除,请刷新当前数据!"
                Call Xtxxts(Tsxx, 0, 4)
                Exit Function
            End If

        End If
     
        '保存记录成功,函数返回真值
        Bclrsj = True
        Exit Function
    End With
 
Swcwcl:
'
    If Err.Number = -2147217887 Then
      Cw_DataEnvi.DataConnect.RollbackTrans
      Tsxx = "数值录入不规范!"
      Call Xtxxts(Tsxx, 0, 1)
      Set Rec_CodeSet = Nothing
      Exit Function
    Else
      Cw_DataEnvi.DataConnect.RollbackTrans
      Tsxx = "存盘过程中出现错误,程序自动恢复保存前状态!"
      Call Xtxxts(Tsxx, 0, 1)
      Exit Function
    End If
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
        
        '[>>
        '在此处可添加新增记录时初始化设置
'        Chk_Scrap.Value = 0
'        StopFlag = 1
        '<<]
    Else
    
        '修改记录时根据记录关键字(编码)从数据表中读入其他字段内容
        With RecTemp
        
            Sqlstr = "SELECT Tr_V_VehicleFile.* FROM Tr_V_VehicleFile Where VehicleNum='" & Trim(CzxsGrid.TextMatrix(CzxsGrid.Row, Sydz("001", GridStr(), szzls))) & "'"
            Set RecTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
       
            '记录如存在则读入其内容,否则提示记录已被其他人删除
            If Not RecTemp.EOF Then
                LrText(0).Text = Trim(.Fields("VehicleNum") & "")                '车号
                LrText(1).Text = Trim(.Fields("TypeName") & "")                  '车辆类型
                LrText(1).Tag = Trim(.Fields("TypeCode") & "")
                LrText(2).Text = Trim(.Fields("NowGradeName") & "")              '车辆等级
                LrText(2).Tag = Trim(.Fields("NowGradeCode") & "")
                LrText(3).Text = Trim(.Fields("UseNatureName") & "")             '车辆使用性质
                LrText(3).Tag = Trim(.Fields("UseNatureCode") & "")
                LrText(4).Text = Trim(.Fields("SituationName") & "")             '车辆状况
                LrText(4).Tag = Trim(.Fields("SituationCode") & "")
                LrText(5).Text = Trim(.Fields("OwnerShipName") & "")             '车辆所有权
                LrText(5).Tag = Trim(.Fields("OwnerShipCode") & "")
                If .Fields("SelfWeight") <> 0 Then                                                                          '自重
                    LrText(6).Text = .Fields("SelfWeight")
                Else
                    LrText(6).Text = ""
                End If
                If .Fields("LoadWeight") <> 0 Then                                                                          '载重
                    LrText(7).Text = .Fields("LoadWeight")
                Else
                    LrText(7).Text = ""
                End If
                If .Fields("FormerValue") <> 0 Then                                                                         '原值
                    LrText(8).Text = .Fields("FormerValue")
                Else
                    LrText(8).Text = ""
                End If
         
                If .Fields("YearOld") <> 0 Then                                                                             '年折旧率
                    LrText(9).Text = .Fields("YearOld")
                Else
                    LrText(9).Text = ""
                End If
                
                If Not IsNull(.Fields("Outdays")) Then                                                                        '出厂日期
                    LrText(10).Text = Format(Trim(.Fields("Outdays")), "yyyy-mm-dd")
                Else
                    LrText(10).Text = ""
                End If
           
                If .Fields("UseYear") <> 0 Then                                                                             '使用年限
                    LrText(11).Text = .Fields("UseYear")
                Else
                    LrText(11).Text = ""
                End If
            
                If Not IsNull(.Fields("MadeIn")) Then                                                                         '制造单位
                    LrText(12).Text = Trim(.Fields("MadeIn") & "")
                Else
                    LrText(12).Text = ""
                End If
    
                If Not IsNull(.Fields("RightUnit")) Then                                                                      '产权单位
                    LrText(13).Text = Trim(.Fields("RightUnit") & "")
                Else
                    LrText(13).Text = ""
                End If
                
                If Not IsNull(.Fields("Remark")) Then                                                                         '备注
                    LrText(14).Text = Trim(.Fields("Remark") & "")
                Else
                    LrText(14).Text = ""
                End If
          
            
                Chk_Scrap.Enabled = True
                If .Fields("IfScrap") Then                                                                                  '停用标记
                   StopFlag = 1
                   Chk_Scrap.Value = 1
                   StopFlag = 0
                Else
                   StopFlag = 1
                   Chk_Scrap.Value = 0
                   StopFlag = 0
                End If
            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
    
    '判断用户是否有此功能执行权限,如有则写上机日志(进入)
    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_VehicleFile where VehicleNum = '" + Trim(CzxsGrid.TextMatrix(CzxsGrid.Row, Sydz("001", GridStr(), szzls))) + "'"
    '以上为自定义部分]
  
    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)

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -