单据类型定义.frm

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

                If key(i) <> 0 Then
                    GetNewBIType = key(i)
                    KeyIndex = i
                    Exit Function
                End If
            Next
        Case "Settle"
            VchType = 2
            For i = 11 To 12
                If key(i) <> 0 Then
                    GetNewBIType = key(i)
                    KeyIndex = i
                    Exit Function
                End If
            Next
        Case "Fix"
            VchType = 3
            For i = 13 To 18
                If key(i) <> 0 Then
                    GetNewBIType = key(i)
                    KeyIndex = i
                    Exit Function
                End If
            Next
        Case "Loan"
            VchType = 4
            For i = 19 To 22
                If key(i) <> 0 Then
                    GetNewBIType = key(i)
                    KeyIndex = i
                    Exit Function
                End If
            Next
        Case "Accrual"
            VchType = 5
            For i = 23 To 27
                If key(i) <> 0 Then
                    GetNewBIType = key(i)
                    KeyIndex = i
                    Exit Function
                End If
            Next
        Case "Else"
            VchType = 6
            For i = 28 To 33
                If key(i) <> 0 Then
                    GetNewBIType = key(i)
                    KeyIndex = i
                    Exit Function
                End If
            Next
    End Select
    For i = 43 To 1 Step -1
        If key(i) <> 0 Then
            GetNewBIType = key(i)
            KeyIndex = i
            Exit Function
        End If
    Next
End Function

Public Sub AddNew()
    Dim objEO As New U8FDEso.EntityObject
                
    On Error GoTo lblHandle
    If Me.treStyle.SelectedItem.key <> NodeKey Then
        Me.treStyle.Nodes(NodeKey).Selected = True
    End If
    
    'If Me.treStyle.Nodes("Settle").Children + Me.treStyle.Nodes("Fix").Children + Me.treStyle.Nodes("Loan").Children + Me.treStyle.Nodes("Accrual").Children + Me.treStyle.Nodes("Else").Children = 70 Then
    If Me.treStyle.Nodes.count = 75 Then
        MsgBox "不能再增加单据类型了，本版预定70种单据。", vbInformation
        Exit Sub
    End If
    
    '****************************
    Dim i As Integer
    Dim objfrmVchDefine As frmVchDefine
    For i = 0 To Forms.count - 1
        If Forms(i).Name = "frmVoucherDefine" Then
            Set objfrmVchDefine = Forms(i)
            Exit For
        End If
    Next
    If Not objfrmVchDefine Is Nothing Then
        If objfrmVchDefine.objF1Book.AllowSelections Then
            BringWindowToTop objfrmVchDefine.hWnd
            MsgBox "当前正在修改单据格式，不能增加新的单据类型！", vbInformation, g_conSysName
            Exit Sub
        End If
    End If
    Set objfrmVchDefine = Nothing
    '*********************
    
    '1、申请权限
    
    '初始化实体对象
    'Set objEO = objVchDefBI.Init(g_sDataSourceName, 11)
    
    '----用于备份
    If Not m_EO Is Nothing Then Set m_OldEO = m_EO.Clone(U8FDEso.esoStructureAndData)
    
    objEO.BIType = GetNewBIType
    objEO.State = U8FDEso.esoAddNew
    Set m_EO = objEO
    
    Set objEO = Nothing
    '----设置界面(值和状态)
    SetUI
    
    Me.txtVchStyle(1).SetFocus
    
    Exit Sub
lblHandle:
    MsgBox Err.Description, vbInformation, g_conSysName
End Sub

Public Sub Edit()
    Dim objLockMgr   As New U8FDMgr.LockManager

    On Error GoTo lblHandle
    
    '1、申请权限
    If Me.treStyle.SelectedItem.key <> NodeKey Then
        Me.treStyle.Nodes(NodeKey).Selected = True
    End If

    '锁定实体对象
    'Set m_EO.OID = m_EO.BIType
    '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
    
    Exit Sub
lblHandle:
    MsgBox Err.Description, vbInformation, g_conSysName
End Sub

