i-+

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

Public Property Get EO() As U8FDEso.EntityObject
    Set EO = m_EO
End Property

Public Property Set EO(NewEO As U8FDEso.EntityObject)
    Set m_EO = NewEO
End Property

Private Function FindOIDinNodes(ByVal Caption As String) As String
    Dim i As Integer
    For i = 1 To Me.treStyle.Nodes.count
        If Me.treStyle.Nodes(i).Text = Caption Then
            FindOIDinNodes = mID(Me.treStyle.Nodes(i).key, 2)
            Exit For
        End If
    Next
End Function

Private Sub cboParent_Click()
    'MsgBox Me.cboParent.ListIndex
End Sub

Private Sub cboParent_KeyUp(KeyCode As Integer, Shift As Integer)
    If KeyCode = vbKeyReturn Then
        SetEdtTxtFocus Me.txtAccGrp(3)
    End If
End Sub

Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)
    On Error GoTo ErrHandler
    Dim ShiftDown, AltDown, CtrlDown
    ShiftDown = (Shift And vbShiftMask) > 0
    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_CADSET
            End If
        Case vbKeyF4
            If CtrlDown Then
                Unload Me
            End If
    End Select
ErrHandler:
    Exit Sub
End Sub

Private Sub Form_Load()
    Dim objAccGrpBI  As New U8FDBso.clsAccGrpBI
    Dim objOID       As New U8FDEso.OIDObject

    Me.jkrTree.width = 100
    m_EditStatus = False
    
    Me.treStyle.LineStyle = tvwRootLines
    Me.treStyle.Style = tvwTreelinesPlusMinusPictureText
    Me.treStyle.LabelEdit = tvwManual
    Me.treStyle.Indentation = 300
    
    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.cboParent.AddItem ""
    SetPrintDataStyleXML_flag = False

    CreateTree ""
    
    If m_View = False Then
        If Me.treStyle.Nodes.count > 0 Then
            Me.treStyle.Nodes(1).Expanded = True
            If Me.treStyle.Nodes(1).children > 0 Then
                Me.treStyle.Nodes(1).Image = 2
            Else
                Me.treStyle.Nodes(1).Image = 3
            End If
            objOID = mID(Me.treStyle.Nodes(1).key, 2)
            Set EO = objAccGrpBI.MoveTo(g_sDataSourceName, U8FDEso.esoCurrent, m_conBIStyle, objOID)
            EO.OID.id = EO(m_EO.SourceOIDField)
            NodeKey = Me.treStyle.Nodes(1).key
        Else
            Set EO = objAccGrpBI.Init(g_sDataSourceName, m_conBIStyle)
        End If
    End If
    
    If NodeKey <> "" Then
        If Me.treStyle.Nodes(NodeKey).children = 0 Then
            Me.tlbAction.Buttons("Group").Enabled = True
        Else
            Me.tlbAction.Buttons("Group").Enabled = False
        End If
    End If
    
    Set objAccGrpBI = Nothing
    Set objOID = Nothing
    
    SetUI
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    Dim iAnswer As VbMsgBoxResult
    If EO.State = U8FDEso.esoEdit Or EO.State = U8FDEso.esoAddNew Then
        iAnswer = MsgBox("还有尚未保存的数据，保存吗？", vbQuestion + vbYesNoCancel)
        If iAnswer = vbNo Then
            m_EditStatus = True
            If m_EO.State = U8FDEso.esoEdit Then
                CancelDo
            ElseIf m_EO.State = U8FDEso.esoAddNew Then
                Dim objLockMgr  As New U8FDMgr.LockManager
                Dim objOID      As New U8FDEso.OIDObject
                objOID.id = "020000000000000"
                objLockMgr.UnlockIt g_sDataSourceName, objOID 'm_EO.OID
                Set objOID = Nothing
            End If
            m_EditStatus = False
            Unload Me
        ElseIf iAnswer = vbYes Then
            If Not Save Then Cancel = 1: Exit Sub
            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

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 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_CADSET
        Case "AddNew"
            AddNew
        Case "Edit"
            Edit
        Case "Delete"
            Delete
        Case "Save"
            Save
        Case "Cancel"
            CancelDo
        Case "Group"
            frmAccSel.NodeKey = Me.treStyle.SelectedItem.key
            frmAccSel.Show
        Case "Refresh"
            RefreshUI
        Case "Help"
            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_ACCDEF
    End Select
