贷款额度.frm

财务信息管理系统,适合做毕业论文的人使用

            Case "Cancel"
                Call CancelProc
            Case "Save"
                Call saveProc
            Case "search"
                   Call SearchProc
            Case "Help"
                SendKeys "{F1 3}"
            Case "Exit"
                Unload Me
                Exit Sub
        End Select
    End With
    If Button.key <> "Exit" Then
        ocxCtbTool.RefreshEnable
    End If
End Sub



Private Sub ZeroDataProc()
    Call setModiState
    SuperGrid1.row = SuperGrid1.Rows - 1
    credstat.ModifyState = 1
    SuperGrid1.col = 1
    SuperGrid1.SetFocus
End Sub

'检查用户是否有贷款额度设置的纪录
Private Function existRec(ByVal UnitName As String) As Boolean
    Dim rs As New ADODB.Recordset
    Dim i As Integer
    For i = 0 To UBound(unitInfor)
        If UnitName = unitInfor(i, 1) Then
            curPos = i
            Exit For
        Else
            curPos = i + 1
        End If
    Next
    If curPos = UBound(unitInfor) + 1 Then
        existRec = False
        Exit Function
    Else
        sqlstr = "Select count(*) from Fd_borQuaLimSet where cUnitcode='" & unitInfor(curPos, 0) & "'"
        rs.Open sqlstr, con, adOpenDynamic
        If rs(0) <> 0 Then
            existRec = True
        Else
            existRec = False
        End If
    End If
End Function

'没有对应单位的贷款额度设置的纪录，使用默认值填写界面
Private Sub loadZeroData(ByVal curPos As Integer)
    Dim rs As New ADODB.Recordset
'    Dim rs1 As New ADODB.Recordset
    Dim i As Integer
'    sqlStr = "select distinct a.cUnitCode As cUnitCode,a.cUnitName As UnitName,a.iType As iType,"
'    sqlStr = sqlStr & "b.CreClass As creClass from FD_accUnit a,Fd_creEstamate b Where a.cUnitCode='" & unitInfor(curPos, 0) & "' And " '"
'    sqlStr = sqlStr & "a.cUnitCode=b.cUnitCode order by a.cUnitcode"
'    RS.Open sqlStr, con, adOpenDynamic
'    If Not (RS.EOF Or RS.BOF) Then
'        sqlStr = "select sum(realMark) as sum_realMark from fd_creEstamate where cUnitcode='" & unitInfor(curPos, 0) & "';"
'        rs1.Open sqlStr, con, adOpenDynamic, adLockOptimistic
    sqlstr = "select cunitname,itype from fd_accUnit where cunitname='" & Trim(unitInfor(curPos, 1)) & "';"
    ReDim GridData(0, 7)
    rs.Open sqlstr, con, adOpenDynamic, adLockOptimistic
    If Not (rs.EOF Or rs.BOF) Then
        Select Case CInt(Trim(rs("iType")))
             Case 0
                 GridData(i, 0) = "个人"
             Case 1
                 GridData(i, 0) = "部门"
             Case 2
                 GridData(i, 0) = "银行"
             Case 3
                 GridData(i, 0) = "客户"
             Case 4
                 GridData(i, 0) = "供应商"
             Case 5
                 GridData(i, 0) = "项目"
         End Select
        'GridData(0, 0) = Trim(rs("iType"))
        GridData(0, 1) = Trim(rs("cunitName"))
        GridData(0, 2) = ""
        GridData(0, 3) = ""
        GridData(0, 4) = 0
        GridData(0, 5) = Format(zjLogInfo.curDate, "YYYY/MM/DD")
        GridData(0, 6) = ""
        GridData(0, 7) = 0
    Else
        MsgBox "单位信息有误，请退出重新进入本系统！", vbInformation, "系统信息"
        GridData(0, 0) = ""
        GridData(0, 1) = ""
        GridData(0, 2) = ""
        GridData(0, 3) = ""
        GridData(0, 4) = 0
        GridData(0, 5) = Format(zjLogInfo.curDate, "YYYY/MM/DD")
        GridData(0, 6) = ""
        GridData(0, 7) = 0
    End If
    rs.Close
    
    sqlstr = "select sum(realMark),min(creclass) as sum_realMark from fd_creEstamate where cUnitcode='" & unitInfor(curPos, 0) & "';"
    rs.Open sqlstr, con, adOpenDynamic, adLockOptimistic
    If Not (rs.EOF Or rs.BOF) Then
        GridData(0, 2) = IIf(IsNull(rs(0)), "", rs(0))
        GridData(0, 3) = IIf(IsNull(rs(1)), "", rs(1))
    End If
    rs.Close
