++

VB开发的ERP系统

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

    '[>>以下为自定义部分
    With Jlbrec

        CzxsGrid.TextMatrix(Rowjsq, Sydz("001", GridStr(), Szzls)) = Trim(.Fields("GroupCode") & "")      '考核组编码
        CzxsGrid.TextMatrix(Rowjsq, Sydz("002", GridStr(), Szzls)) = Trim(.Fields("GroupName") & "")      '考核组名称

       
    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
                    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 LvListView.ListItems.count = 0 Then
            Tsxx = "已选人员个数不能为0!"
            Call Xtxxts(Tsxx, 0, 1)
            Bclrsj = False
            Exit Function
        End If

        If Lrzt = 1 Then  '增 加
        
            '[>>判断编码是否重复
            If .State = 1 Then .Close
            .Open "SELECT * FROM Kh_Group WHERE GroupCode= '" + 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 Kh_Group WHERE GroupName= '" + Trim(LrText(1).Text) + "' and TitleCode='" + str_TitleCode + "'", 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("GroupCode") = Trim(LrText(0).Text)       '考核组编码
                .Fields("GroupName") = Trim(LrText(1).Text)       '考核组名称
                .Fields("TitleCode") = str_TitleCode              '考核类别编码

            .Update
            
            '保存子表数据
            Call bclusjfz
            
            Cw_DataEnvi.DataConnect.CommitTrans
   
            '将记录加入网格
            Sqlstr = "SELECT * FROM Kh_v_Group WHERE GroupCode= '" + 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 Kh_Group WHERE GroupName= '" + Trim(LrText(1).Text) + "' and TitleCode='" + str_TitleCode + "' and GroupCode<>'" & 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
            
            '删除原考核组子表中所有内容
            Cw_DataEnvi.DataConnect.Execute ("Delete Kh_GroupSub Where GroupCode='" & Trim(LrText(0).Text) & "'")
            
            If .State = 1 Then .Close
            .Open "SELECT * FROM Kh_Group WHERE GroupCode= '" + Trim(LrText(0).Text) + "'", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
             
            If Not .EOF Then
                .Fields("GroupName") = Trim(LrText(1).Text)       '考核组名称
                .Update
            End If
            
            '保存子表数据
            Call bclusjfz
            
            Cw_DataEnvi.DataConnect.CommitTrans
            
            '刷新当前网格
            Sqlstr = "SELECT * FROM Kh_v_Group WHERE GroupCode= '" + Trim(LrText(0).Text) + "'"
            Set Cxnrrec = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
            
            If Not Cxnrrec.EOF Then
                With CzxsGrid
                    Call Jltcwg(Cxnrrec, .Row)
                End With
            Else
                Tsxx = "该记录已经被其他人删除,请刷新当前数据!"
                Call Xtxxts(Tsxx, 0, 4)
                Exit Function
            End If
   
        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
       
        '[>>
        '在此处可添加新增记录时初始化设置
        
        
        '填充待选人员和已选人员
        Call lvListInput(0)
        
        '<<]
    Else
    
        '修改记录时根据记录关键字(编码)从数据表中读入其他字段内容
        With RecTemp
        
            Sqlstr = "SELECT Kh_v_Group.* FROM Kh_v_Group Where GroupCode='" & Trim(CzxsGrid.TextMatrix(CzxsGrid.Row, Sydz("003", GridStr(), Szzls))) & "'"
            Set RecTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
       
            '记录如存在则读入其内容,否则提示记录已被其他人删除
            If Not RecTemp.EOF Then
                LrText(0).Text = Trim(.Fields("GroupCode") & "")             '考核组编码
                LrText(1).Text = Trim(.Fields("GroupName") & "")             '考核组名称
                
                '填充待选人员和已选人员
                Call lvListInput(1)
                
            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 RecExist As New ADODB.Recordset         '临时使用动态集
    '判断用户是否有此功能执行权限,如有则写上机日志(进入)
    If Not Security_Log("Khgl_Group_edit", Xtczybm, 1) 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 WglrGrid
         '1.判断考核组是否被考核数据使用
        Sqlstr = "SELECT GroupCode From Kh_BaseMain Where GroupCode='" + Trim(CzxsGrid.TextMatrix(CzxsGrid.Row, Sydz("001", GridStr(), Szzls))) + " ' "
        Set RecExist = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
                  
        If Not RecExist.EOF Then
            Tsxx = "该考核组已经被使用,不能删除!"
            Call Xtxxts(Tsxx, 0, 1)
            Exit Sub
        End If
    End With

    Cw_DataEnvi.DataConnect.Execute "delete Kh_GroupSub where GroupCode = '" + Trim(CzxsGrid.TextMatrix(CzxsGrid.Row, Sydz("001", GridStr(), Szzls))) + "'"
    Cw_DataEnvi.DataConnect.Execute "delete Kh_Group    where GroupCode = '" + Trim(CzxsGrid.TextMatrix(CzxsGrid.Row, Sydz("001", GridStr(), Szzls))) + "'"
    
    '以上为自定义部分]
  
    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 Function AddTitleCode()
    Dim RecExist As New Recordset
    
    FillImageCombo Imgcbo_Title, "Khgl_TitleCompute", 1
    
        
    
    Sqlstr = "SELECT TitleCode,titleName From Kh_Title where (endflag=1  and CloseFlag=0 and CreateTime=(select max(createTime) from kh_title where endflag=1  and CloseFlag=0))"
    Set RecExist = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
    If Not RecExist.EOF Then
        If Len(Trim(RecExist.Fields("titleName"))) > 0 Then
            Imgcbo_Title.Text = RecExist.Fields("titleName")
            str_TitleName = RecExist.Fields("titleName")
        End If
    End If
    
    str_TitleCode = GetComboKey(Imgcbo_Title, 0)
End Function
'2.保存子表数据
Private Sub bclusjfz()
    Dim int_temp As Integer                 '临时计数器
    Dim Rec_CodeSetSub As New Recordset     '临时记录集