自动还款.frm

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

    End If
End Sub


Private Sub SuperGrid1_GotFocus()
    cmdrefDjmc.Visible = False
    tlbTool.Buttons("linkquery").Enabled = True
End Sub

Private Sub SuperGrid1_LostFocus()
    If modified Then
        'MsgBox SuperGrid1.Row
        Call reCaldata(SuperGrid1.row, SuperGrid1.col)
    End If
End Sub

'修改单元格数据时置修改标记为true
Private Sub SuperGrid1_OnEdit(Editing As Boolean)
    cellEdited = True
End Sub

'根据行列置置列表的修改属性
Private Sub SuperGrid1_RowColChange()
    If modified Then
        With SuperGrid1
            If .row <> 0 And (.col = 8 Or .col = 9) Then
                .ReadOnly = False
            Else
                .ReadOnly = True
            End If
        End With
    End If
    If Not Nodata Then
        curRow = SuperGrid1.row
        curCol = SuperGrid1.col
    End If
End Sub
'工具栏的处理过程
Private Sub tlbTool_ButtonClick(ByVal Button As MSComctlLib.Button)
    With tlbTool
        Select Case Button.key
            Case "print"
                Call printProc
            Case "preview"
                Call previewProc
            Case "output"
                Call outputProc
            Case "modify"
                Call modifyproc
            Case "cancel"
                Call CancelProc
            Case "save"
                Call saveProc
            Case "linkquery"
                Call linkqueryproc
            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 modifyproc()
    modified = True
    SuperGrid1.ReadOnly = False
    Txtdjmc.Enabled = True
    cmdrefDjmc.Visible = True
    cmdrefDjmc.Enabled = True
    tlbTool.Buttons("modify").Enabled = False
    tlbTool.Buttons("cancel").Enabled = True
    tlbTool.Buttons("print").Enabled = False
    tlbTool.Buttons("preview").Enabled = False
    tlbTool.Buttons("output").Enabled = False
    SuperGrid1.SetFocus
End Sub

Private Sub CancelProc()
    Call fillgrid
    Call InitForm
    tlbTool.Buttons("cancel").Enabled = False
    tlbTool.Buttons("modify").Enabled = True
    tlbTool.Buttons("print").Enabled = True
    tlbTool.Buttons("preview").Enabled = True
    tlbTool.Buttons("output").Enabled = True
    modified = False
End Sub

Private Sub saveProc()
    If checkInfo Then
        If SaveData() Then
            modified = False
            SuperGrid1.ReadOnly = True
            Txtdjmc.Enabled = False
            cmdrefDjmc.Enabled = False
            cmdrefDjmc.Visible = False
            tlbTool.Buttons("modify").Enabled = False
            tlbTool.Buttons("save").Enabled = False
            tlbTool.Buttons("cancel").Enabled = False
            tlbTool.Buttons("linkquery").Enabled = True
            tlbTool.Buttons("print").Enabled = True
            tlbTool.Buttons("preview").Enabled = True
            tlbTool.Buttons("output").Enabled = True
        Else
            If conflict_flag Then
                Call conflictProc
            Else
                MsgBox "数据保存失败！", vbInformation, "保存数据"
            End If
        End If
    End If
End Sub

Private Function SaveData() As Boolean
    'Dim rs As New ADODB.Connection
    Dim idMgr As New U8FDMgr.OIDManager
    Dim objEO As U8FDEso.EntityObject
    Dim objVchDefBI As New U8FDBso.clsVchDefBI
    Dim id1 As String
    Dim code1 As String
    Dim i As Integer
    On Error GoTo error0
    Dim rs As New ADODB.Recordset
    sqlstr = "select count(*) from fd_transactions where return_date='" & Trim(Txthkrq.Text) & "' and substring(transactions_id,1,2) in (select iId from fd_entities where (iBIType='42' or iDeriveBIType = '42'));"
    rs.Open sqlstr, con, adOpenDynamic, adLockOptimistic
    If rs(0) > 0 Then
        MsgBox "系统已作过自动还款处理！" & vbCrLf & "请在下次记日记账后再执行本操作！", vbInformation, "系统初始化错误"
        SaveData = False
        rs.Close
        conflict_flag = True
        Exit Function
    End If
    rs.Close

    If Txtdjmc.Text = "" Then
        MsgBox "还款单单据类型不能为空！", vbInformation, "输入错误"
        Txtdjmc.SetFocus
        SaveData = False
        Exit Function
    Else
        sqlstr = "select iId from FD_entities where sCaption='" & Trim(Txtdjmc.Text) & "';"
        rs.Open sqlstr, con, adOpenDynamic, adLockOptimistic
        If Not (rs.EOF Or rs.BOF) Then
            vouchType = Trim(rs("iId"))
        Else
            MsgBox "还款单单据类型不存在！", vbInformation, "输入错误"
            rs.Close
            SaveData = False
            Txtdjmc.SetFocus
            Exit Function
        End If
    End If
    rs.Close
    ReDim loanID(SuperGrid1.Rows - 2)
    con.BeginTrans
