clslistaccount.cls

金算盘软件代码

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "clsListAccount"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Private WithEvents mfrmAccount As frmAListTemplate  '模版窗体
Attribute mfrmAccount.VB_VarHelpID = -1
Private clsListType As String
Private mstrCapton(1 To 5) As String
Private mPages As Integer
Private mblnRefresh() As Boolean

'initialize each page
Private Sub inintTabName()
    Dim intTab As Integer
    Dim strSql As String
    Dim intCount As Integer
    Dim recTemplete As rdoResultset
    strSql = "Select strAccountTypeName from AccountType order by lngaccountTypeID  "
    Set recTemplete = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    mPages = recTemplete.RowCount
    ReDim mblnRefresh(0 To mPages)
    For intTab = 1 To 5
        If recTemplete.EOF Then Exit For
        mstrCapton(intTab) = recTemplete!strAccountTypeName
        recTemplete.MoveNext
    Next
    If recTemplete Is Nothing Then recTemplete.Close
End Sub
'类的初始化
Private Sub Class_Initialize()
    
    Set mfrmAccount = New frmAListTemplate
    mfrmAccount.blnReceptionList = False
    mfrmAccount.mTitle = "会计科目"
    mfrmAccount.mHelpID = 30002
    
    inintTabName
    
    mfrmAccount.Tabs = mPages + 1
    mfrmAccount.SpTabCaption(0) = "全部(&O)"
    mfrmAccount.SpViewID(0) = 6
    mfrmAccount.SpPrintID(0) = 23
    mfrmAccount.SpPrintTitle(0) = "全部科目一览表" & Chr(1) & gclsBase.BaseName & Chr(1) & gclsBase.OperatorName
    
    If Trim(mstrCapton(1)) <> "" Then
        mfrmAccount.SpTabCaption(1) = mstrCapton(1) & "(&P)"
        mfrmAccount.SpViewID(1) = 385
        mfrmAccount.SpPrintID(1) = 55
        mfrmAccount.SpPrintTitle(1) = mstrCapton(1) & "科目一览表 " & Chr(1) & gclsBase.BaseName & Chr(1) & gclsBase.OperatorName
    End If
    If Trim(mstrCapton(2)) <> "" Then
        mfrmAccount.SpTabCaption(2) = mstrCapton(2) & "(&T)"
        mfrmAccount.SpViewID(2) = 386
        mfrmAccount.SpPrintID(2) = 56
        mfrmAccount.SpPrintTitle(2) = mstrCapton(2) & "科目一览表" & Chr(1) & gclsBase.BaseName & Chr(1) & gclsBase.OperatorName
    End If
    If Trim(mstrCapton(3)) <> "" Then
        mfrmAccount.SpTabCaption(3) = mstrCapton(3) & "(&L)"
        mfrmAccount.SpViewID(3) = 387
        mfrmAccount.SpPrintID(3) = 57
        mfrmAccount.SpPrintTitle(3) = mstrCapton(3) & "科目一览表" & Chr(1) & gclsBase.BaseName & Chr(1) & gclsBase.OperatorName
    End If
    If Trim(mstrCapton(4)) <> "" Then
        mfrmAccount.SpTabCaption(4) = mstrCapton(4) & "(&M)"
        mfrmAccount.SpViewID(4) = 388
        mfrmAccount.SpPrintID(4) = 58
        mfrmAccount.SpPrintTitle(4) = mstrCapton(4) & "科目一览表" & Chr(1) & gclsBase.BaseName & Chr(1) & gclsBase.OperatorName
    End If
    If Trim(mstrCapton(5)) <> "" Then
        mfrmAccount.SpTabCaption(5) = mstrCapton(5) & "(&N)"
        mfrmAccount.SpViewID(5) = 389
        mfrmAccount.SpPrintID(5) = 59
        mfrmAccount.SpPrintTitle(5) = mstrCapton(5) & "科目一览表" & Chr(1) & gclsBase.BaseName & Chr(1) & gclsBase.OperatorName
    End If
    Dim i As Integer
    For i = 0 To mPages
        mblnRefresh(i) = False
        mfrmAccount.SpSelect(i) = "Account.lngAccountID As id,decode(Account.blnIsInActive,1,'√',' ') As ""停用"""
        mfrmAccount.blnEditByRight(i) = IsCanDo(10, gclsBase.OperatorID)
        mfrmAccount.MenuEnbaleOnPage(i) = True
        mfrmAccount.ShowAll(i) = " Account.blnIsInActive=0"
    Next
    mfrmAccount.SpMenuCount = 1
    mfrmAccount.SpPosition = 7
    mfrmAccount.SpMenuName(0) = "科目复制(&C)"
    mfrmAccount.SpEnableOnPageNo(0) = 127
    mfrmAccount.blnConstant(0) = False
    
    mfrmAccount.MenuEnbaleOnPage(0) = 127
    mfrmAccount.MenuEnbaleOnPage(1) = 127
    mfrmAccount.MenuEnbaleOnPage(2) = 127
    mfrmAccount.MenuEnbaleOnPage(3) = 127
    mfrmAccount.MenuEnbaleOnPage(4) = 127
    mfrmAccount.MenuEnbaleOnPage(5) = 127
    mfrmAccount.MenuEnbaleOnPage(6) = 127
    mfrmAccount.MenuEnbaleOnPage(7) = 127
    Erase mstrCapton
