VB开发的ERP系统

End Sub

Private Sub Sub_CheckStatus()                                       '设置审核弃审按钮状态(亦可设置其他动作按钮状态)
    Dim State As Integer
    Dim sChecker As String
    State = Fn_GetBillState(sChecker)
    
    Select Case State
        Case 0 '未审核
            Tlb_Action.Buttons("shsh").Enabled = True           '审核
            Tlb_Action.Buttons("shqs").Enabled = False          '弃审
        Case 1 '审核
            Tlb_Action.Buttons("shsh").Enabled = False          '审核
            Tlb_Action.Buttons("shqs").Enabled = True           '弃审
        Case 2 '生成
            Tlb_Action.Buttons("shsh").Enabled = False          '审核
            Tlb_Action.Buttons("shqs").Enabled = False          '弃审
    End Select
End Sub
'Return Bill State
Private Function Fn_GetBillState(Checker As String) As Integer
    Dim Rect As New ADODB.Recordset, State As Integer
    
    Sqlstr = "Select PurPlanStyle From Cg_PurPlanMain Where PurPlanMainID ='" & Trim(Me.Lab_BillId) & "'"
    Set Rect = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
    State = 0
    If Not Rect.EOF Then
        Fn_GetBillState = Val(Rect.Fields("PurPlanStyle") & "")
    Else
        Fn_GetBillState = 0
    End If

End Function


Private Sub Wbkcl()                                                 '文本框录入之前处理(根据实际情况)
    
    Dim xswbrr As String
    With WglrGrid
        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) As Boolean       '录入数据字段有效性判断,同时进行字段录入事后处理
 
    '函数参数:Dqpdwgh, Dqpdwgl 当前要判断网格单元所处行列值

    Dim Str_JudgeText As String                 '临时有效性判断字段内容
    Dim Coljsq As Long                          '临时列计数器
    Dim RecTemp As New ADODB.Recordset          '临时使用动态集
    Dim Sqlstr As String                        '临时使用查询字符串

    With WglrGrid
        '非录入状态或非数据行则其有效性为合法
        If Yxxpdlock Or .Row < .FixedRows Then
            sjzdyxxpd = True
            Exit Function
        End If
        
        '取得当前要判断字段内容
        Str_JudgeText = Trim(.TextMatrix(Dqpdwgh, Dqpdwgl))
      
        '根据不同字段进行相应的处理(依据其逻辑编号)
        Select Case GridStr(Dqpdwgl, 1)
            '[>>以下为自定义部分

            Case "005"          '需求数量
                '1.放置字段有效性判断
                If Str_JudgeText <> "" Then
                    If Not IsNumeric(Str_JudgeText) Then
                        Tsxx = "非法数字录入!"
                        GoTo Lrcwcl
                    ElseIf Val(Str_JudgeText) <= 0 Then
                        Tsxx = "计划数量不能小于等于零!"
                        GoTo Lrcwcl
                        
                    End If
                Else
                    If Len(Str_JudgeText) = 0 Then
                        Tsxx = "计划数量不能为空!"
                        GoTo Lrcwcl
                    End If
                End If
            Case "006"
                
                If Str_JudgeText <> "" Then
                    If Not IsDate(Str_JudgeText) Then
                        Tsxx = "非法公历日期!(格式:" + Format(Date, "yyyy-mm-dd") + ")"
                        GoTo Lrcwcl
                    End If
                
                    If Format(CDate(Str_JudgeText), "yyyy-mm-dd") <= Format(Xtrq, "yyyy-mm-dd") Then
                        Tsxx = "计划到货日期必须大于当前系统日期!"
                        GoTo Lrcwcl
                    End If
                    WglrGrid.TextMatrix(Dqpdwgh, Sydz("006", GridStr(), Szzls)) = Format(CDate(Str_JudgeText), "yyyy-mm-dd")
                End If
                '2.放置字段事后处理程序

                '2.放置字段事后处理程序
 
                '<<以上为自定义部分]
        End Select
        
        '字段录入正确后为零字段清空(Fixed)
        Call Qkwlzd(Dqpdwgh, Dqpdwgl)
     
        '字段录入正确后进行数据合计(Fixed)
        For Coljsq = Qslz To .Cols - 1
            Call Sjhj(Coljsq)
        Next Coljsq
     
        '字段有效性判断通过,将字段有效性判断加锁直至再次改变(Fixed)
        sjzdyxxpd = True
        Yxxpdlock = True
        Exit Function
    End With
  
