+

VB开发的ERP系统

                    .Select Rowjsq, Coljsq
                End If
                
            Case vbKeyUp                    '上 箭 头 =38
                KeyCode = 0
                .SetFocus
                Call Lrsjhx
                If .Row > .FixedRows Then
                    .Row = .Row - 1
                End If
                
            Case vbKeyDown                  '下 箭 头 =40
                KeyCode = 0
                .SetFocus
                Call Lrsjhx
                If .Row < .Rows - 1 Then
                    .Row = .Row + 1
                End If
            Case vbKeyLeft                  '左 箭 头 =37
                If .Col - 1 = Qslz Then
                    If .ColHidden(Qslz) Or (Not GridBoolean(Qslz, 1)) Then
                        GoTo jzzx
                    End If
                End If
                If Ydtext.SelStart = 0 And .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
jzzx:
           
           
            Case vbKeyRight                 '右 箭 头 =39
                wblong = Len(Ydtext.Text)
                If (Ydtext.SelStart = wblong Or Ydtext.SelLength = wblong) Then
                    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
                End If
            Case Else
        End Select
    End With
End Sub
Private Sub ydtext_KeyPress(KeyAscii As Integer)         '录入字符事中控制
    Call InputFieldLimit(Ydtext, GridInt(WglrGrid.Col, 1), KeyAscii)
End Sub
Private Sub ydtext_Change() '录入事中变化处理
    '防止程序改变但不进行处理

    If Wbkbhlock Then
         Exit Sub
    End If

    With WglrGrid

        '限制字段录入长度
        Wbkbhlock = True
        
        Select Case GridInt(.Col, 1)
            Case 8, 11   '金额型
                Call Sjgskz(Ydtext, Xtjezws - Xtjexsws - 1, Xtjexsws)
            Case 9, 12   '数量型
                Call Sjgskz(Ydtext, Xtslzws - Xtslxsws - 1, Xtslxsws)
            Case 10      '单价型
                Call Sjgskz(Ydtext, Xtdjzws - Xtdjxsws - 1, Xtdjxsws)
            Case Else    '其他类型
                If GridInt(.Col, 3) <> 0 Or GridInt(.Col, 4) <> 0 Then
                    Call Sjgskz(Ydtext, GridInt(.Col, 3), GridInt(.Col, 4))
                End If
        End Select
        
        Wbkbhlock = False
    End With
End Sub
Private Sub ydtext_LostFocus()            '如果由于选中网格之外的控件而发生有效性判断(选中网格会先发生Rowcolchange事件置Valiock为TRUE)
    With WglrGrid
        If Not Valilock Then
            Call Lrsjhx
            If Not sjzdyxxpd(Dqlrwgh, Dqlrwgl) Then
                Exit Sub
            End If
            If Not Sjhzyxxpd(Dqlrwgh) Then
                Exit Sub
            End If
        End If
    End With
End Sub
Private Sub WglrGrid_KeyDown(KeyCode As Integer, Shift As Integer)    '网格录入在录入状态下的增行，删行快捷键
    '如果单据操作状态为浏览状态则不能显示录入载体
    If Trim(Lab_OperStatus.Caption) = "1" Then
        Exit Sub
    End If
    
    Select Case KeyCode
    Case vbKeyF2                   '按F2键参照
        Call xswbk
        Call Lrzdbz
    Case vbKeyDelete               '删行
        Call Scdqfl
    Case vbKeyInsert               '增行
        Call zjlrfl
    End Select
End Sub
Private Sub WglrGrid_KeyPress(KeyAscii As Integer)                             '网格接受键盘录入
    
    '当某种条件成立时禁止文本框激活使单据处于录入状态
    If Not Fun_AllowInput Then
        Exit Sub
    End If
    
    With WglrGrid
        
        '屏 蔽 回 车 键
        If KeyAscii = vbKeyReturn Then
            KeyAscii = 0
            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
            
            If Rowjsq <= .Rows - 1 Then
                .Select Rowjsq, Coljsq
            End If
            
            Exit Sub
        End If
        
        '接受用户录入
        Select Case KeyAscii
        Case 0 To 32             '用户输入KeyAscii为0-32的键 如空格
            
            '显示录入载体
            Call xswbk
            
        Case Else
            
            '防止非编辑字段SendKeys()出现死循环
            If Not GridBoolean(.Col, 1) Or .Row < .FixedRows Then
                Exit Sub
            End If
            
            '如果此字段为列表框录入则调入相应列表框
            If GridBoolean(.Col, 3) Then
                
                '列表框录入
                Call xswbk
            Else
                
                Ydtext.Text = ""
                
                '录入限制
                Call InputFieldLimit(Ydtext, GridInt(WglrGrid.Col, 1), KeyAscii)
                
                If KeyAscii = 0 Then
                    Exit Sub
                End If
                
                '如果录入字符有效则写有效行数据标志
                Call Xyxhbz(.Row)
                Call xswbk
                Ydtext.Text = ""
                Valilock = True
                SendKeys Chr(KeyAscii), True
                DoEvents
                Valilock = False
            End If
        End Select
    End With
    
