单据类型定义.frm

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

                objEOS.Append objEO, "K" & objEO.BIType
                Set m_EO = objEOS.Item("K" & objEO.BIType)
                Set objEO = Nothing
            End If
        End If
    End If
    
    Set objDataMgr = Nothing
    
    m_EO.State = U8FDEso.esoInstance
    
    '----设置界面(值和状态)
    SetUI
    
    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 objLockMgr  As New U8FDMgr.LockManager
        
    On Error GoTo lblHandle
    '----State 若为 esoEdit, 解锁
    'If m_EO.State = esoEdit Then
    '    objLockMgr.UnlockIt g_sDataSourceName, m_EO.OID
    'End If
    'Set objLockMgr = Nothing
    
    '----恢复原实体对象
    objEOS.Item(NodeKey).State = U8FDEso.esoInstance
    
    If Not m_OldEO Is Nothing Then
        Set m_EO = m_OldEO.Clone(U8FDEso.esoStructureAndData)
    Else
        Set m_EO = objEOS.Item(NodeKey)
    End If
    
    '----设置界面
    SetUI
    
    Exit Sub
lblHandle:
    MsgBox Err.Description, vbInformation, g_conSysName
End Sub

Private Sub RefreshUI()
    Dim NodeFlag    As Boolean
    Dim SelectText  As String
    Dim i           As Integer
    
    SelectText = Me.treStyle.SelectedItem.Text
    Me.treStyle.Nodes.clear
    
    Dim IsRootageNode As Integer
    Dim objVchDefBI   As New U8FDBso.clsVchDefBI
    
    Me.jkrTree.width = 100
    IsRootageNode = 0
    
    Set objEOS = Nothing
    
    Set objEOS = objVchDefBI.LoadVchEOs(g_sDataSourceName, True)
    '定义所有未使用的单据号
    For i = 1 To 43 '43为固定的单据子节点总数
        If i < 11 Then
            key(i) = 10 + 0 + i '10为起点(起点应为11,因为i从1开始,所以这里为10),0为本节点下固定的子节点数
        ElseIf i < 13 Then
            key(i) = 20 + 8 + i - 10 '20为起点,8为本节点下固定的子节点数,10(11-1)是为了与数组索引对齐,以下类推
        ElseIf i < 19 Then
            key(i) = 30 + 4 + i - 12
        ElseIf i < 23 Then
            key(i) = 40 + 6 + i - 18
        ElseIf i < 28 Then
            key(i) = 50 + 5 + i - 22
        ElseIf i < 34 Then
            key(i) = 60 + 4 + i - 27
        ElseIf i < 44 Then
            key(i) = 70 + 0 + i - 33 '这一列为公用单据号71-80
        End If
    Next
    For i = 1 To objEOS.count
        Set m_EO = objEOS.Item(i)
        If left$(Me.EO.VchType, 1) = "1" Then
            If IsRootageNode <= 0 Then IsRootageNode = 1
            If IsRootageNode = 1 Then Me.treStyle.Nodes.Add , , "Contract", "合同": IsRootageNode = 2
            Me.treStyle.Nodes.Add "Contract", tvwChild, "K" & Me.EO.BIType, Me.EO.Caption
        ElseIf left$(Me.EO.VchType, 1) = "2" Then
            If IsRootageNode <= 2 Then IsRootageNode = 3
            If IsRootageNode = 3 Then Me.treStyle.Nodes.Add , , "Settle", "结算": IsRootageNode = 4
            Me.treStyle.Nodes.Add "Settle", tvwChild, "K" & Me.EO.BIType, Me.EO.Caption
        ElseIf left$(Me.EO.VchType, 1) = "3" Then
            If IsRootageNode <= 4 Then IsRootageNode = 5
            If IsRootageNode = 5 Then Me.treStyle.Nodes.Add , , "Fix", "定期存取款": IsRootageNode = 6
            Me.treStyle.Nodes.Add "Fix", tvwChild, "K" & Me.EO.BIType, Me.EO.Caption
        ElseIf left$(Me.EO.VchType, 1) = "4" Then
            If IsRootageNode <= 6 Then IsRootageNode = 7
            If IsRootageNode = 7 Then Me.treStyle.Nodes.Add , , "Loan", "贷还款": IsRootageNode = 8
            Me.treStyle.Nodes.Add "Loan", tvwChild, "K" & Me.EO.BIType, Me.EO.Caption
        ElseIf left$(Me.EO.VchType, 1) = "5" Then
            If IsRootageNode <= 8 Then IsRootageNode = 9
            If IsRootageNode = 9 Then Me.treStyle.Nodes.Add , , "Accrual", "利息": IsRootageNode = 10
            Me.treStyle.Nodes.Add "Accrual", tvwChild, "K" & Me.EO.BIType, Me.EO.Caption
        ElseIf left$(Me.EO.VchType, 1) = "6" Then
            If IsRootageNode <= 10 Then IsRootageNode = 11
            If IsRootageNode = 11 Then Me.treStyle.Nodes.Add , , "Else", "其它": IsRootageNode = 12
            Me.treStyle.Nodes.Add "Else", tvwChild, "K" & Me.EO.BIType, Me.EO.Caption
        End If
        If SelectText = Me.EO.Caption Then NodeFlag = True
        
        '如果单据号已经使用,设置为0
        If CInt(Me.EO.BIType) >= 11 And CInt(Me.EO.BIType) <= 20 Then
            key(Me.EO.BIType - (20 - 10)) = 0
        End If
        If CInt(Me.EO.BIType) >= 29 And CInt(Me.EO.BIType) <= 30 Then
            key(Me.EO.BIType - (30 - 12)) = 0
        End If
        If CInt(Me.EO.BIType) >= 35 And CInt(Me.EO.BIType) <= 40 Then
            key(Me.EO.BIType - (40 - 18)) = 0
        End If
        If CInt(Me.EO.BIType) >= 47 And CInt(Me.EO.BIType) <= 50 Then
            key(Me.EO.BIType - (50 - 22)) = 0
        End If
        If CInt(Me.EO.BIType) >= 56 And CInt(Me.EO.BIType) <= 60 Then
            key(Me.EO.BIType - (60 - 27)) = 0
        End If
        If CInt(Me.EO.BIType) >= 65 And CInt(Me.EO.BIType) <= 70 Then
            key(Me.EO.BIType - (70 - 33)) = 0
        End If
        If CInt(Me.EO.BIType) >= 71 And CInt(Me.EO.BIType) <= 80 Then
            key(Me.EO.BIType - (80 - 43)) = 0
        End If
    Next
    
    m_EditStatus = False
    
    For i = 1 To treStyle.Nodes.count
        If treStyle.Nodes(i).children > 0 Then
            treStyle.Nodes(i).Image = 1
        Else
            treStyle.Nodes(i).Image = 3
        End If
    Next
    
    If NodeFlag Then
        Me.treStyle.Nodes(NodeKey).Selected = True
        Me.treStyle.Nodes(NodeKey).Expanded = True
        If Me.treStyle.Nodes(NodeKey).children > 0 Then Me.treStyle.Nodes(NodeKey).Image = 2
        Set EO = objEOS.Item(NodeKey)
    Else
        For i = 1 To 5
            If Me.treStyle.Nodes(i).children > 0 Then
                Me.treStyle.Nodes(i).Expanded = True
                Me.treStyle.Nodes(i).Image = 2
                Me.treStyle.Nodes(i).child.Selected = True
                NodeKey = Me.treStyle.Nodes(i).child.key
                Set EO = objEOS.Item(NodeKey)
                Exit For
            End If
        Next
    End If
    
    SetUI
