clslistcustom.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 = "clsListCustom"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Private WithEvents mfrmCustom As frmAListTemplate   '模版窗体
Attribute mfrmCustom.VB_VarHelpID = -1
Private clsListType As String
Private mblnRefresh(5) As Boolean

Public Function SetListType(ByVal strList As String)
    mfrmCustom.strListType = strList
    clsListType = strList
End Function
Private Sub Class_Initialize()
    Dim strTitle(5) As String
    Dim blnisUser(5) As Boolean
    Dim i As Integer
    Set mfrmCustom = New frmAListTemplate
    
    mfrmCustom.blnReceptionList = False
    mfrmCustom.mTitle = "自定义项目列表"
    mfrmCustom.mHelpID = 30029
    
    For i = 0 To 5
        mblnRefresh(i) = False
    Next
    
    If Not ListModule.InitTitle(strTitle, blnisUser) Then
        MsgBox "没有设置自定义项目", vbExclamation, "自定义项目设置"
        frmDefineSetCard.EditCard
    End If
    ListModule.InitTitle strTitle, blnisUser
    
    mfrmCustom.Tabs = 6
    mfrmCustom.SpTabCaption(0) = strTitle(0) & "(&O)"
    mfrmCustom.SpViewID(0) = 24
    mfrmCustom.SpTabCaption(1) = strTitle(1) & "(&P)"
    mfrmCustom.SpViewID(1) = 25
    mfrmCustom.SpTabCaption(2) = strTitle(2) & "(&T)"
    mfrmCustom.SpViewID(2) = 26
    mfrmCustom.SpTabCaption(3) = strTitle(3) & "(&L)"
    mfrmCustom.SpViewID(3) = 27
    mfrmCustom.SpTabCaption(4) = strTitle(4) & "(&M)"
    mfrmCustom.SpViewID(4) = 28
    mfrmCustom.SpTabCaption(5) = strTitle(5) & "(&N)"
    mfrmCustom.SpViewID(5) = 29
   
    mfrmCustom.SpSelect(0) = "Custom0.lngCustomID As id,decode(Custom0.blnIsInActive,1,'√',' ') As ""停用"""
    mfrmCustom.SpSelect(1) = "Custom1.lngCustomID As id,decode(Custom1.blnIsInActive,1,'√',' ') As ""停用"""
    mfrmCustom.SpSelect(2) = "Custom2.lngCustomID As id,decode(Custom2.blnIsInActive,1,'√',' ') As ""停用"""
    mfrmCustom.SpSelect(3) = "Custom3.lngCustomID As id,decode(Custom3.blnIsInActive,1,'√',' ') As ""停用"""
    mfrmCustom.SpSelect(4) = "Custom4.lngCustomID As id,decode(Custom4.blnIsInActive,1,'√',' ') As ""停用"""
    mfrmCustom.SpSelect(5) = "Custom5.lngCustomID As id,decode(Custom5.blnIsInActive,1,'√',' ') As ""停用"""
    mfrmCustom.ShowAll(0) = " Custom0.blnIsInActive=0"
    mfrmCustom.ShowAll(1) = " Custom1.blnIsInActive=0"
    mfrmCustom.ShowAll(2) = " Custom2.blnIsInActive=0"
    mfrmCustom.ShowAll(3) = " Custom3.blnIsInActive=0"
    mfrmCustom.ShowAll(4) = " Custom4.blnIsInActive=0"
    mfrmCustom.ShowAll(5) = " Custom5.blnIsInActive=0"
    
    mfrmCustom.blnEditByRight(0) = IsCanDo(17, gclsBase.OperatorID)
    mfrmCustom.blnEditByRight(1) = IsCanDo(17, gclsBase.OperatorID)
    mfrmCustom.blnEditByRight(2) = IsCanDo(17, gclsBase.OperatorID)
    mfrmCustom.blnEditByRight(3) = IsCanDo(17, gclsBase.OperatorID)
    mfrmCustom.blnEditByRight(4) = IsCanDo(17, gclsBase.OperatorID)
    mfrmCustom.blnEditByRight(5) = IsCanDo(17, gclsBase.OperatorID) 'False 'IsCanDo(10, gclsBase.OperatorID)
    
    mfrmCustom.SpPrintID(0) = 92
    mfrmCustom.SpPrintID(1) = 93
    mfrmCustom.SpPrintID(2) = 94
    mfrmCustom.SpPrintID(3) = 95
    mfrmCustom.SpPrintID(4) = 96
    mfrmCustom.SpPrintID(5) = 97
    mfrmCustom.SpPrintTitle(0) = "自定义项目0列表 " & Chr(1) & gclsBase.BaseName & Chr(1) & gclsBase.OperatorName
    mfrmCustom.SpPrintTitle(1) = "自定义项目1列表" & Chr(1) & gclsBase.BaseName & Chr(1) & gclsBase.OperatorName
    mfrmCustom.SpPrintTitle(2) = "自定义项目2列表" & Chr(1) & gclsBase.BaseName & Chr(1) & gclsBase.OperatorName
    mfrmCustom.SpPrintTitle(3) = "自定义项目3列表" & Chr(1) & gclsBase.BaseName & Chr(1) & gclsBase.OperatorName
    mfrmCustom.SpPrintTitle(4) = "自定义项目4列表" & Chr(1) & gclsBase.BaseName & Chr(1) & gclsBase.OperatorName
    mfrmCustom.SpPrintTitle(5) = "自定义项目5列表" & Chr(1) & gclsBase.BaseName & Chr(1) & gclsBase.OperatorName
    
    mfrmCustom.SpMenuCount = 1
    mfrmCustom.SpPosition = 7
    mfrmCustom.SpEnableOnPageNo(0) = 63
    mfrmCustom.blnConstant(0) = True
    mfrmCustom.SpMenuName(0) = "自定项目设置(&C)"
    
    mfrmCustom.MenuEnbaleOnPage(0) = 63
    mfrmCustom.MenuEnbaleOnPage(1) = 63
    mfrmCustom.MenuEnbaleOnPage(2) = 63
    mfrmCustom.MenuEnbaleOnPage(3) = 63
    mfrmCustom.MenuEnbaleOnPage(4) = 63
    mfrmCustom.MenuEnbaleOnPage(5) = 63
    mfrmCustom.MenuEnbaleOnPage(6) = 63
    mfrmCustom.MenuEnbaleOnPage(7) = 63
