VB开发的ERP系统

Private Sub Form_Unload(Cancel As Integer)           '窗体卸载
    '卸载打印页面窗体
    Unload Dyymctbl
    Dim frm_temp As Form
    For Each frm_temp In Forms
       If frm_temp.Name = "Balance_KF_InOut" Then
           Balance_KF_InOut.UnloadCheck = 1
           Unload Balance_KF_InOut
       ElseIf frm_temp.Name = "Balance_KF_Invoice" Then
           Balance_KF_Invoice.UnloadCheck = 1
           Unload Balance_KF_Invoice
       ElseIf frm_temp.Name = "Balance_KF_Query" Then
           Balance_KF_Query.UnloadCheck = 1
           Unload Balance_KF_Query
       End If
    Next frm_temp
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 BanlGrid2
        Zdlrqnr = Trim(.Text)
        xswbrr = Trim(.Text)
    
        If GridBoolean(.Col, 3) Then   '列表框录入
    
            '填充列表框程序
            Call FillCombo(YdCombo, GridStr(.Col, 5), xswbrr, 0)
        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)        '录入数据字段有效性判断,同时进行字段录入事后处理
    
    Dim Str_JudgeText As String            '临时有效性判断字段内容
    Dim Coljsq As Long                     '临时列计数器
    Dim RecTemp As New ADODB.Recordset     '临时使用动态集
    Dim Dbl_Qcye As Double                 '临时期初余额
 
    With BanlGrid2
    
        '非录入状态有效性为合法
        If Yxxpdlock Or .Row < .FixedRows Then
           sjzdyxxpd = True
           Exit Function
        End If
 
        Str_JudgeText = Trim(.TextMatrix(Dqpdwgh, Dqpdwgl))
        Select Case GridStr(Dqpdwgl, 1)
         
            '以下为自定义部分[
            Case "009"
                If Trim(Str_JudgeText) <> "" Then
                    Sqlstr = "SELECT WhName, WhCode FROM KF_V_WhLimit  WHERE ( WhCode='" & Trim(Str_JudgeText) & "' or WhName='" & Trim(Str_JudgeText) & "') AND (Czybm = '" & Xtczybm & "')"
                    Set RecTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
                    If RecTemp.EOF Then
                        Tsxx = "此仓库不存在或权限不够!"
                        GoTo Lrcwcl
                    Else
                        .TextMatrix(Dqpdwgh, 4) = Trim("" & RecTemp.Fields("WhCode"))
                        .TextMatrix(Dqpdwgh, Sydz("009", GridStr(), Szzls)) = Trim("" & RecTemp.Fields("WhName"))
                    End If
                Else
                    .TextMatrix(Dqpdwgh, 4) = ""
                    .TextMatrix(Dqpdwgh, Sydz("009", GridStr(), Szzls)) = ""
                End If
            Case "010"
                If Trim(Str_JudgeText) <> "" Then
                    Sqlstr = "SELECT MNumber, MName FROM Gy_Material WHERE (IsCharge = 0) AND (MNumber ='" & Trim(Str_JudgeText) & "' or MName='" & Trim(Str_JudgeText) & "')"
                    Set RecTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
                    If RecTemp.EOF Then
                        Tsxx = "此物料(实物)不存在!"
                        GoTo Lrcwcl
                    Else
                        .TextMatrix(Dqpdwgh, 5) = Trim("" & RecTemp.Fields("MNumber"))
                        .TextMatrix(Dqpdwgh, Sydz("010", GridStr(), Szzls)) = Trim("" & RecTemp.Fields("MName"))
                    End If
                Else
                    .TextMatrix(Dqpdwgh, 5) = ""
                    .TextMatrix(Dqpdwgh, Sydz("010", GridStr(), Szzls)) = ""
                End If
            '以上为自定义部分]
        End Select
     
        '字段录入正确后为零字段清空
        Call Qkwlzd(Dqpdwgh, Dqpdwgl)
    
        sjzdyxxpd = True
        Yxxpdlock = True
        Exit Function
    
    End With
  
Lrcwcl:    '录入错误处理

    With BanlGrid2
        Call Xtxxts(Tsxx, 0, 1)
        Changelock = True
        .Select Dqpdwgh, Dqpdwgl
        Changelock = False
        Call xswbk
        sjzdyxxpd = False
        Exit Function
    End With
    
End Function

Private Function Sjhzyxxpd(ByVal Yxxpdh As Long) As Boolean                  '录入数据行有效性判断,同时进行行处理
 
    Dim Lrywlz As Long                     '录入错误列值(Fixed)
    Dim RecTemp As New ADODB.Recordset     '临时使用动态集
    Dim Sqlstr As String                   '临时查询字符串
    Dim Str_Ccode As String                '临时索引编码

    With BanlGrid2
        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.放置行处理程序(当数据行通过有效性判断)
           
        Str_Ccode = Trim(.TextMatrix(Yxxpdh, Sydz("001", GridStr(), Szzls)))
           
         
    End With

    '以上为自定义部分]


    Sjhzyxxpd = True
    Hyxxpdlock = True
    Exit Function

Swcwcl:

    Cw_DataEnvi.DataConnect.RollbackTrans
    Tsxx = "存盘过程中出现未知错误,程序自动恢复保存前状态!"
    Call Xtxxts(Tsxx, 0, 1)
    Exit Function

Lrcwcl:      '录入错误处理

    With BanlGrid2
        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 BanlGrid2
     
        Valilock = True
    
        '处理通用部分
        Changelock = True        '调入另外窗体必须加锁
        If GridInt(.Col, 6) <> 1 Then
            strHlpR = FunHlpR(Trim(GridStr(.Col, 3)), "czybm", Xtczybm)
        End If
        Call Drbmhelp(GridInt(.Col, 6), GridStr(.Col, 3), Trim(Ydtext.Text))
        strHlpR = ""
        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 BanlGrid2
   
        '如果当前网格处于编辑状态,则先进行数据回写再进行有效性判断
  
        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 BanlGrid2_EnterCell()                                          '显示当前数据行相关信息

    With BanlGrid2
        If .Row >= .FixedRows Then
            '[>>
                '此处可以填写显示与此网格行相关信息
            '<<]
        End If
    End With
   
End Sub

Private Sub BanlGrid2_GotFocus()                                           '网格得到焦点

    '网格得到焦点,如果当前选择行为非数据行
    '则调整当前焦点至有效数据行

    With BanlGrid2
        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 BanlGrid2_LostFocus()                                          '录入网格失去焦点

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

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

End Sub

Private Sub BanlGrid2_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 BanlGrid2
        If Ydtext.Visible Or YdCombo.Visible Then
            Gdtlock = True
            .TopRow = Dqtoprow
            .LeftCol = Dqleftcol
            Gdtlock = False
            Exit Sub
        End If
    End With
    
End Sub