+

VB开发的ERP系统

    
        '增加新记录时将文本框清空
        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
       
        '[>>
        '在此处可添加新增记录时初始化设置
        For i = 1 To 3
           Ydcommand1(i).Enabled = True
        Next
        Cbo_DeptLevel.Enabled = True
        Cbo_DeptLevel.Text = ""
        '<<]
    Else
    
        '修改记录时根据记录关键字(编码)从数据表中读入其他字段内容
        With RecTemp
            Sqlstr = "SELECT * FROM PM_StandTbl Where BzbNO=" & Trim(CzxsGrid.TextMatrix(CzxsGrid.Row, 0))

            Set RecTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
       
            '记录如存在则读入其内容,否则提示记录已被其他人删除
            If Not RecTemp.EOF Then
                LrText(0).Text = Trim(.Fields("BzbName") & "")            '标准表名称
                If Rsc.State = 1 Then Rsc.Close
                Set Rsc = Cw_DataEnvi.DataConnect.Execute("select * from Rs_Items where ltriM(rtrim(tablename)) + '.' + ltrim(rtrim(fieldname))='" & Trim(.Fields("BzbHxItem") & "") & "'")
                If Not Rsc.EOF Then
                    LrText(1).Text = Trim(Rsc!ChName)            '横向项目
                    If LCase(Trim(.Fields("BzbHxItem") & "")) = "rs_basicinfo.deptcode" Then
                        LrText(1).Tag = "rs_basicinfo.deptcode"
                    Else
                        LrText(1).Tag = Trim(.Fields("BzbHxItem") & "")
                    End If
                End If
                
                If Rsc.State = 1 Then Rsc.Close
                Set Rsc = Cw_DataEnvi.DataConnect.Execute("select * from Rs_Items where ltriM(rtrim(tablename)) + '.' + ltrim(rtrim(fieldname))='" & Trim(.Fields("BzbVxItem") & "") & "'")
                If Not Rsc.EOF Then
                    LrText(2).Text = Trim(Rsc!ChName)            '纵向项目
                    If LCase(Trim(.Fields("BzbVxItem") & "")) = "rs_basicinfo.deptcode" Then
                        LrText(2).Tag = "rs_basicinfo.deptcode"
                    Else
                        LrText(2).Tag = Trim(.Fields("BzbVxItem") & "")
                    End If
                Else
                   LrText(2).Text = ""
                   LrText(2).Tag = ""
                End If
                
                If Rsc.State = 1 Then Rsc.Close
                Set Rsc = Cw_DataEnvi.DataConnect.Execute("select * from Rs_Items where FieldName='" & Trim(.Fields("BzbResuItem") & "") & "'")
                If Not Rsc.EOF Then
                     LrText(3).Text = Trim(Rsc!ChName)            '结果项目
                     LrText(3).Tag = Trim(.Fields("BzbResuItem") & "")
                End If
                If .Fields("BzbUnEnable") = True Then
                    Chk_UnEnable.Value = 1
                Else
                    Chk_UnEnable.Value = 0
                End If
                If !CodeLevel & "" = 0 Then
                    Cbo_DeptLevel.Text = ""
                Else
                    Cbo_DeptLevel.Text = !CodeLevel & ""
                End If
            Else
                Tsxx = "该记录已经被其他人删除,请刷新当前数据!"
                Call Xtxxts(Tsxx, 0, 4)
                Call Cancel
                TextChangeLock = False
                Exit Function
            End If
        End With
        For i = 1 To 3
           Ydcommand1(i).Enabled = False
        Next
        Cbo_DeptLevel.Enabled = False
    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.Rows = CzxsGrid.FixedRows 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

    '[>>以下需自定义部分
    Sql = "delete PM_StandTblData where BzbNO = " & Trim(CzxsGrid.TextMatrix(CzxsGrid.Row, 0))
    Sql = Sql & "delete PM_StandTbl where BzbNO = " & Trim(CzxsGrid.TextMatrix(CzxsGrid.Row, 0))
    Cw_DataEnvi.DataConnect.Execute Sql
    '以上为自定义部分<<]
  
    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).Enabled = True
                    LrText(0).SetFocus
                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 ImgCbo_Sort_Click()
    SortId = GetComboKey(ImgCbo_Sort, 0)
    Call Cxnrtcwg
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 "data"
            '判断用户是否有此功能执行权限,如有则写上机日志(进入)
            If Not Security_Log(Str_RightEdit, Xtczybm, 1, True, False) Then
                Stand_FrmData.Tlb_Action.Buttons("bc").Enabled = False
            End If
            With CzxsGrid
                If .Rows = .FixedRows Then
                    Exit Sub
                End If
            End With
            Stand_FrmData.Show 1
        Case "condition"
            '判断用户是否有此功能执行权限,如有则写上机日志(进入)
            If Not Security_Log(Str_RightEdit, Xtczybm, 1, True, False) Then
                Stand_FrmLimit.Cmd_Save.Enabled = False
            End If
            With CzxsGrid
                If .Rows = .FixedRows Then
                    Exit Sub
                End If
            End With
            Stand_FrmLimit.Show 1
        Case "import"
            '判断用户是否有此功能执行权限,如有则写上机日志(进入)
            If Not Security_Log(Str_RightEdit, Xtczybm, 1, True) Then
                Exit Sub
            End If
            If Rsc.State = 1 Then Rsc.Close
            Set Rsc = Cw_DataEnvi.DataConnect.Execute("select * from PM_StandTbl ")
            If Rsc.EOF Then
                Call Xtxxts("没有标准表，无法导入!", 0, 1)
                Exit Sub
            End If
            Stand_FrmGuide.Show 1
            Call Cxnrtcwg
        Case "data"
        Case "sx"                                            '刷 新
            Call Cxnrtcwg
        Case "bz"                                            '帮 助
            Call F1bz
        Case "fh"                                            '退 出
            Unload Me
        End Select
        
