VB开发的ERP系统

    
        '对需要进行事后判断的文本框录入内容进行有效性判断 (固定不变)
        For jsqte = 0 To Max_Text_Index
            If Textint(jsqte, 9) = 0 Or Textint(jsqte, 9) = 2 Then
                If Not TextYxxpd(jsqte) Then
                    Exit Function
                End If
            End If
        Next jsqte
   
        If Lrzt = 1 Then  '增 加
        
            '[>>判断编码是否重复
            If .State = 1 Then .Close
            .Open "SELECT * FROM Gy_Warehouse WHERE WhCode= '" + Trim(LrText(0).Text) + "'", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
    
            If Not .EOF Then
                Tsxx = "仓库编码重复!"
                Call Xtxxts(Tsxx, 0, 1)
                LrText(0).SetFocus
                Bclrsj = False
                Exit Function
            End If
    
            '判断名称是否重复
            If .State = 1 Then .Close
            .Open "SELECT * FROM Gy_Warehouse WHERE WhName= '" + Trim(LrText(1).Text) + "'", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
    
            If Not .EOF Then
                Tsxx = "仓库名称重复!"
                Call Xtxxts(Tsxx, 0, 1)
                LrText(1).SetFocus
                Bclrsj = False
                Exit Function
            End If

            '判断记录内容无误后,将记录内容写入数据表
            On Error GoTo Swcwcl
    
            Cw_DataEnvi.DataConnect.BeginTrans
   
            .AddNew
            .Fields("WhCode") = Trim(LrText(0).Text)             '仓库编码
            .Fields("WhName") = Trim(LrText(1).Text)             '仓库名称
            .Fields("Whprofix") = Trim(LrText(2).Text)           '仓库前缀
            If Trim(LrText(3).Tag) <> "" Then
                .Fields("deptcode") = Trim(LrText(3).Tag)        '所属部门
            Else
                .Fields("deptcode") = Null
            End If
            .Fields("whaddress") = Trim(LrText(4).Text)          '仓库地址
            .Fields("manageman") = Trim(LrText(5).Text)          '负责人
            .Fields("telephone") = Trim(LrText(6).Text)          '电话
            .Fields("moneyration") = Val(LrText(7).Text)         '资金定额
            .Fields("remark") = Trim(LrText(8).Text)             '备注
            
            .Fields("warehouseattribute") = Trim(Lrcomb(0).Text) '属性
            .Fields("pricemode") = Trim(Lrcomb(1).Text)          '记价方式
            
            .Fields("chhsuseflag") = Lrcheck(0).Value            '存货核算
            .Fields("ishqgl") = Lrcheck(1).Value                 '货区管理
            .Fields("isrepertory") = Lrcheck(2).Value            '储备预警
            
            .Update
            
            Cw_DataEnvi.DataConnect.CommitTrans

            '将记录加入网格
            Sqlstr = "SELECT * FROM Gy_V_Warehouse WHERE WhCode= '" + 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)
            
            Call Cshlrxx(1)
            LrText(0).SetFocus

            '将网格按编码排序
            With CzxsGrid
                .Col = Sydz("001", GridStr(), Szzls)
                CzxsGrid.Sort = flexSortStringAscending
            End With
            '<<]
    
        Else  '否则为修改记录
 
            If .State = 1 Then .Close
            .Open "SELECT * FROM Gy_Warehouse WHERE WhName= '" + Trim(LrText(1).Text) + "' and WhCode<>'" & Trim(LrText(0).Text) & "'", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic

            If Not .EOF Then
                Tsxx = "仓库名称重复!"
                Call Xtxxts(Tsxx, 0, 1)
                LrText(1).SetFocus
        
                Bclrsj = False
                Exit Function
            End If

            On Error GoTo Swcwcl

            Cw_DataEnvi.DataConnect.BeginTrans

            If .State = 1 Then .Close
            .Open "SELECT * FROM Gy_Warehouse WHERE WhCode= '" + Trim(LrText(0).Text) + "'", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
     
            If Not .EOF Then
                .Fields("WhName") = Trim(LrText(1).Text)             '仓库名称
                .Fields("Whprofix") = Trim(LrText(2).Text)           '仓库前缀
                If Trim(LrText(3).Tag) <> "" Then
                    .Fields("deptcode") = Trim(LrText(3).Tag)        '所属部门
                Else
                    .Fields("deptcode") = Null
                End If
                .Fields("whaddress") = Trim(LrText(4).Text)          '仓库地址
                .Fields("manageman") = Trim(LrText(5).Text)          '负责人
                .Fields("telephone") = Trim(LrText(6).Text)          '电话
                .Fields("moneyration") = Val(LrText(7).Text)         '资金定额
                .Fields("remark") = Trim(LrText(8).Text)             '备注
                
                .Fields("warehouseattribute") = Trim(Lrcomb(0).Text) '属性
                .Fields("pricemode") = Trim(Lrcomb(1).Text)          '记价方式
                
                .Fields("chhsuseflag") = Lrcheck(0).Value            '存货核算
                .Fields("ishqgl") = Lrcheck(1).Value                 '货区管理
                .Fields("isrepertory") = Lrcheck(2).Value            '储备预警
                .Update
            End If

             Cw_DataEnvi.DataConnect.CommitTrans
   
            '刷新当前网格
            Sqlstr = "SELECT * FROM Gy_V_Warehouse WHERE WhCode= '" + Trim(LrText(0).Text) + "'"
            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事件
    
    LrText(2).Enabled = True
    Lrcomb(0).Enabled = True
    Lrcomb(1).Enabled = True
    Lrcheck(1).Enabled = True
    lblMsg.Visible = False
    
    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
       
        '[>>
        Lrcomb(0).ListIndex = 0
        Lrcomb(1).ListIndex = 0
        Lrcheck(0).Value = 0
        Lrcheck(1).Value = 0
        Lrcheck(2).Value = 0
        
        '在此处可添加新增记录时初始化设置
        '<<]
    Else
    
        '修改记录时根据记录关键字(编码)从数据表中读入其他字段内容
        With RecTemp
            Sqlstr = "SELECT * FROM Gy_V_Warehouse Where WhCode='" & 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("WhCode") & "")              '仓库编码
                LrText(1).Text = Trim(.Fields("WhName") & "")              '仓库名称
                LrText(2).Text = Trim(.Fields("Whprofix") & "")            '仓库前缀
                LrText(3).Tag = Trim(.Fields("deptcode") & "")             '所属部门
                LrText(3).Text = Trim(.Fields("deptname") & "")            '所属部门
                LrText(4).Text = Trim(.Fields("whaddress") & "")           '仓库地址
                LrText(5).Text = Trim(.Fields("manageman") & "")           '负责人
                LrText(6).Text = Trim(.Fields("telephone") & "")           '电话
                LrText(7).Text = Trim(.Fields("moneyration") & "")         '资金定额
                LrText(8).Text = Trim(.Fields("remark") & "")              '备注
                
                Lrcomb(0).Text = Trim(.Fields("warehouseattribute") & "")  '仓库属性
                Lrcomb(1).Text = Trim(.Fields("pricemode") & "")           '计价方式
                
                If .Fields("chhsuseflag") Then                             '存货核算
                    Lrcheck(0).Value = 1
                Else
                    Lrcheck(0).Value = 0
                End If
                If .Fields("ishqgl") Then                                  '货区管理
                    Lrcheck(1).Value = 1
                Else
                    Lrcheck(1).Value = 0
                End If
                If .Fields("isrepertory") Then                             '储备预警
                    Lrcheck(2).Value = 1
                Else
                    Lrcheck(2).Value = 0
                End If