End Sub

Private Sub SetUI()
    Dim i As Integer
    Dim NodeTemp As MSComctlLib.Node
    '----Set Status
    Select Case m_EO.State
        Case U8FDEso.esoAddNew
            Me.tlbAction.Buttons("AddNew").Enabled = False
            Me.tlbAction.Buttons("Edit").Enabled = False
            Me.tlbAction.Buttons("Delete").Enabled = False
            Me.tlbAction.Buttons("Save").Enabled = True
            Me.tlbAction.Buttons("Cancel").Enabled = True
            Me.picView.Enabled = True
            Me.lblBIType.Visible = True
            Me.cboBIType.Visible = True
            Me.cboBIType.clear
            
            Set NodeTemp = Me.treStyle.Nodes(NodeKey).Parent.child
            For i = 1 To Me.treStyle.Nodes(NodeKey).Parent.children
                Me.cboBIType.AddItem NodeTemp.Text
                Set NodeTemp = NodeTemp.Next
            Next
            Set NodeTemp = Nothing
            
            'Me.cboBIType.ListIndex = 0
            Me.cboBIType.Text = Me.treStyle.SelectedItem.Text
        Case U8FDEso.esoEdit
            Me.tlbAction.Buttons("AddNew").Enabled = False
            Me.tlbAction.Buttons("Edit").Enabled = False
            Me.tlbAction.Buttons("Delete").Enabled = False
            Me.tlbAction.Buttons("Save").Enabled = True
            Me.tlbAction.Buttons("Cancel").Enabled = True
            Me.picView.Enabled = True
            If EO.DeriveBIType > 0 Then
                Me.lblBIType.Visible = True
                Me.cboBIType.Visible = True
                Me.cboBIType.clear
                
                Set NodeTemp = Me.treStyle.Nodes(NodeKey).Parent.child
                For i = 1 To Me.treStyle.Nodes(NodeKey).Parent.children
                    If NodeTemp.Text <> Me.treStyle.SelectedItem.Text Then Me.cboBIType.AddItem NodeTemp.Text
                    Set NodeTemp = NodeTemp.Next
                Next
                Set NodeTemp = Nothing
                
                'Me.cboBIType.ListIndex = 0
                Me.cboBIType.Text = Me.treStyle.Nodes("K" & mID(EO.Name, 3, 2)).Text
            Else
                Me.lblBIType.Visible = False
                Me.cboBIType.Visible = False
                Me.cboBIType.clear
                Me.cboBIType.AddItem ""
                Me.cboBIType.ListIndex = Me.cboBIType.ListCount - 1
            End If
        Case U8FDEso.esoInstance
            Me.tlbAction.Buttons("AddNew").Enabled = True
            Me.tlbAction.Buttons("Edit").Enabled = True
            If IsNumeric(mID(Me.treStyle.SelectedItem.key, 2)) Then
                Me.tlbAction.Buttons("Delete").Enabled = True
            Else
                Me.tlbAction.Buttons("Delete").Enabled = False
            End If
            Me.tlbAction.Buttons("Save").Enabled = False
            Me.tlbAction.Buttons("Cancel").Enabled = False
            Me.picView.Enabled = False
            Me.lblBIType.Visible = False
            Me.cboBIType.Visible = False
        Case U8FDEso.esoInitialized
            Me.tlbAction.Buttons("AddNew").Enabled = False
            Me.tlbAction.Buttons("Edit").Enabled = False
            Me.tlbAction.Buttons("Delete").Enabled = False
            Me.tlbAction.Buttons("Save").Enabled = False
            Me.tlbAction.Buttons("Cancel").Enabled = False
            Me.picView.Enabled = False
            Me.lblBIType.Visible = False
            Me.cboBIType.Visible = False
    End Select
    
    '----Set Value
    With m_EO
        Me.txtVchStyle(0).Property = EditId
        Me.txtVchStyle(0).MaxLength = 2 ' .Fields("ID").Length
        
        Me.txtVchStyle(1).Property = EditNormal
        Me.txtVchStyle(1).MaxLength = 25 ' .Fields("Caption").Length
        
        Me.txtVchStyle(2).Property = EditNormal
        Me.txtVchStyle(2).MaxLength = 8 ' .Fields("PzSign").Length
        
        Me.txtVchStyle(3).Property = EditNormal
        Me.txtVchStyle(3).MaxLength = 255 ' .Fields("Description").Length
        
        If m_EO.State = U8FDEso.esoInitialized Then
            Me.txtVchStyle(0).Text = ""
            Me.txtVchStyle(1).Text = ""
            Me.txtVchStyle(2).Text = ""
            Me.txtVchStyle(3).Text = ""
            Me.chkUse.Value = 0
        ElseIf m_EO.State = U8FDEso.esoAddNew Then
            Me.txtVchStyle(0).Text = GetNewBIType
            Me.txtVchStyle(1).Text = ""
            Me.txtVchStyle(2).Text = ""
            Me.txtVchStyle(3).Text = ""
            Me.chkUse.Value = 1
        Else
            Me.txtVchStyle(0).Text = EO.id
            Me.txtVchStyle(1).Text = EO.Caption
            Me.txtVchStyle(2).Text = EO.PzSign
            Me.txtVchStyle(3).Text = EO.Description
            If EO.IsUsed Then
                Me.chkUse.Value = 1
            Else
                Me.chkUse.Value = 0
            End If
            'Me.txtVchStyle(0).Text = IIf(IsNull(.Fields("ID")), "", .Fields("ID"))
            'Me.txtVchStyle(1).Text = IIf(IsNull(.Fields("Caption")), "", .Fields("Caption"))
            'Me.txtVchStyle(2).Text = IIf(IsNull(.Fields("PzSign")), "", .Fields("PzSign"))
            'Me.txtVchStyle(3).Text = IIf(IsNull(.Fields("Description")), "", .Fields("Description"))
            'Me.chkUse.Value = IIf(IsNull(.Fields("IsUsed")), 0, CByte(.Fields("IsUsed")) / 255)
        End If
    End With
    SetTlbStyle Me, False
    ocxCtbTool.RefreshEnable
