自动还款.frm

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

        GridData(i, 9) = 0
    ElseIf CDbl(GridData(i, 7)) >= CDbl((CDbl(GridData(i, 14)) - CDbl(GridData(i, 3)))) And CDbl(GridData(i, 7)) >= CDbl((CDbl(GridData(i, 14)) - CDbl(GridData(i, 3)))) + (CDbl(GridData(i, 4)) - CDbl(GridData(i, 11))) Then
        GridData(i, 8) = (CDbl(GridData(i, 14)) - CDbl(GridData(i, 3)))
        GridData(i, 9) = GridData(i, 4)
    End If
'    If i < SuperGrid1.Rows - 2 Then
'        If gridData(i, 5) = gridData(i + 1, 5) Then
'            gridData(i + 1, 7) = gridData(i, 7) - gridData(i, 8) - griddata(i, 9)
'        End If
'    End If
End Sub

Private Sub reCaldata(ByVal R As Integer, ByVal C As Integer)
    Dim i As Integer
    With SuperGrid1
        If Trim(.TextMatrix(R, C) <> "") Then
            If CDbl(.TextMatrix(R, 9)) > CDbl(.TextMatrix(R, 4)) Then
                MsgBox "还本金额不能大于结欠本金额！", vbInformation, "输入错误！"
                errornum = 1
                OK = False
                .col = C
                .row = R
                .SetFocus
                Exit Sub
            ElseIf CDbl(.TextMatrix(R, 10)) > CDbl(.TextMatrix(R, 5)) Then
                MsgBox "还利息额不能大于结欠利息额！", vbInformation, "输入错误！"
                errornum = 1
                OK = False
                .col = C
                .row = R
                .SetFocus
                Exit Sub
            ElseIf CDbl(.TextMatrix(R, 10)) < 0 Or CDbl(.TextMatrix(R, 9)) < 0 Then
                MsgBox "还本金额或还利息额不能为负数！", vbInformation, "输入错误！"
                errornum = 1
                OK = False
                .col = C
                .row = R
                .SetFocus
                Exit Sub
            ElseIf CDbl(.TextMatrix(R, 9)) + CDbl(.TextMatrix(R, 10)) > CDbl(.TextMatrix(R, 8)) Then
                MsgBox "还本金额和还利息额之和不能大于账户可使用余额！", vbInformation, "输入错误！"
                errornum = 1
                OK = False
                .col = C
                .row = R
                .SetFocus
                Exit Sub
            Else
                For i = R + 1 To .Rows - 1
                    If Trim(.TextMatrix(R, 6)) = Trim(.TextMatrix(i, 5)) Then
                        .TextMatrix(i, 8) = CDbl(.TextMatrix(i - 1, 8)) - CDbl(.TextMatrix(i - 1, 9)) - CDbl(.TextMatrix(i - 1, 10))
                    Else
                        OK = True
                        Exit Sub
                    End If
                    Select Case l_returnSort
                        Case 0
                            Call fill0(i)
                        Case 1
                            Call fill1(i)
                        Case 2
                            Call fill2(i)
                    End Select
                Next
            End If
        End If
    End With
    OK = True
End Sub

'先还本金
Private Sub fill0(ByVal i As Integer)

With SuperGrid1
    If CDbl(.TextMatrix(i, 8)) < CDbl(.TextMatrix(i, 4)) Then
        .TextMatrix(i, 9) = .TextMatrix(i, 8)
        .TextMatrix(i, 10) = 0
    ElseIf CDbl(.TextMatrix(i, 8)) >= CDbl(.TextMatrix(i, 4)) And CDbl(.TextMatrix(i, 8)) < CDbl(.TextMatrix(i, 4)) + CDbl(.TextMatrix(i, 5)) Then
        .TextMatrix(i, 9) = .TextMatrix(i, 4)
        .TextMatrix(i, 10) = .TextMatrix(i, 8) - .TextMatrix(i, 9)
    ElseIf CDbl(.TextMatrix(i, 8)) >= CDbl(.TextMatrix(i, 4)) And CDbl(.TextMatrix(i, 8)) >= CDbl(.TextMatrix(i, 4)) + CDbl(.TextMatrix(i, 5)) Then
        .TextMatrix(i, 9) = .TextMatrix(i, 4)
        .TextMatrix(i, 10) = .TextMatrix(i, 5)
    End If
'    If i < .Rows - 2 Then
'        If .TextMatrix(i, 5) = .TextMatrix(i + 1, 5) Then
'            .TextMatrix(i + 1, 7) = .TextMatrix(i, 7) - .TextMatrix(i, 8) - .TextMatrix(i, 9)
'        End If
'    End If
End With
End Sub