'****************************************************已使用仓库只能修改部分属性
'如果删除产生异常，说明记录已被引用
On Error GoTo ErrMsg
                Cw_DataEnvi.DataConnect.BeginTrans

                Cw_DataEnvi.DataConnect.Execute "delete Gy_warehouse where whcode = '" + Trim(CzxsGrid.TextMatrix(CzxsGrid.Row, Sydz("001", GridStr(), Szzls))) + "'"

                Cw_DataEnvi.DataConnect.RollbackTrans
                Cshlrxx = True
                TextChangeLock = False
                Exit Function

ErrMsg:
                Cw_DataEnvi.DataConnect.RollbackTrans
                If Err.Number = -2147217873 Then                '(-2147217873 为SQL Server 2000通过建立外键产生的错误号)
                    
                    
                    LrText(2).Enabled = False
                    Lrcomb(0).Enabled = False
                    Lrcomb(1).Enabled = False
                    Lrcheck(1).Enabled = False
                    lblMsg.Visible = True
                    
                    TextChangeLock = False
                    Cshlrxx = True
                    Exit Function
                Else
                    Tsxx = "出现未知情况,请重新进入系统再试!"
                    Call Xtxxts(Tsxx, 0, 4)
                    Call Cancel
                    TextChangeLock = False
                    Exit Function
                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 Gy_Warehouse where WhCode = '" + 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)
        Exit Sub
    Else
        Tsxx = "出现未知情况,此仓库不能被删除!"
        Call Xtxxts(Tsxx, 0, 1)
        Exit Sub
    End If
    