'    Set objEO = objVchDefBI.Init(con.ConnectionString, CInt(vouchType))
    With SuperGrid1
        For i = 1 To SuperGrid1.Rows - 1
            If Not (CDbl(Trim(.TextMatrix(i, 9))) = 0 And CDbl(Trim(.TextMatrix(i, 10))) = 0) Then
''                Set objEO = objVchDefBI.Init(con.ConnectionString, CInt(vouchType))
'                'id1 = idMgr.GetNewOID(con, CInt(vouchType), True)
'                code1 = objVchDefBI.GetMaxCode(con.ConnectionString, objEO, CInt(vouchType))
                'get max code number 2002-07-09
'                    Dim con1 As New ADODB.Connection
'                    Dim rec As New ADODB.Recordset
'                    Dim sql As String
'
'                    con1.Open zjLogInfo.UfDbName
'
'                    sql = "select max(transactions_code) from fd_transactions where substring(transactions_id,1,2)=" & vouchType
'
'                    rec.Open sql, con1, adOpenDynamic
'
'                    If Not rec.EOF Then
'                        If IsNull(rec.Fields(0).Value) Then
'                            'code1 = String(objEO("transactions_code").length - 1, "0") & "1"
'                            code1 = String(9, "0") & "1"
'                        'ElseIf rec.Fields(0).Value = String(objEO("transactions_code").length, "9") Then
'                        ElseIf rec.Fields(0).Value = String(10, "9") Then
'                            code1 = ""
'                        Else
'                            code1 = Right(String(10, "0") & (IIf(IsNull(rec.Fields(0).Value), 0, rec.Fields(0).Value) + 1), 10)
'                        End If
'                    Else
'                        code1 = ""
'                    End If
'
'                    Set rec = Nothing
'                    Set con1 = Nothing
'get max code number 2002-07-09
'-----------------------------2002-07-10
    Dim rec    As New ADODB.Recordset
    Dim sql    As String
    
    sql = "Select sMaxOID From FD_Entities Where iID = " & vouchType
    rec.Open sql, con, adOpenDynamic, adLockOptimistic
    
        rec!sMaxOID = right(String(15, "0") & rec!sMaxOID + 1, 15)
        rec.Update
        id1 = rec!sMaxOID
    rec.Close
    Set rec = Nothing
    

'-----------------------------2002-07-10 end
                