End Sub

Private Function InitPrnGrid() As Boolean
    InitPrnGrid = False
    With frmRightMenu.GrdPrn
        frmRightMenu.TabFlg = TAB_ACCDEF
        .Redraw = False
        .Cols = 4
        .FixedCols = 0
        .ColWidth(0) = 1000
        .ColWidth(1) = 1600
        .ColWidth(2) = 1000
        .ColWidth(3) = 1900
        
        Dim vt As Variant
        Dim rsl As New UfRecordset
        Dim SQL As String
        SQL = "select " & EO.SourceTable & "." & EO("accgrp_code").SourceField & "," & EO.SourceTable & "." & EO("accgrp_name").SourceField & "," & EO.SourceTable & "_1." & EO("accgrp_name").SourceField & " AS " & EO("accgrp_name").SourceField & "_1" & "," & EO.SourceTable & "." & EO("digest").SourceField & " from " & EO.SourceTable & " " & EO.SourceTable & "_1 RIGHT OUTER JOIN " & EO.SourceTable & " ON " & EO.SourceTable & "_1." & EO.SourceOIDField & "=" & EO.SourceTable & "." & EO("parent_id").SourceField
        
        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_ALIGNRIGHT
        .JoinCells 0, 2, 1, 2, True
                    
        .TextMatrix(0, 3) = "备注"
        .ColAlignment(3) = UG_ALIGNRIGHT
        .JoinCells 0, 3, 1, 3, True
                
        .HeadForeColor = &H404040
        .HeadFont.Name = "宋体"
        .HeadFont.Size = 9
        .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_NodeClick(ByVal Node As MSComctlLib.Node)
    Dim objAccGrpBI As New U8FDBso.clsAccGrpBI
    Dim objOID      As New U8FDEso.OIDObject
    Dim iAnswer     As VbMsgBoxResult
    Dim con         As New adodb.Connection
    Dim rs          As New adodb.Recordset
    Dim SQL         As String
    Dim objAccDefBI As New U8FDBso.clsAccDefBI
    Dim objEO       As U8FDEso.EntityObject
    
    If Me.treStyle.SelectedItem.children = 0 Then
        Me.tlbAction.Buttons("Group").Enabled = True
    Else
        Me.tlbAction.Buttons("Group").Enabled = False
    End If
    
    If NodeKey <> Node.key Then ' Or m_EO.State = esoAddNew
        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
            End If
        End If
                        
        NodeKey = Node.key
        
        objOID.id = mID(Node.key, 2)
        Set m_EO = objAccGrpBI.MoveTo(g_sDataSourceName, U8FDEso.esoCurrent, m_conBIStyle, objOID)
        
        Set objAccGrpBI = Nothing
        Set objOID = Nothing
        SetUI
    End If
    
    Set objEO = objAccDefBI.Init(g_sDataSourceName)
    Set objAccDefBI = Nothing
    If NodeKey <> "" And Me.tlbAction.Buttons("AddNew").Enabled = True Then
        con.Open g_sDataSourceName
        SQL = "Select " & objEO("accdef_id").SourceField & "," & objEO("accdef_code").SourceField & "," & objEO("accdef_name").SourceField & " from " & objEO.SourceTable & " where " & objEO("destroy_flag").SourceField & "=0 and " & objEO("accdef_id").SourceField & " in (Select " & objEO("accdef_id").SourceField & " from fd_accgrplnk where accgrp_id ='" & mID(NodeKey, 2, Len(NodeKey) - 1) & "') order by " & objEO("accdef_code").SourceField
        rs.Open SQL, con
        If Not rs.EOF Then
            Me.tlbAction.Buttons("AddNew").Enabled = False
        Else
            Me.tlbAction.Buttons("AddNew").Enabled = True
        End If
    End If
    Set rs = Nothing
    Set con = Nothing
    Set objEO = Nothing
End Sub

Public Sub AddNew()
    Dim oEO         As U8FDEso.EntityObject
    Dim objAccGrpBI As New U8FDBso.clsAccGrpBI
    Dim objLockMgr  As New U8FDMgr.LockManager