VB开发的ERP系统

Dim Szzls As Integer                     '数组总列数(网格列数-1)

'以下为固定使用变量(文本框)
Dim Textvar() As Variant                 '存储变体型文本框信息
Dim Textboolean() As Boolean             '存储布尔型文本框信息
Dim Textint() As Integer                 '存储整型文本框信息
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                '取消按钮信息传递

Dim nodX As Node
Dim CodSchemeIndex As String             '编码方案编码
Dim CodScheme As String                  '编码方案
Dim ParentCode As String                 '上级编码
Dim CodeLevel As Integer                 '编码级次

Private Sub CzxsGrid_Click()

    Dim count As Integer
    
    With CzxsGrid
        If Trim(.TextMatrix(.Row, Sydz("001", GridStr(), Szzls))) <> "" And .Rows <> .FixedRows Then
            TreeView.Nodes("T" & Trim(.TextMatrix(.Row, Sydz("001", GridStr(), Szzls)))).Selected = True
            TreeView.SetFocus
        End If
    End With

End Sub

Private Sub Form_KeyPress(KeyAscii As Integer)   '控 制 焦 点 转 移
    
    jdzygs = 10
    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()
    
    CodSchemeIndex = "Gdzc_Sort"
    Add_Tree
    Text_CodScheme
  
    '打印报表标题信息
    ReportTitle = "固定资产类别设置"
   
    '调入打印页面设置窗体
    XtReportCode = "Gdzc_Sort"
    Load Dyymctbl
  
    '以下为文本框处理程序(读入文本框录入信息)
    TextGroupCode = "Gdzc_Sort"
    Call Drwbkxx(TextGroupCode, Textvar(), Textboolean(), Textint(), Textstr())
    Call Wbkcsh
  
    '调入网格设置信息
    GridCode = "Gdzc_Sort"
    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
       
    '设置为非录入状态
    Lrzt = 0
    
    '将默认值赋给折旧方法下拉列表框
    Com_DeprMethod.Text = "不计提折旧"
    
    '编辑(新增、修改、删除)权限索引
    Str_RightEdit = "Gdzc_FaSort_Edit"
    
End Sub

Private Sub Cxnrtcwg()                               '查询内容填充网格
    
    Dim Sqlstr As String              '查询连接串
    Dim Jsqte As Long                 '查询临时使用变量
  
    '为加快显示速度,将网格刷新动作冻结
    CzxsGrid.Redraw = False
  
    '[>>查询连接串
    Sqlstr = "SELECT * FROM Gdzc_Sort order by FASortCode"
  
    '<<]
  
    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("FaSortCode") & "")            '类别编码
        CzxsGrid.TextMatrix(Rowjsq, Sydz("002", GridStr(), Szzls)) = Trim(.Fields("FaSortName") & "")            '类别名称
        CzxsGrid.TextMatrix(Rowjsq, Sydz("003", GridStr(), Szzls)) = Trim(.Fields("CodeLevel") & "")             '级次
        CzxsGrid.TextMatrix(Rowjsq, Sydz("004", GridStr(), Szzls)) = Trim(.Fields("FAParentCode") & "")          '上级编码
        Select Case .Fields("DeprMethod")                                                                        '折旧方法
            Case "01"
                CzxsGrid.TextMatrix(Rowjsq, Sydz("005", GridStr(), Szzls)) = "不计提折旧"
            Case "02"
                CzxsGrid.TextMatrix(Rowjsq, Sydz("005", GridStr(), Szzls)) = "平均年限法(依净资产计提折旧)"
            Case "03"
                CzxsGrid.TextMatrix(Rowjsq, Sydz("005", GridStr(), Szzls)) = "平均年限法(依帐面原值计提折旧)"
            Case "04"
                CzxsGrid.TextMatrix(Rowjsq, Sydz("005", GridStr(), Szzls)) = "工作量法"
            Case "05"
                CzxsGrid.TextMatrix(Rowjsq, Sydz("005", GridStr(), Szzls)) = "固定折旧额折旧法"
            Case "06"
                CzxsGrid.TextMatrix(Rowjsq, Sydz("005", GridStr(), Szzls)) = "年数总和法"
            Case "07"
                CzxsGrid.TextMatrix(Rowjsq, Sydz("005", GridStr(), Szzls)) = "双倍余额法"
        End Select
        CzxsGrid.TextMatrix(Rowjsq, Sydz("006", GridStr(), Szzls)) = Trim(.Fields("UseYears") & "")              '使用年限
        CzxsGrid.TextMatrix(Rowjsq, Sydz("007", GridStr(), Szzls)) = Trim(.Fields("SalvageRate") & "")           '残值率
        CzxsGrid.TextMatrix(Rowjsq, Sydz("008", GridStr(), Szzls)) = Trim(.Fields("DeprRate") & "")              '月折旧率
        CzxsGrid.TextMatrix(Rowjsq, Sydz("009", GridStr(), Szzls)) = Trim(.Fields("EndFlag") & "")               '是否末级
    End With
    '以上为自定义部分<<]

    Call Txt_Clear
    
