i-+

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

'设计:章景峰
'编码:章景峰
'说明:U8资金管理---账户定义
'--------------------------------
Option Explicit
Private Const conMoveLimit = 1000
Private Const m_conBIStyle = 1
Private WithEvents mRefCtlUI As clsRefCtlUI
Attribute mRefCtlUI.VB_VarHelpID = -1

Public ShowMode              As ShowModeEnum
Private m_EO                 As U8FDEso.EntityObject
Private m_OldEO              As U8FDEso.EntityObject
Private m_PasteEO            As U8FDEso.EntityObject
Private m_objOID             As New U8FDEso.OIDObject
Private m_EditStatus         As Boolean
Private m_FreezeDestroy      As Boolean '冻结销户
Private m_ShowDestroy        As Byte '显示已销户
Private m_IRateCad           As Boolean
Private m_View               As Boolean
Private m_ExchangeRate       As Double
Public NodeKey               As String

Private sgdRow               As Long
Private edstatus             As Ed_Status
Private Switch_Mode          As SwitchMode
Private CellBackColor(5)     As String
Private PrintTypeList        As String
Private PrintSizeList        As String
Private SetPrintDataStyleXML_flag As Boolean

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

Public Sub View(Optional OID As U8FDEso.OIDObject)
    On Error GoTo lblHandle
    Dim objAccDefBI As New U8FDBso.clsAccDefBI
    
    If Not OID Is Nothing Then
        Set m_EO = objAccDefBI.MoveTo(g_sDataSourceName, U8FDEso.esoCurrent, m_conBIStyle, OID)
        Set m_objOID = OID
    Else
        Set m_EO = objAccDefBI.MoveTo(g_sDataSourceName, U8FDEso.esoFirst, m_conBIStyle)
        m_objOID.id = m_EO(m_EO.SourceOIDField)
    End If
    
    m_View = True
    Set objAccDefBI = Nothing
    
    SetUI
    
    Exit Sub
lblHandle:
    MsgBox Err.Description, vbInformation, g_conSysName
End Sub

Private Sub cboAccIO_KeyUp(KeyCode As Integer, Shift As Integer)
    'If KeyCode = vbKeyRight Or KeyCode = vbKeyReturn Then
    '    If Me.txtQcYe.Enabled Then SetEdtTxtFocus Me.txtQcYe
    'ElseIf KeyCode = vbKeyUp Then
    '    Me.cboMoneyName.SetFocus
    'ElseIf KeyCode = vbKeyDown Then
    '    If Me.txtQcJs.Enabled Then SetEdtTxtFocus Me.txtQcJs
    'ElseIf KeyCode = vbKeyLeft Then
    '    Me.cboAccType.SetFocus
    'End If
    If KeyCode = vbKeyReturn Then
        SendKeys "{TAB}"
    End If
End Sub

Private Sub cboAccType_Click()
    If Me.cboSource.ListIndex = 0 Then '资金
        If Me.cboAccType.ListIndex = 0 Then '定期
            Me.txtCad(0).Text = ""
            Me.txtCad(1).Text = ""
            Me.txtCad(1).Enabled = False
            Me.cmdCad.Enabled = False
            Me.txtQcYe.Enabled = False
            Me.txtQcYe.Text = ""
            Me.txtQcYe.BackColor = &HFF00FF
            Me.txtQcJs.Enabled = False
            Me.txtQcJs.Text = ""
            Me.txtQcJs.BackColor = &HFF00FF
            Me.txtbwQcYe.Enabled = False
            Me.txtbwQcYe.Text = ""
            Me.txtbwQcYe.BackColor = &HFF00FF
            Me.txtbwQcJs.Enabled = False
            Me.txtbwQcJs.Text = ""
            Me.txtbwQcJs.BackColor = &HFF00FF
        ElseIf Me.cboAccType.ListIndex = 1 Then '活期
            Me.txtCad(1).Enabled = True
            Me.cmdCad.Enabled = True
            Me.txtQcYe.Enabled = True
            Me.txtQcYe.BackColor = &HFFFFFF
            'Me.txtQcYe.Text = ""
            Me.txtQcJs.Enabled = True
            Me.txtQcJs.BackColor = &HFFFFFF
            'Me.txtQcJs.Text = ""
            Me.txtbwQcYe.Enabled = True
            Me.txtbwQcYe.BackColor = &HFFFFFF
            'Me.txtbwQcYe.Text = ""
            Me.txtbwQcJs.Enabled = True
            Me.txtbwQcJs.BackColor = &HFFFFFF
            'Me.txtbwQcJs.Text = ""
        End If
    Else '总帐
        If Me.cboAccType.ListIndex = 0 Then '活期
            Me.txtCad(1).Enabled = True
            Me.cmdCad.Enabled = True
            Me.txtQcYe.Enabled = False
            Me.txtQcYe.BackColor = &HFF00FF
            Me.txtQcYe.Text = ""
            Me.txtQcJs.Enabled = True
            Me.txtQcJs.BackColor = &HFFFFFF
            'Me.txtQcJs.Text = ""
            Me.txtbwQcYe.Enabled = False
            Me.txtbwQcYe.BackColor = &HFF00FF
            Me.txtbwQcYe.Text = ""
            Me.txtbwQcJs.Enabled = True
            Me.txtbwQcJs.BackColor = &HFFFFFF
            'Me.txtbwQcJs.Text = ""
        End If
    End If
