VB开发的ERP系统

Private Sub Timer1_Timer()
    
    Timer1.Enabled = False
    
    '加快显示速度
    WglrGrid.Redraw = False
 
    '生成查询结果
    Call Sub_Query
   
    WglrGrid.Redraw = True
    
End Sub

Private Sub Tlb_Action_ButtonClick(ByVal Button As MSComctlLib.Button)             '用户点击工具条
    
    '屏蔽文本框,下拉组合框有效性判断
    
    Valilock = True
    
    '屏蔽网格失去焦点产生的有效性判断
    
    Changelock = True
    
    Select Case Button.Key
    Case "ymsz"                                          '页面设置
        Dyymctbl.Show 1
    Case "yl"                                            '预 览
        If Fun_Drfrmyxxpd Then
            Call bbyl(True)
        End If
    Case "dy"                                            '打 印
        If Fun_Drfrmyxxpd Then
            Call bbyl(False)
        End If
    Case "cx"                                            '查询
        '调入其它窗体或功能产生的有效性判断(包括数据回写)
        If Not Fun_Drfrmyxxpd Then
            Exit Sub
        End If
        
        CL_InterimMaterialFind.Show 1
        
    Case "bill"                                          '单据
        '调入其它窗体或功能产生的有效性判断(包括数据回写)
        If Not Fun_Drfrmyxxpd Then
            Exit Sub
        End If
        
        Call ShowBill
        
    Case "sx"                                            '刷新
        Call Sub_Query
    Case "bz"                                            '帮 助
        Call F1bz
    Case "fh"                                            '退 出
        Unload Me
        
    End Select
    
    '解 锁
    Valilock = False
    Changelock = False
    
End Sub

Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)        '支持热键操作
    
    If Shift = 2 Then
        Select Case UCase(Chr(KeyCode))
        Case "P"                   'Ctrl+P 打印
            If Tlb_Action.Buttons("dy").Enabled Then
                Call bbyl(False)
            End If
        End Select
    End If
    
End Sub

Private Sub Wbkcl()                                                 '文本框录入之前处理(根据实际情况)
    
    Dim xswbrr As String
    
    With WglrGrid
        Zdlrqnr = Trim(.Text)
        xswbrr = Trim(.Text)
        
        If GridBoolean(.Col, 3) Then   '列表框录入
            
        Else
            Wbkbhlock = True
            
            '====以下为用户自定义
            Ydtext.Text = xswbrr
            '====以上为用户自定义
            
            Wbkbhlock = False
            Ydtext.SelStart = Len(Ydtext.Text)
        End If
    End With
    
End Sub

Private Function sjzdyxxpd(Dqpdwgh As Long, Dqpdwgl As Long) As Boolean       '录入数据字段有效性判断,同时进行字段录入事后处理
    '函数参数:Dqpdwgh, Dqpdwgl 当前要判断网格单元所处行列值
    
    Dim Str_JudgeText As String                 '临时有效性判断字段内容(Fixed)
    Dim Coljsq As Long                          '临时列计数器(Fixed)
    Dim Rectemp As New ADODB.Recordset          '临时使用动态集(Fixed)
    Dim SqlStr As String                        '临时使用查询字符串(Fixed)
    
    With WglrGrid
        
        '非录入状态或非数据行则其有效性为合法(Fixed)
        If Yxxpdlock Or .Row < .FixedRows Then
            sjzdyxxpd = True
            Exit Function
        End If
        
        '取得当前要判断字段内容(Fixed)
        Str_JudgeText = Trim(.TextMatrix(Dqpdwgh, Dqpdwgl))
        
        '根据不同字段进行相应的处理(依据其逻辑编号)
        Select Case GridStr(Dqpdwgl, 1)
            
            '[>>以下为自定义部分
            
            Case "010"
                If Val(Str_JudgeText) <= 0 Then
                    Tsxx = "单价必须大于零!"
                    GoTo Lrcwcl
                End If
                
                WglrGrid.TextMatrix(Dqpdwgh, Sydz("011", GridStr(), Szzls)) = Format(Val(WglrGrid.TextMatrix(Dqpdwgh, Sydz("009", GridStr(), Szzls))) * Val(WglrGrid.TextMatrix(Dqpdwgh, Sydz("010", GridStr(), Szzls))), "###0." + String(Xtjexsws, "0"))
            
            '<<以上为自定义部分]
        End Select
        
        '字段有效性判断通过,将字段有效性判断加锁直至再次改变(Fixed)
        sjzdyxxpd = True
        Yxxpdlock = True
        Exit Function
    End With
    
Lrcwcl:    '录入错误处理(Fixed)
    
    With WglrGrid
        '给出错误提示信息
        Call Xtxxts(Tsxx, 0, 1)
        
        '返回网格错误位置(ChangeLock避免再次引发RowColChange有效性判断),装入录入载体
        Changelock = True
        .Select Dqpdwgh, Dqpdwgl
        Changelock = False
        Call xswbk
        
        '函数返回False
        sjzdyxxpd = False
        Exit Function
    End With
    