End Sub

'*******************以下区域为编写自定义过程区域**********************


'*******************以上区域为编写自定义过程区域**********************

'******************以下为基本处理程序(固定不变)************************'
Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)        '支持热键操作

    If Shift = 2 Then
        Select Case UCase(Chr(KeyCode))
            Case "P"                                                                          'Ctrl+P 打印
                If SzToolbar.Buttons("dy").Visible And SzToolbar.Buttons("dy").Enabled Then
                    Call bbyl(False)
                End If
            Case "A"                                                                          'Ctrl+A 增加
                '判断用户是否有此功能执行权限,如有则写上机日志(进入)
                If Not Security_Log(Str_RightEdit, Xtczybm, 1, True) Then
                    Exit Sub
                End If
                If SzToolbar.Buttons("zj").Visible And SzToolbar.Buttons("zj").Enabled Then
                    Call Toolbjzt
                    Lrzt = 1
                    Call Cshlrxx(Lrzt)
                    LrText(0).SetFocus
                    LrText(0).Enabled = True
                End If
            Case "D"                                                                          'Ctrl+D 删除
                If SzToolbar.Buttons("sc").Visible And SzToolbar.Buttons("sc").Enabled Then
                    Call Scdqjl
                End If
        End Select
    End If
    
End Sub

Private Sub SzToolbar_ButtonClick(ByVal Button As MSComctlLib.Button)
   
    Select Case Button.Key
        Case "ymsz"                                          '页面设置
            Dyymctbl.Show 1
        Case "yl"                                            '预 览
            Call bbyl(True)
        Case "dy"                                            '打 印
            Call bbyl(False)
        Case "zj"                                            '增 加
            '判断用户是否有此功能执行权限,如有则写上机日志(进入)
            If Not Security_Log(Str_RightEdit, Xtczybm, 1, True) Then
                Exit Sub
            End If
            Call Toolbjzt
            Lrzt = 1
            Call Cshlrxx(Lrzt)
            
            LrText(0).Enabled = True
            LrText(0).SetFocus
        Case "xg"                                            '修 改
            Call Xgdqjl
        Case "sc"                                            '删 除
            Call Scdqjl
        Case "Limit"                                         '权限
            '判断用户是否有此功能执行权限,如有则写上机日志(进入)
            If Not Security_Log("Gy_Warehouse_Power", Xtczybm, 1, True) Then
                Exit Sub
            End If
            If CzxsGrid.Rows <= CzxsGrid.FixedRows Then
                Tsxx = "没有仓库,不能设置仓库权限!"
                Call Xtxxts(Tsxx, 0, 4)
            Else
                RZ = CzxsGrid.Row
                LZ = Sydz("001", GridStr(), Szzls)
                Gy_WarehousePower.Show 1