VB开发的ERP系统

    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 xswbk()                       '在当前选中单元显示文本框,列表框,帮助按钮(通用)
    
    Dim Wbkpy As Integer, Wbkpy1 As Integer '文本框偏移量
    
    '当某种条件成立时禁止文本框激活使单据处于录入状态
    If Not Fun_AllowInput Then
        Exit Sub
    End If
    
    '显示文本框前返回有效行列（解决滚动条问题）
    Call Xldqh
    Call Xldql
    
    '隐藏文本框,帮助按钮,列表组合框
    Call Ycwbk
    
    With WglrGrid
        Dqlrwgh = .Row
        Dqlrwgl = .Col
        If Not GridBoolean(.Col, 1) Or .Row < .FixedRows Then
            Exit Sub
        End If
        
        Wbkpy = 30
        Wbkpy1 = 15
        
        On Error Resume Next
        
        Ydtext.Left = .CellLeft + .Left + Wbkpy
        Ydtext.Top = .CellTop + .Top + Wbkpy
        Ydtext.Width = .CellWidth - Wbkpy1
        Ydtext.Height = .CellHeight - Wbkpy1
        
        If GridInt(.Col, 2) <> 0 Then
            Ydtext.MaxLength = GridInt(.Col, 2)
        Else
            Ydtext.MaxLength = 3000
        End If
        
        Call Wbkcl
        
        Ydtext.Visible = True
        Ydtext.SetFocus
        
        Dqtoprow = .TopRow
        Dqleftcol = .LeftCol
        
        '重置锁值
        Valilock = False
        Wbkbhlock = False
        
    End With
    
End Sub

Private Function Fun_AllowInput() As Boolean                           '当某种条件成立时禁止文本框激活使单据处于录入状态
    
    '如果单据操作状态为浏览状态则不能显示录入载体(通用)
    If Trim(Lab_OperStatus.Caption) = "1" Then
        Exit Function
    End If
    
    '[>>
    
    '此处可以填写禁止文本框激活使单据处于录入状态的理由
    If WglrGrid.TextMatrix(WglrGrid.Row, 0) <> "*" Then
        Exit Function
    End If
    '<<]
    
    Fun_AllowInput = True
    
End Function

Private Sub Cxxswbk()                                                  'Formresize中重新显示文本框,列表框,帮助按钮(通用)
    
    Dim Wbkpy As Integer, Wbkpy1 As Integer
    
    Wbkpy = 30
    Wbkpy1 = 15
    
    With WglrGrid
        If Ydtext.Visible Then
            Ydtext.Width = .CellWidth
            Ydtext.Left = .CellLeft + .Left + Wbkpy
            Ydtext.Top = .CellTop + .Top + Wbkpy
            Ydtext.Height = .CellHeight - Wbkpy1
        End If
    End With
    
End Sub

Private Sub Lrsjhx()                                                   '文本框录入数据回写
    
    With WglrGrid
        If Ydtext.Visible Then
            .Text = Trim(Ydtext.Text)
        End If
        
        '(如果字段录入内容发生变化,则打开有效性判断锁)
        If Zdlrqnr <> Trim(.Text) Then
            Yxxpdlock = False
            Hyxxpdlock = False
        End If
        
        '隐藏文本框,帮助按钮,列表组合框
        Call Ycwbk
    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
    End Select
    
End Sub

Private Sub WglrGrid_KeyPress(KeyAscii As Integer)                             '网格接受键盘录入
    
    '当某种条件成立时禁止文本框激活使单据处于录入状态

    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 xswbk
                Ydtext.Text = ""
                Valilock = True
                SendKeys Chr(KeyAscii), True
                DoEvents
                Valilock = False
            End If
        End Select
    End With
    
End Sub

Private Sub fhyxh()                                                     '返回录入数据有效行,同时让得到焦点网格可见
    
    With WglrGrid
        If .Row >= .FixedRows Then
            Changelock = True
            .Select .Row, .Col
            Changelock = False
            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()                                                     '显露当前列
    
    Dim Leftcolte As Long
    
    With WglrGrid
        If .Col >= Qslz And .Col >= .FixedCols Then
            If .LeftCol > .Col Then
                .LeftCol = .Col
            End If
            Leftcolte = 0
            Do While .CellLeft + .CellWidth > .Width And .LeftCol <> Leftcolte
                Leftcolte = .LeftCol
                .LeftCol = .LeftCol + 1
            Loop
        End If
    End With
    
End Sub

Private Function pdhwk(sjh As Long)                                     '判断网格行是否为空行(所有录入字段均为空*非录入字段除外)
    
    With WglrGrid
        For Coljsq = Qslz To .Cols - 1
            If Len(Trim(.TextMatrix(sjh, Coljsq))) <> 0 And GridBoolean(Coljsq, 1) Then
                pdhwk = False
                Exit Function
            End If
        Next Coljsq
        pdhwk = True
    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 GsToolbar_ButtonClick(ByVal Button As MSComctlLib.Button)   '表格格式设置(通用)

    Select Case Button.Key
        Case "bcgs"                                          '保存表格格式
            Call Bcwggs(WglrGrid, GridCode, GridStr())
        Case "hfmrgs"                                        '恢复默认格式
            Call Hfmrgs(WglrGrid, GridCode, GridStr())
        Case "szxsxm"                                        '设置显示项目
            Call Szxsxm(WglrGrid, GridCode)
    End Select
    
End Sub

Private Sub bbyl(bbylte As Boolean)                    '报表打印预览
    
    Dim Bbzbt$, Bbxbt() As String, bbxbtzzxs() As Integer, Bbxbtgs As Integer
    Dim Bbbwh() As String, Bbbwhzzxs() As Integer, Bbbwhgs As Integer
    Bbxbtgs = 1                                          '报 表 小 标 题 行 数
    Bbbwhgs = 0                                          '报 表 表 尾 行 数
    ReDim Bbxbt(1 To Bbxbtgs)
    ReDim bbxbtzzxs(1 To Bbxbtgs)
    
    If Bbbwhgs <> 0 Then
        ReDim Bbbwh(1 To Bbbwhgs)
        ReDim Bbbwhzzxs(1 To Bbbwhgs)
    End If
    
    Bbzbt = ReportTitle
    
    Call Scyxsjb(WglrGrid)                               '生成报表数据
    Call Scdybb(Dyymctbl, Bbzbt, Bbxbt(), bbxbtzzxs(), Bb