账户管理.frm

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

    Me.tlbAction.Buttons("Delete").Enabled = False

    IsGroup = False
    CreateSQL IsGroup
    
    Dim sql As String
    Dim objEO       As U8FDEso.EntityObject
    Dim objAccGrpBI As New U8FDBso.clsAccGrpBI
    
    Set objEO = objAccGrpBI.Init(g_sDataSourceName)
    
    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"))
    
    Set objAccGrpBI = Nothing
    Set objEO = Nothing
    
    With Adodc
       .ConnectionString = g_sDataSourceName
       .RecordSource = sql
    End With
    Me.msg.ColWidth(1) = 0
    'Me.msg.TextMatrix(1, 0)
    Set Me.msg.DataSource = Adodc
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.msg.Move Me.jkrTree.left + 50, Me.tlbAction.Height, Me.ScaleWidth - Me.jkrTree.left - 50, Me.ScaleHeight - Me.tlbAction.Height
    ResizeCtbTool Me, msg, 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.msg.left = Me.jkrTree.left + 50
    Me.msg.width = Me.ScaleWidth - Me.treStyle.width - 50
End Sub

Public Sub SetUI(Optional accdef_id As String)
    If IsEmpty(accdef_id) Then
        '----Set Value
        With msg
            .Cols = 11
            .Rows = 1
        End With
    End If
    
    treStyle_NodeClick Me.treStyle.SelectedItem
    
    Dim i As Integer
    
    For i = 1 To Me.msg.Rows
        If Me.msg.TextMatrix(i, 1) = accdef_id Then
            Me.msg.row = i: Me.msg.RowSel = i
            Me.msg.col = 0: Me.msg.ColSel = Me.msg.Cols - 1
            'Me.msg.BackColorSel = vbBlue
            'Me.msg.FocusRect = flexFocusHeavy
            Exit For
        End If
    Next
End Sub

Private Sub RecordShow(Optional ByVal EO As U8FDEso.EntityObject, Optional ByVal MoveMode As U8FDEso.MoveModeEnum = U8FDEso.esoLast)
    Dim objDataMgr  As New U8FDMgr.DataManager
    Dim objAccDefBI As New U8FDBso.clsAccDefBI
    
    If Not EO Is Nothing Then
        Set m_EO = objAccDefBI.MoveTo(g_sDataSourceName, MoveMode, m_conBIStyle, EO.OID)
    Else
        Set m_EO = objDataMgr.LoadEOMetaData(g_sDataSourceName, m_conBIStyle)
    End If
    SetUI
End Sub

Private Sub AddNew(ByVal ActiveCtl As Control)
    Dim AccountUI As New clsAccDefUI
    Dim AccGrpUI  As New clsAccGrpUI
    Dim OID       As New U8FDEso.OIDObject
    If Not ActiveCtl Is Nothing Then
        If ActiveCtl.Name = "treStyle" Then
            OID = Me.treStyle.SelectedItem.key
            AccGrpUI.Show g_sDataSourceName, smAddNew, OID
        ElseIf ActiveCtl.Name = "msg" Then
            If Me.treStyle.SelectedItem.key <> "K" And Me.treStyle.SelectedItem.children = 0 Then
                flag = True
            End If
            If msg.Rows > 0 Then
                If Me.msg.row > 0 Then
                    OID = Me.msg.TextMatrix(Me.msg.row, 1)
                    AccountUI.Show g_sDataSourceName, smAddNew, OID
                End If
            Else
                AccountUI.Show g_sDataSourceName, smAddNew
            End If
        End If
    End If
End Sub

Private Sub Edit(ByVal ActiveCtl As Control)
    Dim AccountUI As New clsAccDefUI
    Dim AccGrpUI  As New clsAccGrpUI
    Dim OID       As New U8FDEso.OIDObject
    If Not ActiveCtl Is Nothing Then
        If ActiveCtl.Name = "treStyle" Then
            OID = Me.treStyle.SelectedItem.key
            AccGrpUI.Show g_sDataSourceName, smEdit, OID
        ElseIf ActiveCtl.Name = "msg" And msg.Rows > 0 Then
            If Me.msg.row > 0 Then
                OID = Me.msg.TextMatrix(Me.msg.row, 1)
                AccountUI.Show g_sDataSourceName, smEdit, OID
            End If
        End If
    End If
