i-+

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

Private Sub RefreshUI()
    Dim objAccGrpBI  As New U8FDBso.clsAccGrpBI
    Dim objOID       As New U8FDEso.OIDObject
    Dim MsgStr       As String
    Dim NodeTemp     As String
    
    If Me.treStyle.Nodes.count > 0 Then
        If Me.treStyle.Nodes(NodeKey).root.key = Me.treStyle.Nodes(NodeKey).FirstSibling.key Then
            NodeTemp = ""
        Else
            NodeTemp = Me.treStyle.Nodes(NodeKey).Parent.key
        End If
    End If
    
    MsgStr = "【" & Me.txtAccGrp(0).Text & ":" & Me.txtAccGrp(1) & "】"
    
    Me.treStyle.Nodes.clear
    
    Me.treStyle.LineStyle = tvwRootLines
    Me.treStyle.Style = tvwTreelinesPlusMinusPictureText
    Me.treStyle.LabelEdit = tvwManual
    Me.treStyle.Indentation = 300
    
    m_NodeFlag = False
    CreateTree "", NodeKey
    
    If Not m_NodeFlag And Len(MsgStr) > 3 Then
        MsgBox MsgStr & "被删除了！"
    End If

    If Me.treStyle.Nodes.count > 0 Then
        objOID = mID(NodeKey, 2)
        If m_NodeFlag Then
            Set EO = objAccGrpBI.MoveTo(g_sDataSourceName, U8FDEso.esoCurrent, m_conBIStyle, objOID)
        Else
            Set EO = objAccGrpBI.MoveTo(g_sDataSourceName, U8FDEso.esoNext, m_conBIStyle, objOID, mID(NodeTemp, 2))
        End If
        EO.OID.id = EO(m_EO.SourceOIDField)
        NodeKey = "K" & EO.OID.id
        Me.treStyle.Nodes(NodeKey).Selected = True
        Me.treStyle.Nodes(NodeKey).Expanded = True
        If Me.treStyle.Nodes(NodeKey).children > 0 Then
            Me.treStyle.Nodes(NodeKey).Image = 2
        Else
            Me.treStyle.Nodes(NodeKey).Image = 3
        End If
    Else
        Set EO = objAccGrpBI.Init(g_sDataSourceName, m_conBIStyle)
    End If
    
    Set objAccGrpBI = Nothing
    Set objOID = Nothing
    
    SetUI
End Sub