End Function

Private Function Sjhzyxxpd(ByVal Yxxpdh As Long) As Boolean                  '录入数据行有效性判断,同时进行行处理
    
    Dim Lrywlz As Long                     '录入错误列值(Fixed)
    Dim SqlStr As String                   '临时查询字符串
    Dim MainId As Long
    Dim SubId As Integer
    Dim PriceValue As Double
    Dim MoneyValue As Double
    Dim Jsqte As Long
    
    With WglrGrid
        If Yxxpdh > (.Rows - 1) Then Exit Function
        '行没有发生变化则不进行有效性判断
        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
        
        
        '2.放置行处理程序(当数据行通过有效性判断)
        
        On Error GoTo Swcwcl
        
        Cw_DataEnvi.DataConnect.BeginTrans
        
        MainId = Val(WglrGrid.TextMatrix(Yxxpdh, 1))
        SubId = Val(WglrGrid.TextMatrix(Yxxpdh, 2))
        PriceValue = Format(Val(WglrGrid.TextMatrix(Yxxpdh, Sydz("010", GridStr(), Szzls))), "###0." + String(Xtdjxsws, "0"))
        MoneyValue = Format(Val(WglrGrid.TextMatrix(Yxxpdh, Sydz("009", GridStr(), Szzls))) * PriceValue, "###0." + String(Xtjexsws, "0"))
        
        SqlStr = "UPDATE GY_InOutSub SET Price=" & Val(PriceValue) & ",EMoney=" & Val(MoneyValue) & " WHERE InOutMainId=" & MainId & " AND InOutSubId=" & SubId & ""
        Cw_DataEnvi.DataConnect.Execute (SqlStr)
        
        Cw_DataEnvi.DataConnect.CommitTrans
        
    End With
    
    '判断是否输出合计
        
    If CL_InterimMaterialFind.Chk_Sum.Value = 1 Then
        WglrGrid.BackColorAlternate = &H80000005
        WglrGrid.Subtotal flexSTSum, 1, Sydz("009", GridStr(), Szzls), , &HF7F3EC, , , "合计"
        WglrGrid.Subtotal flexSTSum, 1, Sydz("011", GridStr(), Szzls), , &HF7F3EC, , , "合计"
    Else
        WglrGrid.BackColorAlternate = &H80000005
    End If
        
    '调整网格
    For Jsqte = WglrGrid.FixedRows To WglrGrid.Rows - 1
        WglrGrid.RowHeight(Jsqte) = Sjhgd
        If WglrGrid.TextMatrix(Jsqte, 1) = "合计" Then
            WglrGrid.TextMatrix(Jsqte, Sydz("001", GridStr(), Szzls)) = "合计"
            WglrGrid.TextMatrix(Jsqte, 1) = WglrGrid.TextMatrix(Jsqte - 1, 1)
            WglrGrid.TextMatrix(Jsqte, 0) = ""
        End If
        If Val(WglrGrid.TextMatrix(Jsqte, Sydz("009", GridStr(), Szzls))) = 0 Then
            WglrGrid.TextMatrix(Jsqte, Sydz("009", GridStr(), Szzls)) = ""
        End If
        If Val(WglrGrid.TextMatrix(Jsqte, Sydz("011", GridStr(), Szzls))) = 0 Then
            WglrGrid.TextMatrix(Jsqte, Sydz("011", GridStr(), Szzls)) = ""
        End If
    Next Jsqte
    
    '以上为自定义部分]
    
    Sjhzyxxpd = True
    Hyxxpdlock = True
    Exit Function
    
Swcwcl:
    
    Cw_DataEnvi.DataConnect.RollbackTrans
    If Err.Number = -2147217833 Then
        Tsxx = "录入数据超出允许范围"
        Call Xtxxts(Tsxx, 0, 1)
        Changelock = True
        WglrGrid.Select Yxxpdh, Sydz("010", GridStr(), Szzls)
        Changelock = False
        Call xswbk
        Sjhzyxxpd = False
    Else
        Tsxx = "存盘过程中出现未知错误,程序自动恢复保存前状态!"
        Call Xtxxts(Tsxx, 0, 1)
    End If
    
    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 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()                                                '窗体大小发生变化时,重新显示文本框
    
    On Error Resume Next
    With WglrGrid
        .Width = Me.Width - 160
        .Height = Me.Height - .Top - 400
    End With
    With Pic_Title
        .Width = Me.Width - 160
    End With
    
    GsToolbar.Left = Me.Width - GsToolbar.Width - 140
    
    
    Call Cxxswbk
    
End Sub

Private Function Fun_Drfrmyxxpd() As Boolean                             '调入其它窗体或功能产生的有效性判断(包括数据回写)
    
    Fun_Drfrmyxxpd = True
    
    With WglrGrid
        '如果当前网格处于编辑状态,则先进行数据回写再进行有效性判断
        
        If Ydtext.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