'    Else
'    End If
'    Set rs1 = Nothing
    Set rs = Nothing
End Sub

'有对应单位的贷款额度设置的纪录，使用设置值填写界面
Private Sub loadData(ByVal curPos As Integer)
    Dim rs As New ADODB.Recordset, rs1 As New ADODB.Recordset
    Dim i As Integer
    Dim sumRealMark As Double, curvalue As Double
    Dim crestr As String
    On Error GoTo error0
    '取单位信息
    sumRealMark = 0
    sqlstr = "select dbo.FD_accUnit.cUnitCode As cUnitCode,dbo.FD_accUnit.cUnitName As UnitName,dbo.FD_accUnit.iType As iType,dbo.Fd_creEstamate.realMark As realMark,"
    sqlstr = sqlstr & "dbo.Fd_creEstamate.CreClass As creClass from dbo.FD_accUnit inner join dbo.Fd_creEstamate on"
    sqlstr = sqlstr & " dbo.FD_accUnit.cUnitCode=dbo.Fd_creEstamate.cUnitCode "
    sqlstr = sqlstr & "Where (dbo.FD_accUnit.cUnitCode='" & unitInfor(curPos, 0) & "');"
    rs.Open sqlstr, con, adOpenDynamic, adLockOptimistic
    If Not (rs.EOF Or rs.BOF) Then
        While Not (rs.EOF Or rs.BOF)
            curvalue = IIf(IsNull(rs("realMark")), 0, rs("realmark"))
            sumRealMark = sumRealMark + CDbl(curvalue)
            crestr = IIf(IsNull(rs("creClass")), "", rs("creClass"))
            rs.MoveNext
        Wend
    Else
        sumRealMark = 0
        crestr = ""
    End If
    rs.Close
       
    '取贷款额度设置信息
    sqlstr = "select * From FD_borQuaLimSet where cUnitCode='" & unitInfor(curPos, 0) & "'"
    rs1.Open sqlstr, con, adOpenDynamic
    i = 0
    If rs1.RecordCount > 0 Then
        ReDim GridData(rs1.RecordCount - 1, 7)
        GridData(0, 2) = 0
        While Not (rs1.EOF Or rs1.BOF)
            'GridData(i, 0) = Trim(RS("iType"))
            If Not IsNull(Trim(unitInfor(curPos, 2))) Then
                Select Case CInt(Trim(unitInfor(curPos, 2)))
                    Case 0
                        GridData(i, 0) = "个人"
                    Case 1
                        GridData(i, 0) = "部门"
                    Case 2
                        GridData(i, 0) = "银行"
                    Case 3
                        GridData(i, 0) = "客户"
                    Case 4
                        GridData(i, 0) = "供应商"
                    Case 5
                        GridData(i, 0) = "项目"
                End Select
            Else
                GridData(i, 0) = ""
            End If
            'GridData(i, 0) = Trim(unitInfor(curPos, 2))
            GridData(i, 1) = Trim(unitInfor(curPos, 1))
            GridData(i, 2) = sumRealMark
            GridData(i, 3) = crestr
'            If Not (rs.EOF Or rs.BOF) Then
'                GridData(i, 2) = IIf(IsNull(rs("realMark")), 0, rs("realmark"))
'                GridData(i, 3) = CStr(IIf(IsNull(rs("creClass")), "", rs("creClass")))
'            Else
'                GridData(i, 2) = 0
'                GridData(i, 3) = ""
'            End If
            GridData(i, 4) = rs1("bType")
            GridData(i, 5) = Format(rs1("avalDateStart"), "YYYY/MM/DD")
            GridData(i, 6) = Format(rs1("avalDateEnd"), "YYYY/MM/DD")
            GridData(i, 7) = Format(IIf(IsNull(rs1("borLimValue")), 0, rs1("borLimValue")), "0.00")
            i = i + 1
            rs1.MoveNext
        Wend
    Else
        ReDim GridData(0, 7)
        If Not IsNull(Trim(unitInfor(curPos, 2))) Then
            Select Case CInt(Trim(unitInfor(curPos, 2)))
                Case 0
                    GridData(i, 0) = "个人"
                Case 1
                    GridData(i, 0) = "部门"
                Case 2
                    GridData(i, 0) = "银行"
                Case 3
                    GridData(i, 0) = "客户"
                Case 4
                    GridData(i, 0) = "供应商"
                Case 4
                    GridData(i, 0) = "项目"
            End Select
        Else
            GridData(i, 0) = ""
        End If
        'GridData(i, 0) = Trim(RS("iType"))
        'GridData(i, 0) = Trim(unitInfor(curPos, 2))
        GridData(i, 1) = Trim(unitInfor(curPos, 1))
        GridData(i, 2) = 0
        GridData(i, 3) = ""
        GridData(i, 4) = True
        GridData(i, 5) = Format(Date, "YYYY/MM/DD")
        GridData(i, 6) = ""
        GridData(i, 7) = 0
    End If
    rs1.Close
    'rs.Close
    Set rs1 = Nothing
    Set rs = Nothing
    Exit Sub