'先还利息
Private Sub fill1(ByVal i As Integer)
With SuperGrid1
    If CDbl(.TextMatrix(i, 8)) < CDbl(.TextMatrix(i, 5)) Then
        .TextMatrix(i, 10) = .TextMatrix(i, 8)
        .TextMatrix(i, 9) = 0
    ElseIf CDbl(.TextMatrix(i, 8)) >= CDbl(.TextMatrix(i, 5)) And CDbl(.TextMatrix(i, 8)) < CDbl(.TextMatrix(i, 4)) + CDbl(.TextMatrix(i, 5)) Then
        .TextMatrix(i, 10) = .TextMatrix(i, 5)
        .TextMatrix(i, 9) = .TextMatrix(i, 8) - .TextMatrix(i, 10)
    ElseIf CDbl(.TextMatrix(i, 8)) >= CDbl(.TextMatrix(i, 4)) And CDbl(.TextMatrix(i, 8)) >= CDbl(.TextMatrix(i, 4)) + CDbl(.TextMatrix(i, 5)) Then
        .TextMatrix(i, 9) = .TextMatrix(i, 4)
        .TextMatrix(i, 10) = .TextMatrix(i, 5)
    End If
'    If i < SuperGrid1.Rows - 2 Then
'        If .TextMatrix(i, 5) = .TextMatrix(i + 1, 5) Then
'            .TextMatrix(i + 1, 7) = .TextMatrix(i, 7) - .TextMatrix(i, 8) - .TextMatrix(i, 9)
'        End If
'    End If
End With
End Sub

'一并归还
Private Sub fill2(ByVal i As Integer)
With SuperGrid1
    If CDbl(.TextMatrix(i, 8)) < CDbl(.TextMatrix(i, 4)) + CDbl(.TextMatrix(i, 5)) Then
        .TextMatrix(i, 9) = 0
        .TextMatrix(i, 10) = 0
    ElseIf CDbl(.TextMatrix(i, 8)) >= CDbl(.TextMatrix(i, 4)) And CDbl(.TextMatrix(i, 5)) >= CDbl(.TextMatrix(i, 4)) + CDbl(.TextMatrix(i, 5)) Then
        .TextMatrix(i, 9) = .TextMatrix(i, 4)
        .TextMatrix(i, 10) = .TextMatrix(i, 5)
    End If
'    If i < SuperGrid1.Rows - 2 Then
'        If .TextMatrix(i, 5) = .TextMatrix(i + 1, 5) Then
'            .TextMatrix(i + 1, 7) = .TextMatrix(i, 7) - .TextMatrix(i, 8) - griddata(i, 9)
'        End If
'    End If
End With

End Sub

'填表
Private Sub fillgrid()
    Dim i, j As Integer
    With SuperGrid1
        For i = 0 To UBound(GridData)
            For j = 0 To 10
                If j = 4 Then
                    .TextMatrix(i + 1, j) = CStr(CDbl(GridData(i, 14)) - CDbl(GridData(i, 3)))
                ElseIf j = 5 Then
                    .TextMatrix(i + 1, j) = CStr(CDbl(GridData(i, 4)) - CDbl(GridData(i, 11)))
                ElseIf j = 2 Then
                    .TextMatrix(i + 1, j) = GridData(i, 31)
                ElseIf j = 3 Then
                    .TextMatrix(i + 1, j) = GridData(i, 2)
                Else
                    If j < 5 Then
                        .TextMatrix(i + 1, j) = GridData(i, j)
                    Else
                        .TextMatrix(i + 1, j) = GridData(i, j - 1)
                    End If
                End If
                If j <> 9 And j <> 10 Then
                    .col = j
                    .row = i + 1
                    .CellBackColor = vbInactiveTitleBar
                End If
            Next
        Next
    End With
End Sub

Private Sub cmdrefDjmc_Click()
    Dim rs1 As New ADODB.Recordset
    Dim rfd As New UFReferC.UFReferClient
    Dim sqlstr As String
    'Sqlstr = "select cUnitCode As 单位代码,cUnitName As 单位名称 from FD_AccUnit order by cUnitCode"
    sqlstr = "select iId As 序号,sCaption As  单据名称 from FD_entities where (iBIType='42' or iDeriveBIType = '42');"
    rfd.SetLogin zjLogInfo
    rfd.SetReferSQLString sqlstr
    rfd.SetReferDisplayMode enuGrid
    rfd.Show
    If rfd.recmx Is Nothing Then Exit Sub
    Set rs1 = rfd.recmx
    If Not (rs1.EOF Or rs1.BOF) Then
        Txtdjmc.Text = rs1(1)
        vouchType = Trim(rs1(0))
    End If
    'TxtUnitCode.Text = rs1(0)
    Set rfd = Nothing
    Set rs1 = Nothing

End Sub