End Sub

Private Sub Delete(ByVal ActiveCtl As Control)
    If Not ActiveCtl Is Nothing Then
        If ActiveCtl.Name = "treStyle" Then
            DeleteGrp Me.treStyle.SelectedItem.key
        ElseIf ActiveCtl.Name = "msg" And msg.Rows > 0 Then
            'If msg.Row = msg.RowSel Then
                DeleteAcc Me.msg.TextMatrix(Me.msg.row, 1)
            'End If
        End If
    End If
End Sub

Private Sub DeleteGrp(ByVal Node As String)
    If MsgBox("真的要删除当前记录吗？", vbQuestion + vbYesNo) = vbNo Then Exit Sub
    
    Dim objAccGrpBI As New U8FDBso.clsAccGrpBI
    Dim objEO       As U8FDEso.EntityObject
    Dim objOID      As New U8FDEso.OIDObject
    Dim objNode     As MsComctlLib.Node
    Dim ParentOID   As String
    
    On Error GoTo lblHandle
    
    If Me.treStyle.Nodes(Node).FirstSibling.key = Me.treStyle.Nodes(Node).root.key Then
        ParentOID = ""
    Else
        ParentOID = mID(Me.treStyle.Nodes(Node).Parent.key, 2, Len(Me.treStyle.Nodes(Node).Parent.key) - 0)
    End If
    
    objOID = mID(Node, 2)
    Set objEO = objAccGrpBI.MoveTo(g_sDataSourceName, U8FDEso.esoCurrent, , objOID)
    
    If objAccGrpBI.Delete(g_sDataSourceName, objEO) Then
        Me.treStyle.Nodes.Remove Me.treStyle.Nodes(Node).key
            
        '----移动到下一条记录
            
        objOID = mID(Node, 2)
        Set objEO = objAccGrpBI.MoveTo(g_sDataSourceName, U8FDEso.esoNext, , objOID, ParentOID)
        If Not objEO Is Nothing Then '主要看objAccGrpBI.MoveTo返回值是否为Nothing
            If Me.treStyle.Nodes.count > 1 Then
                If ParentOID <> "" Then
                    If Me.treStyle.Nodes("K" & ParentOID).children = 0 Then
                        Me.treStyle.Nodes("K" & ParentOID).Image = 3
                    End If
                End If
                Node = "K" & objEO(objEO.SourceOIDField)
                'Me.treStyle.Nodes(Node).Expanded = True
                Me.treStyle.Nodes(Node).Selected = True
                Set objOID = Nothing
            Else
                Set objEO = objAccGrpBI.Init(g_sDataSourceName, m_conBIStyle)
                Node = "K"
            End If
        Else
            Set objEO = objAccGrpBI.Init(g_sDataSourceName, m_conBIStyle)
            Node = "K"
        End If
    Else
        MsgBox "删除没有成功!"
    End If
    
    '----设置界面
    Set objNode = Me.treStyle.Nodes(Node)
    
    treStyle_NodeClick objNode
    
    Set objNode = Nothing
    Set objOID = Nothing
    Set objAccGrpBI = Nothing
    Set objEO = Nothing
    
    Exit Sub
lblHandle:
    MsgBox Err.Description, vbInformation, g_conSysName
End Sub