End Sub

Private Sub CzxsGrid_DblClick()                            '修改当前编码记录

    Call Xgdqjl
  
End Sub

Private Sub Xgdqjl()                                       '修改当前编码记录
    '判断用户是否有此功能执行权限,如有则写上机日志(进入)
    If Not Security_Log(Str_RightEdit, Xtczybm, 1, True, False) Then
        BcCommand.Enabled = False
    End If
    
    If CzxsGrid.Rows = CzxsGrid.FixedRows Then
        Exit Sub
    End If
    
    If CzxsGrid.Row < CzxsGrid.FixedRows Then
        Exit Sub
    End If
    
    Call Toolbjzt
    Lrzt = 2
    
    If Cshlrxx(Lrzt) Then
        LrText(1).SetFocus
        LrText(0).Enabled = False
    End If
  
End Sub

Private Sub Toolbjzt()                                     'Toolbar状态(编辑状态)

    StTab.TabEnabled(1) = True
    StTab.Tab = 1
    Frame1.Enabled = True
    StTab.TabEnabled(0) = False
    CzxsGrid.Enabled = False
  
    With SzToolbar
        .Buttons("ymsz").Enabled = False
        .Buttons("dy").Enabled = False
        .Buttons("yl").Enabled = False
        .Buttons("zj").Enabled = False
        .Buttons("xg").Enabled = False
        .Buttons("sc").Enabled = False
        .Buttons("sx").Enabled = False
        .Buttons("data").Enabled = False
        .Buttons("condition").Enabled = False
        .Buttons("import").Enabled = False
    End With
    ImgCbo_Sort.Enabled = False
End Sub

Private Sub Toolfbjzt()                                    'Toolbar状态(非编辑状态)

    StTab.TabEnabled(0) = True
    StTab.Tab = 0
    CzxsGrid.Enabled = True
    Frame1.Enabled = False
    StTab.TabEnabled(1) = False
    Lrzt = 0
    
    With SzToolbar
        .Buttons("ymsz").Enabled = True
        .Buttons("dy").Enabled = True
        .Buttons("yl").Enabled = True
        .Buttons("zj").Enabled = True
        .Buttons("xg").Enabled = True
        .Buttons("sc").Enabled = True
        .Buttons("sx").Enabled = True
        .Buttons("data").Enabled = True
        .Buttons("condition").Enabled = True
        .Buttons("import").Enabled = True
    End With