++

VB开发的ERP系统

                
            '以上为自定义部分]
            
        End Select
     
        '字段录入正确后为零字段清空
        Call Qkwlzd(Dqpdwgh, Dqpdwgl)
    
        sjzdyxxpd = True
        Yxxpdlock = True
        Exit Function
    
    End With
  
Lrcwcl:    '录入错误处理

    With WglrGrid
        Call Xtxxts(Tsxx, 0, 1)
        Changelock = True
        .Select Dqpdwgh, Dqpdwgl
        Changelock = False
        Call xswbk
        sjzdyxxpd = False
        Exit Function
    End With
    
End Function

Private Function Sjhzyxxpd(Yxxpdh As Long, Yxxpdl As Long) As Boolean    '录入数据单元有效性判断,同时进行单元处理
 
    Dim Lrywlz As Long                     '录入错误列值(Fixed)
    Dim RecTemp As New ADODB.Recordset     '临时使用动态集
    Dim Sqlstr As String                   '临时查询字符串
    Dim Str_Ccode As String                '临时索引编码


    With WglrGrid

        '单元没有发生变化则不进行有效性判断
        If Hyxxpdlock Then          ' 单元改变
            Sjhzyxxpd = True
            Exit Function
        End If
    
        '以下为自定义部分[
    
        '1.1首先进行单个不能为空或不能为零判断(Fixed)
        For Jsqte = Qslz To .Cols - 1
            '字段不能为空
            If GridInt(Jsqte, 5) = 1 Then
                If Len(Trim(.TextMatrix(Yxxpdh, Jsqte))) = 0 Then
                    Tsxx = GridStr(Jsqte, 2)
                    Lrywlz = Jsqte
                    GoTo Lrcwcl
                    Exit For
                End If
            End If
            
            '字段不能为零
            If GridInt(Jsqte, 5) = 2 Then
                If Val(Trim(.TextMatrix(Yxxpdh, Jsqte))) = 0 Then
                    Tsxx = GridStr(Jsqte, 2)
                    Lrywlz = Jsqte
                    GoTo Lrcwcl
                    Exit For
                End If
            End If
        Next Jsqte
    
    
        '1.2进行其他有效性判断,编写格式同1.1
        
        '如果是分值规则，则录入数据不能超过最大值和最小值
        If strFactor(Yxxpdh, 1) = "0" And Len(Trim(.TextMatrix(Yxxpdh, Yxxpdl))) > 0 Then
            Sqlstr = " SELECT PointName,PointMin,PointMax " & _
                     " FROM Kh_Point where PointCode=" & strFactor(Yxxpdh, 2)
            Set RecTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
            '张洪军修改于2002.01.30
            If (Val(Trim(.TextMatrix(Yxxpdh, Yxxpdl))) < RecTemp.Fields("PointMin")) Or (Val(Trim(.TextMatrix(Yxxpdh, Yxxpdl))) > RecTemp.Fields("PointMax")) Then
                Tsxx = Trim(.TextMatrix(Yxxpdh, Sydz("003", GridStr(), Szzls))) + "最大值为" + Str(RecTemp.Fields("PointMax")) + ",最小值为" + Str(RecTemp.Fields("PointMin")) + "!"
                Lrywlz = Yxxpdl
                GoTo Lrcwcl
            End If
        End If
                
        '2.放置行处理程序(当数据行通过有效性判断)
           
        Str_Ccode = Trim(.TextMatrix(Yxxpdh, 1))

        
        On Error GoTo Swcwcl
    
        Cw_DataEnvi.DataConnect.BeginTrans
    
        With RecTemp
            If .State = 1 Then .Close

            .Open "  SELECT * FROM Kh_BaseSub WHERE FactorCode='" + Str_Ccode + "'" & _
                  "  and BaseMainID=" & Val(sItem(Yxxpdl - 1).ItemCode), Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
                  
            If Not RecTemp.EOF Then
                .Fields("CheckValues") = Val(WglrGrid.TextMatrix(Yxxpdh, Yxxpdl))      '考核得分
                .Update
            Else
                .AddNew
                .Fields("BaseMainID") = Val(sItem(Yxxpdl - 1).ItemCode)               '考核数据ID号
                .Fields("FactorCode") = Str_Ccode                                     '考核要素
                .Fields("CheckValues") = Val(WglrGrid.TextMatrix(Yxxpdh, Yxxpdl))     '考核得分
                .Update
            End If
        End With
         
        Cw_DataEnvi.DataConnect.CommitTrans
         
    End With

    '以上为自定义部分]


    Sjhzyxxpd = True
    Hyxxpdlock = True
    Exit Function

