ȡ-++

VB开发的ERP系统

        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
            
        '2.放置行处理程序(当数据行通过有效性判断)
       
        On Error GoTo Swcwcl

        Cw_DataEnvi.DataConnect.BeginTrans
         
        With RecTemp

            '判断此行记录ID是否为零,如不为零则修改记录;否则为新增记录,然后将新增后记录ID回写网格
            If Val(Trim(WglrGrid.TextMatrix(Yxxpdh, 1))) <> 0 Then
                If .State = 1 Then .Close
                .Open "SELECT Xs_MaterialAccount.* From Xs_MaterialAccount WHERE I_id = " & Val(WglrGrid.TextMatrix(Yxxpdh, 1)), Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic

                If Not .EOF Then
                    .Fields("MaterialCode") = Trim(WglrGrid.TextMatrix(Yxxpdh, Sydz("001", GridStr(), Szzls)))      '存货编码
                    .Fields("Quantity") = Val(WglrGrid.TextMatrix(Yxxpdh, Sydz("004", GridStr(), Szzls)))           '数量
                    .Fields("SumMoney") = Val(WglrGrid.TextMatrix(Yxxpdh, Sydz("005", GridStr(), Szzls)))           '金额
                    .Update
                End If
                 
            Else
               
                If .State = 1 Then .Close
                .Open "SELECT Xs_MaterialAccount.* From Xs_MaterialAccount WHERE 1=2", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
                 
                .AddNew
                .Fields("MaterialCode") = Trim(WglrGrid.TextMatrix(Yxxpdh, Sydz("001", GridStr(), Szzls)))      '存货编码
                .Fields("Quantity") = Val(WglrGrid.TextMatrix(Yxxpdh, Sydz("004", GridStr(), Szzls)))           '数量
                .Fields("SumMoney") = Val(WglrGrid.TextMatrix(Yxxpdh, Sydz("005", GridStr(), Szzls)))           '金额
                .Update
                    
                WglrGrid.TextMatrix(Yxxpdh, 1) = .Fields("I_ID")                                                '记录唯一标识
                    
            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

'===================以 下 程 序 为 通 用 部 分 ,一 般 不 需 更 改(程序动作部分)======================='
Private Sub Sub_AdjustGrid()
    
    '调 整 网 格
    With WglrGrid
        '加 1 保持一行录入行
        If .Rows < Pmbcsjhs + .FixedRows + Fzxwghs + 1 Then
            .Rows = Pmbcsjhs + .FixedRows + Fzxwghs + 1
            For jsqte = .FixedRows To .Rows - 1
                .RowHeight(jsqte) = Sjhgd
            Next jsqte
        End If
        
        '判断是否有辅助行和录入行,如没有则加行
        Do While .TextMatrix(.Rows - 1 - Fzxwghs, 0) = "*"
            .AddItem ""
            .RowHeight(.Rows - 1) = Sjhgd
        Loop
    
    End With
    
End Sub

Private Sub Lrzdbz()                                                      '录入字段帮助
  
    If Not Ydcommand.Visible Then
        Exit Sub
    End If
   
    With WglrGrid
     
        Valilock = True
    
        '处理通用部分
        Changelock = True        '调入另外窗体必须加锁
        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) 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()                                    '录入网格失去焦点

    '用以屏蔽调用其它窗体时发生网格失去焦点事件
    If Changelock Then
        Exit Sub
    End If

    '引发网格RowcolChange事件
    With WglrGrid
        If Not (Ydtext.Visible Or YdCombo.Visible) Then
            .Select 0, 0
        End If
    End With

End Sub

Private Sub WglrGrid_Scroll()                                       '限制用户在录入过程中滚动鼠标

    If Gdtlock Then
        Exit Sub
    End If
 
    With WglrGrid
        If Ydtext.Visible Or YdCombo.Visible Then
            Gdtlock = True
            .TopRow = Dqtoprow
            .LeftCol = Dqleftcol
            Gdtlock = False
            Exit Sub
        End If
    End With
    
End Sub

Private Sub WglrGrid_LeaveCell()                                    '离开单元格
  
    If Changelock Then
        Exit Sub
    End If

    '记录刚刚离开网格单元的行列值
    Dqlkwgh = WglrGrid.Row
    Dqlkwgl = WglrGrid.Col

    '判断是否需要录入数据回写
    If Not (Ydtext.Visible Or YdCombo.Visible) Then
        Exit Sub
    End If
    
    Call Lrsjhx
    
End Sub

Private Sub WglrGrid_RowColChange()                                '网格录入行列发生变化时,进行有效性判断
   
    Valilock = True       '屏蔽文本框失去焦点进行有效性判断
    
    With WglrGrid
        If Changelock Then
            Exit Sub
        End If
        If Not sjzdyxxpd(Dqlrwgh, Dqlrwgl) Then
            Exit Sub
        End If
        If .Row <> Dqlkwgh Then
            If Not Sjhzyxxpd(Dqlkwgh) Then
                Exit Sub
            End If
        End If
    End With
    
    Call fhyxh
    Call Xldql
   
End Sub

Private Sub WglrGrid_DblClick()          '鼠标双击网格显示文本框

    With WglrGrid
        Call xswbk
    End With
  
End Sub

Private Sub Ycwbk()                      '隐藏文本框,帮助按钮,列表组合框
 
    Valilock = True
    Ydtext.Visible = False
    YdCombo.Visible = False
    Ydcommand.Visible = False
    
End Sub

Private Sub YdCombo_KeyDown(KeyCode As Integer, Shift As Integer)        '列表框移动
    With WglrGrid
        Select Case KeyCode
            Case vbKeyEscape                'ESC 键放弃录入
                Valilock = True
                .SetFocus
                Call Ycwbk
                Valilock = False
            Case vbKeyReturn                '回 车 键 =13
                KeyCode = 0
                .SetFocus
                Call Lrsjhx
                Rowjsq = .Row
                Coljsq = .Col + 1
                If Coljsq > .Cols - 1 Then
                    If Rowjsq < .Rows - 1 Then
                        Rowjsq = Rowjsq + 1
                    End If
                    Coljsq = Qslz
                End If
                Do While Rowjsq <= .Rows - 1
                    If .ColHidden(Coljsq) Or (Not GridBoolean(Coljsq, 1)) Then
                        Coljsq = Coljsq + 1
                        If Coljsq > .Cols - 1 Then
                            Rowjsq = Rowjsq + 1
                            Coljsq = Qslz
                        End If
                    Else
                        Exit Do
                    End If
                Loop
                .Select Rowjsq, Coljsq
                
            Case vbKeyLeft                  '左 箭 头 =37
                If .Col - 1 = Qslz Then
                    If .ColHidden(Qslz) Or (Not GridBoolean(Qslz, 1)) Then
                        GoTo jzzx
                    End If
                End If
                If .Col > Qslz Then
                    KeyCode = 0
                    .SetFocus
                    Call Lrsjhx
                    Coljsq = .Col - 1
                    Do While Coljsq > Qslz
                        If Coljsq - 1 = Qslz Then
                            If .ColHidden(Qslz) Or (Not GridBoolean(Qslz, 1)) Then
                                GoTo jzzx
                            End If
                        End If
                        If .ColHidden(Coljsq) Or (Not GridBoolean(Coljsq, 1)) Then
                            Coljsq = Coljsq - 1
                        Else
                            Exit Do
                        End If
                    Loop
                    .Select .Row, Coljsq
                End If