i-+

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

    Dim objOID      As New U8FDEso.OIDObject
    
    On Error GoTo lblHandle
    '1、申请权限
    
    '初始化实体对象
    Set oEO = objAccGrpBI.Init(g_sDataSourceName, m_conBIStyle)
    
    objOID.id = "020000000000000"
    objLockMgr.LockIt g_sDataSourceName, objOID, zjLogInfo.cUserName, ComputerName
    Set objLockMgr = Nothing
    Set objOID = Nothing
    '----用于备份
    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
    
    Exit Sub
lblHandle:
    MsgBox Err.Description, vbInformation, g_conSysName
End Sub

Public Sub Edit(Optional OID As U8FDEso.OIDObject)
    Dim objAccGrpBI  As New U8FDBso.clsAccGrpBI
    Dim objLockMgr   As New U8FDMgr.LockManager
    Dim objOID       As New U8FDEso.OIDObject
    
    On Error GoTo lblHandle
    '----申请权限
    
    '----
    If Not OID Is Nothing Then
        m_EO.OID = OID
    ElseIf Not IsNull(NodeKey) And NodeKey <> "" Then
        m_EO.OID = mID(Me.treStyle.Nodes(NodeKey).key, 2)
    Else
        Set m_EO = objAccGrpBI.MoveTo(g_sDataSourceName, U8FDEso.esoFirst, m_conBIStyle)
    End If
    
    '----锁定实体对象
    objOID.id = "020000000000000"
    objLockMgr.LockIt g_sDataSourceName, objOID, zjLogInfo.cUserName, ComputerName
    Set objLockMgr = Nothing
    Set objOID = Nothing
    
    '----用于备份
    Set m_OldEO = m_EO.Clone(U8FDEso.esoStructureAndData)
    m_EO.State = U8FDEso.esoEdit
    
    '----设置界面
    SetUI
    
    Exit Sub
lblHandle:
    MsgBox Err.Description, vbInformation, g_conSysName
End Sub

Public Sub View(Optional OID As U8FDEso.OIDObject)
    Dim objAccGrpBI As New U8FDBso.clsAccGrpBI
    
    On Error GoTo lblHandle
    '1、申请权限
        
    '----
    If Not OID Is Nothing Then
        Set m_EO = objAccGrpBI.MoveTo(g_sDataSourceName, U8FDEso.esoCurrent, m_conBIStyle, OID)
    End If
    
    '----
    If m_EO Is Nothing Then
        Set m_EO = objAccGrpBI.MoveTo(g_sDataSourceName, U8FDEso.esoLast, m_conBIStyle)
    End If
    
    m_View = True
    '----设置界面
    SetUI
    
    Exit Sub
lblHandle:
    MsgBox Err.Description, vbInformation, g_conSysName
End Sub