End Sub

Private Sub cboAccType_KeyUp(KeyCode As Integer, Shift As Integer)
    'If KeyCode = vbKeyRight Or KeyCode = vbKeyReturn Then
    '    Me.cboAccIO.SetFocus
    'ElseIf KeyCode = vbKeyUp Then
    '    Me.cboSource.SetFocus
    'ElseIf KeyCode = vbKeyDown Then
    '    If Me.txtQcYe.Enabled Then SetEdtTxtFocus Me.txtQcYe
    'ElseIf KeyCode = vbKeyLeft Then
    '    Me.cboMoneyName.SetFocus
    'End If
    If KeyCode = vbKeyReturn Then
        SendKeys "{TAB}"
    End If
End Sub

Private Sub cboMoneyName_Click()
    m_ExchangeRate = 1
End Sub

Private Sub cboMoneyName_KeyUp(KeyCode As Integer, Shift As Integer)
    'If KeyCode = vbKeyRight Or KeyCode = vbKeyReturn Then
    '    Me.cboAccType.SetFocus
    'ElseIf KeyCode = vbKeyUp Then
    '    If Me.txtCad(1).Enabled Then SetEdtTxtFocus Me.txtCad(1)
    'ElseIf KeyCode = vbKeyDown Then
    '    Me.cboAccIO.SetFocus
    'ElseIf KeyCode = vbKeyLeft Then
    '    Me.cboSource.SetFocus
    'End If
    If KeyCode = vbKeyReturn Then
        SendKeys "{TAB}"
    End If
End Sub

Private Sub cboSource_KeyUp(KeyCode As Integer, Shift As Integer)
    'If KeyCode = vbKeyRight Or KeyCode = vbKeyReturn Then
    '    Me.cboMoneyName.SetFocus
    'ElseIf KeyCode = vbKeyUp Then
    '    If Me.txtIRate(1).Enabled Then SetEdtTxtFocus Me.txtIRate(1)
    'ElseIf KeyCode = vbKeyDown Then
    '    Me.cboAccType.SetFocus
    'ElseIf KeyCode = vbKeyLeft Then
    '    If Me.txtCad(1).Enabled Then SetEdtTxtFocus Me.txtCad(1)
    'End If
    If KeyCode = vbKeyReturn Then
        SendKeys "{TAB}"
    End If
End Sub

Private Sub chkDeficit_Click()
    If Me.chkDeficit.Value = 1 Then
        Me.txtDeficit.Enabled = True
        Me.txtDeficit.BackColor = &HFFFFFF
        Me.chkDeficitRestrict.Enabled = True
    Else
        Me.txtDeficit.Enabled = False
        Me.txtDeficit.Text = ""
        Me.txtDeficit.BackColor = &HFF00FF
        Me.chkDeficitRestrict.Value = 0
        Me.chkDeficitRestrict.Enabled = False
    End If
End Sub

Private Sub chkDeficit_KeyUp(KeyCode As Integer, Shift As Integer)
    If KeyCode = vbKeyReturn Then
        SendKeys "{TAB}"
    End If
End Sub

Private Sub chkDeficitRestrict_KeyUp(KeyCode As Integer, Shift As Integer)
    If KeyCode = vbKeyReturn Or KeyCode = vbKeyRight Then
        SendKeys "{TAB}"
    End If
End Sub

Private Sub chkYt_Click()
    If Me.chkYt.Value = 1 Then
        Me.txtYtCad(1).Enabled = True
        Me.txtYtCad(1).BackColor = &HFFFFFF
        Me.cmdYtCad.Enabled = True
    Else
        Me.txtYtCad(1).Enabled = False
        Me.txtYtCad(1).Text = ""
        Me.txtYtCad(1).BackColor = &HFF00FF
        Me.cmdYtCad.Enabled = False
    End If
End Sub

