贷款额度.frm

用友U8财务软件VB源程序, 本版本为2002年版本

           credstat.selRow = 3
        Else
            MsgBox "第1行有效期限下限不能为空！", vbInformation, "输入错误"
            credstat.selRow = 2
        End If
        Call setModiState
    Else
        If DateCheck(Trim(SuperGrid1.TextMatrix(SuperGrid1.Rows - 1, 1))) <> "" Then
            credstat.ModifyState = 1
            If SuperGrid1.Rows > 2 And SuperGrid1.TextMatrix(SuperGrid1.Rows - 1, 1) <> "" Then
                SuperGrid1.AddRecord DateAdd("d", 1, DateCheck(SuperGrid1.TextMatrix(SuperGrid1.Rows - 1, 1))), discolor
            Else
                SuperGrid1.AddRecord Format(Date, "YYYY/MM/DD"), discolor
            End If
            If Trim(LblcreClass.Caption) <> "" Then
                SuperGrid1.TextMatrix(SuperGrid1.Rows - 1, 2) = borQua("b" & LblcreClass.Caption)
            Else
                SuperGrid1.TextMatrix(SuperGrid1.Rows - 1, 2) = 0
            End If
            credstat.selRow = SuperGrid1.Rows - 1
            Call setModiState
        Else
            MsgBox "第" & credstat.selRow - 2 & "行" & "有效期限下限输入非法！", vbInformation, "输入错误"
        End If
    End If
End Sub

'删除处理过程
Private Sub delColumnProc()
'    Dim rs As New ADODB.Recordset
    Dim result As VbMsgBoxResult
    If credstat.selRow = 0 Or credstat.selRow = 1 Then
        MsgBox "未选择要删除的数据行！", vbInformation, "删除数据"
        Exit Sub
    End If
'    If DateCheck(Trim(SuperGrid1.TextMatrix(credstat.selRow, 0))) <> "" Then
        If SuperGrid1.Rows > 3 Then
'            sqlstr = "delete from FD_borQuaLimSet where cUnitCode='" & unitInfor(curPos, 0) & "' And avaldateStart='" & SuperGrid1.TextMatrix(credstat.selRow, 0) & "'"
'            Con.BeginTrans
'            Con.Execute sqlstr
'            Con.CommitTrans
            SuperGrid1.RemoveItem credstat.selRow
            credstat.selRow = SuperGrid1.Rows - 1
            credstat.modified = True
        ElseIf SuperGrid1.Rows = 3 Then
            result = MsgBox("该操作将删除该单位的贷款额度纪录！" & vbCrLf & "确定要删除吗？", vbYesNo, "删除数据")
            Select Case result
                Case vbYes
                    sqlstr = "delete from FD_borQuaLimSet where cUnitCode='" & unitInfor(curPos, 0) & "';"
                    On Error GoTo error0
                    con.BeginTrans
                    con.Execute sqlstr
                    con.CommitTrans
                    credstat.selRow = 2
                    Call setTreeview
                    Call setQueryState
                Case vbNo
                    SuperGrid1.SetFocus
            End Select
        End If
        Exit Sub
'    Else
'        MsgBox "第" & credstat.selRow & "行" & "有效期限下限输入非法！", vbInformation, "输入错误"
''    rs.Open sqlstr, Con, adOpenDynamic
''    rs.Delete adAffectCurrent
''    rs.Close
''    Set rs = Nothing
'    Exit Sub
'    End If
error0:
    con.RollbackTrans
    MsgBox "删除数据失败", vbInformation, "系统信息"
    Exit Sub
