单据类型定义.frm

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

    AltDown = (Shift And vbAltMask) > 0
    CtrlDown = (Shift And vbCtrlMask) > 0
    
    Select Case KeyCode
        Case vbKeyF1
            SendKeys "{F1 3}"
        Case vbKeyF5
            If Me.tlbAction.Buttons("AddNew").Enabled Then
                AddNew
            End If
        Case vbKeyF8
            If Me.tlbAction.Buttons("Edit").Enabled Then
                Edit
            End If
        Case vbKeyDelete
            If Me.tlbAction.Buttons("Delete").Enabled Then
                Delete
            End If
        Case vbKeyF6
            If Me.tlbAction.Buttons("Save").Enabled Then
                Save
            End If
        Case vbKeyZ
            If CtrlDown And Me.tlbAction.Buttons("Cancel").Enabled Then
                CancelDo
            End If
        Case vbKeyP
            If CtrlDown And Me.tlbAction.Buttons("Print").Enabled Then
                If Not InitPrnGrid Then Exit Sub
                Print_Doc Me, "Print", TAB_UNITDEF
            End If
        Case vbKeyF4
            If CtrlDown Then
                Unload Me
            End If
    End Select
ErrHandler:
    Exit Sub
End Sub

Private Sub ocxCtbTool_OnCommand(ByVal enumType As prjTBCtrl.ENUM_MENU_OR_BUTTON, ByVal cButtonId As String, ByVal cMenuId As String)
    tlbAction_ButtonClick tlbAction.Buttons(cButtonId)
End Sub

Private Sub txtVchStyle_Change(Index As Integer)
'    If Index = 1 Then
'        Me.treStyle.Nodes(NodeKey).Text = Me.txtVchStyle(1).Text
'    End If
End Sub

Private Sub Form_Load()
    Dim IsRootageNode As Integer
    Dim objVchDefBI   As New U8FDBso.clsVchDefBI
    
    MSImageList_Initialize ilsTlb
    MSToolBar_Initialize tlbAction, "Print", TB_PRINT
    MSToolBar_Initialize tlbAction, "Preview", TB_PREVIEW
    MSToolBar_Initialize tlbAction, "Export", TB_Export
    MSToolBar_Initialize tlbAction, "AddNew", TB_AddNew
    MSToolBar_Initialize tlbAction, "Edit", TB_Edit
    MSToolBar_Initialize tlbAction, "Delete", TB_Delete
    MSToolBar_Initialize tlbAction, "Save", TB_Save
    MSToolBar_Initialize tlbAction, "Cancel", TB_Cancel
    MSToolBar_Initialize tlbAction, "Refresh", TB_Refresh
    MSToolBar_Initialize tlbAction, "Help", TB_HELP
    MSToolBar_Initialize tlbAction, "Exit", TB_EXIT
    
    Me.jkrTree.width = 100
    IsRootageNode = 0
    SetPrintDataStyleXML_flag = False

    Set objEOS = objVchDefBI.LoadVchEOs(g_sDataSourceName, True)
    Dim i As Integer
    '定义所有未使用的单据号
    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
        
        '如果单据号已经使用,设置为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
    
    Me.treStyle.LineStyle = tvwRootLines
    Me.treStyle.Style = tvwTreelinesPlusMinusPictureText
    Me.treStyle.LabelEdit = tvwManual
    Me.treStyle.Indentation = 300
    
    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
    
    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
    
    SetUI
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    Dim iAnswer As Long
    If EO.State = U8FDEso.esoEdit Or EO.State = U8FDEso.esoAddNew Then
        iAnswer = MsgBox("还有尚未保存的数据，保存吗？", vbQuestion + vbYesNoCancel)
        If iAnswer = vbYes Then
            Save
            Unload Me
        ElseIf iAnswer = vbNo Then
            m_EditStatus = True
            If m_EO.State = U8FDEso.esoEdit Then CancelDo
            m_EditStatus = False
            Unload Me
        ElseIf iAnswer = vbCancel Then
            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

Private Sub tlbAction_ButtonClick(ByVal Button As MSComctlLib.Button)
    Select Case Button.key
        Case "Print"
            PrintData
        Case "Preview"
            PrintView
        Case "Export"
            Export
'        Case "Print", "Preview", "Export"
'            If Not InitPrnGrid Then Exit Sub
'            Print_Doc Me, Button.key, TAB_UNITDEF
        Case "AddNew"
            AddNew
        Case "Edit"
            Edit
        Case "Delete"
            Delete
        Case "Save"
            Save
        Case "Cancel"
            CancelDo
        Case "Refresh"
            RefreshUI
        Case "Help"
