+

VB开发的ERP系统

    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)
                    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)
                        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 Trim(SortId) = "" Then
            Call Xtxxts("工资类别不能空!", 0, 1)
            Exit Function
        End If
        
        If Chk_Stop = 1 Then
            '如果本项目是清空项,则不能停用
            If Chk_Clear = 1 Then
                Call Xtxxts("“" & Trim(LrText(0)) & "”是清空项，不能停用!", 0, 1)
                Exit Function
            End If
            
          
            '如果本项目是计算月平均工资项目，则不能停用
            If Chk_Cal = 1 Then
                Call Xtxxts("“" & Trim(LrText(0)) & "”是计算年度月平均工资项目，不能停用!", 0, 1)
                Exit Function
            End If
        End If
        If Lrzt = 1 Then  '增 加
        
             '判断记录内容无误后,将记录内容写入数据表
            On Error GoTo Swcwcl
            If .State = 1 Then .Close
            .Open "select * from PM_SortItem where SortID='" & SortId & "'", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
            Cw_DataEnvi.DataConnect.BeginTrans
   
            .AddNew
            .Fields("SortID") = Trim(SortId)    '类别号
            .Fields("ItemID") = Trim(LrText(0).Tag)    '项目号
            .Fields("ClearFlag") = Chk_Clear.Value     '清空项
            .Fields("EndMonth") = Chk_Cal.Value     '计算平均工资
            .Fields("HaltFlag") = Chk_Stop.Value     '停用
            .Fields("DisplayOrder") = CzxsGrid.Rows   '顺序
            .Update
            
            Cw_DataEnvi.DataConnect.CommitTrans

            '将记录加入网格
            Sqlstr = "SELECT p.*,ChName,FieldName FROM PM_SortItem p,Rs_Items r WHERE p.ItemID =r.ItemID and SortId= '" & SortId & "' and p.ItemID=" & LrText(0).Tag
            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)

            '<<]
    
        Else  '否则为修改记录

            On Error GoTo Swcwcl
            If Chk_Stop = 1 Then
                With CzxsGrid
                    If StopDelItem(.TextMatrix(.Row, 0), .TextMatrix(.Row, 1), .TextMatrix(.Row, Sydz("002", GridStr(), Szzls)), "停用", SortId) = False Then
                        Exit Function
                    End If
                End With
            End If
            
            Cw_DataEnvi.DataConnect.BeginTrans

            If .State = 1 Then .Close
            .Open "SELECT * FROM pm_SortItem WHERE Sortid='" & SortId & "' and ItemID= " & CzxsGrid.TextMatrix(CzxsGrid.Row, 0), Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
     
            
            If Not .EOF Then
                !ClearFlag = Chk_Clear
                !EndMonth = Chk_Cal
                !HaltFlag = Chk_Stop
                .Update
            End If

             Cw_DataEnvi.DataConnect.CommitTrans
   
            '刷新当前网格
            Sqlstr = "SELECT p.*,ChName,FieldName FROM pm_SortItem p,Rs_Items r  WHERE p.ItemId=r.ItemId " & _
                     "and SortID= '" & SortId & "' and p.ItemID=" & CzxsGrid.TextMatrix(CzxsGrid.Row, 0)
            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事件
    
    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
       
        '[>>
        '在此处可添加新增记录时初始化设置
        Chk_Clear.Value = 0
        Chk_Cal.Value = 0
        Chk_Stop.Value = 0
        '<<]
    Else
    
        '修改记录时根据记录关键字(编码)从数据表中读入其他字段内容
        With RecTemp
            Sqlstr = "SELECT p.*,ChName,FieldName FROM PM_SortItem p,Rs_Items r " & _
                     "  Where p.ItemID=r.ItemId and SortID='" & SortId & "'" & _
                     " and p.ItemId=" & Trim(CzxsGrid.TextMatrix(CzxsGrid.Row, 0))

            Set RecTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
       
            '记录如存在则读入其内容,否则提示记录已被其他人删除
            If Not RecTemp.EOF Then
                LrText(0).Text = Trim(.Fields("ChName") & "")            '项目名称
                '个人所得税的停用属性不能修改
                If LCase(Trim(.Fields("FieldName") & "")) = "tax" Or LCase(Trim(.Fields("FieldName") & "")) = "taxitem" Then
                    Chk_Stop.Enabled = False
                Else
                    Chk_Stop.Enabled = True
                End If
                '工资类别的“在本类别扣税”属性为真，实发工资的停用属性不能修改
                If Rsc.State = 1 Then Rsc.Close
                Set Rsc = Cw_DataEnvi.DataConnect.Execute("select * from pm_Sort where SortId='" & SortId & "'")
                If LCase(Trim(.Fields("FieldName") & "")) = "paywage" Then
                    If Rsc!DeductTax = True Then
                        Chk_Stop.Enabled = False
                    Else
                        Chk_Stop.Enabled = True
                    End If
                End If
                
                If !ClearFlag = True Then
                    Chk_Clear = 1
                Else
                    Chk_Clear = 0
                End If
                
                If !EndMonth = True Then
                    Chk_Cal = 1
                Else
                    Chk_Cal = 0
                End If

               
                If !HaltFlag = True Then
                    Chk_Stop = 1
                Else
                    Chk_Stop = 0
                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

    '[>>以下需自定义部分
    With CzxsGrid
        If StopDelItem(.TextMatrix(.Row, 0), .TextMatrix(.Row, 1), .TextMatrix(.Row, Sydz("002", GridStr(), Szzls)), "删除", SortId) = True Then
            If Rsc.State = 1 Then Rsc.Close
            Set Rsc = Cw_DataEnvi.DataConnect.Execute("select * from pm_Payroll where SortId='" & SortId & "' and " & .TextMatrix(.Row, 1) & "<>0")
            If Rsc.EOF Then
                Cw_DataEnvi.DataConnect.Execute "delete PM_SortItem where Itemid = " & .TextMatrix(.Row, 0) & " and SortId='" & SortId & "'"
                CzxsGrid.RemoveItem CzxsGrid.Row
            Else
                Call Xtxxts("“" & Trim(LrText(0)) & "”在工资数据表中已有数据不能删除!", 0, 1)
            End If
        End If
    End With
    
    '以上为自定义部分<<]
  
    Cw_DataEnvi.DataConnect.CommitTrans

    

    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 = False
                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)
    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 = False
            Ydcommand1(0).Enabled = True
        Case "xg"                                            '修 改
            Call Xgdqjl
        Case "sc"                                            '删 除
            Call Scdqjl
            Lbl_Count.Caption = "共" & CzxsGrid.Rows - 1 & "项"
        Case "sx"                                            '刷 新
            Call Cxnrtcwg
        Case "bz"                                            '帮 助
            Call F1bz
        Case "fh"                                            '退 出
            Unload Me
        End Select
        
End Sub

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

    Call Xgdqjl