VB开发的ERP系统

Dim Textstr() As String                  '存储字符型文本框信息
Dim Max_Text_Index As Integer            '最大录入文本框索引值
Dim TextGroupCode As String              '文本框录入分组编码
Dim TextValiLock As Boolean              '文本框失去焦点是否进行有效性控制判断
Dim TextValiJudgeLock() As Boolean       '文本框录入有效性判断控制锁
Dim CurTextIndex As Integer              '当前文本框索引值
Dim TextChangeLock As Boolean            '文本框内容变换控制锁
Dim Bln_Cancel As Boolean                '取消按钮信息传递
Public RZ As Long
Public LZ As Long

Private Sub Form_KeyPress(KeyAscii As Integer)   '控 制 焦 点 转 移

    jdzygs = 15
    
    Select Case KeyAscii
        Case vbKeyReturn
            If Kjjdzy(jdzygs) Then
                KeyAscii = 0
            End If
        Case 39           '屏蔽"'"
            KeyAscii = 0
   End Select
   
End Sub

Private Sub Form_Load()
  
    '打印报表标题信息
    ReportTitle = "仓 库 档 案 设 置"
     
    '调入打印页面设置窗体
    XtReportCode = "Gy_Warehouse"
    Load Dyymctbl
    
    '以下为文本框处理程序(读入文本框录入信息)
    TextGroupCode = "Gy_Warehouse"
    Call Drwbkxx(TextGroupCode, Textvar(), Textboolean(), Textint(), Textstr())
    Call Wbkcsh
    
    '调入网格设置信息
    GridCode = "Gy_Warehouse"
    Call BzWgcsh(CzxsGrid, GridCode, GridInf(), GridBoolean(), GridInt(), GridStr())
    Qslz = GridInf(1)
    Sjhgd = GridInf(2)
    Szzls = CzxsGrid.Cols - 1
    
    '填 充 网 格
    Call Cxnrtcwg
       
    '初始化toolbar,tab卡状态
    StTab.Tab = 0
    StTab.TabEnabled(1) = False
    Frame1.Enabled = False
     
    '设置为非录入状态
    Lrzt = 0
    
    '编辑(新增、修改、删除)权限索引
    Str_RightEdit = "Gy_Warehouse_Edit"
    
    Dim rs As New ADODB.Recordset
    
    Set rs = Cw_DataEnvi.DataConnect.Execute("select * from Xt_ComboList where combo_code='Gy_WhAttribute' order by item_index")
    Do While Not rs.EOF
        Lrcomb(0).AddItem Trim(rs("item_content"))
        rs.MoveNext
    Loop
    rs.Close
    Set rs = Cw_DataEnvi.DataConnect.Execute("select * from Xt_ComboList where combo_code='Gy_PriceMode' order by item_index")
    Do While Not rs.EOF
        Lrcomb(1).AddItem Trim(rs("item_content"))
        rs.MoveNext
    Loop
    
End Sub
 
Private Sub Cxnrtcwg()                               '查询内容填充网格

    Dim Sqlstr As String              '查询连接串
    Dim jsqte As Long                '查询临时使用变量
  
    '为加快显示速度,将网格刷新动作冻结
    CzxsGrid.Redraw = False
  
    '[>>查询连接串
    Sqlstr = "SELECT * FROM Gy_V_Warehouse order by WhCode"
    '<<]
    Set Cxnrrec = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
    
    With Cxnrrec
        CzxsGrid.Rows = CzxsGrid.FixedRows
        If .EOF And .BOF Then
            CzxsGrid.Redraw = True
            Exit Sub
        End If
        
        jsqte = CzxsGrid.FixedRows
        
        Do While Not .EOF
            CzxsGrid.AddItem ""
            Call Jltcwg(Cxnrrec, jsqte)                              '调入填充网格子过程
            CzxsGrid.RowHeight(jsqte) = Sjhgd                        '设置网格高度
            .MoveNext
            jsqte = jsqte + 1
        Loop
    End With
  
    '将网格刷新动作解冻
    CzxsGrid.Redraw = True
    
End Sub

Private Sub Jltcwg(Jlbrec As ADODB.Recordset, Rowjsq As Long)           '记录内容填充网格

    '[>>以下为自定义部分
    With Jlbrec
        CzxsGrid.TextMatrix(Rowjsq, Sydz("001", GridStr(), Szzls)) = Trim(.Fields("WhCode") & "")              '仓库编码
        CzxsGrid.TextMatrix(Rowjsq, Sydz("002", GridStr(), Szzls)) = Trim(.Fields("WhName") & "")              '仓库名称
        CzxsGrid.TextMatrix(Rowjsq, Sydz("003", GridStr(), Szzls)) = Trim(.Fields("Whprofix") & "")            '仓库前缀
        CzxsGrid.TextMatrix(Rowjsq, Sydz("004", GridStr(), Szzls)) = Trim(.Fields("Deptname") & "")            '所属部门
        CzxsGrid.TextMatrix(Rowjsq, Sydz("005", GridStr(), Szzls)) = Trim(.Fields("WhAddress") & "")           '仓库地址
        CzxsGrid.TextMatrix(Rowjsq, Sydz("006", GridStr(), Szzls)) = Trim(.Fields("pricemode") & "")           '记价方式
        CzxsGrid.TextMatrix(Rowjsq, Sydz("007", GridStr(), Szzls)) = Trim(.Fields("warehouseattribute") & "")  '属性
        CzxsGrid.TextMatrix(Rowjsq, Sydz("008", GridStr(), Szzls)) = Trim(.Fields("telephone") & "")           '电话
        CzxsGrid.TextMatrix(Rowjsq, Sydz("009", GridStr(), Szzls)) = Trim(.Fields("manageman") & "")           '负责人
        CzxsGrid.TextMatrix(Rowjsq, Sydz("010", GridStr(), Szzls)) = IIf(.Fields("moneyration") = 0, "", .Fields("moneyration") & "")     '资金定额
        CzxsGrid.TextMatrix(Rowjsq, Sydz("011", GridStr(), Szzls)) = Trim(.Fields("ishqgl") & "")              '是否货区管理
    End With
    '以上为自定义部分<<]
    
End Sub

Private Sub Form_Unload(Cancel As Integer)             '窗体卸载

    Set Cxnrrec = Nothing
    Set Rec_CodeSet = Nothing
    Unload Dyymctbl
   
End Sub

Private Function Bclrsj() As Boolean                   '判断录入数据有效性,并保存数据

    Dim jsqte As Integer
  
    '对文本框录入内容进行为零和为空判断(固定不变)
    With Rec_CodeSet
    
        For jsqte = 0 To Max_Text_Index
            If Textint(jsqte, 8) = 1 Then     '字段不能为空
                If Len(Trim(LrText(jsqte).Text)) = 0 Then
                    If LrText(jsqte).Enabled Then
                        Tsxx = Textstr(jsqte, 7) & "不能为空!"
                        Call Xtxxts(Tsxx, 0, 1)
                        LrText(jsqte).SetFocus
                        Bclrsj = False
                        Exit Function
                    End If
                End If
            Else
                If Textint(jsqte, 8) = 2 Then   '字段不能为零
                    If Val(Trim(LrText(jsqte).Text)) = 0 Then
                        Tsxx = Textstr(jsqte, 7) & "不能为零!"
                        Call Xtxxts(Tsxx, 0, 1)
                        LrText(jsqte).SetFocus
                        Bclrsj = False
                        Exit Function
                    End If
                End If
            End If
        Next jsqte
    
        '对需要进行事后判断的文本框录入内容进行有效性判断 (固定不变)
        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