+

VB开发的ERP系统

    '调入打印页面设置窗体
    XtReportCode = "KF_MArea"
    Load Dyymctbl
  
    '以下为文本框处理程序(读入文本框录入信息)
    TextGroupCode = "Kf_MArea"
    Call Drwbkxx(TextGroupCode, Textvar(), Textboolean(), Textint(), Textstr())
    Call Wbkcsh
  
    '调入网格设置信息
    GridCode = "Kf_MArea"
    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
   
   Str_RightEdit = "Kf_Area_Edit"
    '设置为非录入状态
    Lrzt = 0
    Set TreeView.SelectedItem = TreeView.Nodes.Item(1)
    
End Sub

Private Sub Cxnrtcwg()                               '查询内容填充网格
    
    Dim Sqlstr As String              '查询连接串
    Dim jsqte As Long                 '查询临时使用变量
    Dim lngSelectRow As Long
  
    '为加快显示速度,将网格刷新动作冻结
    CzxsGrid.Redraw = False
  
    '[>>查询连接串
    Sqlstr = "SELECT * FROM KF_V_Area where whcode in (select whcode from gy_whlimit where czybm='" & Xtczybm & "') order by MArea"
  
    '<<]
  
    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                        '设置网格高度
            If Trim(.Fields("MArea")) = strMArea Then
                lngSelectRow = jsqte
            End If
            .MoveNext
            jsqte = jsqte + 1
        Loop
        CzxsGrid.Select lngSelectRow, 0
    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("MArea") & "")                '货区编码
        CzxsGrid.TextMatrix(Rowjsq, Sydz("002", GridStr(), Szzls)) = Trim(.Fields("MAreaName") & "")            '货区名称
        CzxsGrid.TextMatrix(Rowjsq, Sydz("003", GridStr(), Szzls)) = Trim(.Fields("WhName") & "")               '仓库名称
        CzxsGrid.TextMatrix(Rowjsq, Sydz("004", GridStr(), Szzls)) = Trim(.Fields("CodeLevel") & "")            '级次
        CzxsGrid.TextMatrix(Rowjsq, Sydz("005", GridStr(), Szzls)) = Trim(.Fields("EndFlag") & "")              '末级标志
        CzxsGrid.TextMatrix(Rowjsq, Sydz("006", GridStr(), Szzls)) = Trim(.Fields("WhCode") & "")               '仓库名称

    End With
    '以上为自定义部分<<]

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
   
        If Lrzt = 1 Then  '增 加
        
            '[>>判断编码是否重复
            If .State = 1 Then .Close
            .Open "SELECT * FROM KF_MArea WHERE MArea= '" + 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 kf_MArea WHERE MAreaName= '" + 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("MArea") = Trim(LrText(0).Text)         '货区编码
            .Fields("MAreaName") = Trim(LrText(1).Text)     '货区名称
            .Fields("WhCode") = Trim(LrText(2).Tag)         '所属仓库
            .Fields("ParentCode") = ParentCode              '上级编码
            .Fields("CodeLevel") = CodeLevel                '编码级次
            .Fields("EndFlag") = 1
            .Update
            Cw_DataEnvi.DataConnect.Execute "update KF_MArea set EndFlag=0  where MArea='" & ParentCode & "'"
            ParentCode = Trim(LrText(2).Tag) & ParentCode
            Cw_DataEnvi.DataConnect.CommitTrans
            If CodeLevel <> 1 Then
                Set nodX = TreeView.Nodes.Add("T" & Mid(ParentCode, Len(ParentCode) - Len(Trim(LrText(2).Tag)) + 1), 4, "T" & ParentCode & LrText(0).Text, "(" & Trim(LrText(0).Text) & ")" & Trim(LrText(1).Text), "C")
                nodX.EnsureVisible
            Else
                Set nodX = TreeView.Nodes.Add("T" & Trim(LrText(2).Tag) & "*", 4, "T" & LrText(0).Text, "(" & Trim(LrText(0).Text) & ")" & Trim(LrText(1).Text), "C")
            End If
            ParentCode = "": CodeLevel = 0
            
            '将记录加入网格
            strMArea = Trim(LrText(0).Text)
            Call Cxnrtcwg

            Tsxx = "保存完毕!"
            Call Xtxxts(Tsxx, 0, 4)
            Call Cshlrxx(1)
            '将网格按编码排序
            With CzxsGrid
                .Col = Sydz("001", GridStr(), Szzls)
                CzxsGrid.Sort = flexSortStringAscending
            End With
            '<<]
    
        Else  '否则为修改记录
 
            If Rec_CodeSet.State = 1 Then Rec_CodeSet.Close
            Rec_CodeSet.Open "SELECT * FROM kf_MArea WHERE MAreaName= '" + Trim(LrText(1).Text) + "' and MArea<>'" & 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 kf_MArea WHERE MArea= '" + Trim(LrText(0).Text) + "'", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
            If Not .EOF Then
                .Fields("MAreaName") = Trim(LrText(1).Text)     '货区名称
                .Fields("WhCode") = Trim(LrText(2).Tag)         '仓库名称
                .Update
            End If
            TreeView.Nodes("T" & Trim(CzxsGrid.TextMatrix(CzxsGrid.Row, Sydz("001", GridStr(), Szzls)))).Text = "(" & Trim(LrText(0).Text) & ")" & Trim(LrText(1).Text)
            Cw_DataEnvi.DataConnect.CommitTrans
   
            '刷新当前网格
            Sqlstr = "SELECT * FROM KF_V_Area WHERE MArea= '" + 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              '初始化录入字段信息
    
    Dim adoRec As New ADODB.Recordset
    Dim strSQL As String
    
    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
        '[>>
        '在此处可添加新增记录时初始化设置
        If TreeView.SelectedItem.Key <> "T" Then
            If TreeView.SelectedItem.Parent.Key <> "T" Then
                
                If CzxsGrid.Row > 0 Then
                    LrText(0).Text = Trim(CzxsGrid.TextMatrix(CzxsGrid.Row, Sydz("001", GridStr(), Szzls)))
                    LrText(2).Text = Trim(CzxsGrid.TextMatrix(CzxsGrid.Row, Sydz("003", GridStr(), Szzls)))
                    LrText(2).Tag = Trim(CzxsGrid.TextMatrix(CzxsGrid.Row, Sydz("006", GridStr(), Szzls)))
                End If
            Else
                LrText(2).Text = Mid(TreeView.SelectedItem.Text, Len(TreeView.SelectedItem.Key) + 1)
                LrText(2).Tag = Mid(TreeView.SelectedItem.Key, Len(TreeView.SelectedItem.Root.Key) + 1, Len(TreeView.SelectedItem.Key) - 2)
            End If
            LrText(2).Enabled = False
            Ydcommand1(2).Enabled = False
        End If
        Set TreeView.SelectedItem = TreeView.Nodes.Item(1)
        LrText(0).SetFocus
        LrText(0).Locked = False

        '<<]
    Else
        '修改记录时根据记录关键字(编码)从数据表中读入其他字段内容
        With RecTemp
            Sqlstr = "SELECT * FROM KF_V_Area Where MArea='" & 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("MArea") & "")                '货区编码
                LrText(1).Text = Trim(.Fields("MAreaName") & "")            '货区名称
                LrText(2).Text = Trim(.Fields("WhName") & "")               '仓库名称
                LrText(2).Tag = Trim(.Fields("WhCode"))                     '仓库编码
            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 aDo_Rec As New Recordset
    
    If Not Security_Log(Str_RightEdit, Xtczybm, 1, True) Then
         Exit Sub