Private Sub SetUI()
    '----Set Status
    Select Case m_EO.State
        Case U8FDEso.esoAddNew
            Me.tlbAction.Buttons("AddNew").Enabled = False
            Me.tlbAction.Buttons("Edit").Enabled = False
            Me.tlbAction.Buttons("Delete").Enabled = False
            Me.tlbAction.Buttons("Save").Enabled = True
            Me.tlbAction.Buttons("Cancel").Enabled = True
            Me.tlbAction.Buttons("Refresh").Enabled = False
            cboAddItem mID(NodeKey, 2), False
            
            If Me.cboParent.ListCount > 1 Then
                If Me.treStyle.Nodes(NodeKey).root.key = Me.treStyle.Nodes(NodeKey).FirstSibling.key Then
                    Me.cboParent.Text = Me.treStyle.Nodes(NodeKey).Text
                Else
                    Me.cboParent.Text = Me.treStyle.Nodes(NodeKey).Parent.Text
                End If
            Else
                Me.cboParent.ListIndex = 0
            End If
            Me.picView.Enabled = True
        Case U8FDEso.esoEdit
            Me.tlbAction.Buttons("AddNew").Enabled = False
            Me.tlbAction.Buttons("Edit").Enabled = False
            Me.tlbAction.Buttons("Delete").Enabled = False
            Me.tlbAction.Buttons("Save").Enabled = True
            Me.tlbAction.Buttons("Cancel").Enabled = True
            Me.tlbAction.Buttons("Refresh").Enabled = False
            cboAddItem mID(NodeKey, 2)

            If Me.treStyle.Nodes(NodeKey).root.key = Me.treStyle.Nodes(NodeKey).FirstSibling.key Then
                Me.cboParent.ListIndex = 0
            Else
                Me.cboParent.Text = Me.treStyle.Nodes(NodeKey).Parent.Text
            End If
            Me.picView.Enabled = True
        Case U8FDEso.esoInstance
            Me.tlbAction.Buttons("AddNew").Enabled = True
            Me.tlbAction.Buttons("Edit").Enabled = True
            Me.tlbAction.Buttons("Delete").Enabled = True
            Me.tlbAction.Buttons("Save").Enabled = False
            Me.tlbAction.Buttons("Cancel").Enabled = False
            Me.tlbAction.Buttons("Refresh").Enabled = True
            cboAddItem mID(NodeKey, 2), False
            
            If Me.treStyle.Nodes(NodeKey).root.key = Me.treStyle.Nodes(NodeKey).FirstSibling.key Then
                Me.cboParent.ListIndex = 0
            Else
                Me.cboParent.Text = Me.treStyle.Nodes(NodeKey).Parent.Text
            End If
            Me.picView.Enabled = False
        Case U8FDEso.esoInitialized
            Me.tlbAction.Buttons("AddNew").Enabled = True
            Me.tlbAction.Buttons("Edit").Enabled = False
            Me.tlbAction.Buttons("Delete").Enabled = False
            Me.tlbAction.Buttons("Save").Enabled = False
            Me.tlbAction.Buttons("Cancel").Enabled = False
            Me.tlbAction.Buttons("Refresh").Enabled = True
            Me.cboParent.ListIndex = 0
            Me.picView.Enabled = False
    End Select
    '----Set Value
    With m_EO
        Me.txtAccGrp(0).MaxLength = 10 ' .Fields("accgrp_code").length
        Me.txtAccGrp(0).Property = 2 'SwitchDataType(.Fields("accgrp_code").DataType)
        Me.txtAccGrp(0).Text = IIf(IsNull(.Fields("accgrp_code")), "", .Fields("accgrp_code"))
        
        Me.txtAccGrp(1).MaxLength = .Fields("accgrp_name").length
        Me.txtAccGrp(1).Property = SwitchDataType(.Fields("accgrp_name").DataType)
        Me.txtAccGrp(1).Text = IIf(IsNull(.Fields("accgrp_name")), "", .Fields("accgrp_name"))
        
        Me.txtAccGrp(3).MaxLength = .Fields("digest").length
        Me.txtAccGrp(3).Property = SwitchDataType(.Fields("digest").DataType)
        Me.txtAccGrp(3).Text = IIf(IsNull(.Fields("digest")), "", .Fields("digest"))
        
        'SetchkUnique
    End With
    SetTlbStyle Me, False
    ocxCtbTool.RefreshEnable
End Sub

Private Sub CreateTree(ByVal ParentOID As String, Optional NodeTemp As String)
    Dim objAccGrpBI  As New U8FDBso.clsAccGrpBI
    Dim objEO        As U8FDEso.EntityObject
    Dim objOID       As New U8FDEso.OIDObject
    
    Dim i As Integer, RecordCount As Long
    
    Set objEO = objAccGrpBI.MoveTo(g_sDataSourceName, U8FDEso.esoFirst, m_conBIStyle, , ParentOID)
    RecordCount = objAccGrpBI.RecordCount(g_sDataSourceName, objEO, ParentOID)
    
    For i = 1 To RecordCount
        If NodeTemp = "K" & objEO("accgrp_id") Then m_NodeFlag = True
        If IsNull(objEO("parent_id")) Or Len(Trim(objEO("parent_id"))) = 0 Then
            Me.treStyle.Nodes.Add , , "K" & objEO("accgrp_id"), "【" & objEO("accgrp_code") & "】" & objEO("accgrp_name")
            Me.treStyle.Nodes("K" & objEO("accgrp_id")).Image = 3
            'Me.treStyle.Nodes("K" & objEO("accgrp_id")).Expanded = True
            Me.cboParent.AddItem "【" & objEO("accgrp_code") & "】" & objEO("accgrp_name")
        
            CreateTree objEO("accgrp_id"), NodeTemp
        Else
            Me.treStyle.Nodes.Add "K" & objEO("parent_id"), tvwChild, "K" & objEO("accgrp_id"), "【" & objEO("accgrp_code") & "】" & objEO("accgrp_name")
            'Me.treStyle.Nodes("K" & objEO("parent_id")).Expanded = True
            Me.treStyle.Nodes("K" & objEO("parent_id")).Image = 1
            Me.treStyle.Nodes("K" & objEO("accgrp_id")).Image = 3
            Me.cboParent.AddItem "【" & objEO("accgrp_code") & "】" & objEO("accgrp_name")
        
            CreateTree objEO("accgrp_id"), NodeTemp
        End If
        If i < RecordCount Then
            objOID = objEO("accgrp_id")
            Set objEO = objAccGrpBI.MoveTo(g_sDataSourceName, U8FDEso.esoNext, m_conBIStyle, objOID, ParentOID)
        End If
    Next
    If RecordCount = 0 Then
        If Not (IsNull(ParentOID) Or ParentOID = "") Then
            Me.treStyle.Nodes("K" & Trim(ParentOID)).Image = 3
        End If
    End If
    
    Set objAccGrpBI = Nothing
    Set objOID = Nothing
    Set objEO = Nothing
    
