+

VB财务软件系统下载源代码提供自由下载使用学习

            m_EditStatus = True
            If m_EO.State = U8FDEso.esoEdit Then CancelDo
            m_EditStatus = False
            Unload Me
        ElseIf iAnswer = vbYes Then
            Save
            Unload Me
        Else
            Cancel = 1
        End If
    Else
        Unload Me
    End If
End Sub

Private Sub Form_Resize()
    On Error Resume Next
    Me.jkrTree.maxLeft = Me.ScaleWidth - conMoveLimit
    Me.jkrTree.minLeft = conMoveLimit
    
    Me.treStyle.Move 0, Me.tlbAction.Height, Me.jkrTree.left, Me.ScaleHeight - Me.tlbAction.Height
    Me.jkrTree.Move Me.jkrTree.left, Me.tlbAction.Height, 50, Me.ScaleHeight
    Me.picView.Move Me.jkrTree.left + 50, Me.tlbAction.Height, Me.ScaleWidth - Me.jkrTree.left - 50, Me.ScaleHeight - Me.tlbAction.Height
    ResizeCtbTool Me, picView, treStyle, jkrTree
    On Error GoTo 0
End Sub

Private Sub jkrTree_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
    Me.jkrTree.ZOrder 0
End Sub

Private Sub jkrTree_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
    If Me.jkrTree.left < conMoveLimit Then
        Me.jkrTree.left = conMoveLimit
    ElseIf Me.jkrTree.left > Me.ScaleWidth - conMoveLimit Then
        Me.jkrTree.left = Me.ScaleWidth - conMoveLimit
    End If
    
    Me.treStyle.width = Me.jkrTree.left
    Me.picView.left = Me.jkrTree.left + 50
    Me.picView.width = Me.ScaleWidth - Me.treStyle.width - 50
    
End Sub

Public Sub AddNew()
    Dim oEO         As U8FDEso.EntityObject
    Dim objIRateBI  As New U8FDBso.clsIRateBI
    
    On Error GoTo lblHandle
    
    '1、申请权限
    
    '初始化实体对象
    Set oEO = objIRateBI.Init(g_sDataSourceName, m_conBIStyle)
    
    '----用于备份
    If Not m_EO Is Nothing Then Set m_OldEO = m_EO.Clone(U8FDEso.esoStructureAndData)
    Set m_EO = oEO
    
    m_EO.State = U8FDEso.esoAddNew
    
    '----设置界面
    SetUI
    Me.txtIRateCode.SetFocus
    
    Exit Sub
lblHandle:
    MsgBox Err.Description, vbInformation, g_conSysName
End Sub

Public Sub Edit(Optional OID As U8FDEso.OIDObject)
    Dim objLockMgr As New U8FDMgr.LockManager
    Dim objIRateBI As New U8FDBso.clsIRateBI

    On Error GoTo lblHandle
    '----申请权限
    
    '----
    If Not OID Is Nothing Then
        m_EO.OID = OID
    ElseIf mID(NodeKey, 2) = m_OID.id Then
        m_EO.OID = mID(Me.treStyle.Nodes(NodeKey).Parent.key, 2)
    End If
    
    '----锁定实体对象
    objLockMgr.LockIt g_sDataSourceName, m_EO.OID, zjLogInfo.cUserName, ComputerName
    Set objLockMgr = Nothing
    
    '----用于备份
    Set m_OldEO = m_EO.Clone(U8FDEso.esoStructureAndData)
    m_EO.State = U8FDEso.esoEdit
    
    '----设置界面
    SetUI
    Me.txtAdjustDate.SetFocus
    
    Exit Sub
lblHandle:
    MsgBox Err.Description, vbInformation, g_conSysName
End Sub

