VB开发的ERP系统

   
End Sub

Private Sub Form_Load()
  
    '打印报表标题信息
    ReportTitle = "付 款 条 件 设 置"
     
    '调入打印页面设置窗体
    XtReportCode = "Gy_Paycon"
    Load Dyymctbl
    
    '以下为文本框处理程序(读入文本框录入信息)
    TextGroupCode = "Gy_Paycon"
    Call Drwbkxx(TextGroupCode, Textvar(), Textboolean(), Textint(), Textstr())
    Call Wbkcsh
    
    '调入网格设置信息
    GridCode = "Gy_Paycon"
    Call BzWgcsh(CzxsGrid, GridCode, GridInf(), GridBoolean(), GridInt(), GridStr())
    Qslz = GridInf(1)
    Sjhgd = GridInf(2)
    Szzls = CzxsGrid.Cols - 1
    
    '填 充 网 格
    Call Cxnrtcwg
       
    '初始化toolbar,tab卡状态
    StTab.Tab = 0
    StTab.TabEnabled(1) = False
    Frame1.Enabled = False
     
    '设置为非录入状态
    Lrzt = 0
    
    '编辑(新增、修改、删除)权限索引
    Str_RightEdit = "Gy_Paycon_Edit"
    
End Sub
 
Private Sub Cxnrtcwg()                               '查询内容填充网格

    Dim Sqlstr As String              '查询连接串
    Dim jsqte As Long                '查询临时使用变量
  
    '为加快显示速度,将网格刷新动作冻结
    CzxsGrid.Redraw = False
  
    '[>>查询连接串
    Sqlstr = "SELECT * FROM Gy_Paycon order by PayCode"
    '<<]
    Set Cxnrrec = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
    
    With Cxnrrec
        CzxsGrid.Rows = CzxsGrid.FixedRows
        If .EOF And .BOF Then
            CzxsGrid.Redraw = True
            Exit Sub
        End If
        
        jsqte = CzxsGrid.FixedRows
        
        Do While Not .EOF
            CzxsGrid.AddItem ""
            Call Jltcwg(Cxnrrec, jsqte)                              '调入填充网格子过程
            CzxsGrid.RowHeight(jsqte) = Sjhgd                        '设置网格高度
            .MoveNext
            jsqte = jsqte + 1
        Loop
    End With
  
    '将网格刷新动作解冻
    CzxsGrid.Redraw = True
    
End Sub

Private Sub Jltcwg(Jlbrec As ADODB.Recordset, Rowjsq As Long)           '记录内容填充网格

    '[>>以下为自定义部分
    With Jlbrec
        CzxsGrid.TextMatrix(Rowjsq, Sydz("001", GridStr(), Szzls)) = Trim(.Fields("PayCode") & "")            '付款条件编码
        CzxsGrid.TextMatrix(Rowjsq, Sydz("002", GridStr(), Szzls)) = Trim(.Fields("PayName") & "")            '付款条件名称
        CzxsGrid.TextMatrix(Rowjsq, Sydz("003", GridStr(), Szzls)) = Trim(.Fields("PayCredays") & "")         '信用天数
        CzxsGrid.TextMatrix(Rowjsq, Sydz("004", GridStr(), Szzls)) = Trim(.Fields("PayFadays1") & "")         '优惠天数1
        CzxsGrid.TextMatrix(Rowjsq, Sydz("005", GridStr(), Szzls)) = Trim(.Fields("PayFarate1") & "")         '优惠率1
        If Trim(.Fields("payfadays2")) <> 0 Then
            CzxsGrid.TextMatrix(Rowjsq, Sydz("006", GridStr(), Szzls)) = Trim(.Fields("payfadays2"))          '优惠天数2
        Else
            CzxsGrid.TextMatrix(Rowjsq, Sydz("006", GridStr(), Szzls)) = ""
        End If
        If Trim(.Fields("payfarate2")) <> 0 Then
            CzxsGrid.TextMatrix(Rowjsq, Sydz("007", GridStr(), Szzls)) = Trim(.Fields("payfarate2"))          '优惠率2
        Else
            CzxsGrid.TextMatrix(Rowjsq, Sydz("007", GridStr(), Szzls)) = ""
        End If
        If Trim(.Fields("payfadays3")) <> 0 Then
            CzxsGrid.TextMatrix(Rowjsq, Sydz("008", GridStr(), Szzls)) = Trim(.Fields("payfadays3"))          '优惠天数3
        Else
            CzxsGrid.TextMatrix(Rowjsq, Sydz("008", GridStr(), Szzls)) = ""
        End If
        If Trim(.Fields("payfarate3")) <> 0 Then
            CzxsGrid.TextMatrix(Rowjsq, Sydz("009", GridStr(), Szzls)) = Trim(.Fields("payfarate3"))          '优惠率3
        Else
            CzxsGrid.TextMatrix(Rowjsq, Sydz("009", GridStr(), Szzls)) = ""
        End If
        If Trim(.Fields("payfadays4")) <> 0 Then
            CzxsGrid.TextMatrix(Rowjsq, Sydz("010", GridStr(), Szzls)) = Trim(.Fields("payfadays4"))          '优惠天数4
        Else
            CzxsGrid.TextMatrix(Rowjsq, Sydz("010", GridStr(), Szzls)) = ""
        End If
        If Trim(.Fields("payfarate4")) <> 0 Then
            CzxsGrid.TextMatrix(Rowjsq, Sydz("011", GridStr(), Szzls)) = Trim(.Fields("payfarate4"))          '优惠率4
        Else
            CzxsGrid.TextMatrix(Rowjsq, Sydz("011", GridStr(), Szzls)) = ""
        End If
        
    End With
    '以上为自定义部分<<]
    