'    Dim con As New ADODB.Connection
'    Dim Rs  As New ADODB.Recordset
'    Dim SQL As String
'    Dim bNoRepeatAcc As String
'
'    con.Open g_sDataSourceName
'    If IsNull(ParentOID) Or ParentOID = "" Then
'        SQL = "SELECT * From FD_AccGrp where sParentOID is Null ORDER BY sOID"
'    Else
'        SQL = "SELECT * From FD_AccGrp where sParentOID='" & Mid(ParentOID, 1, Len(ParentOID) - 1) & "' ORDER BY sOID"
'    End If
'
'    Rs.Open SQL, con, adOpenStatic, adLockOptimistic
'    If Not Rs.EOF Then
'        Do Until Rs.EOF
'            bNoRepeatAcc = CByte(Rs("bNoRepeatAcc")) / 255
'            If IsNull(Rs("sParentOID")) Then
'                Me.treStyle.Nodes.Add , , "K" & Trim(Rs("sOID")) & bNoRepeatAcc, Rs("sName")
'                Me.treStyle.Nodes("K" & Trim(Rs("sOID")) & bNoRepeatAcc).Image = 3
'                Me.treStyle.Nodes("K" & Trim(Rs("sOID")) & bNoRepeatAcc).Expanded = True
'                Me.cboParent.AddItem Rs("sName")
'                CreateTree Trim(Rs("sOID")) & CByte(Rs("bNoRepeatAcc")) / 255
'            Else
'                Me.treStyle.Nodes.Add "K" & Trim(Rs("sParentOID")) & Right(ParentOID, 1), tvwChild, "K" & Trim(Rs("sOID")) & bNoRepeatAcc, Rs("sName")
'                Me.treStyle.Nodes("K" & Trim(Rs("sParentOID")) & Right(ParentOID, 1)).Image = 2
'                Me.treStyle.Nodes("K" & Trim(Rs("sOID")) & bNoRepeatAcc).Image = 3
'                Me.treStyle.Nodes("K" & Trim(Rs("sOID")) & bNoRepeatAcc).Expanded = True
'                Me.cboParent.AddItem Rs("sName")
'                CreateTree Trim(Rs("sOID")) & CByte(Rs("bNoRepeatAcc")) / 255
'            End If
'            Rs.MoveNext
'        Loop
'    Else
'        If Not (IsNull(ParentOID) Or ParentOID = "") Then
'            Me.treStyle.Nodes("K" & Trim(ParentOID)).Image = 3
'        End If
'    End If
End Sub

Private Sub SetchkUnique()
    If Not (IsNull(NodeKey) Or NodeKey = "") And m_EO.State <> U8FDEso.esoInitialized Then
        If Me.treStyle.Nodes(NodeKey).root.key = Me.treStyle.Nodes(NodeKey).FirstSibling.key Then
            Me.chkUnique.Enabled = True
            Me.chkUnique.Value = right(NodeKey, 1)
        Else
            If right(Me.treStyle.Nodes(NodeKey).Parent.key, 1) = 1 Then
                Me.chkUnique.Enabled = False
                Me.chkUnique.Value = 1
            Else
                Me.chkUnique.Enabled = True
                Me.chkUnique.Value = right(NodeKey, 1)
            End If
        End If
    End If