End Sub

Private Sub Form_Resize()
    
    On Error Resume Next
    
    Dim St_tab As Integer
    If Me.Height < 7000 Then Me.Height = 7000
    If Me.Width < 10000 Then Me.Width = 10000

    StTab.Width = Me.Width - (TreeView.Width + 300)
    StTab.Height = Me.Height - (StTab.Top + 400)
    TreeView.Height = Me.Height - (TreeView.Top + 400)
    imgSplitter.Height = TreeView.Height

    St_tab = StTab.Tab
    StTab.Tab = 0
    CzxsGrid.Width = StTab.Width - CzxsGrid.Left * 2
    CzxsGrid.Height = StTab.Height - 500
    StTab.Tab = St_tab

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
                    Tsxx = Textstr(Jsqte, 7) & "不能为空!"
                    Call Xtxxts(Tsxx, 0, 1)
                    LrText(Jsqte).SetFocus
                    Bclrsj = False
                    Exit Function
                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
   
        '判断“残值率”和“月折旧率”的输入值不能大于100%
        If Val(LrText(3).Text) > 100 Then
            Tsxx = "残值率不能超过100%!"
            Call Xtxxts(Tsxx, 0, 1)
            LrText(3).Text = ""
            LrText(3).SetFocus
            Exit Function
        End If
        If Val(LrText(4).Text) > 100 Then
            Tsxx = "月折旧率不能超过100%!"
            Call Xtxxts(Tsxx, 0, 1)
            LrText(4).Text = ""
            LrText(4).SetFocus
            Exit Function
        End If

        '判断记录内容无误后,将记录内容写入数据表

        If Lrzt = 1 Then  '增 加
        
            
            '[>>判断编码是否重复
            If .State = 1 Then .Close
            .Open "SELECT * FROM Gdzc_Sort WHERE FaSortCode= '" + 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 Gdzc_Sort WHERE FaSortName= '" + 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("FaSortCode") = Trim(LrText(0).Text)    '资产类别编码
            .Fields("FaSortName") = Trim(LrText(1).Text)    '资产类别名称
            .Fields("FAParentCode") = ParentCode            '上级编码
            .Fields("CodeLevel") = CodeLevel                '编码级次
            Select Case Trim(Com_DeprMethod.Text)           '折旧方法
                Case "不计提折旧"
                    .Fields("DeprMethod") = "01"
                Case "平均年限法(依净资产计提折旧)"
                    .Fields("DeprMethod") = "02"
                Case "平均年限法(依帐面原值计提折旧)"
                    .Fields("DeprMethod") = "03"
                Case "工作量法"
                    .Fields("DeprMethod") = "04"
                Case "固定折旧额折旧法"
                    .Fields("DeprMethod") = "05"
                Case "年数总和法"
                    .Fields("DeprMethod") = "06"
                Case "双倍余额法"
                    .Fields("DeprMethod") = "07"
            End Select
            .Fields("UseYears") = Val(LrText(2).Text)
            .Fields("SalvageRate") = Val(LrText(3).Text)
            .Fields("DeprRate") = Val(LrText(4).Text)
            .Update
            Cw_DataEnvi.DataConnect.Execute "update Gdzc_Sort set EndFlag=0  where FaSortCode='" & ParentCode & "'"
    
            Cw_DataEnvi.DataConnect.CommitTrans
            Add_Tree
            ParentCode = "": CodeLevel = 0
   
            '将记录加入网格
            Call Cxnrtcwg

            Tsxx = "保存完毕!"
            Call Xtxxts(Tsxx, 0, 4)
            Call Cshlrxx(1)
            LrText(0).SetFocus

            '将网格按编码排序
            With CzxsGrid
                .Col = Sydz("001", GridStr(), Szzls)
                CzxsGrid.Sort = flexSortStringAscending
            End With
            '<<]
            Exit Function
        Else  '否则为修改记录
 
            Set rstemp = New ADODB.Recordset
            rstemp.Open "Select * from Gdzc_Sort where FASortCode='" & Trim(LrText(0).Text) & "'", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
            If rstemp.EOF Then
                Tsxx = "您要修改的类别已经被别人删除!"
                Call Xtxxts(Tsxx, 0, 4)
                Exit Function
            End If
            rstemp.Close
            Set rstemp = Nothing

            On Error GoTo Swcwcl
            Cw_DataEnvi.DataConnect.BeginTrans
            
            If .State = 1 Then .Close
            .Open "SELECT * FROM Gdzc_Sort WHERE FaSortCode= '" + Trim(LrText(0).Text) + "'", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
            If Not .EOF Then
                .Fields("FaSortName") = Trim(LrText(1).Text)    '资产类别名称
                Select Case Trim(Com_DeprMethod.Text)           '折旧方法
                    Case "不计提折旧"
                        .Fields("DeprMethod") = "01"
                    Case "平均年限法(依净资产计提折旧)"
                        .Fields("DeprMethod") = "02"