frminterestinfor.frm

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

'    If Not optwjz.Value Then
'        sqlstr1 = sqlstr & " and (fd_transactions.book_Name<>'' And fd_transactions.book_Name is not null)"
'    End If
    lblBillName.Caption = zjLogInfo.cUserName
    lblPrnDate.Caption = zjLogInfo.curDate
    frmLoanFind.loan_or_inter = 2
    frmLoanFind.Show 1
    If sqlwhere <> "" Then
        sqlstr1 = sqlstr & sqlwhere
    End If
    sqlstr1 = sqlstr1 & " order by fd_transactions.money_name,fd_transactions.from_date"
    initGrid
    fillgrid
    ocxCtbtool.RefreshEnable
End Sub

Private Sub fillgrid()
    Dim rs As New UfRecordset
    Dim i As Integer
    Dim j As Integer
    Dim k As Double
    
    On Error GoTo error0
    Set rs = dbsZJ.OpenRecordset(sqlstr1, dbOpenSnapshot)
    If rs.EOF Or rs.BOF Then
        initGrid
        Exit Sub
    End If
    ufgridado1.Rows = rs.RecordCount + 2
    ReDim transactionsId(rs.RecordCount - 1)
    ReDim cunitName(rs.RecordCount - 1)
    i = 1
    With ufgridado1
        While Not (rs.EOF Or rs.BOF)
            transactionsId(i - 1) = rs![correspond_vch_id]
            cunitName(i - 1) = IIf(IsNull(rs![cunitName]), "", rs![cunitName])
            .TextMatrix(i, 0) = IIf(IsNull(rs![transactions_code]), "", rs![transactions_code])
            .TextMatrix(i, 1) = Format(IIf(IsNull(rs![from_date]), "", rs![from_date]), "YYYY-MM-DD")
            .TextMatrix(i, 2) = Format(IIf(IsNull(rs![sum_mny]), 0, rs![sum_mny]), "#0.00")
            .TextMatrix(i, 3) = IIf(IsNull(rs![Money_name]), "", rs![Money_name])
            .TextMatrix(i, 4) = IIf(IsNull(rs![exchange_rate]), "", rs![exchange_rate])
            .TextMatrix(i, 5) = Format(IIf(IsNull(rs![natural_mny]), 0, rs![natural_mny]), "#0.00")
            .TextMatrix(i, 6) = IIf(IsNull(rs![cintrid]), "", rs![cintrid])
            '.TextMatrix(i, 7) = IIf(IsNull(rs![Nzy]), "", rs![Nzy])
            k = getIntrValue(.TextMatrix(i, 6), IIf(IsNull(rs![bill_date]), "", rs![bill_date]))
            .TextMatrix(i, 7) = IIf(k = 0, "", k)
            If .TextMatrix(i, 7) <> "" Then
                .TextMatrix(i, 7) = Format(.TextMatrix(i, 7), "#0.00") & "%"
            End If
            '.TextMatrix(i, 8) = IIf(IsNull(rs![cad_id]), "", rs![cad_id])
            .TextMatrix(i, 8) = IIf(IsNull(rs![cCadID]), "", rs![cCadID])
            If IsNull(rs![calctype_flag]) Then
                .TextMatrix(i, 9) = ""
            Else
                j = CInt(rs![calctype_flag])
                Select Case j
                    Case 0
                        .TextMatrix(i, 9) = "到期内利息挂账不计复利，逾期时对本金及结欠利息计复利"
                    Case 1
                        .TextMatrix(i, 9) = "到期内利息计复利，逾期时对本金及结欠利息计复利"
                    Case 2
                        .TextMatrix(i, 9) = "到期内利息挂账不计复利，逾期时只对本金计逾期复利"
                    Case 3
                        .TextMatrix(i, 9) = "利随本清"
                End Select
            End If
            .TextMatrix(i, 10) = Format(IIf(IsNull(rs![to_date]), "", rs![to_date]), "YYYY-MM-DD")
            .TextMatrix(i, 11) = IIf(IsNull(rs![mh_mny]), 0, rs![mh_mny])
            .TextMatrix(i, 11) = Format(.TextMatrix(i, 11), "#0.00")
             'If Not fillJqje(i) Then GoTo error0
             fillJqje (i)
            i = i + 1
            rs.MoveNext
        Wend
    End With
    If rs.State = adStateOpen Then
        rs.oClose
    End If
    Set rs = Nothing
    sumGrid
    Exit Sub
error0:
'    If rs.State = adStateOpen Then
'        rs.oClose
'    End If
    Set rs = Nothing
    initGrid
End Sub