error0: MsgBox "系统装载数据失败，请退出重起！", vbCritical, "系统错误"
        Exit Sub
End Sub

'利用数组信息填写界面
Private Sub fillgrid()
    Dim i As Long
    On Error Resume Next
    i = UBound(GridData)
    If Err.Number <> 0 Then
        Err.clear
        Exit Sub
    End If
    LblUnitType.Caption = GridData(0, 0)
    lblUnitName.Caption = GridData(0, 1)
    LblrealMark.Caption = "0"
'    For i = 0 To UBound(GridData)
'        LblrealMark.Caption = CDbl(Trim(LblrealMark.Caption)) + CDbl(IIf(Trim(GridData(i, 2) = ""), 0, GridData(i, 2)))
'    Next
    LblrealMark.Caption = Trim(GridData(0, 2))
    LblcreClass.Caption = GridData(0, 3)
    If GridData(0, 4) <> "" Then
        If GridData(0, 4) Then
             Optdkze.Value = True
        Else
             Optdkye.Value = True
        End If
    Else
        Optdkze.Value = True
    End If
    With SuperGrid1
    .Rows = 2 + UBound(GridData) + 1
    For i = 0 To UBound(GridData)
        .TextMatrix(i + 2, 0) = GridData(i, 5)
        .TextMatrix(i + 2, 1) = GridData(i, 6)
        If GridData(i, 7) <> 0 Then
            .TextMatrix(i + 2, 2) = GridData(i, 7)
        Else
            .TextMatrix(i + 2, 2) = getdefault_loanValue(GridData(0, 3))
        End If
    Next
    End With
    credstat.selRow = SuperGrid1.Rows - 1
End Sub

'设置查询状态界面
Private Sub setQueryState()
credstat.modified = False
credstat.ModifyState = 0
    If Not unitzero Then
        With tlbTool
            .Buttons("print").Enabled = True
            .Buttons("preview").Enabled = True
            .Buttons("Output").Enabled = True
            .Buttons("addColumn").Enabled = False
            .Buttons("delColumn").Enabled = False
            .Buttons("Modi").Enabled = True
            .Buttons("Cancel").Enabled = False
            .Buttons("Save").Enabled = False
            .Buttons("search").Enabled = True
        End With
    Else
        With tlbTool
            .Buttons("print").Enabled = False
            .Buttons("preview").Enabled = False
            .Buttons("Output").Enabled = False
            .Buttons("addColumn").Enabled = False
            .Buttons("delColumn").Enabled = False
            .Buttons("Modi").Enabled = False
            .Buttons("Cancel").Enabled = False
            .Buttons("Save").Enabled = False
            .Buttons("search").Enabled = True
        End With
    End If
    Optdkze.Enabled = False
    Optdkye.Enabled = False
    Call setSupergrid
    SuperGrid1.ReadOnly = True
End Sub
'设置修改界面状态
Private Sub setModiState()
    credstat.modified = True
    With tlbTool
        .Buttons("print").Enabled = False
        .Buttons("preview").Enabled = False
        .Buttons("Output").Enabled = False
        .Buttons("addColumn").Enabled = True
        .Buttons("delColumn").Enabled = True
        .Buttons("Modi").Enabled = False
        .Buttons("Cancel").Enabled = True
        .Buttons("Save").Enabled = True
        .Buttons("search").Enabled = False
    End With
    Optdkze.Enabled = True
    Optdkye.Enabled = True
    SuperGrid1.ReadOnly = False
End Sub

'修改处理过程
Private Sub ModiProc()
    credstat.ModifyState = 2
    credstat.modified = True
    Call setModiState
    credstat.selRow = 0
End Sub
'增加处理过程
Private Sub addColumnProc()
    Dim discolor() As Long
    If SuperGrid1.Rows = 3 Then
        credstat.ModifyState = 1
        SuperGrid1.ReadOnly = False
        If DateCheck(SuperGrid1.TextMatrix(2, 1)) <> "" Then
           SuperGrid1.AddRecord DateAdd("d", 1, DateCheck(SuperGrid1.TextMatrix(2, 1))), discolor
            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