Private Sub DeleteAcc(ByVal accgrp_id As String)
    Dim i As Integer, BeginRow As Integer, EndRow As Integer
    Dim con As New adodb.Connection
    Dim sql As String
    Dim objEO       As U8FDEso.EntityObject
    Dim objAccGrpBI As New U8FDBso.clsAccGrpBI
    Dim objAccDefBI As New U8FDBso.clsAccDefBI

    Set objEO = objAccGrpBI.Init(g_sDataSourceName)
    
    If msg.row > msg.RowSel Then
        BeginRow = msg.RowSel
        EndRow = msg.row
    Else
        BeginRow = msg.row
        EndRow = msg.RowSel
    End If
    
    If Not objAccDefBI.IsUsed(g_sDataSourceName, accgrp_id) Then
        con.Open g_sDataSourceName
        If Me.treStyle.SelectedItem.key = "K" Then
            For i = BeginRow To EndRow
                EO(EO.SourceOIDField) = Me.msg.TextMatrix(i, 1)
                If Not objAccDefBI.Delete(g_sDataSourceName, EO) Then
                    MsgBox "删除不成功!", vbInformation, App.ProductName
                End If
            Next
        Else
            For i = BeginRow To EndRow
                sql = "Delete From fd_accgrplnk where " & EO.SourceOIDField & "='" & Me.msg.TextMatrix(i, 1) & "' and " & objEO.SourceOIDField & "='" & mID(Me.treStyle.SelectedItem.key, 2, Len(Me.treStyle.SelectedItem.key) - 1) & "'"
                con.Execute sql
            Next
        End If
    Else
        MsgBox "已经使用不能删除!", vbInformation, App.ProductName
    End If
    
    Set con = Nothing
    Set objAccDefBI = Nothing
    Set objAccGrpBI = Nothing
    Set objEO = Nothing
    
    RefreshUI 2
End Sub

Private Sub View(ByVal ActiveCtl As Control)
    Dim AccountUI As New clsAccDefUI
    Dim OID       As New U8FDEso.OIDObject
    If Not ActiveCtl Is Nothing Then
        If ActiveCtl.Name = "treStyle" Then
            MsgBox Me.treStyle.SelectedItem.key
        ElseIf ActiveCtl.Name = "msg" And msg.Rows > 0 Then
            If Me.msg.row > 0 Then
                OID = Me.msg.TextMatrix(Me.msg.row, 1)
                AccountUI.Show g_sDataSourceName, smView, OID
            End If
        End If
    End If
End Sub

Private Sub Grouping(ByVal ActiveCtl As Control)
    If Not ActiveCtl Is Nothing Then
        If ActiveCtl.Name = "treStyle" Then
            frmAccSel.NodeKey = Me.treStyle.SelectedItem.key
            frmAccSel.Show
        ElseIf ActiveCtl.Name = "msg" And msg.Rows > 0 Then
            If msg.row = msg.RowSel Then
                frmAccGrpLnk.NodeKey = Me.msg.TextMatrix(Me.msg.row, 1)
                frmAccGrpLnk.Show
            End If
        End If
    End If
End Sub

Public Sub RefreshUI(Optional Range As Integer = 0)
    Dim Node  As String
    Dim i     As Integer
    Dim oNode As MsComctlLib.Node
    
    Node = Me.treStyle.SelectedItem.key
    If Range = 0 Then
        Me.treStyle.Nodes.clear
        Me.treStyle.Nodes.Add , , "K", "未分组的账户号"
        Me.treStyle.Nodes("K").Image = 3
        CreateTree ""
        For i = 1 To Me.treStyle.Nodes.count
            If mID(Node, 1, Len(Node) - 1) = mID(Me.treStyle.Nodes(i).key, 1, Len(Me.treStyle.Nodes(i).key) - 1) Then
                Node = Me.treStyle.Nodes(i).key
                Exit For
            End If
        Next
        Me.treStyle.Nodes(Node).Selected = True
        
        Set oNode = Me.treStyle.Nodes(Node)
        treStyle_NodeClick oNode
        If LeftRight = 2 Then msg_Click
    ElseIf Range = 1 Then
        Me.treStyle.Nodes.clear
        Me.treStyle.Nodes.Add , , "K", "未分组的账户号"
        Me.treStyle.Nodes("K").Image = 3
        CreateTree ""
        For i = 1 To Me.treStyle.Nodes.count
            If mID(Node, 1, Len(Node) - 1) = mID(Me.treStyle.Nodes(i).key, 1, Len(Me.treStyle.Nodes(i).key) - 1) Then
                Node = Me.treStyle.Nodes(i).key
                Exit For
            End If
        Next
        Me.treStyle.Nodes(Node).Selected = True
    ElseIf Range = 2 Then
        Set oNode = Me.treStyle.Nodes(Node)
        treStyle_NodeClick oNode
        If LeftRight = 2 Then msg_Click
    End If
    SetTlbStyle Me, False: ocxCtbTool.RefreshEnable
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 = m_sql
    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