Private Function Save() As Boolean
    Dim objLockMgr     As New U8FDMgr.LockManager
    Dim objAccGrpBI    As New U8FDBso.clsAccGrpBI
    Dim FindOIDByNode  As String
    Dim AccGrpID       As String
    Dim ParentKey      As String
    Dim NodeTemp       As MSComctlLib.Node
    Dim i              As Long
    
    On Error GoTo lblHandle
    
    If Me.treStyle.Nodes.count > 0 Then
        If Me.treStyle.SelectedItem.FirstSibling.key = Me.treStyle.SelectedItem.root.key Then
            Set NodeTemp = Me.treStyle.SelectedItem.FirstSibling
            Do Until NodeTemp.key = Me.treStyle.SelectedItem.LastSibling.key
                If Me.treStyle.SelectedItem.key <> NodeTemp.key And mID(Me.treStyle.Nodes(NodeTemp.key).Text, 2, InStr(2, Me.treStyle.Nodes(NodeTemp.key).Text, "】") - 2) = Me.txtAccGrp(0).Text Then
                    MsgBox "同级别的代码不能重复！", vbInformation, App.ProductName
                    Exit Function
                End If
                Set NodeTemp = NodeTemp.Next
            Loop
            Set NodeTemp = Nothing
        Else
            ParentKey = Me.treStyle.SelectedItem.Parent.key
            Set NodeTemp = Me.treStyle.SelectedItem.FirstSibling
            For i = 1 To Me.treStyle.SelectedItem.Parent.children
                If Me.treStyle.SelectedItem.key <> NodeTemp.key And mID(Me.treStyle.Nodes(NodeTemp.key).Text, 2, InStr(2, Me.treStyle.Nodes(NodeTemp.key).Text, "】") - 2) = Me.txtAccGrp(0).Text Then
                    MsgBox "同级别的代码不能重复！", vbInformation, App.ProductName
                    Exit Function
                End If
                Set NodeTemp = NodeTemp.Next
            Next
            Set NodeTemp = Nothing
        End If
    End If
    
    '删除FD_AccGrpLnk中sAccGroupOID = NodeKey的行
    FindOIDByNode = FindOIDinNodes(Me.cboParent.Text)
    
    If NodeKey <> "" And FindOIDByNode = mID(NodeKey, 2) Then
        Dim con As New adodb.Connection
        Dim SQL As String
        
        con.Open g_sDataSourceName
        SQL = "Delete From FD_AccGrpLnk where " & EO.SourceOIDField & "='" & mID(NodeKey, 2) & "'"
        con.Execute SQL
        Set con = Nothing
    End If
    '----赋值
    'bNoRepeatAcc = m_EO("bNoRepeatAcc")
    
    m_EO("accgrp_code") = Me.txtAccGrp(0)
    m_EO("accgrp_name") = Me.txtAccGrp(1)
    m_EO("digest") = Me.txtAccGrp(3)
    If Me.cboParent.ListIndex = 0 Then
        m_EO("parent_id") = Null
    Else
        m_EO("parent_id") = FindOIDByNode ' Mid(FindOIDByNode, 1, Len(FindOIDByNode) - 1)
    End If
    
    '----实体对象验证
    If Not m_EO.Validate Then Exit Function
    
    '----调用业务对象并保存
    If objAccGrpBI.Save(g_sDataSourceName, m_EO, m_conBIStyle) = False Then Exit Function
    AccGrpID = m_EO("accgrp_id")
    
    '----解除锁定
    Dim objOID      As New U8FDEso.OIDObject
    'If m_EO.State = U8FDEso.esoEdit Then
        objOID.id = "020000000000000"
        objLockMgr.UnlockIt g_sDataSourceName, objOID 'm_EO.OID
        Set objOID = Nothing
    'End If
    
    If m_EO.State = U8FDEso.esoAddNew Then
        If Me.cboParent.ListIndex = 0 Then
            Me.treStyle.Nodes.Add , , "K" & AccGrpID, "【" & Me.txtAccGrp(0) & "】" & Me.txtAccGrp(1)
            If treStyle.Nodes("K" & AccGrpID).children > 0 Then
                treStyle.Nodes("K" & AccGrpID).Image = 2
            Else
                treStyle.Nodes("K" & AccGrpID).Image = 3
            End If
            treStyle.Nodes("K" & AccGrpID).Selected = True

            Me.cboParent.AddItem "【" & Me.txtAccGrp(0) & "】" & Me.txtAccGrp(1)
        Else
            Me.treStyle.Nodes.Add "K" & FindOIDByNode, tvwChild, "K" & AccGrpID, "【" & Me.txtAccGrp(0) & "】" & Me.txtAccGrp(1)

            If treStyle.Nodes("K" & FindOIDByNode).children > 0 Then
                treStyle.Nodes("K" & FindOIDByNode).Image = 2
            Else
                treStyle.Nodes("K" & FindOIDByNode).Image = 3
            End If
            
            treStyle.Nodes("K" & FindOIDByNode).Expanded = True
            
            If treStyle.Nodes("K" & AccGrpID).children > 0 Then
                treStyle.Nodes("K" & AccGrpID).Image = 2
            Else
                treStyle.Nodes("K" & AccGrpID).Image = 3
            End If
            
            treStyle.Nodes("K" & AccGrpID).Selected = True

            Me.cboParent.AddItem "【" & Me.txtAccGrp(0) & "】" & Me.txtAccGrp(1)
        End If
    ElseIf m_EO.State = U8FDEso.esoEdit Then
        If Me.cboParent.ListIndex = 0 Then
            '由内层迁往顶层
            If Not treStyle.Nodes("K" & AccGrpID).root.key = treStyle.Nodes("K" & AccGrpID).FirstSibling.key Then
                If treStyle.Nodes("K" & AccGrpID).Parent.children - 1 > 0 Then
                    treStyle.Nodes("K" & AccGrpID).Parent.Image = 1
                Else
                    treStyle.Nodes("K" & AccGrpID).Parent.Image = 3
                End If
                
                Me.treStyle.Nodes.Remove "K" & AccGrpID
                
                Me.treStyle.Nodes.Add , , "K" & AccGrpID, "【" & Me.txtAccGrp(0) & "】" & Me.txtAccGrp(1)
                
                CreateTree AccGrpID
            Else
                '由顶层迁往顶层,只修改属性值
                If treStyle.Nodes("K" & AccGrpID).children - 1 > 0 Then
                    treStyle.Nodes("K" & AccGrpID).Image = 2
                Else
                    treStyle.Nodes("K" & AccGrpID).Image = 3
                End If
                
                Me.treStyle.Nodes("K" & AccGrpID).Text = "【" & Me.txtAccGrp(0) & "】" & Me.txtAccGrp(1)
                Me.treStyle.Nodes("K" & AccGrpID).key = "K" & AccGrpID
            End If
        Else
            '由顶层迁往内层
            If treStyle.Nodes("K" & AccGrpID).root.key = treStyle.Nodes("K" & AccGrpID).FirstSibling.key Then
                Me.treStyle.Nodes.Remove "K" & AccGrpID
                Me.treStyle.Nodes.Add "K" & FindOIDByNode, tvwChild, "K" & AccGrpID, "【" & Me.txtAccGrp(0) & "】" & Me.txtAccGrp(1)
                
                CreateTree AccGrpID
                
                If treStyle.Nodes("K" & AccGrpID).children > 0 Then
                    treStyle.Nodes("K" & AccGrpID).Image = 2
                Else
                    treStyle.Nodes("K" & AccGrpID).Image = 3
                End If
            Else
            '由内层迁往内层
                If Not "K" & FindOIDByNode = treStyle.Nodes("K" & AccGrpID).Parent.key Then
                    If treStyle.Nodes("K" & AccGrpID).Parent.children - 1 > 0 Then
                        treStyle.Nodes("K" & AccGrpID).Parent.Image = 2
                    Else
                        treStyle.Nodes("K" & AccGrpID).Parent.Image = 3
                    End If
                    Me.treStyle.Nodes.Remove "K" & AccGrpID
                    Me.treStyle.Nodes.Add "K" & FindOIDByNode, tvwChild, "K" & AccGrpID, "【" & Me.txtAccGrp(0) & "】" & Me.txtAccGrp(1)
                    Me.treStyle.Nodes("K" & FindOIDByNode).Image = 2
                    CreateTree AccGrpID
                Else
                    Me.treStyle.Nodes("K" & AccGrpID).Text = "【" & Me.txtAccGrp(0) & "】" & Me.txtAccGrp(1)
                    Me.treStyle.Nodes("K" & AccGrpID).key = "K" & AccGrpID
                End If
            End If
        End If
    End If
    
    NodeKey = "K" & AccGrpID
    
    Me.treStyle.Nodes(NodeKey).Selected = True
    Me.treStyle.Nodes(NodeKey).Expanded = True
    m_EO.State = U8FDEso.esoInstance
    
    '----释放任务
    
    '----设置界面
    SetUI
    
    Save = True
    
    Exit Function