Private Sub Form_Load()
'    FrmAutoReturn.width = 11295
    loadstatic
    
    SetTBStyle Me
    
    Me.WindowState = 2
    modified = False
    Nodata = False
    errornum = 0
    conflict_flag = False
   ' If Not App.PrevInstance Then
    curRow = 0
    Call Initialize
    TxtcUsername.Text = SystemInfo(1)
    TxtOprDate.Text = SystemInfo(2)
    cmdrefDjmc.Picture = LoadResPicture(129, vbResBitmap)
    'cmdrefDjmc.Picture = ImageList1.ListImages("refer").Picture

    'Else
     '   MsgBox "Already Exist!"
      '  End
       ' Exit Sub
    'End If
    ocxCtbtool.RefreshEnable
End Sub

Private Sub Form_Resize()
'    If (Me.WindowState = 1 Or Me.WindowState = 2) Then Exit Sub
    With SuperGrid1
        .top = Txthkrq.top + Txthkrq.Height + 100
        .left = tlbTool.left + 100
        If Me.width > 200 Then
            .width = Me.width - 200
        End If
        If Me.Height > tlbTool.Height + Txthkrq.Height + TxtcUsername.Height + 800 Then
            .Height = Me.Height - tlbTool.Height - Txthkrq.Height - TxtcUsername.Height - 800
        Else
            .Height = 1200
        End If
        .ReadOnly = True
''        .colwidth(0) = 2000
'        .SetColProperty 0, 30
''        .colwidth(1) = 1450
'        .SetColProperty 1, 28
''        .colwidth(2) = 900
'        .SetColProperty 2, 40
'        .SetColProperty 3, 10
'        '.ColWidth(3) = 1400
'        .SetColProperty 4, 15
'        '.ColWidth(4) = 1400
'        .SetColProperty 5, 15
''        .colwidth(5) = 1100
'        .SetColProperty 6, 20
'        '.ColWidth(6) = 1400
'        .SetColProperty 7, 15
'        '.ColWidth(7) = 1400
'        .SetColProperty 8, 15
'        '.ColWidth(8) = 1700
'        .SetColProperty 9, 19, DblBrowButton, EditDbl
'        '.ColWidth(9) = 1700
'        .SetColProperty 10, 19, DblBrowButton, EditDbl
    End With
    TxtcUsername.left = Txthkrq.left
    TxtcUsername.top = SuperGrid1.top + SuperGrid1.Height + 50
    TxtOprDate.left = Txtdjmc.left
    TxtOprDate.top = SuperGrid1.top + SuperGrid1.Height + 50
    TxtcUsername.Enabled = False
    TxtOprDate.Enabled = False
    Label3.top = TxtcUsername.top + 50
    Label3.left = Label1.left
    Label4.top = TxtOprDate.top + 50
    Label4.left = Label2.left
    
    ResizeTlb Me
End Sub

Private Sub Form_Unload(Cancel As Integer)
    Dim result As VbMsgBoxResult
    If modified Then
        result = MsgBox("您还有数据未保存，是否决定在退出自动还款程序时保存数据？", vbYesNoCancel, "退出程序")
        Select Case result
            Case vbYes
                If SaveData Then
                   Cancel = 0
                Else
                   Cancel = 1
                   Exit Sub
                End If
            Case vbNo
                Cancel = 0
            Case vbCancel
                Cancel = 1
                Exit Sub
        End Select
    End If
    xmlInit = False
    If con.State = adStateOpen Then
        con.Close
        Set con = Nothing
    End If
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 SuperGrid1_CellDataCheck(RetValue As String, RetState As MsSuperGrid.OpType, ByVal R As Long, ByVal C As Long)
    If errornum = 0 Then
        Call reCaldata(R, C)
    Else
        errornum = 0
    End If
End Sub

Private Sub SuperGrid1_Click()
    curRow = SuperGrid1.row
    tlbTool.Buttons("linkquery").Enabled = True
End Sub

Private Sub SuperGrid1_DblClick()
    If Not modified Then
        If Not Nodata Then
            Dim OID           As New U8FDEso.OIDObject
            Dim objVchInputUI As New clsVchInputUI
           
            If Not (tlbTool.Buttons("save").Enabled) Then
                If SuperGrid1.row > 0 Then
                    OID = loanID(SuperGrid1.row - 1)
                    objVchInputUI.Show g_sDataSourceName, smView, OID, mID(OID.id, 1, 2)
                End If
            Else
                If SuperGrid1.row > 0 Then
                    OID = GridData(SuperGrid1.row - 1, 10)
                    objVchInputUI.Show g_sDataSourceName, smView, OID, mID(OID.id, 1, 2)
                End If
            End If
            
            Set OID = Nothing
            Set objVchInputUI = Nothing
        End If