'                code1 = Right(GridData(i - 1, 1), 10)
'                id1 = Trim(vouchType) & Right(GridData(i - 1, 10), 15 - Len(vouchType))
'                If Len(code1) + Len(vouchType) < 15 Then
'                    id1 = Trim(vouchType) & String(15 - (Len(code1) + Len(vouchType)), "0")
'                Else
'                    id1 = Trim(vouchType) & Trim(code1)
'                End If
'                id1 = id1 & code1
                code1 = mID(id1, 6, 10)
                loanID(i - 1) = CStr(id1)
                sqlstr = "insert into fd_transactions (transactions_id,transactions_code,correspond_vch_id,bill_date,pay_acc_id,sum_mny,mcde_mny,commission_mny,mcdeh_mny,"
                sqlstr = sqlstr & "exchange_rate,settle_code,irate_id,cad_id,equalsubject_code,from_date,to_date,calctype_flag,bill_Name,loan_flag,userdefine21,money_name,natural_mny,settle_flag,return_date) "
                sqlstr = sqlstr & " values('" & id1 & "','" & code1 & "','" & GridData(i - 1, 10) & "','" & Trim(Txthkrq.Text) & "','" & GridData(i - 1, 12) & "',"
                sqlstr = sqlstr & Trim(.TextMatrix(i, 9)) & "," & GridData(i - 1, 3) & "," & Trim(.TextMatrix(i, 10)) & "," & GridData(i - 1, 11) & ",'" & GridData(i - 1, 16) & "','" & GridData(i - 1, 23) & "','" & GridData(i - 1, 18) & "','"
                sqlstr = sqlstr & GridData(i - 1, 19) & "','" & GridData(i - 1, 29) & "','" & .TextMatrix(i, 3) & "','" & Trim(Txthkrq.Text) & "','" & GridData(i - 1, 22) & "','"
                sqlstr = sqlstr & Trim(TxtcUsername.Text) & "',1," & GridData(i - 1, 24) & ",'" & GridData(i - 1, 30) & "',"
                'sqlstr = sqlstr & CDbl(.TextMatrix(i, 9)) * CDbl(GridData(i - 1, 16)) & ","
                sqlstr = sqlstr & (CDbl(.TextMatrix(i, 9)) + CDbl(.TextMatrix(i, 10))) * CDbl(GridData(i - 1, 16)) & ","
                If CDbl(.TextMatrix(i, 9)) = CDbl(.TextMatrix(i, 4)) And CDbl(.TextMatrix(i, 10)) = CDbl(.TextMatrix(i, 5)) Then
                    sqlstr = sqlstr & "1"
                Else
                    sqlstr = sqlstr & "0"
                End If
                sqlstr = sqlstr & ",'" & Txthkrq.Text & "');"
                con.Execute sqlstr
            End If
        Next
    'rs("transactions_id") = idMgr.GetNewOID(m_sCon, CInt(vchstyle), True)
    End With
    con.CommitTrans
    SaveData = True
    Set idMgr = Nothing
    Set objEO = Nothing
    Set objVchDefBI = Nothing
    Exit Function
error0:
    MsgBox Err.Description, vbInformation, "错误信息"
    SaveData = False
    
    If rs.State = adStateOpen Then
        rs.Close
    End If
    Set rs = Nothing

    con.RollbackTrans
    Set idMgr = Nothing
    Set objEO = Nothing
    Set objVchDefBI = Nothing
End Function

Private Function checkInfo() As Boolean
    Dim rs As New ADODB.Recordset
    Dim i As Integer
    On Error GoTo error0
    If Txtdjmc.Text = "" Then
        MsgBox "单据名称能为空！", vbInformation, "输入错误"
        checkInfo = False
        Exit Function
    Else
        sqlstr = "select count(*) from FD_entities where scaption='" & Trim(Txtdjmc.Text) & "';"
        rs.Open sqlstr, con, adOpenDynamic, adLockOptimistic
        If rs(0) = 0 Then
            MsgBox "单据名称不存在！", vbInformation, "输入错误"
            checkInfo = False
            rs.Close
            Exit Function
        End If
        rs.Close
    End If
    For i = 1 To SuperGrid1.Rows - 1
        Call reCaldata(i, 9)
        If OK = False Then
           checkInfo = False
           Exit Function
        End If
    Next
    checkInfo = True
    Exit Function
error0:
    If rs.State = adStateOpen Then
        rs.Close
    End If
    checkInfo = False
End Function

Private Sub linkqueryproc()
    If Not Nodata Then
        If curRow > 0 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
'                    Dim OID           As New U8FDEso.OIDObject
'                    Dim objVchinputUI As New clsVchInputUI
'
                    OID = GridData(SuperGrid1.row - 1, 10)
                    objVchInputUI.Show g_sDataSourceName, smView, OID, mID(OID.id, 1, 2)

'                    Set OID = Nothing
'                    Set objVchinputUI = Nothing
                End If
            End If
            Set OID = Nothing
            Set objVchInputUI = Nothing

        Else
            MsgBox "您没有选择要查看的单据！", vbInformation, "错误信息"
        End If
    End If