End Sub
'calling method
Public Function Showlist()
    mfrmAccount.Show
    mfrmAccount.ZOrder 0
End Function

Private Sub Class_Terminate()
    Set mfrmAccount = Nothing
    'gclsList.Remove clsListType
End Sub
'Deal with messages
Private Sub mfrmAccount_ListChildActive()
    Dim vntMessage As Variant
    Dim i As Integer
    '响应消息
    For Each vntMessage In mfrmAccount.mclsMainControl.Messages
        If vntMessage = Message.msgAccount Then
            mfrmAccount.ToolRefresh
            mblnRefresh(mfrmAccount.sstPages.Tab) = False
            If mfrmAccount.sstPages.Tab <> 0 Then
                mblnRefresh(0) = True
            Else
                For i = 1 To mPages
                    mblnRefresh(i) = True
                Next
            End If
        End If
        mfrmAccount.mclsMainControl.Messages.Remove CStr(vntMessage) '清除部门雇员改变消息
    Next
    If mblnRefresh(mfrmAccount.sstPages.Tab) Then
        mfrmAccount.ToolRefresh
        mblnRefresh(mfrmAccount.sstPages.Tab) = False
    End If
    mfrmAccount.mclsMainControl.Messages.Clear
    'UpdateMenuStatus
End Sub
'delete records
Private Sub mfrmAccount_ListDel()
     Dim lngID As Long
    lngID = mfrmAccount.ListID
    If lngID = 0 Then Exit Sub
    If frmAccountCard.DelCard(lngID, , True) Then
        gclsSys.SendMessage mfrmAccount.hWnd, Message.msgAccount
        mfrmAccount.ToolRefresh
    End If
    Unload frmAccountCard
    Set frmAccountCard = Nothing
End Sub
'Add a record
Private Sub mfrmAccount_ListEdite()
    Dim lngID As Long
    lngID = mfrmAccount.ListID
    mfrmAccount.Enabled = False
    If lngID > 0 Then
        If CheckIDUsed("Account", "lngAccountID", lngID) Then
            frmAccountCard.EditCard lngID, vbModal
            Set frmAccountCard = Nothing
        Else
            ShowMsg 0, "该会计科目不存在,不能进行修改!", vbExclamation + MB_TASKMODAL, "修改会计科目"
            mfrmAccount.ToolRefresh
        End If
    End If
    mfrmAccount.Enabled = True
End Sub
'
Private Sub mfrmAccount_ListInActive(blnLevel As Boolean, blnSuceess As Boolean)
        Dim lngID As Long
        Dim blnYes As Boolean
        Dim strCode As String
        Dim blnRemark As BOFActionConstants
        Dim intResponse As Integer
        
        blnLevel = True
        blnSuceess = False
        lngID = mfrmAccount.ListID
        If lngID = 0 Then Exit Sub
        blnRemark = ListIsInActive(lngID, strCode)
        If IsLevelWCode("会计科目编码") And Trim(strCode) <> "" Then
            If blnRemark And IsLowerCode(strCode) Then
                intResponse = ShowMsg(mfrmAccount.hWnd, "是否取消所有下级的停用标记", vbYesNo, mfrmAccount.mTitle)
                blnYes = IIf(intResponse = 6, True, False)
            End If
        End If
        If UpdateIsActive(strCode, Not blnRemark, blnYes) Then
            blnSuceess = True
            mfrmAccount.ToolRefresh
        End If
End Sub

