单位定义.frm

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

                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 Form_Load()
    Dim objAccUnitBI As New U8FDBso.clsAccUnitBI
    Dim objEO        As U8FDEso.EntityObject
    Dim objOID       As New U8FDEso.OIDObject
    
    Me.jkrTree.width = 100
    m_EditStatus = False
    
    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, "Import", TB_IMPORT
    MSToolBar_Initialize tlbAction, "Find", TB_FIND
    MSToolBar_Initialize tlbAction, "Help", TB_HELP
    MSToolBar_Initialize tlbAction, "Exit", TB_EXIT
    SetPrintDataStyleXML_flag = False
    
    cboType.AddItem "个人"
    cboType.AddItem "部门"
    cboType.AddItem "银行"
    cboType.AddItem "客户"
    cboType.AddItem "供应商"
    cboType.AddItem "项目"
    
    Me.treStyle.Nodes.Add , , "K0", "个人"
    Me.treStyle.Nodes.Add , , "K1", "部门"
    Me.treStyle.Nodes.Add , , "K2", "银行"
    Me.treStyle.Nodes.Add , , "K3", "客户"
    Me.treStyle.Nodes.Add , , "K4", "供应商"
    Me.treStyle.Nodes.Add , , "K5", "项目"
    
    Me.treStyle.LineStyle = tvwRootLines
    Me.treStyle.Style = tvwTreelinesPlusMinusPictureText
    Me.treStyle.LabelEdit = tvwManual
    Me.treStyle.Indentation = 300
    
    Set objEO = objAccUnitBI.MoveTo(g_sDataSourceName, U8FDEso.esoFirst, m_conBIStyle)
    
    Me.treStyle.Nodes("K0").Selected = True
    NodeKey = Me.treStyle.SelectedItem.key
    Set EO = objEO
    
    Dim i As Integer, RecordCount As Long
    
    RecordCount = objAccUnitBI.RecordCount(g_sDataSourceName, objEO)
    
    For i = 1 To RecordCount
        Me.treStyle.Nodes.Add "K" & objEO("type_flag"), tvwChild, "K" & objEO("type_flag") & objEO("accunit_id"), "【" & objEO("accunit_code") & "】" & objEO("accunit_name")
        objOID = objEO("accunit_id")
        Set objEO = objAccUnitBI.MoveTo(g_sDataSourceName, U8FDEso.esoNext, m_conBIStyle, objOID)
    Next
    
    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 = 0 To 5
        If Me.treStyle.Nodes(i + 1).children > 0 Then
            Me.treStyle.Nodes(i + 1).Expanded = True
            Me.treStyle.Nodes(i + 1).Image = 2
            Me.treStyle.Nodes(i + 1).child.Selected = True
            NodeKey = Me.treStyle.Nodes(i + 1).child.key
            objOID = mID(NodeKey, 3)
            Set EO = objAccUnitBI.MoveTo(g_sDataSourceName, U8FDEso.esoCurrent, m_conBIStyle, objOID)
            Exit For
        End If
    Next
    
    Set objAccUnitBI = Nothing
    Set objOID = Nothing
    Set objEO = Nothing
    
    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 = vbNo Then
            m_EditStatus = True
            If m_EO.State = U8FDEso.esoEdit Then CancelDo
            m_EditStatus = False
            Unload Me
        ElseIf iAnswer = vbYes Then
            Save
            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_UNITDEF
        Case "AddNew"
            AddNew
        Case "Edit"
            Edit
        Case "Delete"
            Delete
        Case "Save"
            Save
        Case "Cancel"
            CancelDo
        Case "Refresh"
            RefreshUI
        Case "Import"
            frmAccUnitImport.Show vbModal
        Case "Find"
            frmAccUnitFind.Show vbModal
        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_UNITDEF
        .Redraw = False
        .Cols = 4
        .FixedCols = 0
        .ColWidth(0) = 2000
        .ColWidth(1) = 5000
        .ColWidth(2) = 800
        .ColWidth(3) = 3000
        
        Dim vt As Variant
        Dim rsl As New UfRecordset
        Dim SQL As String
        
        SQL = "Select " & EO("accunit_code").SourceField & "," & EO("accunit_name").SourceField & "," & _
              "(Case When " & EO("type_flag").SourceField & "=0 Then '个人' Else " & _
                "(Case When " & EO("type_flag").SourceField & "=1 Then '部门' Else " & _
                  "(Case When " & EO("type_flag").SourceField & "=2 Then '银行' Else " & _
                    "(Case When " & EO("type_flag").SourceField & "=3 Then '客户' Else " & _
                      "(Case When " & EO("type_flag").SourceField & "=4 Then '供应商' Else '项目' END)" & _
                    " END)" & _
                  " END)" & _
                " END)" & _
              " END)" & _
              " As TypeName, " & EO("digest").SourceField & _
              " From " & EO.SourceTable & _
              " order by " & EO("type_flag").SourceField & "," & EO("accunit_code").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_ALIGNVCENTER
        .JoinCells 0, 2, 1, 2, True
                    
        .TextMatrix(0, 3) = "备注"
        .ColAlignment(3) = UG_ALIGNLEFT
        .JoinCells 0, 3, 1, 3, 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_NodeClick(ByVal Node As MSComctlLib.Node)
    Dim objAccUnitBI As New U8FDBso.clsAccUnitBI
    Dim objOID       As New U8FDEso.OIDObject
    Dim iAnswer      As Long

    If NodeKey <> Node.key 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
            End If
        End If
    End If

    NodeKey = Node.key

    cboType.ListIndex = mID(Node.key, 2, 1)
    objOID = mID(Node.key, 3)
    Set EO = objAccUnitBI.MoveTo(g_sDataSourceName, U8FDEso.esoCurrent, m_conBIStyle, objOID)
    
    NodeKey = Node.key
    
    Set objAccUnitBI = Nothing
    Set objOID = Nothing
    
    SetUI
End Sub

Public Sub AddNew()
    Dim objEO        As New U8FDEso.EntityObject
    Dim objAccUnitBI As New U8FDBso.clsAccUnitBI
    
    On Error GoTo lblHandle
    
    If Me.treStyle.SelectedItem.key <> NodeKey Then
        Me.treStyle.Nodes(NodeKey).Selected = True
    End If
    
    '申请权限
    
    '初始化实体对象
    Set objEO = objAccUnitBI.Init(g_sDataSourceName, m_conBIStyle)
    Set objAccUnitBI = Nothing
    
    '----用于备份
    If Not m_EO Is Nothing Then Set m_OldEO = m_EO.Clone(U8FDEso.esoStructureAndData)
    
    objEO.State = U8FDEso.esoAddNew
    Set m_EO = objEO
    
    Set objEO = Nothing
    
    SetUI
    
    Exit Sub
lblHandle:
    MsgBox Err.Description, vbInformation, g_conSysName
End Sub

Public Sub Edit(Optional OID As U8FDEso.OIDObject)
    Dim objLockMgr   As New U8FDMgr.LockManager

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

    '锁定实体对象
    m_EO.OID = mID(NodeKey, 3)
    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()
    Dim objAccUnitBI As New U8FDBso.clsAccUnitBI
    
    On Error GoTo lblHandle
    
    If Me.treStyle.SelectedItem.key <> NodeKey Then
        Me.treStyle.Nodes(NodeKey).Selected = True
    End If