End Sub
'查询数据过程
Private Sub SearchProc()
    Dim i As Integer
    Dim rs As New ADODB.Recordset
    Dlgquerystr.Show 1
    If cre_Where = "" Then
        Exit Sub
        'cre_Where = "1=1"
    End If
    sqlstr = "select distinct cUnitCode,cUnitName,iType"
    sqlstr = sqlstr & " from FD_accUnit "
    sqlstr = sqlstr & " Where " & cre_Where
    sqlstr = sqlstr & " order by cUnitcode"
    rs.Open sqlstr, con, adOpenDynamic
    If Not (rs.EOF Or rs.BOF) Then
        If existRec(rs("cUnitName")) Then
            Call loadData(curPos)
           '取贷款额度设置信息
    '        rs.Close
    '        sqlstr = "select * From FD_borQuaLimSet where cUnitCode=" & unitInfor(curPos, 0)
    '        rs.Open sqlstr, con, adOpenDynamic
    '        ReDim GridData(rs.RecordCount - 1, 7)
    '        For i = 0 To rs.RecordCount - 1
    '            GridData(i, 0) = Trim(rs("iType"))
    '            GridData(i, 1) = Trim(rs("unitName"))
    '            GridData(i, 2) = CStr(rs("realMark"))
    '            GridData(i, 3) = CStr(rs("creClass"))
    '            GridData(i, 4) = rs("bType")
    '            GridData(i, 5) = Format(rs("perStart"), "YYYY/MM/DD")
    '            GridData(i, 6) = Format(rs("perEnd"), "YYYY/MM/DD")
    '            GridData(i, 7) = rs("borLImValue")
    '        Next
         Else
            Call loadZeroData(curPos)
        End If
            rs.Close
    Else
        MsgBox "没有找到符合条件的单位！", vbInformation, "系统信息"
        rs.Close
        Exit Sub
    End If
        Call setQueryState
        Call fillgrid
End Sub

'取消操作
Private Sub CancelProc()
    SuperGrid1.clear
    Call setSupergrid
    Call setQueryState
    Call fillgrid
End Sub