'Private Sub mfrmAccount_ListInActive()
'        Dim lngID As Long
'        Dim blnYes As Boolean
'        Dim strCode As String
'        lngID = mfrmAccount.ListID
'        If lngID = 0 Then Exit Sub
'        blnRemark = ListIsInActive(lngID, strCode)
'        If IsLevelWCode("会计科目编码") And Trim(strCode) <> "" Then
'            If blnRemark And IsLowerCode(strCode) Then
'                intResponse = ShowMsg(mfrmAccount.hwnd, "是否取消所有下级的停用标记", vbYesNo, mfrmAccount.mTitle)
'                blnYes = IIf(intResponse = 6, True, False)
'            End If
'        End If
'        If UpdateIsActive(strCode, Not blnRemark, blnYes) Then
'            mfrmAccount.ToolRefresh
'            'mfrmAccount.ListRefresh
'        End If
'
'End Sub

Private Sub mfrmAccount_ListNew()
    frmAccountCard.AddCard , mfrmAccount.sstPages.Tab, vbModal
    Set frmAccountCard = Nothing
End Sub

Private Sub mfrmAccount_ListShowAll()
    With mfrmAccount
        If .chkShowall = 0 Then
            .ShowAll(.sstPages.Tab) = " Account.blnIsInActive=0"
'            .SpSelect(.sstPages.Tab) = "Account.lngAccountID As id"
'            .SpWhere(.sstPages.Tab) = "not Account.blnIsInActive"
        Else
            .ShowAll(.sstPages.Tab) = ""
'            .SpSelect(.sstPages.Tab) = "Account.lngAccountID As id,IIF(Account.blnIsInActive,'√','') As 停用"
'            .SpWhere(.sstPages.Tab) = ""
        End If
        .ToolRefresh
    End With
End Sub

Private Sub mfrmAccount_ListUsed()
    UseCode Message.msgAccount, mfrmAccount.ListID
    mfrmAccount.ZOrder 1
End Sub
'用户菜单处理
Private Sub mfrmAccount_ListUserMenu(ByVal Index As Integer)
    If Index = 7 Then
        frmAccountCopyCard.Show vbModal
        Unload frmAccountCopyCard
        Set frmAccountCopyCard = Nothing
    End If
End Sub
'停用
Private Function UpdateIsActive(ByVal strCode As String, ByVal blnIsInActive As Boolean, ByVal blnYes As Boolean) As Boolean
    Dim strSql As String
    Dim strSuSql As String
    
    If blnIsInActive Then
        strSql = "UPDATE Account SET blnIsInActive = " & IIf(blnIsInActive, 1, 0) & " WHERE strAccountcode='" & strCode & "' Or strAccountcode like '" & strCode & "-%'"
    Else
        If blnYes Then
            strSuSql = "UPDATE Account SET blnIsInActive = " & IIf(blnIsInActive, 1, 0) & " WHERE strAccountcode='" & strCode & "' Or strAccountcode like '" & strCode & "-%'"
        End If
        strSql = "UPDATE Account SET blnIsInActive = " & IIf(blnIsInActive, 1, 0) & " WHERE strAccountcode  in  ('" & strCode
        Do Until CodePrefix(strCode) = ""
            strCode = CodePrefix(strCode)
            strSql = strSql & "','" & strCode
        Loop
        strSql = strSql & "')"
    End If
    If blnYes Then
        If Not gclsBase.ExecSQL(strSuSql) Then
            UpdateIsActive = False
            Exit Function
        End If
    End If
    UpdateIsActive = gclsBase.ExecSQL(strSql)
End Function
'是否停用
Private Function ListIsInActive(ByVal lngID As Long, strCode As String) As Boolean
    Dim recTmp As rdoResultset
    Dim strSql As String
    strSql = "Select blnIsInActive,strAccountCode  from Account Where lngAccountID=" & lngID
    Set recTmp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    If Not recTmp.EOF Then
        ListIsInActive = IIf(recTmp!blnIsInActive = 1, True, False)
        strCode = recTmp!strAccountCode
    End If
    recTmp.Close
    Set recTmp = Nothing
End Function
'是否有下层编码
Private Function IsLowerCode(ByVal strCode As String) As Boolean
    Dim strSql As String
    Dim tmp As rdoResultset
    strSql = "select blnIsInActive from Account where blnIsInActive=1 and strAccountcode like '" & strCode & "-%'"
    Set tmp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    If tmp.RowCount <> 0 Then
        IsLowerCode = True
    Else
        IsLowerCode = False
    End If
    tmp.Close
    Set tmp = Nothing
End Function
'列表类型
Public Function SetListType(ByVal strList As String)
    mfrmAccount.strListType = strList
    clsListType = strList
End Function
'调用接口
Public Function ShowEachList(ByVal lngID As Long, Optional intTab As Integer = 0) As Boolean
    strWhere = "Account.lngAccountID=" & lngID
    ShowEachList = mfrmAccount.Showlist(lngID, intTab, strWhere)
End Function