Public Sub AddCol()
    Dim objLockMgr    As New U8FDMgr.LockManager
    Dim objIRateBI    As New U8FDBso.clsIRateBI

    On Error GoTo lblHandle
    '----申请权限
    
    '----
    If mID(NodeKey, 2) = m_OID.id Then
        m_EO.OID = mID(Me.treStyle.Nodes(NodeKey).Parent.key, 2)
    Else
        m_EO.OID = mID(Me.treStyle.Nodes(NodeKey).key, 2)
    End If
    
    '----锁定实体对象
    objLockMgr.LockIt g_sDataSourceName, m_EO.OID, zjLogInfo.cUserName, ComputerName
    Set objLockMgr = Nothing
    
    '----用于备份
    Set m_OldEO = m_EO.Clone(U8FDEso.esoStructureAndData)
    m_EO.State = U8FDEso.esoEdit
    
    '----设置界面
    SetUI
    Me.txtAdjustDate.SetFocus
    
    Exit Sub
lblHandle:
    MsgBox Err.Description, vbInformation, g_conSysName
End Sub

Private Function Save() As Boolean
    Dim objLockMgr  As New U8FDMgr.LockManager
    Dim objIRateBI  As New U8FDBso.clsIRateBI
    Dim Child_EO    As U8FDEso.EntityObject
    Dim i           As Integer
    
    On Error GoTo lblHandle
    If Len(Trim(txtAdjustDate.Text)) = 0 Then
        MsgBox "日期不能为空！"
        Me.txtAdjustDate.SetFocus
        Exit Function
    ElseIf Len(Trim(ForDate(txtAdjustDate.Text))) = 1 Then
        Me.txtAdjustDate.SetFocus
        Exit Function
    Else
        txtAdjustDate.Text = ForDate(txtAdjustDate.Text)
    End If
    If Not IsNumeric(Me.txtNzy_rate.Text) Then
        MsgBox "年利率不能为空!", vbInformation, App.ProductName
        SetEdtTxtFocus Me.txtNzy_rate
        Exit Function
    'ElseIf Val(Me.txtNzy_rate.Text) = 0 Then
    '    MsgBox "年利率不能为0!", vbInformation, App.ProductName
    '    SetEdtTxtFocus Me.txtNzy_rate
    '    Exit Function
    End If
'    If IsNumeric(Me.txtNcq_rate.Text) Then
'        If Val(Me.txtNcq_rate.Text) = 0 Then
'            MsgBox "提前年利率不能为0!", vbInformation, App.ProductName
'            SetEdtTxtFocus Me.txtNcq_rate
'            Exit Function
'        End If
'    End If
'    If IsNumeric(Me.txtNyq_rate.Text) Then
'        If Val(Me.txtNyq_rate.Text) = 0 Then
'            MsgBox "逾期年利率不能为0!", vbInformation, App.ProductName
'            SetEdtTxtFocus Me.txtNyq_rate
'            Exit Function
'        End If
'    End If
    If Me.chkRation_flag.Value = 1 Then
        If Not IsNumeric(Me.txtRation_mny.Text) Then
            MsgBox "超定额金额不能为空!", vbInformation, App.ProductName
            SetEdtTxtFocus Me.txtRation_mny
            Exit Function
'        ElseIf Val(Me.txtRation_mny.Text) = 0 Then
'            MsgBox "超定额金额不能为0!", vbInformation, App.ProductName
'            SetEdtTxtFocus Me.txtRation_mny
'            Exit Function
        End If
        If Not IsNumeric(Me.txtRation_rate.Text) Then
            MsgBox "超定额利率不能为空!", vbInformation, App.ProductName
            SetEdtTxtFocus Me.txtRation_rate
            Exit Function