'计算结欠本金额和结欠利息额
Private Function fillJqje(ByVal i As Integer) As Boolean
    Dim lxje As Double
    Dim rsjqje As New UfRecordset
    Dim sqlsum As String
    fillJqje = False
    On Error GoTo error0
    sqlsum = "select sum(sum_mny),sum(commission_mny) from fd_transactions where correspond_vch_id='" & transactionsId(i - 1) & "'"
    If Not optwjz Then
        sqlsum = sqlsum & " and (fd_transactions.book_Name<>'' or fd_transactions.book_Name is not null)"
    End If
    sqlsum = sqlsum & " and substring(transactions_id,1,2) in (select IBIType from fd_entities where (ibitype=42 or ibitype=46 or iderivebitype=41 or iderivebitype=46)) "
    sqlsum = sqlsum & " and fd_transactions.bill_date>='" & ufgridado1.TextMatrix(i, 1) & "' and fd_transactions.bill_date<='" & ufgridado1.TextMatrix(i, 10) & "'"
    Set rsjqje = dbsZJ.OpenRecordset(sqlsum, dbOpenSnapshot)
    If (rsjqje.EOF Or rsjqje.BOF) Then
        ufgridado1.TextMatrix(i, 13) = 0
        GoTo error0
    Else
        With ufgridado1
            .TextMatrix(i, 13) = Format(IIf(IsNull(rsjqje(1)), 0, rsjqje(0)), "#0.00")
        End With
    End If
    rsjqje.oClose
    
    '取对应利息单的利息总额
'    sqlsum = "select sum(sum_mny) from fd_transactions where correspond_vch_id='" & transactionsId(i - 1) & "' "
'    If Not optwjz Then
'        sqlsum = sqlsum & " and (fd_transactions.book_Name<>'' or fd_transactions.book_Name is not null)"
'    End If
'    sqlsum = sqlsum & " and substring(transactions_id,1,2) in (select iId from fd_entities where (iBIType='52'or iDeriveBIType = '52' or iBIType='55'or iDeriveBIType = '55'));"
'    Set rsjqje = dbsZJ.OpenRecordset(sqlsum, dbOpenSnapshot)
'    If (rsjqje.EOF Or rsjqje.BOF) Then
'        With ufgridado1
'            .TextMatrix(i, 12) = 0
'            .TextMatrix(i, 14) = 0
'        End With
'        GoTo error0
'    Else
        'lxje = IIf(IsNull(rsjqje(0)), 0, rsjqje(0))
        lxje = ufgridado1.TextMatrix(i, 2)
        rsjqje.oClose
        With ufgridado1
            .TextMatrix(i, 12) = Format(lxje, "#0.00")
            .TextMatrix(i, 14) = Format((CDbl(lxje) - CDbl(.TextMatrix(i, 13))), "#0.00")
        End With
'    End If
    fillJqje = True
    Set rsjqje = Nothing
    Exit Function
error0:
'    If rsjqje.State = adStateOpen Then
'        rsjqje.oClose
'    End If
    Set rsjqje = Nothing
End Function

Private Sub sumGrid()
    Dim i As Integer
    Dim j As Integer
    Dim sqlstr As String
    Dim rs As New UfRecordset
    Dim bz() As String
    Dim sum() As Double
    Dim coldiscolor() As Long
    
    sqlstr = "select distinct money_name from fd_transactions"
    sqlstr = sqlstr & " where substring(fd_transactions.transactions_id,1,2) in (select IBIType from fd_entities where ibitype=52 or ibitype=55 or iderivebitype=52 or iderivebitype=55)"
    Set rs = dbsZJ.OpenRecordset(sqlstr, dbOpenSnapshot)
    If rs.EOF Or rs.BOF Then
        ReDim bz(0)
        bz(0) = ""
    Else
        ReDim bz(rs.RecordCount - 1)
        For i = 1 To rs.RecordCount
            bz(i - 1) = IIf(IsNull(rs(0)), "", rs(0))
            rs.MoveNext
        Next
    End If
    rs.oClose
    Set rs = Nothing
    ReDim sum(UBound(bz), 3)
    With ufgridado1
        For i = 1 To .Rows - 2
inner:      For j = 0 To UBound(bz)
                If bz(j) = .TextMatrix(i, 3) Then
                    sum(j, 0) = sum(j, 0) + IIf(Not IsNumeric(.TextMatrix(i, 2)), 0, .TextMatrix(i, 2))
                    sum(j, 1) = sum(j, 1) + IIf(Not IsNumeric(.TextMatrix(i, 12)), 0, .TextMatrix(i, 12))
                    sum(j, 2) = sum(j, 2) + IIf(Not IsNumeric(.TextMatrix(i, 13)), 0, .TextMatrix(i, 13))
                    sum(j, 3) = sum(j, 3) + IIf(Not IsNumeric(.TextMatrix(i, 14)), 0, .TextMatrix(i, 14))
                    Exit For
                End If
            Next
        Next
        .TextMatrix(.Rows - 1, 0) = "合计"
        .TextMatrix(.Rows - 1, 2) = Format(sum(0, 0), "#0.00")
        .TextMatrix(.Rows - 1, 12) = Format(sum(0, 1), "#0.00")
        .TextMatrix(.Rows - 1, 13) = Format(sum(0, 2), "#0.00")
        .TextMatrix(.Rows - 1, 14) = Format(sum(0, 3), "#0.00")
        .TextMatrix(.Rows - 1, 3) = bz(0)
        For i = 1 To UBound(bz)
            .AddRecord "", coldiscolor
            .TextMatrix(.Rows - 1, 2) = Format(sum(i, 0), "#0.00")
            .TextMatrix(.Rows - 1, 12) = Format(sum(i, 1), "#0.00")
            .TextMatrix(.Rows - 1, 13) = Format(sum(i, 2), "#0.00")
            .TextMatrix(.Rows - 1, 14) = Format(sum(i, 3), "#0.00")
            .TextMatrix(.Rows - 1, 3) = bz(i)
        Next
    End With
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    If con.State = adStateOpen Then
        con.Close
    End If
    Set con = Nothing