lblHandle:
    MsgBox Err.Description, vbInformation, g_conSysName
End Function

Private Sub Delete()
    If MsgBox("真的要删除当前记录吗？", vbQuestion + vbYesNo) = vbNo Then Exit Sub
    
    Dim objAccGrpBI As New U8FDBso.clsAccGrpBI
    Dim ParentOID   As String
    Dim objLockMgr  As New U8FDMgr.LockManager
    Dim objOID      As New U8FDEso.OIDObject
    
    On Error GoTo lblHandle
    
    objOID.id = "020000000000000"
    objLockMgr.LockIt g_sDataSourceName, objOID, zjLogInfo.cUserName, ComputerName
    '----删除当前记录
    If objAccGrpBI.Delete(g_sDataSourceName, m_EO, m_conBIStyle) Then
        Me.treStyle.Nodes.Remove Me.treStyle.Nodes(NodeKey).key
            
        '----移动到下一条记录
        If Me.cboParent.ListIndex = 0 Then
            ParentOID = ""
        Else
            ParentOID = FindOIDinNodes(Me.cboParent.Text)
        End If
        
        objOID = mID(NodeKey, 2)
        Set m_EO = objAccGrpBI.MoveTo(g_sDataSourceName, U8FDEso.esoNext, m_conBIStyle, objOID, ParentOID)
        If Not m_EO Is Nothing Then '主要看objAccGrpBI.MoveTo返回值是否为Nothing
            If Me.treStyle.Nodes.count > 0 Then
                If ParentOID <> "" Then
                    If Me.treStyle.Nodes("K" & ParentOID).children = 0 Then
                        Me.treStyle.Nodes("K" & ParentOID).Image = 3
                    End If
                End If
                NodeKey = "K" & m_EO(m_EO.SourceOIDField)
                'Me.treStyle.Nodes(NodeKey).Expanded = True
                Me.treStyle.Nodes(NodeKey).Selected = True
                Set objOID = Nothing
            Else
                Set m_EO = objAccGrpBI.Init(g_sDataSourceName, m_conBIStyle)
                NodeKey = ""
            End If
        Else
            Set m_EO = objAccGrpBI.Init(g_sDataSourceName, m_conBIStyle)
            NodeKey = ""
        End If
    Else
        MsgBox "删除没有成功!"
    End If
    objOID.id = "020000000000000"
    objLockMgr.UnlockIt g_sDataSourceName, objOID 'm_EO.OID
    Set objOID = Nothing
    Set objLockMgr = Nothing
    '----设置界面
    SetUI
    
    Set objAccGrpBI = Nothing
    
    Exit Sub
