账户管理.frm

用友u8财务源码,用visual basic开发

        End If
    End If
    LeftRight = 2
End Sub

Private Sub msg_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
    If Button = vbRightButton Then
        Me.PopupMenu frmRightMenu.mnuAccMgr
    End If
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_ACCDEF
        Case "Grouping"
            Grouping Me.ActiveControl
        Case "Find"
            frmAccFind.m_FromAccOrGrp = 1
            frmAccFind.Show vbModal
        Case "ColumnSet"
            frmAccSort.Show vbModal
        Case "AddNew"
            AddNew Me.ActiveControl
        Case "Edit"
            Edit Me.ActiveControl
        Case "Delete"
            Delete Me.ActiveControl
        Case "Refresh"
            RefreshUI
        Case "Help"
            SendKeys "{F1 3}"
        Case "Exit"
            Unload Me
    End Select
    If Button.key <> "Refresh" And Button.key <> "Exit" Then SetTlbStyle Me, False: ocxCtbTool.RefreshEnable
End Sub

Public Function InitPrnGrid() As Boolean
    Dim objUnitEO    As U8FDEso.EntityObject
    Dim objAccUnitBI As New U8FDBso.clsAccUnitBI
    Dim objAccGrpEO  As U8FDEso.EntityObject
    Dim objAccGrpBI  As New U8FDBso.clsAccGrpBI
    
    Set objUnitEO = objAccUnitBI.Init(g_sDataSourceName)
    Set objAccGrpEO = objAccGrpBI.Init(g_sDataSourceName)
    Set objAccUnitBI = Nothing
    Set objAccGrpBI = Nothing
    
    InitPrnGrid = False
    With frmRightMenu.GrdPrn
        frmRightMenu.TabFlg = TAB_ACCDEF
        .Redraw = False
        .Cols = 12
        .FixedCols = 0
        .ColWidth(0) = 2205
        .ColWidth(1) = 2445
        .ColWidth(2) = 2445
        .ColWidth(3) = 990
        .ColWidth(4) = 990
        .ColWidth(5) = 705
        .ColWidth(6) = 705
        .ColWidth(7) = 705
        .ColWidth(8) = 705
        .ColWidth(9) = 1335
        .ColWidth(10) = 2635
        .ColWidth(11) = 1335
        .ColWidth(12) = 2635
        .ColWidth(13) = 1450
        .ColWidth(14) = 1450
        .ColWidth(15) = 705
        .ColWidth(16) = 705
        .ColWidth(17) = 705
        .ColWidth(18) = 705
        .ColWidth(19) = 3000
        
        Dim vt As Variant
        Dim rsl As New UfRecordset
        Dim sql As String
        Dim SqlTemp As String
        
        sql = "Select " & objUnitEO.SourceTable & "." & objUnitEO("accunit_name").SourceField & "," & EO("accdef_code").SourceField & "," & EO("accdef_name").SourceField & "," & EO("irate_code").SourceField & "," & EO("cad_code").SourceField & "," & EO("io_flag").SourceField & "," & EO.SourceTable & "." & EO("type_flag").SourceField & "," & EO("datasrc_flag").SourceField & "," & EO("money_name").SourceField & "," & EO("qcye_mny").SourceField & "," & EO("qcye_natural_mny").SourceField & "," & EO("qcjs_mny").SourceField & "," & EO("qcjs_natural_mny").SourceField & "," & EO("open_date").SourceField & "," & EO("accbank").SourceField & _
             "," & EO("freeze_flag").SourceField & "," & EO("destroy_flag").SourceField & "," & EO("deficit_flag").SourceField & "," & EO("yt_flag").SourceField & "," & EO.SourceTable & "." & EO("digest").SourceField & " from " & EO.SourceTable & "," & objUnitEO.SourceTable & " where " & EO("destroy_flag").SourceField & "=0 and " & EO.SourceTable & "." & EO("accunit_id").SourceField & "=" & objUnitEO.SourceTable & "." & objUnitEO("accunit_id").SourceField
        If Me.treStyle.SelectedItem.key = "K" Then
            sql = sql & " and " & EO.SourceOIDField & " not in (select " & EO.SourceOIDField & " from fd_accgrplnk)"
        ElseIf Me.treStyle.SelectedItem.children = 0 Then
            sql = mID(sql, 1, InStr(1, sql, "where") - 2) & ",fd_accgrplnk " & mID(sql, InStr(1, sql, "where"), 5) & " fd_accgrplnk." & objAccGrpEO.SourceOIDField & "='" & mID(Me.treStyle.SelectedItem.key, 2, Len(Me.treStyle.SelectedItem.key) - 1) & "'" & " and fd_accgrplnk." & EO.SourceOIDField & "=" & EO.SourceTable & "." & EO.SourceOIDField & " and " & mID(sql, InStr(1, sql, "where") + 6)
        Else
            sql = sql & " and 0=1"
        End If
        sql = sql & " order by " & objUnitEO.SourceTable & "." & objUnitEO("type_flag").SourceField & "," & EO.SourceTable & "." & EO("accunit_code").SourceField & "," & EO.SourceTable & "." & EO("accdef_code").SourceField
        Set objUnitEO = Nothing
        Set objAccGrpEO = Nothing
        
        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
                    
        .TextMatrix(0, 3) = "利率代码"
        .ColAlignment(3) = UG_ALIGNLEFT
        .JoinCells 0, 3, 1, 3, True
        
        .TextMatrix(0, 4) = "结息日"
        .ColAlignment(4) = UG_ALIGNLEFT
        .JoinCells 0, 4, 1, 4, True
        
        .TextMatrix(0, 5) = "类型"
        .ColAlignment(5) = UG_ALIGNCENTER
        .JoinCells 0, 5, 1, 5, True
        
        .TextMatrix(0, 6) = "标志"
        .ColAlignment(6) = UG_ALIGNCENTER
        .JoinCells 0, 6, 1, 6, True
        
        .TextMatrix(0, 7) = "数据源"
        .ColAlignment(7) = UG_ALIGNCENTER
        .JoinCells 0, 7, 1, 7, True
    
        .TextMatrix(0, 8) = "币别"
        .ColAlignment(8) = UG_ALIGNCENTER
        .JoinCells 0, 8, 1, 8, True
        
        .TextMatrix(0, 9) = "期初余额"
        .ColAlignment(9) = UG_ALIGNRIGHT
        .JoinCells 0, 9, 1, 9, True
        
        .TextMatrix(0, 10) = "期初本位币余额"
        .ColAlignment(10) = UG_ALIGNRIGHT
        .JoinCells 0, 10, 1, 10, True
    
        .TextMatrix(0, 11) = "期初积数"
        .ColAlignment(11) = UG_ALIGNRIGHT
        .JoinCells 0, 11, 1, 11, True
        
        .TextMatrix(0, 12) = "期初本位币积数"
        .ColAlignment(12) = UG_ALIGNRIGHT
        .JoinCells 0, 12, 1, 12, True
        
        .TextMatrix(0, 13) = "开户日期"
        .ColAlignment(13) = UG_ALIGNRIGHT
        .JoinCells 0, 13, 1, 13, True
        
        .TextMatrix(0, 14) = "开户银行"
        .ColAlignment(14) = UG_ALIGNRIGHT
        .JoinCells 0, 14, 1, 14, True
        
        .TextMatrix(0, 15) = "冻结"
        .ColAlignment(15) = UG_ALIGNRIGHT
        .JoinCells 0, 15, 1, 15, True
    
        .TextMatrix(0, 16) = "销户"
        .ColAlignment(16) = UG_ALIGNRIGHT
        .JoinCells 0, 16, 1, 16, True
    
        .TextMatrix(0, 17) = "赤字控制"
        .ColAlignment(17) = UG_ALIGNRIGHT
        .JoinCells 0, 17, 1, 17, True
    
        .TextMatrix(0, 18) = "预提利息"
        .ColAlignment(18) = UG_ALIGNRIGHT
        .JoinCells 0, 18, 1, 18, True
        
        .TextMatrix(0, 19) = "备注"
        .ColAlignment(19) = UG_ALIGNRIGHT
        .JoinCells 0, 19, 1, 19, True
        
        .HeadForeColor = &H404040
        .HeadFont.Name = "宋体"
        .HeadFont.Size = 9
        .HeadFont.Bold = True
    End With
    InitPrnGrid = True