Private Sub cboSource_Click()
    Dim arrCurr As Variant
    Dim i       As Integer
    
    If Me.cboSource.ListIndex = 0 Then
        Me.cboMoneyName.clear
        arrCurr = GetAllCurrencyNames
        For i = 0 To UBound(arrCurr) - 1
            Me.cboMoneyName.AddItem arrCurr(i)
        Next
        Me.cboMoneyName.ListIndex = 0
        
        Me.cboAccType.clear
        Me.cboAccType.AddItem "定期"
        Me.cboAccType.AddItem "活期"
        'Me.cboAccType.AddItem "定额"
        Me.cboAccType.ListIndex = 1
        
        'Me.txtQcYe.Enabled = True
        'Me.txtQcYe.BackColor = &HFFFFFF
        'Me.txtQcJs.Enabled = True
        'Me.txtQcJs.BackColor = &HFFFFFF
        'Me.txtbwQcYe.Enabled = True
        'Me.txtbwQcYe.BackColor = &HFFFFFF
        'Me.txtbwQcJs.Enabled = True
        'Me.txtbwQcJs.BackColor = &HFFFFFF
        'Me.tabAccDef.TabVisible(2) = False
    Else
        Me.cboMoneyName.clear
        arrCurr = GetAllCurrencyNames
        For i = 0 To UBound(arrCurr) - 1
            'Me.cboMoneyName.AddItem arrCurr(i)
            If arrCurr(i) = ZjAccInfo.zjStandExch Then
                Me.cboMoneyName.AddItem arrCurr(i)
                Me.cboMoneyName.ListIndex = 0
                Exit For
            End If
        Next
        
        Me.cboAccType.clear
        Me.cboAccType.AddItem "活期"
        'Me.cboAccType.AddItem "定额"
        Me.cboAccType.ListIndex = 0
        
        'Me.txtQcYe.Enabled = False
        'Me.txtQcYe.BackColor = &HFF00FF
        'Me.txtQcYe.Text = ""
        'Me.txtQcJs.Enabled = True
        'Me.txtQcJs.BackColor = &HFFFFFF
        'Me.txtQcJs.Text = ""
        'Me.txtbwQcYe.Enabled = False
        'Me.txtbwQcYe.BackColor = &HFF00FF
        'Me.txtbwQcYe.Text = ""
        'Me.txtbwQcJs.Enabled = True
        'Me.txtbwQcJs.BackColor = &HFFFFFF
        'Me.txtbwQcJs.Text = ""
        'Me.tabAccDef.TabVisible(2) = True
    End If
End Sub

Private Sub chkYt_KeyUp(KeyCode As Integer, Shift As Integer)
    If KeyCode = vbKeyReturn Then
        SendKeys "{TAB}"
    End If
End Sub

Private Sub cmdCad_KeyUp(KeyCode As Integer, Shift As Integer)
    If KeyCode = vbKeyRight Then
        SendKeys "{TAB}"
    End If
End Sub

Private Sub cmdCode_Click()
    Dim objfrmRefCtl As New frmRefCtl
    Dim objEO        As U8FDEso.EntityObject
    Dim objAccDefBI  As New U8FDBso.clsAccDefBI
    
    Set objEO = objAccDefBI.Init(g_sDataSourceName)
    Load objfrmRefCtl
    objfrmRefCtl.FormName = "frmAccDef"
    objfrmRefCtl.ControlName = "txtAccCode"
    objfrmRefCtl.FDRefCtrl.ReferenceType = enmAccount
    Set objfrmRefCtl.FDRefCtrl.EO = objEO
    objfrmRefCtl.FDRefCtrl.Refresh
    objfrmRefCtl.Show vbModal
    Set objAccDefBI = Nothing
    Set objEO = Nothing
    Set objfrmRefCtl = Nothing
End Sub

Private Sub cmdCad_Click()
    Dim objfrmRefCtl As New frmRefCtl
    Dim objEO        As U8FDEso.EntityObject
    Dim objCadBI     As New U8FDBso.clsCadBI
    
    Set objEO = objCadBI.Init(g_sDataSourceName)
    Load objfrmRefCtl
    objfrmRefCtl.FormName = "frmAccDef"
    objfrmRefCtl.ControlName = "txtCad"
    objfrmRefCtl.FDRefCtrl.ReferenceType = enmCad
    Set objfrmRefCtl.FDRefCtrl.EO = objEO
    objfrmRefCtl.FDRefCtrl.Refresh
    objfrmRefCtl.Show
    Set objCadBI = Nothing
    Set objEO = Nothing
    Set objfrmRefCtl = Nothing
End Sub

Private Sub cmdIRate_Click()
    Dim objfrmRefCtl As New frmRefCtl
    Dim objEO        As U8FDEso.EntityObject
    Dim objIRateBI   As New U8FDBso.clsIRateBI
    
    Set objEO = objIRateBI.Init(g_sDataSourceName)
    Load objfrmRefCtl
    objfrmRefCtl.Show
    'Dim i   As Long
    'For i = 0 To Forms.Count - 1
    '    If Forms(i).Name = "frmRefCtl" Then
    '        Set objfrmRefCtl = Forms(i)
    '        Exit For
    '    End If
    'Next
    objfrmRefCtl.FormName = "frmAccDef"
    objfrmRefCtl.ControlName = "txtIRate"
    objfrmRefCtl.FDRefCtrl.ReferenceType = enmInterestRate
    Set objfrmRefCtl.FDRefCtrl.EO = objEO
    objfrmRefCtl.FDRefCtrl.Refresh
    'objfrmRefCtl.Show
    Set objIRateBI = Nothing