End Sub

Private Sub txtVchStyle_CustKeyDown(Index As Integer, ByVal key As EDITLib.KeyTypes)
    Select Case Index
        Case 1
            If key = KeyDown Or key = KeyRet Then
                SetEdtTxtFocus Me.txtVchStyle(2)
            ElseIf key = KeyUp Then
                SetEdtTxtFocus Me.txtVchStyle(3)
            End If
        Case 2
            If key = KeyDown Or key = KeyRet Then
                SetEdtTxtFocus Me.txtVchStyle(3)
            ElseIf key = KeyUp Then
                SetEdtTxtFocus Me.txtVchStyle(1)
            End If
        Case 3
            If key = KeyDown Or key = KeyRet Then
                'SetEdtTxtFocus Me.txtVchStyle(0)
                Save
            ElseIf key = KeyUp Then
                SetEdtTxtFocus Me.txtVchStyle(2)
            End If
    End Select
End Sub

Private Sub txtVchStyle_KeyUp(Index As Integer, KeyCode As Integer, Shift As Integer)
    If Index = 2 And KeyCode = 113 Then 'F2
        cmdVch_Click
    End If
End Sub

Private Sub txtVchStyle_LostFocus(Index As Integer)
    If Index = 2 Then
        If Me.ActiveControl.Name = "cmdVch" Then
            Exit Sub
        End If
        If Me.txtVchStyle(2).Text <> "" Then
            If Not PzSign(Me.txtVchStyle(2).Text) Then
                MsgBox "凭证类别不存在！", vbInformation, App.ProductName
                Me.txtVchStyle(2).Text = ""
            End If
        End If
    End If