Swcwcl:

    Cw_DataEnvi.DataConnect.RollbackTrans
    Tsxx = "存盘过程中出现未知错误,程序自动恢复保存前状态!"
    Call Xtxxts(Tsxx, 0, 1)
    Exit Function

Lrcwcl:      '录入错误处理

    With WglrGrid
        Call Xtxxts(Tsxx, 0, 1)
        Changelock = True
        .Select Yxxpdh, Lrywlz
        Changelock = False
        Call xswbk
        Sjhzyxxpd = False
        Exit Function
    End With
    
End Function

Public Function ShowRecord()

    '定义变量
    Dim cn As Connection
    Dim s As String
    Dim rs As New ADODB.Recordset
    Dim i As Integer
    Dim j As Integer
    Dim iFixedCols As Integer
    Dim iBeginCol As Integer
    
    Set cn = Cw_DataEnvi.DataConnect
    iFixedCols = 4
    
    ReDim sItem(2) '字段属性
    sItem(0).ItemCode = 0
    sItem(0).ItemName = "考核要素编码"
    
    sItem(1).ItemCode = 0
    sItem(1).ItemName = "考核指标"
    
    sItem(2).ItemCode = 0
    sItem(2).ItemName = "考核要素名称"
    
    '初始化各种变量
    iBeginCol = GridInf(1)  '数据开始行数
    
    '生成查询语句

    
                
    s = " select  BaseMainID,EmpName   From Kh_v_BaseMain  " & _
        " where TitleCode ='" & str_TitleCode & "'" & _
        " and   GroupCode ='" & str_GroupCode & "'" & _
        " and   ValListCode='" & Trim(str_ValListCode) & "'" & _
        " and   ValListCodeID=" & int_ValListCodeID & _
        "  order by EmpID "
    Set rs = cn.Execute(s)
    
    
    With rs
        Do While Not .EOF()
            ReDim Preserve sItem(UBound(sItem) + 1)
            sItem(UBound(sItem)).ItemCode = Str((!BaseMainID))
            sItem(UBound(sItem)).ItemName = Trim(!EmpName)
            .MoveNext
        Loop
    End With
    
     
    With Me.WglrGrid
        '初始化网格
        .Redraw = False
        .Cols = UBound(sItem) + 2
        .FixedCols = iFixedCols
        '设置行标题
        For i = iFixedCols To .Cols - 1
            .TextMatrix(0, i) = sItem(i - 1).ItemName
            .ColWidth(i) = 1000                         '宽度
            .ColAlignment(i) = flexAlignRightCenter     '数据右对齐
            .FixedAlignment(i) = 4                      '列标题居中
        Next i
    
        For i = .FixedRows To .Rows - 1
            .RowHeight(i) = GridInf(2)
            .Cell(flexcpBackColor, i, .FixedCols, i, .Cols - 1) = vbWhite
            For j = iBeginCol To .Cols - 1
                .TextMatrix(i, j) = 0
            Next j
            rs.MoveNext
        Next i
        
        .Redraw = True
    End With
    
   '刷新控制数组
    'iFixedCols = rs.RecordCount + iBeginCol + 1
    iFixedCols = rs.RecordCount + WglrGrid.FixedCols
    '网格隐藏(非操作显示)列数
     GridInf(1) = iBeginCol                         '起始列值
     With Me.WglrGrid
        ReDim GridBoolean(.Cols - 1, 1 To 6)
        ReDim GridInt(.Cols - 1, 1 To 7)
        ReDim GridStr(.Cols - 1, 1 To 5)
        '张洪军修改于2002.01.30
        For i = 0 To iFixedCols - 1
            If i < GridInf(1) + WglrGrid.FixedCols - 1 Then
                GridStr(i, 1) = IIf(i - iBeginCol + 1 > 0, Format(i - iBeginCol + 1, "000"), Format(0, "000"))   '网格列索引值
            Else
            
                GridBoolean(i, 1) = True                            '网格列是否可编辑
                GridBoolean(i, 2) = True                            '网格列是否提供帮助，'如果提供帮组只需调整本行为真
                GridBoolean(i, 3) = False                           '网格列是否列表框录入
                GridBoolean(i, 4) = False                           '网格列是否合计
                GridBoolean(i, 5) = False                           '网格内容为零是否清空
                GridBoolean(i, 6) = False                           '网格列是否为布尔型
                
                GridInt(i, 1) = 6                                   '字段数据类型
                GridInt(i, 2) = 10                                  '字段录入长度
                GridInt(i, 3) = 6                                   '字段整数位长度
                GridInt(i, 4) = 4                                   '字段小数位长度
                GridInt(i, 5) = 0                                   '字段不允许为空或为零
                GridInt(i, 6) = 0                                   '帮助类型
                GridInt(i, 7) = 1                                   '帮助返回值(0-显示返回编码 1-显示返回名称)
        
                GridStr(i, 1) = IIf(i - iBeginCol + 1 > 0, Format(i - iBeginCol + 1, "000"), Format(0, "000"))   '网格列索引值
                GridStr(i, 2) = "考核得分不能为空!"                 '字段为空提示信息
                GridStr(i, 3) = "Khgl_GauList"                      '通用帮助编码
                GridStr(i, 4) = ""                                  '连接字段(通用帮助)
                GridStr(i, 5) = ""                                  '列表框编码
            End If
        Next i
    End With
    
    
    Set rs = Nothing
    Set cn = Nothing
        
    