End Sub

Private Sub cboAddItem(ParentOID As String, Optional isRem As Boolean = True)
    Dim i   As Integer
   
    Set m_Nodes = Me.TreeView.Nodes
    m_Nodes.clear
    For i = 1 To Me.treStyle.Nodes.count
        If Me.treStyle.Nodes(i).root.key = Me.treStyle.Nodes(i).FirstSibling.key Then
            m_Nodes.Add , , Me.treStyle.Nodes(i).key, Me.treStyle.Nodes(i).Text
        Else
            m_Nodes.Add Me.treStyle.Nodes(i).Parent.key, tvwChild, Me.treStyle.Nodes(i).key, Me.treStyle.Nodes(i).Text
        End If
    Next
    If isRem Then cboRemoveItem ParentOID
    Me.cboParent.clear
    Me.cboParent.AddItem ""
    For i = 1 To m_Nodes.count
        Me.cboParent.AddItem m_Nodes(i).Text
    Next
    Set m_Nodes = Nothing
End Sub

Private Sub cboRemoveItem(ParentOID As String)
    Dim objAccGrpBI  As New U8FDBso.clsAccGrpBI
    Dim objEO        As U8FDEso.EntityObject
    Dim objOID       As New U8FDEso.OIDObject
    
    Dim i As Integer, RecordCount As Long
    
    Set objEO = objAccGrpBI.MoveTo(g_sDataSourceName, U8FDEso.esoFirst, m_conBIStyle, , ParentOID)
    RecordCount = objAccGrpBI.RecordCount(g_sDataSourceName, objEO, ParentOID)
    
    For i = 1 To RecordCount
        If objEO("parent_id") = ParentOID Then
            cboRemoveItem objEO(objEO.SourceOIDField) '& CByte(Rs("bNoRepeatAcc")) / 255
        End If
        If i < RecordCount Then
            objOID = objEO("accgrp_id")
            Set objEO = objAccGrpBI.MoveTo(g_sDataSourceName, U8FDEso.esoNext, m_conBIStyle, objOID, ParentOID)
        End If
    Next
    
    m_Nodes.Remove "K" & ParentOID
    
    Set objAccGrpBI = Nothing
    Set objOID = Nothing
    Set objEO = Nothing
End Sub

Private Sub txtAccGrp_CustKeyDown(Index As Integer, ByVal key As EDITLib.KeyTypes)
    Select Case Index
        Case 0
            If key = KeyDown Or key = KeyRet Then
                SetEdtTxtFocus Me.txtAccGrp(1)
            ElseIf key = KeyUp Then
                SetEdtTxtFocus Me.txtAccGrp(3)
            End If
        Case 1
            If key = KeyDown Or key = KeyRet Then
                Me.cboParent.SetFocus
            ElseIf key = KeyUp Then
                SetEdtTxtFocus Me.txtAccGrp(0)
            End If
        Case 3
            If key = KeyDown Or key = KeyRet Then
                'SetEdtTxtFocus Me.txtAccGrp(0)
                Save
            ElseIf key = KeyUp Then
                Me.cboParent.SetFocus
            End If
    End Select
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 = "select " & EO.SourceTable & "." & EO("accgrp_code").SourceField & " as " & EO("accgrp_code").Caption & "," & EO.SourceTable & "." & EO("accgrp_name").SourceField & " as " & EO("accgrp_name").Caption & "," & EO.SourceTable & "_1." & EO("accgrp_code").SourceField & " AS 上级账户类型代码" & "," & EO.SourceTable & "." & EO("digest").SourceField & " as " & EO("digest").Caption & " from " & EO.SourceTable & " " & EO.SourceTable & "_1 RIGHT OUTER JOIN " & EO.SourceTable & " ON " & EO.SourceTable & "_1." & EO.SourceOIDField & "=" & EO.SourceTable & "." & EO("parent_id").SourceField
    
    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

Private Sub txtAccGrp_LostFocus(Index As Integer)
    If Index = 0 Then
        If Len(txtAccGrp(0).Text) Mod 2 <> 0 Then
            MsgBox "类型代码不符合编码规则！", vbInformation, App.ProductName
            txtAccGrp(0).SetFocus
        End If
    End If
End Sub