End Sub
Private Sub zjlrfl()                                                    '增加
    With WglrGrid
        If Not (Ydtext.Visible Or YdCombo.Visible) Then
            If Not Fun_Drfrmyxxpd Then Exit Sub
        Else
            Exit Sub
        End If
        If .Row < .FixedRows Then Exit Sub
        .AddItem "", .Row
        .RowHeight(.Row) = Sjhgd
        If .Row <> .Rows - 1 Then
            If .TextMatrix(.Row + 1, 0) = "*" Then
                .TextMatrix(.Row, 0) = "*"
            Else
                .RemoveItem .Rows - 1
            End If
        End If
        Call Xldqh
        Call Xldql
        Hyxxpdlock = False
    End With
End Sub
Private Sub Scdqfl()                                                    '删除
    Dim Answer As Integer, Scqwghz As Long, Scqwglz As Long, Hjlzte As Long, Sflrzt As Boolean
    With WglrGrid
        Scqwghz = .Row
        Scqwglz = .Col
        If .TextMatrix(.Row, 0) = "*" Then
            '判断是否为录入状态
            If Ydtext.Visible Or YdCombo.Visible Then
                Sflrzt = True
                Validate = True
                Call Lrsjhx
                Validate = False
            End If
            Call Xldqh
            Changelock = True
            .Select .Row, 0
            Changelock = False
            If Shsfts Then
                .Cell(flexcpBackColor, .Row, Qslz, .Row, .Cols - 1) = QBColor(12)
                Tsxx = "请确认是否删除当前记录?"
                yhAnswer = Xtxxts(Tsxx, 2, 2)
                If yhAnswer = 2 Then
                    .Cell(flexcpBackColor, .Row, Qslz, .Row, .Cols - 1) = &H80000005
                    Changelock = True
                    .Select Scqwghz, Scqwglz
                    Changelock = False
                    '如为录入状态,则恢复录入
                    If Sflrzt Then
                        Call xswbk
                    End If
                    Exit Sub
                End If
            End If
            '删除记录
            Cw_DataEnvi.DataConnect.Execute ("Delete From Cb_GatherSet Where CenterCode='" & Combo_CostCellCode(Combo_CostCell.ListIndex) & "' And ItemCode='" & Trim(.TextMatrix(.Row, Sydz("001", GridStr(), Szzls))) & "'")
            '删除行
            .RemoveItem .Row
            If .Rows < Pmbcsjhs + .FixedRows + Fzxwghs + 1 Then
                .AddItem ""
                .RowHeight(.Rows - 1) = Sjhgd
            End If
            Changelock = True
            .Select .Row, Scqwglz
            Changelock = False
        End If
    End With
End Sub
Private Sub Qkwlzd(sjh As Long, Sjl As Long)                            '清空为零字段
    If Not GridBoolean(Sjl, 5) Then Exit Sub
    With WglrGrid
        If Val(Trim(.TextMatrix(sjh, Sjl))) = 0 Then .TextMatrix(sjh, Sjl) = ""
    End With
End Sub
Private Sub fhyxh()                                                     '返回录入数据有效行,同时让得到焦点网格可见
    With WglrGrid
        If .Row >= .FixedRows Then
            If .TextMatrix(.Row, 0) <> "*" Then     '点击网格空区域时执行此语句
                For Rowjsq = .FixedRows To .Rows - 1        '为找到最后一数据行的下一行
                    If .TextMatrix(Rowjsq, 0) <> "*" Then
                    Exit For
                    End If
                Next Rowjsq
                If Rowjsq <= .Rows - 1 Then
                    Changelock = True
                    .Select Rowjsq, .Col
                    Changelock = False
                Else
                    Changelock = True
                    .Select .Rows - 1, .Col
                    Changelock = False
                End If
            End If
            Call Xldqh
        End If
    End With
End Sub
Private Sub Xldqh()                                                      '显露当前行
    Dim Toprowte As Long
    With WglrGrid
        Toprowte = 0
        Do While .CellTop + .RowHeight(.Row) + Fzxwghs * Sjhgd > .Height And .TopRow <> Toprowte
            Toprowte = .TopRow
            .TopRow = .TopRow + 1
        Loop
        Toprowte = 0
        Do While .CellTop < .FixedRows * .RowHeight(0) And .TopRow <> Toprowte
            Toprowte = .TopRow
            .TopRow = .TopRow - 1
        Loop
    End With
End Sub
Private Sub Xldql()