clslistclass.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 = "clsListClass"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Private WithEvents mfrmClass As frmAListTemplate '模版窗体
Attribute mfrmClass.VB_VarHelpID = -1
Private clsListType As String
Public Function SetListType(ByVal strList As String)
    mfrmClass.strListType = strList
    clsListType = strList
End Function
Private Sub Class_Initialize()
    Set mfrmClass = New frmAListTemplate
    
    mfrmClass.blnReceptionList = False
    mfrmClass.mTitle = "统计项目"
    mfrmClass.mHelpID = 30011
    
    mfrmClass.Tabs = 2
    mfrmClass.SpTabCaption(0) = "统计(&M)"
    mfrmClass.SpViewID(0) = 48
    mfrmClass.SpTabCaption(1) = "项目(&N)"
    mfrmClass.SpViewID(1) = 52
    
   
    mfrmClass.SpSelect(0) = "Class1.lngClassID As id,decode(Class1.blnIsInActive,1,'√',' ') As ""停用"""
    mfrmClass.SpSelect(1) = "Class2.lngClassID As id,decode(Class2.blnIsInActive,1,'√',' ') As ""停用"""
    mfrmClass.blnEditByRight(0) = IsCanDo(13, gclsBase.OperatorID)
    mfrmClass.blnEditByRight(1) = IsCanDo(14, gclsBase.OperatorID)
    mfrmClass.ShowAll(0) = " Class1.blnIsInActive=0"
    mfrmClass.ShowAll(1) = " Class2.blnIsInActive=0"
    
    mfrmClass.SpPrintID(0) = 19
    mfrmClass.SpPrintID(1) = 20
   
    mfrmClass.SpPrintTitle(0) = "统计列表" & Chr(1) & gclsBase.BaseName & Chr(1) & gclsBase.OperatorName
    mfrmClass.SpPrintTitle(1) = "项目列表" & Chr(1) & gclsBase.BaseName & Chr(1) & gclsBase.OperatorName
    
    mfrmClass.MenuEnbaleOnPage(0) = 3
    mfrmClass.MenuEnbaleOnPage(1) = 3
    mfrmClass.MenuEnbaleOnPage(2) = 3
    mfrmClass.MenuEnbaleOnPage(3) = 3
    mfrmClass.MenuEnbaleOnPage(4) = 3
    mfrmClass.MenuEnbaleOnPage(5) = 3
    mfrmClass.MenuEnbaleOnPage(6) = 3
    mfrmClass.MenuEnbaleOnPage(7) = 3
End Sub

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

Private Sub mfrmClass_ListChildActive()
    Dim vntMessage As Variant
    '响应消息
    For Each vntMessage In mfrmClass.mclsMainControl.Messages
        Select Case vntMessage
            Case Message.msgClass
                '接收到部门雇员改变消息
                  If mfrmClass.sstPages.Tab = 0 Then
                  mfrmClass.ToolRefresh
                  mfrmClass.mclsMainControl.Messages.Remove CStr(vntMessage) '清除部门雇员改变消息
                  End If
            Case Message.msgClass2
                    If mfrmClass.sstPages.Tab = 1 Then
                    mfrmClass.ToolRefresh
                    mfrmClass.mclsMainControl.Messages.Remove CStr(vntMessage)
                    End If
        End Select
    Next
    'mfrmClass.mclsMainControl.Messages.Clear
End Sub

Private Sub mfrmClass_ListDel()
    Dim lngID As Long
    Dim blnSucess As Boolean
    lngID = mfrmClass.ListID
    If lngID = 0 Then Exit Sub
    blnSucess = False
    Select Case mfrmClass.sstPages.Tab
        Case 0
            If frmClass1Card.DelCard(lngID) Then
                'UpDatePreFlage 0
                blnSucess = True
                gclsSys.SendMessage CStr(mfrmClass.hWnd), Message.msgClass
            End If
            Unload frmClass1Card
            Set frmClass1Card = Nothing
        Case 1
            If frmClass2Card.DelCard(lngID) Then
                'UpDatePreFlage 1
                blnSucess = True
                gclsSys.SendMessage CStr(mfrmClass.hWnd), Message.msgClass2
            End If
            Unload frmClass2Card
            Set frmClass2Card = Nothing
    End Select
    If blnSucess Then
        With mfrmClass
           .ToolRefresh
        End With
    End If
End Sub

Private Sub mfrmClass_ListEdite()
    Dim lngID As Long
    lngID = mfrmClass.ListID
    mfrmClass.Enabled = False
    mfrmClass.MousePointer = vbHourglass
    Select Case mfrmClass.sstPages.Tab
        Case 0
            If lngID > 0 Then
                If CheckIDUsed("Class1", "lngClassID", lngID) Then
                    frmClass1Card.EditCard lngID, vbModal
                    Set frmClass1Card = Nothing
                Else
                    ShowMsg 0, "统计不存在,不能进行修改！", _
                           vbExclamation + MB_TASKMODAL, "修改统计"
                    mfrmClass.ToolRefresh
                End If
            End If
        Case 1
            If lngID > 0 Then
                If CheckIDUsed("Class2", "lngClassID", lngID) Then
'                    frmClass2ListCard.EditCard lngID
                    frmClass2Card.EditCard lngID, vbModal
                    Set frmClass2Card = Nothing
                Else
                    ShowMsg 0, "项目不存在,不能进行修改！", _
                            vbExclamation + MB_TASKMODAL, "修改项目"
                    mfrmClass.ToolRefresh
                End If
            End If
    End Select
    mfrmClass.MousePointer = vbDefault
    mfrmClass.Enabled = True