End Sub

Public Function Showlist()
    mfrmCustom.Show
    mfrmCustom.ZOrder 0
End Function

Private Sub mfrmCustom_ListChildActive()
    Dim vntMessage As Variant
    '响应消息
    Dim i As Integer
    For Each vntMessage In mfrmCustom.mclsMainControl.Messages
        Select Case vntMessage
            Case Message.msgCustom1
                '接收到部门雇员改变消息
                  If mfrmCustom.sstPages.Tab = 0 Then
                  mfrmCustom.ToolRefresh
                  mfrmCustom.mclsMainControl.Messages.Remove CStr(vntMessage) '清除部门雇员改变消息
                  End If
            Case Message.msgCustom2
                    If mfrmCustom.sstPages.Tab = 1 Then
                    mfrmCustom.ToolRefresh
                    mfrmCustom.mclsMainControl.Messages.Remove CStr(vntMessage)
                    End If
            Case Message.msgCustom3
                    If mfrmCustom.sstPages.Tab = 2 Then
                    mfrmCustom.ToolRefresh
                    mfrmCustom.mclsMainControl.Messages.Remove CStr(vntMessage)
                    End If
            Case Message.msgCustom4    '接收到部门雇员改变消息
                   If mfrmCustom.sstPages.Tab = 3 Then
                    mfrmCustom.ToolRefresh
                    mfrmCustom.mclsMainControl.Messages.Remove CStr(vntMessage) '
                    End If
            Case Message.msgCustom5    '接收到部门雇员改变消息
                If mfrmCustom.sstPages.Tab = 4 Then
                    mfrmCustom.ToolRefresh
                    mfrmCustom.mclsMainControl.Messages.Remove CStr(vntMessage) '
                End If
            Case Message.msgCustom6    '接收到部门雇员改变消息
                If mfrmCustom.sstPages.Tab = 5 Then
                mfrmCustom.ToolRefresh
                mfrmCustom.mclsMainControl.Messages.Remove CStr(vntMessage) '
                End If
            Case Message.msgDefinedSetTittle
                
                InitsstPages
                mfrmCustom.ToolRefresh
                For i = 0 To 5
                    If i <> mfrmCustom.sstPages.Tab Then mblnRefresh(i) = True
                Next
            Case Else
                
        End Select
    Next
    For i = 0 To 5
        If i = mfrmCustom.sstPages.Tab Then
            If mblnRefresh(i) Then
                mfrmCustom.ToolRefresh
                mblnRefresh(i) = False
            End If
        End If
    Next
    'mfrmCustom.mclsMainControl.Messages.Clear
End Sub