End Function
'===================以 下 程 序 为 通 用 部 分 ,一 般 不 需 更 改(程序动作部分)======================='
Private Sub Lrzdbz()                                                      '录入字段帮助
  
    If Not Ydcommand.Visible Then
        Exit Sub
    End If
   
    With WglrGrid
     
        Valilock = True
    
        '处理通用部分
        Changelock = True        '调入另外窗体必须加锁
        Xtcdcsfz = strFactor(.Row, 3)
        Call Drbmhelp(GridInt(.Col, 6), GridStr(.Col, 3), Trim(Ydtext.Text))
        Changelock = False
        
        If Len(Xtfhcs) <> 0 Then
            If GridInt(.Col, 7) = 0 Then
                Ydtext.Text = Xtfhcs
            Else
                Ydtext.Text = Xtfhcsfz
            End If
        End If
        
        Valilock = False
  
        If Ydtext.Visible Then
            Ydtext.SetFocus
        End If
    End With
    
End Sub

Private Sub Form_Resize()                                                '窗体大小发生变化时,重新显示文本框
   
    Call Cxxswbk
   
End Sub

Private Function Fun_Drfrmyxxpd() As Boolean                             '调入其它窗体或功能产生的有效性判断(包括数据回写)
  
    Fun_Drfrmyxxpd = True
    
    With WglrGrid
   
        '如果当前网格处于编辑状态,则先进行数据回写再进行有效性判断
  
        If Ydtext.Visible Or YdCombo.Visible Then
            Call Lrsjhx
            If Not sjzdyxxpd(Dqlrwgh, Dqlrwgl) Then
                Fun_Drfrmyxxpd = False
                Exit Function
            End If
        End If
   
        '进行行有效性判断
        If Not Sjhzyxxpd(.Row, .Col) Then
            Fun_Drfrmyxxpd = False
            Exit Function
        End If
    End With
  
End Function

Private Sub WglrGrid_EnterCell()                                          '显示当前数据行相关信息

    With WglrGrid
        If .Row >= .FixedRows Then
            '[>>
                '此处可以填写显示与此网格行相关信息
            '<<]
        End If
    End With
   
End Sub

Private Sub WglrGrid_GotFocus()                                           '网格得到焦点

    '网格得到焦点,如果当前选择行为非数据行
    '则调整当前焦点至有效数据行

    With WglrGrid
        If .Row < .FixedRows And .Rows > .FixedRows Then
            Changelock = True
            .Select .FixedRows, .Col
            Changelock = False
        End If
        If .Col < Qslz Then
            Changelock = True
            .Select .Row, Qslz
            Changelock = False
        End If
    End With

End Sub

Private Sub WglrGrid_LostFocus()                                          '录入网格失去焦点