End Sub

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

lngID = mfrmClass.ListID
If lngID = 0 Then Exit Sub
With mfrmClass.sstPages
        blnRemark = ListIsInActive(.Tab, lngID, strCode)
        If blnRemark And IsLowerCode(.Tab, strCode) Then
            intResponse = ShowMsg(mfrmClass.hWnd, "是否取消所有下级的停用标记", vbYesNo, mfrmClass.mTitle)
            blnYes = IIf(intResponse = 6, True, False)
        End If
        If UpdateIsActive(.Tab, strCode, Not blnRemark, blnYes) Then
            mfrmClass.ToolRefresh
            If .Tab = 0 Then gclsSys.SendMessage CStr(mfrmClass.hWnd), Message.msgClass
            If .Tab = 1 Then gclsSys.SendMessage CStr(mfrmClass.hWnd), Message.msgClass2
        End If
End With
End Sub


Private Sub mfrmClass_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 = mfrmClass.ListID
If lngID = 0 Then Exit Sub
With mfrmClass.sstPages
        blnRemark = ListIsInActive(.Tab, lngID, strCode)
        If blnRemark And IsLowerCode(.Tab, strCode) Then
            intResponse = ShowMsg(mfrmClass.hWnd, "是否取消所有下级的停用标记", vbYesNo, mfrmClass.mTitle)
            blnYes = IIf(intResponse = 6, True, False)
        End If
        If UpdateIsActive(.Tab, strCode, Not blnRemark, blnYes) Then
            mfrmClass.ToolRefresh
            blnSuceess = True
            If .Tab = 0 Then gclsSys.SendMessage CStr(mfrmClass.hWnd), Message.msgClass
            If .Tab = 1 Then gclsSys.SendMessage CStr(mfrmClass.hWnd), Message.msgClass2
        End If
End With
End Sub

Private Sub mfrmClass_ListNew()
    mfrmClass.MousePointer = vbHourglass
    Select Case mfrmClass.sstPages.Tab
        Case 0
            frmClass1Card.AddCard , vbModal
            Set frmClass1Card = Nothing
        Case 1
            frmClass2Card.AddCard , vbModal
            Set frmClass2Card = Nothing
    End Select
    mfrmClass.MousePointer = vbDefault
End Sub

Private Sub mfrmClass_ListShowAll()
    With mfrmClass
        If .chkShowall = 0 Then
            Select Case .sstPages.Tab
                Case 0
                     .ShowAll(.sstPages.Tab) = "  Class1.blnIsInActive=0 "
                Case 1
                    .ShowAll(.sstPages.Tab) = "  Class2.blnIsInActive=0 "
            End Select
        Else
            .ShowAll(.sstPages.Tab) = ""
'            Select Case .sstPages.Tab
'                Case 0
'                    .ShowAll(.sstPages.Tab) = ""
'                     '.SpSelect(.sstPages.Tab) = "Class1.lngClassID As id,IIF(Class1.blnIsInActive,'√','') As 停用"
'                Case 1
'                    .ShowAll(.sstPages.Tab) = ""
'            End Select
        End If
        .ToolRefresh
    End With
End Sub

Private Sub mfrmClass_ListUsed()
    Dim lngID As Long
    
    lngID = mfrmClass.ListID
    Select Case mfrmClass.sstPages.Tab
        Case 0
            UseCode Message.msgClass, lngID
        Case 1
            UseCode Message.msgClass2, lngID
    End Select
    mfrmClass.ZOrder 1
End Sub

Private Function UpdateIsActive(ByVal intTab As Integer, 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 Class" & intTab + 1 & " SET blnIsInActive = " & IIf(blnIsInActive, 1, 0) & " WHERE strClassCode = '" & strCode & "' Or strClassCode like '" & strCode & "-%'"
     Else
        If blnYes Then
            strSuSql = "UPDATE Class" & intTab + 1 & " SET blnIsInActive = " & IIf(blnIsInActive, 1, 0) & " WHERE strClassCode='" & strCode & "' Or strClassCode like '" & strCode & "-%'"
        End If
        strSql = "UPDATE Class" & intTab + 1 & " SET blnIsInActive = " & IIf(blnIsInActive, 1, 0) & " WHERE strClassCode  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 intTab As Integer, ByVal lngID As Long, strCode As String) As Boolean
    Dim recTmp As rdoResultset
    Dim strSql As String
    strSql = "Select blnIsInActive,strClassCode  from Class" & intTab + 1 & " Where lngClassID=" & lngID
    Set recTmp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    If Not recTmp.EOF Then
        ListIsInActive = IIf(recTmp!blnIsInActive = 1, True, False)
        strCode = recTmp!strClassCode
    End If
End Function
Private Function IsLowerCode(ByVal intTab As Integer, ByVal strCode As String) As Boolean
    Dim strSql As String
    Dim tmp As rdoResultset
    strSql = "select blnIsInActive from Class" & intTab + 1 & " where blnIsInActive=1 and strClasscode like '" & strCode & "-%'"
    Set tmp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    If tmp.RowCount <> 0 Then
        IsLowerCode = True
    Else
        IsLowerCode = False
    End If
End Function

Public Function ShowEachList(ByVal lngID As Long, Optional intTab As Integer = 0) As Boolean
    strWhere = "Class" & intTab + 1 & ".lngClassID=" & lngID
    ShowEachList = mfrmClass.Showlist(lngID, intTab, strWhere)
End Function