End Sub

Private Sub PrintData()
    If SetPrintDataStyleXML_flag = False Then SetPrintDataStyleXML
    frmRightMenu.ocxPrint.DoPrint
End Sub

Private Sub PrintView()
    If SetPrintDataStyleXML_flag = False Then SetPrintDataStyleXML
    frmRightMenu.ocxPrint.PrintPreview
End Sub

Private Sub Export()
    If SetPrintDataStyleXML_flag = False Then SetPrintDataStyleXML
    frmRightMenu.ocxPrint.ExportToFile 0, PrintTypeList, PrintSizeList, "", ""
End Sub

Public Sub SetPrintDataStyleXML()
    Dim lRet        As Long
    Dim sData       As String
    Dim sStyle      As String
    Dim sModuleId   As String
    Dim SQL         As String
    
    On Error GoTo lblHandle
    
    SQL = "select sCaption as 单据名称,sPzSign as 凭证类别,sDescription as 说明 from fd_entities where iVchType>0 order by iBIType"
    
    sData = SetPrintDataXML(SQL, "单据类型定义", PrintTypeList, PrintSizeList)
    sStyle = SetPrintStyleXML("")
    sModuleId = "Default"
    
    lRet = frmRightMenu.ocxPrint.SetDataStyleXML(sData, False, sStyle, False, sModuleId)
    If lRet <> 0 Then
        MsgBox "打印数据格式设置失败！", vbInformation, App.ProductName
        SetPrintDataStyleXML_flag = False
    End If
    
    SetPrintDataStyleXML_flag = True
    Exit Sub
lblHandle:
    SetPrintDataStyleXML_flag = False
    MsgBox "打印数据格式设置失败！", vbInformation, App.ProductName
End Sub