'            Dim nRet As Integer
'            If Len(App.HelpFile) = 0 Then
'                MsgBox "不能找到帮助文件.", vbInformation, Me.Caption
'            Else
'                On Error Resume Next
'                nRet = WinHelp(Me.hwnd, App.HelpFile, 3, 0)
'                If Err Then
'                    MsgBox Err.Description
'                End If
'            End If
            SendKeys "{F1 3}"
        Case "Exit"
            Unload Me
    End Select
End Sub

Public Sub Gen_Key(TLB_Key As String)
    On Error Resume Next
    Select Case TLB_Key
        Case "Print", "Preview", "Dataout"
            If Not InitPrnGrid Then Exit Sub
            Print_Doc Me, TLB_Key, TAB_UNITDEF
    End Select
End Sub

Private Function InitPrnGrid() As Boolean
    InitPrnGrid = False
    With frmRightMenu.GrdPrn
        frmRightMenu.TabFlg = TAB_ACCDEF
        .Redraw = False
        .Cols = 3
        .FixedCols = 0
        .ColWidth(0) = 2000
        .ColWidth(1) = 800
        .ColWidth(2) = 3000
        
        Dim vt As Variant
        Dim rsl As New UfRecordset
        Dim SQL As String
        
        SQL = "select sCaption,sPzSign,sDescription from fd_entities where iVchType>0 order by iBIType"
        
        Set rsl = dbsZJ.OpenRecordset(SQL, dbOpenSnapshot)
        If rsl.EOF Then
            MsgBox "没有打印数据!", vbCritical, zjGl_Name
            Exit Function
        Else
            rsl.MoveLast
            rsl.MoveFirst
        End If
        Set vt = rsl.Recordset
        .Rows = 2
        .FixedRows = 2
        .BindRecordSet vt, False, True, True
        CloseRS rsl
        
        '初始化表头及对齐方式
        .TextMatrix(0, 0) = "单据类型"
        .ColAlignment(0) = UG_ALIGNLEFT
        .JoinCells 0, 0, 1, 0, True
        
        .TextMatrix(0, 1) = "凭证类别"
        .ColAlignment(1) = UG_ALIGNLEFT
        .JoinCells 0, 1, 1, 1, True
        
        .TextMatrix(0, 2) = "备注"
        .ColAlignment(2) = UG_ALIGNLEFT
        .JoinCells 0, 2, 1, 2, True
                
        .HeadForeColor = &H404040
        .HeadFont.Name = "宋体"
        .HeadFont.Size = 12
        .HeadFont.Bold = True
    End With
    InitPrnGrid = True
End Function

Private Sub treStyle_Collapse(ByVal Node As MSComctlLib.Node)
    Node.Image = 1
End Sub

Private Sub treStyle_Expand(ByVal Node As MSComctlLib.Node)
    Node.Image = 2
End Sub

Private Sub treStyle_LostFocus()
    If Me.treStyle.SelectedItem.key <> NodeKey Then
        Me.treStyle.Nodes(NodeKey).Selected = True
    End If
End Sub

Private Sub treStyle_NodeClick(ByVal Node As MSComctlLib.Node)
    Dim iAnswer As Long
    Dim objEO As New U8FDEso.EntityObject
    
    If NodeKey <> Node.key Then
        'If m_EO.State = esoEdit Or m_EO.State = esoAddNew Then
        If Me.picView.Enabled = True Then
            iAnswer = MsgBox("放弃当前工作吗?", vbQuestion + vbYesNo)
            If iAnswer = vbNo Then
                Me.treStyle.Nodes(NodeKey).Selected = True
                Me.picView.SetFocus
                Exit Sub
            Else
                m_EditStatus = True
                CancelDo
                m_EditStatus = False
                Me.picView.Enabled = False
                'Me.treStyle.Nodes(NodeKey).Text = objEOS.Item(NodeKey).Caption
            End If
        End If
    End If
    
    NodeKey = Node.key
    
    If Not IsNumeric(mID(NodeKey, 2)) Then
        Set EO = objEO
        Set objEO = Nothing
    Else
        Set EO = objEOS.Item(NodeKey)
    End If
    
    SetUI
End Sub

Private Function GetNewBIType() As Integer
    Dim VchType As Integer
    Dim TreeKey As String
    Dim i       As Integer

    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
            For i = 1 To 10