frmloaninfor.frm

用友u8财务源码,用visual basic开发

'    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
    
    If sqlwhere <> "" Then
        outer_app = True
    Else
        outer_app = False
    End If
    
    If Not outer_app Then
        frmLoanFind.loan_or_inter = 1
        frmLoanFind.Show 1
    End If
    
    If sqlwhere <> "" Then
        sqlstr1 = sqlstr & sqlwhere
    End If
    sqlstr1 = sqlstr1 & " order by fd_transactions.money_name,fd_transactions.bill_date"
    initGrid
    fillgrid
    ocxCtbtool.RefreshEnable
End Sub

Private Sub fillgrid()
    Dim rs As New UfRecordset
    Dim i As Integer
    Dim j As Integer
    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![transactions_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![bill_date]), "", rs![bill_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![skzh]), "", rs![skzh])
            .TextMatrix(i, 7) = IIf(IsNull(rs![fkzh]), "", rs![fkzh])
            .TextMatrix(i, 8) = IIf(IsNull(rs![cintrid]), "", rs![cintrid])
            .TextMatrix(i, 9) = IIf(IsNull(rs![Nzy]), "", rs![Nzy])
            If .TextMatrix(i, 9) <> "" Then
                .TextMatrix(i, 9) = Format(.TextMatrix(i, 9), "#0.00") & "%"
            End If
            '.TextMatrix(i, 10) = IIf(IsNull(rs![cad_id]), "", rs![cad_id])
            .TextMatrix(i, 10) = IIf(IsNull(rs![cCadID]), "", rs![cCadID])
            If IsNull(rs![calctype_flag]) Then
                .TextMatrix(i, 11) = ""
            Else
                j = CInt(rs![calctype_flag])
                Select Case j
                    Case 0
                        .TextMatrix(i, 11) = "到期内利息挂账不计复利，逾期时对本金及结欠利息计复利"
                    Case 1
                        .TextMatrix(i, 11) = "到期内利息计复利，逾期时对本金及结欠利息计复利"
                    Case 2
                        .TextMatrix(i, 11) = "到期内利息挂账不计复利，逾期时只对本金计逾期复利"
                    Case 3
                        .TextMatrix(i, 11) = "利随本清"
                End Select
            End If
            .TextMatrix(i, 12) = Format(IIf(IsNull(rs![return_date]), "", rs![return_date]), "YYYY-MM-DD")
            .TextMatrix(i, 17) = IIf(IsNull(rs![check_name]), "", rs![check_name])
            .TextMatrix(i, 18) = IIf(IsNull(rs![book_name]), "", rs![book_name])
            .TextMatrix(i, 19) = IIf(IsNull(rs![bill_name]), "", rs![bill_name])
            .TextMatrix(i, 20) = IIf(IsNull(rs![digest]), "", rs![digest])
             '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=42 or iderivebitype=46)) "
    Set rsjqje = dbsZJ.OpenRecordset(sqlsum, dbOpenSnapshot)
    If (rsjqje.EOF Or rsjqje.BOF) Then
        With ufgridado1
            .TextMatrix(i, 13) = 0
            .TextMatrix(i, 15) = 0
        End With
        rsjqje.oClose
        GoTo error0
    Else
        With ufgridado1
            .TextMatrix(i, 13) = Format(IIf(IsNull(rsjqje(0)), 0, rsjqje(0)), "#0.00")
            .TextMatrix(i, 15) = 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, 14) = Format((CDbl(.TextMatrix(i, 2)) - CDbl(.TextMatrix(i, 13))), "#0.00")
            .TextMatrix(i, 16) = Format((CDbl(lxje) - CDbl(.TextMatrix(i, 15))), "#0.00")
        End With
        rsjqje.oClose
        GoTo error0
    Else
        lxje = IIf(IsNull(rsjqje(0)), 0, rsjqje(0))
        rsjqje.oClose
        With ufgridado1
            .TextMatrix(i, 14) = Format((CDbl(.TextMatrix(i, 2)) - CDbl(.TextMatrix(i, 13))), "#0.00")
            .TextMatrix(i, 16) = Format((CDbl(lxje) - CDbl(.TextMatrix(i, 15))), "#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=41 or ibitype=45 or iderivebitype=41 or iderivebitype=45)"
    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 sumje(UBound(bz), 4)
    With ufgridado1
        For i = 1 To .Rows - 2
inner:      For j = 0 To UBound(bz)
                If bz(j) = .TextMatrix(i, 3) Then
                    sumje(j, 0) = sumje(j, 0) + CDbl(IIf(IsNumeric(.TextMatrix(i, 2)), .TextMatrix(i, 2), 0))
                    sumje(j, 1) = sumje(j, 1) + CDbl(IIf(IsNumeric(.TextMatrix(i, 13)), .TextMatrix(i, 13), 0))
                    sumje(j, 2) = sumje(j, 2) + CDbl(IIf(IsNumeric(.TextMatrix(i, 14)), .TextMatrix(i, 14), 0))
                    sumje(j, 3) = sumje(j, 3) + CDbl(IIf(IsNumeric(.TextMatrix(i, 15)), .TextMatrix(i, 15), 0))
                    sumje(j, 4) = sumje(j, 4) + CDbl(IIf(IsNumeric(.TextMatrix(i, 16)), .TextMatrix(i, 16), 0))
                    Exit For
                End If
            Next
        Next
        .TextMatrix(.Rows - 1, 0) = "合计"
        .TextMatrix(.Rows - 1, 2) = Format(sumje(0, 0), "#0.00")
        .TextMatrix(.Rows - 1, 13) = Format(sumje(0, 1), "#0.00")
        .TextMatrix(.Rows - 1, 14) = Format(sumje(0, 2), "#0.00")
        .TextMatrix(.Rows - 1, 15) = Format(sumje(0, 3), "#0.00")
        .TextMatrix(.Rows - 1, 16) = Format(sumje(0, 4), "#0.00")
        .TextMatrix(.Rows - 1, 3) = bz(0)
        For i = 1 To UBound(bz)
            .AddRecord "", coldiscolor
            .TextMatrix(.Rows - 1, 2) = Format(sumje(i, 0), "#0.00")
            .TextMatrix(.Rows - 1, 13) = Format(sumje(i, 1), "#0.00")
            .TextMatrix(.Rows - 1, 14) = Format(sumje(i, 2), "#0.00")
            .TextMatrix(.Rows - 1, 15) = Format(sumje(i, 3), "#0.00")
            .TextMatrix(.Rows - 1, 16) = Format(sumje(i, 4), "#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
    outer_app = False
    sqlwhere = ""
    optwjz = False
    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 = 1
            frmLoanFind.Show 1
            If sqlwhere <> "" Then
'                If optwjz Then
'                    sqlstr1 = sqlstr & " and (fd_transactions.book_Name<>'' And fd_transactions.book_Name is not null)"
'                Else
'                    sqlstr1 = sqlstr
'                End If
                sqlstr1 = sqlstr & sqlwhere & " order by fd_transactions.money_name,fd_transactions.bill_date"
            End If
'            sqlstr1 = sqlstr1
            initGrid
            fillgrid
        Case "help"
            SendKeys "{F1 3}"
            'SendKeys "{f1}", True
        Case "exit"
            Unload Me
            Exit Sub
    End Select
    ocxCtbtool.RefreshEnable
End Sub

Private Sub initGrid()
    With ufgridado1
        .clear
        .ReadOnly = True
        .Rows = 2
        .Cols = 21
        .FixedCols = 0
        .FixedRows = 1
        .TextMatrix(0, 0) = "业务编号"
        .SetColProperty 0, 30
        .TextMatrix(0, 1) = "贷款日期"
        .SetColProperty 0, 10
        .TextMatrix(0, 2) = "金额"
        .SetColProperty 0, 15
        .TextMatrix(0, 3) = "币别"
        .SetColProperty 0, 10
        .TextMatrix(0, 4) = "汇率"
        .SetColProperty 0, 12
        .TextMatrix(0, 5) = "本位币金额"
        .SetColProperty 0, 15
        .TextMatrix(0, 6) = "收款账户号"
        .SetColProperty 0, 20
        .TextMatrix(0, 7) = "付款账户号"
        .SetColProperty 0, 20
        .TextMatrix(0, 8) = "利率代码"
        .SetColProperty 0, 8
        .TextMatrix(0, 9) = "利率值"
        .SetColProperty 0, 8
        .TextMatrix(0, 10) = "结息日代码"
        .SetColProperty 0, 8
        .TextMatrix(0, 11) = "计息方式"
        .SetColProperty 0, 32
        .TextMatrix(0, 12) = "到期日期"
        .SetColProperty 0, 10
        .TextMatrix(0, 13) = "已还本金额"
        .SetColProperty 0, 15
        .TextMatrix(0, 14) = "结欠本金额"