Private Sub Delete()
    On Error GoTo lblHandle
    
    Dim objVchDefBI As New U8FDBso.clsVchDefBI
    
    If Me.treStyle.SelectedItem.key <> NodeKey Then
        Me.treStyle.Nodes(NodeKey).Selected = True
    End If
    
    If Not IsNumeric(mID(Me.EO.Name, 3, 2)) Then
        MsgBox "系统内定单据类型，不能删除！", vbInformation
        Exit Sub
    End If
    If objVchDefBI.BITypeIsUsed(g_sDataSourceName, m_EO.BIType) Then
        MsgBox "本单据类型已经使用，不能删除！", vbInformation
        Exit Sub
    End If
    If objVchDefBI.VouchIsUsed(g_sDataSourceName, m_EO.BIType) Then
        MsgBox "本单据类型已有凭证生成,请删除凭证后，再删除单据！", vbInformation
        Exit Sub
    End If
    'Select Case Me.EO.BIType
    '    Case 11 To 14, 21 To 25, 31 To 32, 41 To 46, 51 To 55, 61
    '        MsgBox "系统内定单据类型，不能删除！", vbInformation
    '        Exit Sub
    'End Select
    
    If MsgBox("真的要删除当前记录吗？", vbQuestion + vbYesNo) = vbNo Then Exit Sub
    
    '----删除当前记录
    If objVchDefBI.DeleteBIType(g_sDataSourceName, m_EO.BIType) Then
        If CInt(Me.EO.BIType) >= 11 And CInt(Me.EO.BIType) <= 20 Then
            key(Me.EO.BIType - (20 - 10)) = Me.EO.BIType
        End If
        If CInt(Me.EO.BIType) >= 29 And CInt(Me.EO.BIType) <= 30 Then
            key(Me.EO.BIType - (30 - 12)) = Me.EO.BIType
        End If
        If CInt(Me.EO.BIType) >= 35 And CInt(Me.EO.BIType) <= 40 Then
            key(Me.EO.BIType - (40 - 18)) = Me.EO.BIType
        End If
        If CInt(Me.EO.BIType) >= 47 And CInt(Me.EO.BIType) <= 50 Then
            key(Me.EO.BIType - (50 - 22)) = Me.EO.BIType
        End If
        If CInt(Me.EO.BIType) >= 56 And CInt(Me.EO.BIType) <= 60 Then
            key(Me.EO.BIType - (60 - 27)) = Me.EO.BIType
        End If
        If CInt(Me.EO.BIType) >= 65 And CInt(Me.EO.BIType) <= 70 Then
            key(Me.EO.BIType - (70 - 33)) = Me.EO.BIType
        End If
        If CInt(Me.EO.BIType) >= 71 And CInt(Me.EO.BIType) <= 80 Then
            key(Me.EO.BIType - (80 - 43)) = Me.EO.BIType
        End If
        
        '----移动到下一条记录
        If NodeKey = Me.treStyle.Nodes(NodeKey).FirstSibling.key Then
            Set m_EO = objEOS.Item(Me.treStyle.Nodes(NodeKey).Next.key)
            Me.treStyle.Nodes(Me.treStyle.Nodes(NodeKey).Next.key).Selected = True
        Else
            Set m_EO = objEOS.Item(Me.treStyle.Nodes(NodeKey).Previous.key)
            Me.treStyle.Nodes(Me.treStyle.Nodes(NodeKey).Previous.key).Selected = True
        End If
        objEOS.Delete NodeKey
        Me.treStyle.Nodes.Remove NodeKey
        NodeKey = Me.treStyle.SelectedItem.key
        
        '----设置界面
        SetUI
    Else
        MsgBox "删除没有成功!"
    End If
    
    Set objVchDefBI = Nothing

    Exit Sub
lblHandle:
    MsgBox Err.Description, vbInformation, g_conSysName
End Sub