'        ElseIf Val(Me.txtRation_rate.Text) = 0 Then
'            MsgBox "超定额利率不能为0!", vbInformation, App.ProductName
'            SetEdtTxtFocus Me.txtRation_rate
'            Exit Function
        End If
    End If
    
    '----赋值
    With m_EO
        If m_EO.State = U8FDEso.esoAddNew Then
            m_EO("irate_code") = Me.txtIRateCode.Text
            '保存子表数据
    '        If m_EO.EOS.Count > 0 Then
    '            For i = m_EO.EOS.Count To 1 Step -1
    '                m_EO.EOS.Delete i
    '            Next
    '        End If
            Set Child_EO = objIRateBI.Init(g_sDataSourceName, m_conChildBIStyle)
            Child_EO("irate_code") = Me.txtIRateCode.Text
            If Len(Trim(ForDate(Me.txtAdjustDate.Text))) > 1 Then
                Child_EO("adjust_date") = ForDate(Me.txtAdjustDate.Text)
            Else
                Exit Function
            End If
            Child_EO("nzy_rate") = Me.txtNzy_rate.Text '/ 100
            Child_EO("ncq_rate") = Me.txtNcq_rate.Text '/ 100
            Child_EO("nyq_rate") = Me.txtNyq_rate.Text '/ 100
            If Me.chkRation_flag.Value = 1 Then
                Child_EO("ration_flag") = True
                Child_EO("ration_mny") = Me.txtRation_mny.Text
                Child_EO("ration_rate") = Me.txtRation_rate.Text '/ 100
            Else
                Child_EO("ration_flag") = False
                Child_EO("ration_mny") = 0
                Child_EO("ration_rate") = 0
            End If
        
            m_EO.EOS.Append Child_EO, "K" & Child_EO.OID
        ElseIf m_EO.State = U8FDEso.esoEdit Then
            If m_EditCol = 0 Then
                Dim dateNum      As Long
                Dim NodeTemp     As MSComctlLib.Node
                dateNum = 0
                Set NodeTemp = Me.treStyle.SelectedItem.FirstSibling
                For i = 1 To Me.treStyle.SelectedItem.Parent.children
                    If DateDiff("d", NodeTemp.Text, ForDate(Me.txtAdjustDate.Text)) = 0 And Me.treStyle.SelectedItem.key <> NodeTemp.key Then
                        dateNum = dateNum + 1
                        Exit For
                    End If
                    Set NodeTemp = NodeTemp.Next
                Next
                Set NodeTemp = Nothing
                If dateNum > 0 Then
                    MsgBox "已有该调整日期!", vbInformation, App.ProductName
                    Me.txtAdjustDate.Text = m_EO.EOS("K" & m_OID.id)("adjust_date")
                    Exit Function
                End If
            
                m_EO("irate_code") = Me.txtIRateCode.Text
                m_EO.EOS("K" & m_OID.id)("irate_code") = Me.txtIRateCode.Text
                If Len(Trim(ForDate(Me.txtAdjustDate.Text))) > 1 Then
                    m_EO.EOS("K" & m_OID.id)("adjust_date") = ForDate(Me.txtAdjustDate.Text)
                Else
                    Exit Function
                End If
                m_EO.EOS("K" & m_OID.id)("nzy_rate") = Me.txtNzy_rate.Text '/ 100
                m_EO.EOS("K" & m_OID.id)("ncq_rate") = Me.txtNcq_rate.Text '/ 100
                m_EO.EOS("K" & m_OID.id)("nyq_rate") = Me.txtNyq_rate.Text '/ 100
                If Me.chkRation_flag.Value = 1 Then
                    m_EO.EOS("K" & m_OID.id)("ration_flag") = True
                    m_EO.EOS("K" & m_OID.id)("ration_mny") = Me.txtRation_mny.Text
                    m_EO.EOS("K" & m_OID.id)("ration_rate") = Me.txtRation_rate.Text '/ 100
                Else
                    m_EO.EOS("K" & m_OID.id)("ration_flag") = False
                    m_EO.EOS("K" & m_OID.id)("ration_mny") = 0
                    m_EO.EOS("K" & m_OID.id)("ration_rate") = 0
                End If
            ElseIf m_EditCol = 1 Then
                Set Child_EO = objIRateBI.Init(g_sDataSourceName, m_conChildBIStyle)
                Child_EO("irate_code") = Me.txtIRateCode.Text
                If Len(Trim(ForDate(Me.txtAdjustDate.Text))) > 1 Then
                    Child_EO("adjust_date") = ForDate(Me.txtAdjustDate.Text)
                Else
                    Exit Function
                End If
                Child_EO("nzy_rate") = Me.txtNzy_rate.Text '/ 100
                Child_EO("ncq_rate") = Me.txtNcq_rate.Text '/ 100
                Child_EO("nyq_rate") = Me.txtNyq_rate.Text '/ 100
                If Me.chkRation_flag.Value = 1 Then
                    Child_EO("ration_flag") = True
                    Child_EO("ration_mny") = Me.txtRation_mny.Text
                    Child_EO("ration_rate") = Me.txtRation_rate.Text '/ 100
                Else
                    Child_EO("ration_flag") = False
                    Child_EO("ration_mny") = 0
                    Child_EO("ration_rate") = 0
                End If
                m_EO.EOS.Append Child_EO, "K" & Child_EO.OID
            End If
        End If
    End With
    '----实体对象验证
    If Not m_EO.Validate Then
        For i = 1 To m_EO.EOS.count
            m_EO.EOS.Delete 1
        Next
        Exit Function
    End If
    
    '----调用业务对象并保存
    If objIRateBI.Save(g_sDataSourceName, m_EO, m_conBIStyle) Then
        If m_EO.State = U8FDEso.esoAddNew Then
            Me.treStyle.Nodes.Add , , "K" & m_EO("irate_id"), m_EO("irate_code")
            Me.treStyle.Nodes("K" & m_EO("irate_id")).Image = 2
            Me.treStyle.Nodes("K" & m_EO("irate_id")).Expanded = True
            Me.treStyle.Nodes.Add "K" & m_EO("irate_id"), tvwChild, "K" & m_EO.EOS(1)("irate_b_id"), m_EO.EOS(1)("adjust_date")
            Me.treStyle.Nodes("K" & m_EO.EOS(1)("irate_b_id")).Image = 3
            Me.treStyle.Nodes("K" & m_EO.EOS(1)("irate_b_id")).Selected = True
            NodeKey = "K" & m_EO.EOS(1)("irate_b_id")
            m_OID.id = m_EO.EOS(1)("irate_b_id")
        ElseIf m_EO.State = U8FDEso.esoEdit Then
            If m_EditCol = 0 Then '编辑
                Me.treStyle.Nodes("K" & m_OID.id).Parent.Text = m_EO("irate_code") '未使用时
                Me.treStyle.Nodes("K" & m_OID.id).Text = m_EO.EOS("K" & m_OID.id)("adjust_date")
            ElseIf m_EditCol = 1 Then '增列
                Me.treStyle.Nodes.Add "K" & m_EO("irate_id"), tvwChild, "K" & m_EO.EOS(m_EO.EOS.count)("irate_b_id"), m_EO.EOS(m_EO.EOS.count)("adjust_date")
                Me.treStyle.Nodes("K" & m_EO.EOS(m_EO.EOS.count)("irate_b_id")).Image = 3
                Me.treStyle.Nodes("K" & m_EO.EOS(m_EO.EOS.count)("irate_b_id")).Selected = True
                NodeKey = "K" & m_EO.EOS(m_EO.EOS.count)("irate_b_id")
                m_OID.id = m_EO.EOS(m_EO.EOS.count)("irate_b_id")
            ElseIf m_EditCol = 2 Then '删列
                Me.treStyle.Nodes.Remove "K" & m_OID.id
            End If
        End If
    Else
        If m_EO.State = U8FDEso.esoAddNew Then
            For i = 1 To EO.EOS.count
                m_EO.EOS.Delete 1
            Next
        End If
        If m_EditCol = 1 Then
            m_EO.EOS.Delete "K" & Child_EO.OID
        End If
        Exit Function
    End If