End Sub

Private Sub Form_Unload(Cancel As Integer)             '窗体卸载

    Set Cxnrrec = Nothing
    Set Rec_CodeSet = Nothing
    Unload Dyymctbl
   
End Sub

Private Function Bclrsj() As Boolean                   '判断录入数据有效性,并保存数据

    Dim jsqte As Integer
  
    '对文本框录入内容进行为零和为空判断(固定不变)
    With Rec_CodeSet
    
        For jsqte = 0 To Max_Text_Index
            If Textint(jsqte, 8) = 1 Then     '字段不能为空
                If Len(Trim(LrText(jsqte).Text)) = 0 Then
                    Tsxx = Textstr(jsqte, 7) & "不能为空!"
                    Call Xtxxts(Tsxx, 0, 1)
                    LrText(jsqte).SetFocus
                    Bclrsj = False
                    Exit Function
                End If
            Else
                If Textint(jsqte, 8) = 2 Then   '字段不能为零
                    If Val(Trim(LrText(jsqte).Text)) = 0 Then
                        Tsxx = Textstr(jsqte, 7) & "不能为零!"
                        Call Xtxxts(Tsxx, 0, 1)
                        LrText(jsqte).SetFocus
                        Bclrsj = False
                        Exit Function
                    End If
                End If
            End If
        Next jsqte
    
        '对需要进行事后判断的文本框录入内容进行有效性判断 (固定不变)
        For jsqte = 0 To Max_Text_Index
            If Textint(jsqte, 9) = 0 Or Textint(jsqte, 9) = 2 Then
                If Not TextYxxpd(jsqte) Then
                    Exit Function
                End If
            End If
        Next jsqte
        
        
    If Val(LrText(3).Text) > Val(LrText(2).Text) Then
        Tsxx = "优惠天数1不在信用天数范围内!"
        Call Xtxxts(Tsxx, 0, 1)
        LrText(3).SetFocus
        Bclrsj = False
        Exit Function
    End If
    LrText(1).Text = Trim(LrText(4).Text) & "/" & Trim(LrText(3).Text)
    If Val(LrText(5).Text) <> 0 Then
        If Trim(LrText(6).Text) = "" Then
            Tsxx = "请填入优惠率2!"
            Call Xtxxts(Tsxx, 0, 1)
            LrText(6).SetFocus
            Bclrsj = False
            Exit Function
        End If
        If Val(LrText(6).Text) >= Val(LrText(4).Text) Then
            Tsxx = "输入优惠率2应小于优惠率1!"
            Call Xtxxts(Tsxx, 0, 1)
            LrText(6).SetFocus
            Bclrsj = False
            Exit Function
        End If
        
        If Val(LrText(5).Text) > Val(LrText(2).Text) Then
            Tsxx = "优惠天数2不在信用天数范围内!"
            Call Xtxxts(Tsxx, 0, 1)
            LrText(5).SetFocus
            Bclrsj = False
            Exit Function
        End If
        
        If Val(LrText(3).Text) >= Val(LrText(5).Text) Then
            Tsxx = "优惠天数2应大于优惠天数1!"
            Call Xtxxts(Tsxx, 0, 1)
            LrText(5).SetFocus
            Bclrsj = False
            Exit Function
        End If
        
        LrText(1).Text = Trim(LrText(1).Text) & "," & Trim(LrText(6).Text) & "/" & Trim(LrText(5).Text)
        
    End If
    If Val(LrText(6).Text) <> 0 And Val(LrText(5).Text) = 0 Then
            Tsxx = "输入优惠率必填优惠天数"
            Call Xtxxts(Tsxx, 0, 1)
            LrText(5).SetFocus
            Bclrsj = False
            Exit Function
    End If
    If Val(LrText(7).Text) <> 0 Then
        If Trim(LrText(8).Text) = "" Then
            Tsxx = "请填入优惠率3!"
            Call Xtxxts(Tsxx, 0, 1)
            LrText(8).SetFocus
            Bclrsj = False
            Exit Function
        End If
        If Val(LrText(8).Text) >= Val(LrText(6).Text) Then
            Tsxx = "输入优惠率3应小于优惠率2!"
            Call Xtxxts(Tsxx, 0, 1)
            LrText(8).SetFocus
            Bclrsj = False
            Exit Function
        End If
        If Val(LrText(7).Text) > Val(LrText(2).Text) Then
            Tsxx = "优惠天数3不在信用天数范围内!"
            Call Xtxxts(Tsxx, 0, 1)
            LrText(7).SetFocus
            Bclrsj = False
            Exit Function
        End If
        If Val(LrText(5).Text) >= Val(LrText(7).Text) Then
            Tsxx = "优惠天数3应大于优惠天数2!"
            Call Xtxxts(Tsxx, 0, 1)
            LrText(7).SetFocus
            Bclrsj = False
            Exit Function
        End If
        
        LrText(1).Text = Trim(LrText(1).Text) & "," & Trim(LrText(8).Text) & "/" & Trim(LrText(7).Text)
        
    End If
    If Val(LrText(8).Text) <> 0 And Val(LrText(7).Text) = 0 Then
            Tsxx = "输入优惠率必填优惠天数"
            Call Xtxxts(Tsxx, 0, 1)
            LrText(7).SetFocus
            Bclrsj = False
            Exit Function
        End If
    If Val(LrText(9).Text) <> 0 Then
        If Trim(LrText(10).Text) = "" Then
            Tsxx = "请填入优惠率4!"
            Call Xtxxts(Tsxx, 0, 1)
            LrText(10).SetFocus
            Bclrsj = False
            Exit Function
        End If
        If Val(LrText(10).Text) >= Val(LrText(8).Text) Then
            Tsxx = "输入优惠率4应小于优惠率3!"
            Call Xtxxts(Tsxx, 0, 1)
            LrText(10).SetFocus
            Bclrsj = False
            Exit Function
        End If
        If Val(LrText(9).Text) > Val(LrText(2).Text) Then
            Tsxx = "优惠天数4不在信用天数范围内!"
            Call Xtxxts(Tsxx, 0, 1)
            LrText(9).SetFocus
            Bclrsj = False
            Exit Function
        End If
        If Val(LrText(7).Text) >= Val(LrText(9).Text) Then
            Tsxx = "优惠天数4应大于优惠天数3!"
            Call Xtxxts(Tsxx, 0, 1)
            LrText(9).SetFocus
            Bclrsj = False
            Exit Function
        End If
        
        LrText(1).Text = Trim(LrText(1).Text) & "," & Trim(LrText(10).Text) & "/" & Trim(LrText(9).Text)
        
    End If
    If Val(LrText(10).Text) <> 0 And Val(LrText(9).Text) = 0 Then
            Tsxx = "输入优惠率必填优惠天数"
            Call Xtxxts(Tsxx, 0, 1)
            LrText(9).SetFocus
            Bclrsj = False
            Exit Function
    End If
    
        If Lrzt = 1 Then  '增 加
        
            '[>>判断编码是否重复
            If .State = 1 Then .Close
            .Open "SELECT * FROM Gy_Paycon WHERE PayCode= '" + Trim(LrText(0).Text) + "'", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
    
            If Not .EOF Then
                Tsxx = "付款条件编码重复!"
                Call Xtxxts(Tsxx, 0, 1)
                LrText(0).SetFocus
                Bclrsj = False
                Exit Function
            End If
    
            '判断名称是否重复
            If .State = 1 Then .Close
            .Open "SELECT * FROM Gy_Paycon WHERE PayName= '" + Trim(LrText(1).Text) + "'", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
    
            If Not .EOF Then
                Tsxx = "付款条件名称重复!"
                Call Xtxxts(Tsxx, 0, 1)
                LrText(1).SetFocus
                Bclrsj = False
                Exit Function
            End If

            '判断记录内容无误后,将记录内容写入数据表
            On Error GoTo Swcwcl
    
            Cw_DataEnvi.DataConnect.BeginTrans
   
            .AddNew
            .Fields("PayCode") = Trim(LrText(0).Text)      '付款条件编码
            .Fields("PayName") = Trim(LrText(1).Text)      '付款条件名称
            .Fields("PayCredays") = Val(LrText(2).Text)    '信用天数
            .Fields("PayFadays1") = Val(LrText(3).Text)    '优惠天数1
            .Fields("PayFarate1") = Val(LrText(4).Text)    '优惠率1
            .Fields("PayFadays2") = Val(LrText(5).Text)    '优惠天数2
            .Fields("PayFarate2") = Val(LrText(6).Text)    '优惠率2
            .Fields("PayFadays3") = Val(LrText(7).Text)    '优惠天数3
            .Fields("PayFarate3") = Val(LrText(8).Text)    '优惠率3
            .Fields("PayFadays4") = Val(LrText(9).Text)    '优惠天数4
            .Fields("PayFarate4") = Val(LrText(10).Text)   '优惠率4
            
            .Update
            
            Cw_DataEnvi.DataConnect.CommitTrans

            '将记录加入网格
            Sqlstr = "SELECT * FROM Gy_Paycon WHERE PayCode= '" + Trim(LrText(0).Text) + "'"