End Function

Private Sub treStyle_Click()
    If Me.treStyle.SelectedItem.key = "K" Then
        Me.tlbAction.Buttons("Grouping").Enabled = False
        Me.tlbAction.Buttons("AddNew").Enabled = False
        Me.tlbAction.Buttons("Edit").Enabled = False
        Me.tlbAction.Buttons("Delete").Enabled = False
    ElseIf Me.treStyle.SelectedItem.children = 0 Then
        Me.tlbAction.Buttons("Grouping").Enabled = True
        If Me.msg.Rows > 0 Then
            Me.tlbAction.Buttons("AddNew").Enabled = False
        Else
            Me.tlbAction.Buttons("AddNew").Enabled = True
        End If
        Me.tlbAction.Buttons("Edit").Enabled = True
        Me.tlbAction.Buttons("Delete").Enabled = True
    Else
        Me.tlbAction.Buttons("Grouping").Enabled = False
        Me.tlbAction.Buttons("AddNew").Enabled = True
        Me.tlbAction.Buttons("Edit").Enabled = True
        Me.tlbAction.Buttons("Delete").Enabled = True
    End If
    SetTlbStyle Me, False: ocxCtbTool.RefreshEnable
End Sub

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_GotFocus()
    LeftRight = 1
End Sub

Private Sub treStyle_NodeClick(ByVal Node As MsComctlLib.Node)
    Dim sql As String
    Dim i As Integer
    Dim objEO       As U8FDEso.EntityObject
    Dim objAccGrpBI As New U8FDBso.clsAccGrpBI
    
    Set objEO = objAccGrpBI.Init(g_sDataSourceName)
    
    If Me.treStyle.Nodes(Node.key).children = 0 Then
        'RecordShow Me.EO, esoLast
    End If
    
    msg.HighLight = flexHighlightWithFocus
    msg.Rows = 0
    If Node.key = "K" Then
        Me.tlbAction.Buttons("Grouping").Enabled = False
        Me.tlbAction.Buttons("AddNew").Enabled = False
        Me.tlbAction.Buttons("Edit").Enabled = False
        Me.tlbAction.Buttons("Delete").Enabled = False
        
        IsGroup = False
        CreateSQL IsGroup
        sql = mID(m_sql, 1, InStr(1, m_sql, "order") - 1) & "and " & EO.SourceTable & "." & EO.SourceOIDField & " not in (select " & EO.SourceOIDField & " from fd_accgrplnk) " & mID(m_sql, InStr(1, m_sql, "order"))
        With Adodc
           .ConnectionString = g_sDataSourceName
           .RecordSource = sql
        End With
        Adodc.Refresh
        If Adodc.Recordset.EOF Then
            msg.Rows = 2
            msg.FixedRows = 1
        Else
            msg.Rows = Adodc.Recordset.RecordCount + 1
            msg.FixedRows = 1
        End If
        Me.msg.ColWidth(1) = 0
        Set msg.DataSource = Adodc
    ElseIf Me.treStyle.Nodes(Node.key).children = 0 Then
        Me.tlbAction.Buttons("Grouping").Enabled = True
        Me.tlbAction.Buttons("AddNew").Enabled = True
        Me.tlbAction.Buttons("Edit").Enabled = True
        Me.tlbAction.Buttons("Delete").Enabled = True
        
        IsGroup = True
        CreateSQL IsGroup
        sql = mID(m_sql, 1, InStr(1, m_sql, "order") - 1) & "and fd_accgrp.accgrp_id='" & mID(Node.key, 2, Len(Node.key) - 1) & "' " & mID(m_sql, InStr(1, m_sql, "order"))
        With Adodc
           .ConnectionString = g_sDataSourceName
           .RecordSource = sql
        End With
        Adodc.Refresh
        If Adodc.Recordset.EOF Then
            msg.Rows = 2
            msg.FixedRows = 1
        Else
            msg.Rows = Adodc.Recordset.RecordCount + 1
            msg.FixedRows = 1
        End If
        Me.msg.ColWidth(1) = 0
        'Me.msg.TextMatrix(0, 0)
        Set msg.DataSource = Adodc
    Else
        Me.tlbAction.Buttons("Grouping").Enabled = False
        Me.tlbAction.Buttons("AddNew").Enabled = True
        Me.tlbAction.Buttons("Edit").Enabled = True
        Me.tlbAction.Buttons("Delete").Enabled = True
        
        IsGroup = True
        CreateSQL IsGroup
        sql = mID(m_sql, 1, InStr(1, m_sql, "order") - 1) & "and fd_accgrp.parent_id='" & mID(Node.key, 2, Len(Node.key) - 1) & "' " & mID(m_sql, InStr(1, m_sql, "order"))
        With Adodc
           .ConnectionString = g_sDataSourceName
           .RecordSource = sql
        End With
        Adodc.Refresh
        If Adodc.Recordset.EOF Then
            msg.Rows = 2
            msg.FixedRows = 1
        Else
            msg.Rows = Adodc.Recordset.RecordCount + 1
            msg.FixedRows = 1
        End If
        Me.msg.ColWidth(1) = 0
        'Me.msg.TextMatrix(0, 0)
        Set msg.DataSource = Adodc
    End If
    
    Set objAccGrpBI = Nothing
    Set objEO = Nothing
    'LeftRight = 1
End Sub

Private Sub Form_Load()
    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, "Refresh", TB_Refresh
    MSToolBar_Initialize tlbAction, "Find", TB_FIND
    MSToolBar_Initialize tlbAction, "ColumnSet", TB_ColumnSet
    MSToolBar_Initialize tlbAction, "Help", TB_HELP
    MSToolBar_Initialize tlbAction, "Exit", TB_EXIT
    MSToolBar_Initialize tlbAction, "Grouping", TB_Grouping
    
    Me.jkrTree.width = 100
    SetPrintDataStyleXML_flag = False
    
    Me.treStyle.LineStyle = tvwRootLines
    Me.treStyle.Style = tvwTreelinesPlusMinusPictureText
    Me.treStyle.LabelEdit = tvwManual
    Me.treStyle.Indentation = 300
    
    Me.treStyle.Nodes.Add , , "K", "未分组的账户号"
    Me.treStyle.Nodes("K").Image = 3
    Me.treStyle.Nodes("K").Selected = True
    CreateTree ""
    Me.tlbAction.Buttons("Grouping").Enabled = False
    Me.tlbAction.Buttons("AddNew").Enabled = False
    Me.tlbAction.Buttons("Edit").Enabled = False