lblHandle:
    MsgBox Err.Description, vbInformation, g_conSysName
End Sub

Private Sub CancelDo()
    If Not m_EditStatus Then
        If MsgBox("真的要取消当前操作吗？", vbQuestion + vbYesNo, g_conSysName) = vbNo Then Exit Sub
    End If
    
    Dim objAccGrpBI  As New U8FDBso.clsAccGrpBI
    Dim objLockMgr   As New U8FDMgr.LockManager
    Dim objOID       As New U8FDEso.OIDObject
    
    On Error GoTo lblHandle
    '----State 若为 esoEdit, 解锁
    'If m_EO.State = U8FDEso.esoEdit Then
    objOID.id = "020000000000000"
    objLockMgr.UnlockIt g_sDataSourceName, objOID
    Set objOID = Nothing
    'End If
    
    '----恢复原实体对象
    If Not m_OldEO Is Nothing Then
        Set m_EO = m_OldEO.Clone(U8FDEso.esoStructureAndData)
    Else
        Set m_EO = objAccGrpBI.MoveTo(g_sDataSourceName, U8FDEso.esoLast, m_conBIStyle)
    End If
    
    '----设置界面
    SetUI
    
    Exit Sub
lblHandle:
    MsgBox Err.Description, vbInformation, g_conSysName
End Sub