'检查输入数据的有效性
Private Function CheckData() As Boolean
    Dim i As Integer
    With SuperGrid1
    Select Case .Rows
        Case 3
            If .TextMatrix(2, 0) <> "" And .TextMatrix(2, 1) <> "" Then
                If DateCheck(.TextMatrix(2, 0)) <> "" And DateCheck(.TextMatrix(2, 1)) <> "" Then
                    If DateDiff("d", DateCheck(.TextMatrix(2, 0)), DateCheck(.TextMatrix(2, 1))) > 0 Then
                        CheckData = True
                    Else
                        MsgBox "有效期限下限不能大于上限！", vbInformation, "输入错误"
                        CheckData = False
                        .SetFocus
                        .row = 2
                        Exit Function
                    End If
                Else
                    CheckData = False
                    MsgBox "有效期限输入非法！", vbInformation, "输入错误"
                    .SetFocus
                    .row = 2
                    Exit Function
                End If
            Else
                CheckData = False
                MsgBox "有效期限不能为空!", vbInformation, "输入错误"
                .SetFocus
                .row = 2
                Exit Function
            End If
            If Trim(.TextMatrix(2, 2)) <> "" Then
                If IsNumeric(.TextMatrix(2, 2)) Then
                    If .TextMatrix(2, 2) >= 0 Then
                        CheckData = True
                    Else
                        CheckData = False
                        MsgBox "贷款额度不能为负数", vbInformation, "输入错误"
                        .SetFocus
                        .row = 2
                        .col = 2
                        Exit Function
                    End If
                Else
                    CheckData = False
                    MsgBox "贷款额度必须为数字", vbInformation, "输入错误"
                    .SetFocus
                    .row = 2
                    .col = 2
                    Exit Function
                End If
            Else
                CheckData = False
                MsgBox "贷款额度不能为空", vbInformation, "输入错误"
                .SetFocus
                .row = 2
                .col = 2
                Exit Function
            End If
        Case 4
            For i = 2 To 3
                If .TextMatrix(i, 0) <> "" And .TextMatrix(i, 1) <> "" Then
                    If DateCheck(.TextMatrix(i, 0)) <> "" And DateCheck(.TextMatrix(i, 1)) <> "" Then
                        If DateDiff("d", DateCheck(.TextMatrix(i, 0)), DateCheck(.TextMatrix(i, 1))) > 0 Then
                            CheckData = True
                        Else
                            MsgBox "有效期限下限不能大于上限！", vbInformation, "输入错误"
                            .SetFocus
                            .row = i
                            CheckData = False
                            Exit Function
                        End If
                    Else
                        CheckData = False
                        MsgBox "有效期限输入非法！", vbInformation, "输入错误"
                        .SetFocus
                        .row = i
                        Exit Function
                    End If
                Else
                    CheckData = False
                    MsgBox "有效期限不能为空!", vbInformation, "输入错误"
                    .SetFocus
                    .row = i
                    Exit Function
                End If
            If Trim(.TextMatrix(i, 2)) <> "" Then
                If IsNumeric(.TextMatrix(i, 2)) Then
                    If .TextMatrix(i, 2) >= 0 Then
                        CheckData = True
                    Else
                        CheckData = False
                        MsgBox "贷款额度不能为负数", vbInformation, "输入错误"
                        .SetFocus
                        .row = i
                        .col = 2
                        Exit Function
                    End If
                Else
                    CheckData = False
                    MsgBox "贷款额度必须为数字", vbInformation, "输入错误"
                    .SetFocus
                    .row = i
                    .col = 2
                    Exit Function
                End If
            Else
                CheckData = False
                MsgBox "贷款额度不能为空", vbInformation, "输入错误"
                .SetFocus
                .row = i
                .col = 2
                Exit Function
            End If
        Next
            
            If DateDiff("d", DateCheck(.TextMatrix(2, 1)), DateCheck(.TextMatrix(3, 0))) <= 0 Then
                MsgBox "新增的有效期限下限必须大于上一条的有效期限上限！", vbInformation, "输入错误！"
                CheckData = False
                .SetFocus
                .row = 3
                .col = 0
                Exit Function
            Else
                CheckData = True
            End If
    Case Else
        For i = 2 To .Rows - 1
                If .TextMatrix(i, 0) <> "" And .TextMatrix(i, 1) <> "" Then
                    If DateCheck(.TextMatrix(i, 0)) <> "" And DateCheck(.TextMatrix(i, 1)) <> "" Then
                        If DateDiff("d", DateCheck(.TextMatrix(i, 0)), DateCheck(.TextMatrix(i, 1))) > 0 Then
                            CheckData = True
                        Else
                            MsgBox "有效期限下限不能大于上限！", vbInformation, "输入错误"
                            .SetFocus
                            .row = i
                            CheckData = False
                            Exit Function
                        End If
                    Else
                        CheckData = False
                        MsgBox "有效期限输入非法！", vbInformation, "输入错误"
                        .SetFocus
                        .row = i
                        Exit Function
                    End If
                Else
                    CheckData = False
                    MsgBox "有效期限不能为空!", vbInformation, "输入错误"
                    .SetFocus
                    .row = i
                    Exit Function
                End If
            If Trim(.TextMatrix(i, 2)) <> "" Then
                If IsNumeric(.TextMatrix(i, 2)) Then
                    If .TextMatrix(i, 2) >= 0 Then
                        CheckData = True
                    Else
                        CheckData = False
                        MsgBox "贷款额度不能为负数", vbInformation, "输入错误"
                        .SetFocus
                        .row = i
                        .col = 2
                        Exit Function
                    End If
                Else
                    CheckData = False
                    MsgBox "贷款额度必须为数字", vbInformation, "输入错误"
                    .SetFocus
                    .row = i
                    .col = 2
                    Exit Function
                End If
            Else
                CheckData = False
                MsgBox "贷款额度不能为空", vbInformation, "输入错误"
                .SetFocus
                .row = i
                .col = 2
                Exit Function
            End If
        Next
        For i = 3 To .Rows - 1
            If DateDiff("d", DateCheck(.TextMatrix(i - 1, 1)), DateCheck(.TextMatrix(i, 0))) <= 0 Then
                MsgBox "新增的有效期限下限必须大于上一条的有效期限上限！", vbInformation, "输入错误！"
                CheckData = False
                .SetFocus
                .row = i
                .col = 0
                Exit Function
            Else
                CheckData = True
            End If
        Next
    End Select
    End With
End Function

'保存数据
Private Function SaveData() As Boolean
    'Dim RS As New ADODB.Recordset
    Dim i, j As Integer
    If Optdkze.Value Then
        j = 1
    Else
        j = 0
    End If
    On Error GoTo error0
    'con.BeginTrans
    With SuperGrid1
    Call existRec(Trim(lblUnitName.Caption))
    Select Case credstat.ModifyState
        Case 1  '新增行
            con.BeginTrans
            sqlstr = "delete from FD_borQuaLimSet where cUnitCode='" & unitInfor(curPos, 0) & "'"
'            RS.Open sqlStr, con, adOpenDynamic