Lrcwcl:    '录入错误处理
    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 Sub Sub_JoinCount(Lng_CountRow As Long, Lng_CountCol As Long)       '当网格列值发生改变时,处理网格列之间的关联计算(可选)
  
  '过程参数:Lng_CountRow,Lng_CountCol 网格改变内容所处行列值
   
    With WglrGrid
        Select Case GridStr(Lng_CountCol, 1)         '判断网格列对应逻辑编号
               
            '[>>以下为自定义部分
            '<<以上为自定义部分]
        End Select
    End With

End Sub

Private Function Sjhzyxxpd(ByVal Yxxpdh As Long) As Boolean                     '录入数据行有效性判断,同时进行行处理
 
    '函数参数:Yxxpdh 要进行有效性判断的网格数据行的行值

    Dim Lrywlz As Long                            '录入有误网格列值
    Dim RecTemp As New ADODB.Recordset            '临时使用动态集
    
    With WglrGrid
        '判断行为空(行中所有可编辑列数据均为空或为零)和无效数据行则清除当前行
        If .Rows <= .FixedRows Then Exit Function   ' 如果没有记录，则退出
        If .TextMatrix(Yxxpdh, 0) <> "*" Then
            Sjhzyxxpd = True
            Exit Function
        End If
  
        '行没有发生变化则不进行有效性判断
        If Hyxxpdlock Then
            Sjhzyxxpd = True
            Exit Function
        End If
  
        '[>>以下为自定义部分
    
        '1.放置行有效性判断程序
           
        '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.放置行处理程序(当数据行通过有效性判断)
        
        '以上为自定义部分<<]
    End With    'WglrGrid

    '如果此行通过行有效性判断则加锁,直至此行数据再次发生变化
    Sjhzyxxpd = True
    Hyxxpdlock = True
    Exit Function

Lrcwcl:      '录入错误处理
    With WglrGrid
  
        '给出错误提示信息
        Call Xtxxts(Tsxx, 0, 1)
      
        '返回网格错误位置 (ChangeLock避免再次引发RowColChange有效性判断), 装入录入载体
        Changelock = True
        .Select Yxxpdh, Lrywlz
        Changelock = False
        Call xswbk
    
        '函数返回False
        Sjhzyxxpd = False
        Exit Function
    End With

End Function
 
Private Sub Sub_EditBill()                                                '修改一张单据
   
    Dim RecTemp As New ADODB.Recordset     '临时使用动态集
   
    If Not Security_Log(Str_RightEdit, Xtczybm, 1, True) Then
       Exit Sub
    End If
   
    '非有效单据不予进行修改动作
    If Val(Lab_BillId.Caption) = 0 Then
        Exit Sub
    End If
   
    '判断当前单据是否允许修改
    If Not Fun_AllowEdit Then
        Exit Sub
    End If
   
    '设置操作状态为修改
    Lab_OperStatus.Caption = "3"
   
    '设置工具条状态
    Call Sub_OperStatus("30")
    
    '设置可以修改的文本框
    For jsqte = 0 To Max_Text_Index
        LrText(jsqte).Enabled = False
    Next jsqte
    LrText(7).Enabled = True
    LrText(7).SetFocus
 
   
End Sub

Private Sub Sub_DeleteBill()                                               '删除当前单据
 
End Sub

Private Sub Sub_AbandonBill()                                              '放弃对当前单据的操作
 
    Dim jsqte As Long                    '临时使用计数器
  
    '先关闭录入载体(Fixed)
    Changelock = True
    Valilock = True
    Call Ycwbk
    Changelock = False
    Valilock = False

    '如果单据有效则重新显示当前单据,置单据为空状态
    If Not Rec_Query.EOF Then
        Ydcommand1.Visible = False
        Lab_BillId.Caption = Rec_Query.Fields("PurPlanMainID")
        Call Sub_ShowBill
    Else
        Ydcommand1.Visible = False
        '单据ID置为0
        Lab_BillId.Caption = 0
     
        '清除录入文本框
        For jsqte = Max_Text_Index To 0 Step -1
            LrText(jsqte).Tag = ""
            LrText(jsqte).Text = ""
        Next jsqte

        '