+

VB开发的ERP系统

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
    Valilock = True         '为防止按ydText中帮助按纽时，引起ydText的LostFocus事件。
    With WglrGrid
        '[>>会计科目编码帮助单独处理
        Select Case .Col
            Case Sydz("002", GridStr(), Szzls), Sydz("006", GridStr(), Szzls)
                Xtcdcs = Trim(Ydtext.Text)
                PZ_FrmKjkmcz.Show 1
                If Len(Xtfhcs) <> 0 Then
                    Ydtext.Text = Xtfhcs
                End If
            Case Sydz("010", GridStr(), Szzls)
                AutoTran_AssMy.Show 1
            Case Else
                '处理通用部分
                Changelock = True        '调入另外窗体必须加锁，为不必执行网格的离开焦点造成的RowColChange事件
                                        '?没有必要，因为，文本框和命令按纽之间转换焦点，不会执行RowColChange
                Call Drbmhelp(GridInt(.Col, 6), GridStr(.Col, 3), Trim(Combo_CostCellCode(Combo_CostCell.ListIndex)), .Col)
                Changelock = False
                If Len(Xtfhcs) <> 0 Then
                    If GridInt(.Col, 7) = 0 Then
                        Ydtext.Text = Xtfhcs
                    Else
                        Ydtext.Text = Xtfhcsfz
                    End If
                End If
        End Select
        '[>>处理完毕
        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_BeforeMoveColumn(ByVal Col As Long, Position As Long)
    Call FnBln_RefreshArray(Col, Position, GridStr(), GridInf())
End Sub

Private Sub WglrGrid_EnterCell()                                    '显示当前数据行相关信息
    With WglrGrid
        If .Row >= .FixedRows Then
            Lab_Row = Trim(Str(.Row - .FixedRows + 1))
        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事件
    '故意引发网格RowcolChange事件
    With WglrGrid
        If Not (Ydtext.Visible Or YdCombo.Visible) Then
            .Select 0, 0
        End If
    End With
End Sub
Private Sub WglrGrid_AfterScroll(ByVal OldTopRow As Long, ByVal OldLeftCol As Long, ByVal NewTopRow As Long, ByVal NewLeftCol As Long)                                       '限制用户在录入过程中滚动鼠标
    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()          '鼠标双击网格显示文本框
    Dim CurrentRow As Integer
    Dim CurrentCol As Integer
    '显示公式窗体
    If Lab_OperStatus.Caption = "3" Then
        With WglrGrid
            If .Col = Sydz("003", GridStr(), Szzls) Or .Col = Sydz("004", GridStr(), Szzls) Then
                CurrentRow = .Row
                CurrentCol = .Col
                Glo_FormulaString = .TextMatrix(.Row, .Col)
                Glo_NonceCenter = Combo_CostCell.List(Combo_CostCell.ListIndex)
                Glo_NonceItem = "(" + Trim(.TextMatrix(.Row, Sydz("001", GridStr(), Szzls))) + ")" + Trim(.TextMatrix(.Row, Sydz("002", GridStr(), Szzls)))
                JC_FrmFormulaGen.Show 1
          
                .Row = CurrentRow
                .Col = CurrentCol
                .TextMatrix(.Row, .Col) = Glo_FormulaString
            End If
        End With
    End If
    '显示帮助按钮
    With WglrGrid
        If GridBoolean(.Col, 1) = True Then
            Call xswbk
        End If
   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
            Case vbKeyRight                 '右 箭 头 =39
                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 Else
        End Select
    End With
jzzx:
End Sub
Private Sub YdCombo_LostFocus()                     '下拉列表框失去焦点
    With WglrGrid                                   '因为选中网格会先发生Rowcolchange事件置Valiock
        If Not Valilock Then                        '为TRUE
            Call Lrsjhx
            If Not Sjhzyxxpd(Dqlrwgh) Then
                Exit Sub
            End If
        End If
    End With
End Sub
Private Sub Ydcommand_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
    Call Lrzdbz
End Sub
Private Sub ydtext_KeyDown(KeyCode As Integer, Shift As Integer)    '录入文本框的焦点发生移动或特殊击键动作，回车、帮助、ESC键、上下左右箭头
    Dim Rowjsq As Long, Coljsq As Long
   
    With WglrGrid
        Select Case KeyCode
            Case vbKeyF2
                Call Lrzdbz
            Case vbKeyEscape                'ESC 键放弃录入
                Valilock = True
                Call Ycwbk
                .SetFocus
            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
                If Rowjsq <= .Rows - 1 Then