End Sub

Private Sub Form_Resize()
    If Me.WindowState <> 1 Then
        If Me.Height > tlbtool.Height + 200 Then
            Picture1.Height = Me.Height - tlbtool.Height - 200
        End If
        If Picture1.Height > text1.top + text1.Height + lblBillName.Height + 400 Then
            ufgridado1.Height = Picture1.Height - (text1.top + text1.Height + lblBillName.Height + 400)
        End If
        If Me.width > 200 Then
            Picture1.width = Me.width - 200
        End If
        If Picture1.width > 200 Then
            ufgridado1.width = Picture1.width - 200
        End If
        lblBillName.top = ufgridado1.top + ufgridado1.Height + 50
        Label7.top = lblBillName.top
        lblPrnDate.top = lblBillName.top
        Label8.top = lblBillName.top
    End If
        
        ResizeTlb Me

End Sub

Private Sub ocxCtbtool_OnCommand(ByVal enumType As prjTBCtrl.ENUM_MENU_OR_BUTTON, ByVal cButtonId As String, ByVal cMenuId As String)
    tlbTool_ButtonClick tlbtool.Buttons(cButtonId)
End Sub


Private Sub tlbTool_ButtonClick(ByVal Button As MsComctlLib.Button)
    Select Case Button.key
        Case "print"
            printProc
        Case "preview"
            previewProc
        Case "output"
            outputProc
        Case "find"
            frmLoanFind.loan_or_inter = 2
            frmLoanFind.Show 1
            sqlstr1 = ""
            If sqlwhere <> "" Then
'                If optwjz.Value <> 1 Then
'                    sqlstr1 = sqlstr & " and (fd_transactions.book_Name<>'' and fd_transactions.book_Name is not null)"
'                Else
'                    sqlstr1 = sqlstr
'                End If
                sqlstr1 = sqlstr & sqlwhere
                sqlstr1 = sqlstr1 & " order by fd_transactions.money_name,fd_transactions.bill_date"
            End If
            initGrid
            fillgrid
        Case "help"
            SendKeys "{F1 3}"
        Case "exit"
            Unload Me
            Exit Sub
    End Select
    ocxCtbtool.RefreshEnable
End Sub

Private Sub initGrid()
    With ufgridado1
        .ReadOnly = True
        .clear
        .Rows = 2
        .Cols = 15
        .FixedCols = 0
        .FixedRows = 1
        .TextMatrix(0, 0) = "业务编号"
        .SetColProperty 0, 30
        .TextMatrix(0, 1) = "贷款日期"
        .SetColProperty 1, 10
        .TextMatrix(0, 2) = "金额"
        .SetColProperty 2, 15
        .TextMatrix(0, 3) = "币别"
        .SetColProperty 3, 10
        .TextMatrix(0, 4) = "汇率"
        .SetColProperty 4, 12
        .TextMatrix(0, 5) = "本位币金额"
        .SetColProperty 5, 15
        .TextMatrix(0, 6) = "利率代码"
        .SetColProperty 6, 8
        .TextMatrix(0, 7) = "利率值"
        .SetColProperty 7, 8
        .TextMatrix(0, 8) = "结息日代码"
        .SetColProperty 8, 8
        .TextMatrix(0, 9) = "计息方式"
        .SetColProperty 9, 32
        .TextMatrix(0, 10) = "到期日期"
        .SetColProperty 10, 10
        .TextMatrix(0, 11) = "积数"
        .SetColProperty 11, 18
        .TextMatrix(0, 12) = "应计利息额"
        .SetColProperty 12, 10
        .TextMatrix(0, 13) = "已还利息额"
        .SetColProperty 13, 15
        .TextMatrix(0, 14) = "结欠利息额"
        .SetColProperty 14, 15
    End With
End Sub
'初始化打印数据XML文件
Private Sub initPrnXmlFile()
    '过程变量
    Dim prnxml As New clsPrnXml
    Dim AttrName() As String
    Dim AttrValue() As String
    Dim i, j As Integer
    Dim str1 As String
    
    On Error GoTo error0