Private Sub mfrmCustom_ListDel()
    Dim lngID As Long
    Dim blnSucess As Boolean
    lngID = mfrmCustom.ListID
    If lngID = 0 Then Exit Sub
    blnSucess = False
    If frmDefineCard.DelCard(Left(mfrmCustom.sstPages.Caption, Len(mfrmCustom.sstPages.Caption) - 4), lngID) Then
        'UpDatePreFlage
        blnSucess = True
        Select Case mfrmCustom.sstPages.Tab
            Case 0
                gclsSys.SendMessage CStr(mfrmCustom.hWnd), Message.msgCustom1
            Case 1
                gclsSys.SendMessage CStr(mfrmCustom.hWnd), Message.msgCustom2
            Case 2
                gclsSys.SendMessage CStr(mfrmCustom.hWnd), Message.msgCustom3
            Case 3
                gclsSys.SendMessage CStr(mfrmCustom.hWnd), Message.msgCustom4
            Case 4
                gclsSys.SendMessage CStr(mfrmCustom.hWnd), Message.msgCustom5
            Case 5
                gclsSys.SendMessage CStr(mfrmCustom.hWnd), Message.msgCustom6
        End Select
    End If
    Unload frmDefineCard
    Set frmDefineCard = Nothing
    If blnSucess Then
        With mfrmCustom
           .ToolRefresh
        End With
    End If
End Sub

Private Sub mfrmCustom_ListEdite()
    Dim lngID As Long
    lngID = mfrmCustom.ListID
    mfrmCustom.Enabled = False
    mfrmCustom.MousePointer = vbHourglass
    If lngID > 0 Then
     If CheckIDUsed("Custom" & mfrmCustom.sstPages.Tab, "lngCustomID", lngID) Then
         frmDefineCard.EditCard Left(mfrmCustom.sstPages.Caption, Len(mfrmCustom.sstPages.Caption) - 4), lngID, vbModal
         Set frmDefineCard = Nothing
     Else
         ShowMsg 0, "该自定项目不存在,不能进行修改！", _
                vbExclamation + MB_TASKMODAL, "修改自定项目"
         mfrmCustom.ToolRefresh
     End If
    End If
    mfrmCustom.MousePointer = vbDefault
    mfrmCustom.Enabled = True
End Sub

Private Sub mfrmCustom_oListInActive()
Dim blnYes As Boolean
Dim strCode As String
Dim lngID As Long
Dim blnRemark As Boolean

lngID = mfrmCustom.ListID
If lngID = 0 Then Exit Sub
With mfrmCustom.sstPages
        blnRemark = ListIsInActive(.Tab, lngID, strCode)
        If blnRemark And IsLowerCode(.Tab, strCode) Then
            intResponse = ShowMsg(mfrmCustom.hWnd, "是否取消所有下级的停用标记", vbYesNo, mfrmCustom.mTitle)
            blnYes = IIf(intResponse = 6, True, False)
        End If
        If UpdateIsActive(.Tab, strCode, Not blnRemark, blnYes) Then
            mfrmCustom.ToolRefresh
            If .Tab = 0 Then gclsSys.SendMessage CStr(mfrmCustom.hWnd), Message.msgCustom1
            If .Tab = 1 Then gclsSys.SendMessage CStr(mfrmCustom.hWnd), Message.msgCustom2
            If .Tab = 2 Then gclsSys.SendMessage CStr(mfrmCustom.hWnd), Message.msgCustom3
            If .Tab = 3 Then gclsSys.SendMessage CStr(mfrmCustom.hWnd), Message.msgCustom4
            If .Tab = 4 Then gclsSys.SendMessage CStr(mfrmCustom.hWnd), Message.msgCustom5
            If .Tab = 5 Then gclsSys.SendMessage CStr(mfrmCustom.hWnd), Message.msgCustom6
        End If
    End With
End Sub


Private Sub mfrmCustom_ListInActive(blnLevel As Boolean, blnSuceess As Boolean)
    Dim blnYes As Boolean
Dim strCode As String
Dim lngID As Long
Dim blnRemark As Boolean
blnLevel = True
blnSuceess = False
lngID = mfrmCustom.ListID
If lngID = 0 Then Exit Sub
With mfrmCustom.sstPages
        blnRemark = ListIsInActive(.Tab, lngID, strCode)
        If blnRemark And IsLowerCode(.Tab, strCode) Then
            intResponse = ShowMsg(mfrmCustom.hWnd, "是否取消所有下级的停用标记", vbYesNo, mfrmCustom.mTitle)
            blnYes = IIf(intResponse = 6, True, False)
        End If
        If UpdateIsActive(.Tab, strCode, Not blnRemark, blnYes) Then
            'mfrmCustom.ToolRefresh
            blnSuceess = True
            If .Tab = 0 Then gclsSys.SendMessage CStr(mfrmCustom.hWnd), Message.msgCustom1
            If .Tab = 1 Then gclsSys.SendMessage CStr(mfrmCustom.hWnd), Message.msgCustom2
            If .Tab = 2 Then gclsSys.SendMessage CStr(mfrmCustom.hWnd), Message.msgCustom3