Private Sub Save()
    Dim objVchDefBI     As New U8FDBso.clsVchDefBI
    Dim objDataMgr      As New U8FDMgr.DataManager
    Dim objEO           As New U8FDEso.EntityObject
    Dim TreeKey         As String
    
    On Error GoTo lblHandle
    
    If Len(Trim(Me.txtVchStyle(1).Text)) = 0 Then
        MsgBox "类型名称不能为空!"
        Exit Sub
    End If
    If Me.txtVchStyle(2).Text <> "" Then
        If Not PzSign(Me.txtVchStyle(2).Text) Then
            MsgBox "凭证类别不存在！", vbInformation, App.ProductName
            Exit Sub
        End If
    End If
    
    Dim i            As Integer
    Dim NodeTemp     As MSComctlLib.Node
    Dim FromBIType   As Long
    Dim DeriveBIType As Long
    
    Set NodeTemp = Me.treStyle.SelectedItem.Parent.child
    For i = 1 To Me.treStyle.SelectedItem.Parent.children
        If Me.cboBIType.Text = NodeTemp.Text Then
            FromBIType = mID(NodeTemp.key, 2)
            DeriveBIType = IIf(objEOS(NodeTemp.key).DeriveBIType = 0, objEOS(NodeTemp.key).BIType, objEOS(NodeTemp.key).DeriveBIType)
            Exit For
        End If
        Set NodeTemp = NodeTemp.Next
    Next
    Set NodeTemp = Nothing

    With objEO
        .id = Me.txtVchStyle(0).Text
        If FromBIType <> 0 And FromBIType <> mID(EO.Name, 3, 2) Then
            .Name = "fd" & FromBIType & "_" & Me.txtVchStyle(1).Text
        Else
            .Name = EO.Name
        End If
        .Caption = Me.txtVchStyle(1).Text
        .State = U8FDEso.esoAddNew
        .BIType = Me.txtVchStyle(0).Text
        .TaskId = ""
        .HelpContextID = ""
        .Description = Me.txtVchStyle(3).Text
        .SourceOIDField = "transactions_id"
        .SourceTable = "fd_transactions"
        .SheetID = Me.txtVchStyle(0).Text - 10
        If FromBIType = 0 Then
            .Rows = objEOS.Item("K" & Me.txtVchStyle(0).Text).Rows
            .Cols = objEOS.Item("K" & Me.txtVchStyle(0).Text).Cols
        Else
            .Rows = objEOS.Item("K" & FromBIType).Rows
            .Cols = objEOS.Item("K" & FromBIType).Cols
        End If
        .PzSign = Me.txtVchStyle(2).Text
        .IsUsed = CBool(Me.chkUse.Value)
        If Me.treStyle.SelectedItem.children > 0 Then
            TreeKey = Me.treStyle.SelectedItem.key
        Else
            TreeKey = Me.treStyle.SelectedItem.Parent.key
        End If

        Select Case TreeKey
            Case "Contract"
                .VchType = 1
            Case "Settle"
                .VchType = 2
            Case "Fix"
                .VchType = 3
            Case "Loan"
                .VchType = 4
            Case "Accrual"
                .VchType = 5
            Case "Else"
                .VchType = 6
        End Select
        .DeriveBIType = DeriveBIType
    End With
    '****************************
    If DeriveBIType <> 0 Then
        Dim objfrmVchDefine As frmVchDefine
        For i = 0 To Forms.count - 1
            If Forms(i).Name = "frmVchDefine" Then
                Set objfrmVchDefine = Forms(i)
                Exit For
            End If
        Next
        
        If Not objfrmVchDefine Is Nothing Then
            If objfrmVchDefine.objF1Book.AllowSelections Then
                BringWindowToTop objfrmVchDefine.hWnd
                MsgBox "当前正在修改单据格式，不能增加新的单据类型！", vbInformation, g_conSysName
                Exit Sub
            Else
                objfrmVchDefine.CopyF1Book True, FromBIType, objEO.BIType, objEO.Rows, objEO.Cols
            End If
        Else
            Set objfrmVchDefine = New frmVchDefine
            objfrmVchDefine.CopyF1Book False, FromBIType, objEO.BIType, objEO.Rows, objEO.Cols
            Unload objfrmVchDefine
        End If
        Set objfrmVchDefine = Nothing
    End If
    '****************************
    If m_EO.State = U8FDEso.esoAddNew Then
        If objDataMgr.SaveEOMetaData(g_sDataSourceName, objEO, True) Then
            objVchDefBI.CopyFields g_sDataSourceName, FromBIType, objEO.BIType
            Set objVchDefBI = Nothing
            'MsgBox "保存成功！"
            
            key(KeyIndex) = 0
            '添加到TreeView中
            If left(Me.treStyle.SelectedItem.key, 1) <> "K" Then
                Me.treStyle.Nodes.Add Me.treStyle.SelectedItem.key, tvwChild, "K" & objEO.BIType, objEO.Caption
                Me.treStyle.Nodes("K" & objEO.BIType).Selected = True
            Else
                Me.treStyle.Nodes.Add Me.treStyle.SelectedItem.Parent.key, tvwChild, "K" & objEO.BIType, objEO.Caption
                Me.treStyle.Nodes("K" & objEO.BIType).Selected = True
            End If
            Me.treStyle.Nodes("K" & objEO.BIType).Image = 3
            NodeKey = "K" & objEO.BIType
            
            objEO.State = U8FDEso.esoInstance
            objEOS.Append objEO, "K" & objEO.BIType
            Set m_EO = objEOS.Item("K" & objEO.BIType)
            Set objEO = Nothing
        Else
            'MsgBox "保存不成功！"
            Exit Sub
        End If
    Else
        If FromBIType <> 0 And FromBIType <> mID(EO.Name, 3, 2) Then
            objEO.State = U8FDEso.esoAddNew
            If objVchDefBI.DeleteBIType(g_sDataSourceName, objEO.BIType) Then
                If objDataMgr.SaveEOMetaData(g_sDataSourceName, objEO, True) Then
                    objVchDefBI.CopyFields g_sDataSourceName, FromBIType, objEO.BIType
                    Set objVchDefBI = Nothing
                    'MsgBox "保存成功！"
                    
                    Me.treStyle.Nodes(NodeKey).Text = Me.txtVchStyle(1).Text
                    
                    objEOS.Delete "K" & objEO.BIType
                    objEO.State = U8FDEso.esoInstance
                    objEOS.Append objEO, "K" & objEO.BIType
                    Set m_EO = objEOS.Item("K" & objEO.BIType)
                    NodeKey = "K" & objEO.BIType
                    Me.treStyle.SelectedItem.key = NodeKey
                    Set objEO = Nothing
                End If
            Else
                'MsgBox "保存不成功！"
                Exit Sub
            End If
        Else
            objEO.State = U8FDEso.esoEdit
            If objDataMgr.SaveEOMetaData(g_sDataSourceName, objEO, True) Then
                Me.treStyle.Nodes(NodeKey).Text = Me.txtVchStyle(1).Text
                
                objEOS.Delete "K" & objEO.BIType
                objEO.State = U8FDEso.esoInstance