clslistfixedtype.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 = "clsListFixedType"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Private WithEvents mfrmFixedType As frmAListTemplate    '模版窗体
Attribute mfrmFixedType.VB_VarHelpID = -1
Private clsListType As String
Public Function SetListType(ByVal strList As String)
    mfrmFixedType.strListType = strList
    clsListType = strList
End Function
Private Sub Class_Initialize()
    Set mfrmFixedType = New frmAListTemplate
    
    mfrmFixedType.blnReceptionList = False
    mfrmFixedType.mTitle = "固资编码"
    mfrmFixedType.mHelpID = 30047
    
    mfrmFixedType.Tabs = 2
    mfrmFixedType.SpTabCaption(0) = "固资类别(&M)"
    mfrmFixedType.SpViewID(0) = 46
    mfrmFixedType.SpTabCaption(1) = "固资变动(&N)"
    mfrmFixedType.SpViewID(1) = 16
    
   
    mfrmFixedType.SpSelect(0) = "FixedType.lngFixedTypeID As id,decode(FixedType.blnIsInActive,1,'√',' ') As ""停用"""
    mfrmFixedType.SpSelect(1) = "FixedMethod.lngFixedMethodID As id,decode(FixedMethod.blnIsInActive,1,'√',' ') As ""停用"""
    mfrmFixedType.ShowAll(0) = " FixedType.blnIsInActive=0"
    mfrmFixedType.ShowAll(1) = " FixedMethod.blnIsInActive=0"
    
    mfrmFixedType.blnEditByRight(0) = IsCanDo(20, gclsBase.OperatorID)
    mfrmFixedType.blnEditByRight(1) = IsCanDo(21, gclsBase.OperatorID)
    
    mfrmFixedType.SpPrintID(0) = 27
    mfrmFixedType.SpPrintID(1) = 28
   
    mfrmFixedType.SpPrintTitle(0) = "固资类别列表" & Chr(1) & gclsBase.BaseName & Chr(1) & gclsBase.OperatorName
    mfrmFixedType.SpPrintTitle(1) = "固资变动列表" & Chr(1) & gclsBase.BaseName & Chr(1) & gclsBase.OperatorName
    
    mfrmFixedType.SpMenuCount = 1
    mfrmFixedType.SpPosition = 7
    mfrmFixedType.SpEnableOnPageNo(0) = 1
    mfrmFixedType.blnConstant(0) = True
    mfrmFixedType.SpMenuName(0) = "自定项目设置(&C)"
    
    mfrmFixedType.MenuEnbaleOnPage(0) = 3
    mfrmFixedType.MenuEnbaleOnPage(1) = 3
    mfrmFixedType.MenuEnbaleOnPage(2) = 3
    mfrmFixedType.MenuEnbaleOnPage(3) = 3
    mfrmFixedType.MenuEnbaleOnPage(4) = 3
    mfrmFixedType.MenuEnbaleOnPage(5) = 3
    mfrmFixedType.MenuEnbaleOnPage(6) = 3
    mfrmFixedType.MenuEnbaleOnPage(7) = 3
End Sub

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

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

Private Sub mfrmFixedType_ListDel()
    Dim lngID As Long
    Dim blnSucess As Boolean
    lngID = mfrmFixedType.ListID
    If lngID = 0 Then Exit Sub
    blnSucess = False
    Select Case mfrmFixedType.sstPages.Tab
        Case 0
            If frmFixedTypeCard.DelCard(lngID) Then
                'UpDatePreFlage 0
                blnSucess = True
                gclsSys.SendMessage CStr(mfrmFixedType.hWnd), Message.msgFixed
            End If
            Unload frmFixedTypeCard
            Set frmFixedTypeCard = Nothing
        Case 1
            If frmFixedMethodCard.DelCard(lngID) Then
                blnSucess = True
                gclsSys.SendMessage CStr(mfrmFixedType.hWnd), Message.msgFixedMethod
            End If
            Unload frmFixedMethodCard
            Set frmFixedMethodCard = Nothing
    End Select
    If blnSucess Then
        With mfrmFixedType
           .ToolRefresh
        End With
    End If
End Sub

Private Sub mfrmFixedType_ListEdite()
    Dim lngID As Long
    lngID = mfrmFixedType.ListID
    mfrmFixedType.Enabled = False
    mfrmFixedType.MousePointer = vbHourglass
    Select Case mfrmFixedType.sstPages.Tab
        Case 0
            If lngID > 0 Then
                If CheckIDUsed("FixedType", "lngFixedTypeID", lngID) Then
                    frmFixedTypeCard.EditCard lngID, vbModal
                    Set frmFixedTypeCard = Nothing
                Else
                    ShowMsg 0, "该固资类型不存在,不能进行修改!", _
                            vbExclamation + MB_TASKMODAL, "修改固资类型"
                    mfrmFixedType.ToolRefresh
                End If
            End If
        Case 1
            If lngID > 0 Then
                If CheckIDUsed("FixedMethod", "lngFixedMethodID", lngID) Then
                    frmFixedMethodCard.EditCard lngID, vbModal
                    Set frmFixedMethodCard = Nothing
                Else
                    ShowMsg 0, "该固资变动不存在,不能进行修改!", _
                            vbExclamation + MB_TASKMODAL, "修改固资变动"
                    mfrmFixedType.ToolRefresh
                End If
            End If
    End Select
    mfrmFixedType.MousePointer = vbDefault
    mfrmFixedType.Enabled = True
End Sub

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

lngID = mfrmFixedType.ListID
If lngID = 0 Then Exit Sub
With mfrmFixedType.sstPages
        blnRemark = ListIsInActive(.Tab, lngID, strCode)
        If IsLevelWCode(Choose(.Tab + 1, "固资类别编码", "固资变动")) And Trim(strCode) <> "" Then
            If blnRemark And IsLowerCode(.Tab, strCode) Then
                intResponse = ShowMsg(mfrmFixedType.hWnd, "是否取消所有下级的停用标记", vbYesNo, mfrmFixedType.mTitle)
                blnYes = IIf(intResponse = 6, True, False)
            End If
        End If
        If UpdateIsActive(.Tab, strCode, Not blnRemark, blnYes) Then
            mfrmFixedType.ToolRefresh
            If .Tab = 0 Then gclsSys.SendMessage CStr(mfrmFixedType.hWnd), Message.msgClass
            If .Tab = 1 Then gclsSys.SendMessage CStr(mfrmFixedType.hWnd), Message.msgClass2
        End If
End With
End Sub


Private Sub mfrmFixedType_ListInActive(blnLevel As Boolean, blnSuceess As Boolean)
    Dim blnYes As Boolean
Dim strCode As String
Dim lngID As Long
Dim blnRemark As Boolean

blnLevel = False
blnSuceess = False

lngID = mfrmFixedType.ListID
If lngID = 0 Then Exit Sub
With mfrmFixedType.sstPages
        blnRemark = ListIsInActive(.Tab, lngID, strCode)
        blnLevel = IsLevelWCode(Choose(.Tab + 1, "固资类别编码", "固资变动"))
        If blnLevel And Trim(strCode) <> "" Then
            If blnRemark And IsLowerCode(.Tab, strCode) Then
                intResponse = ShowMsg(mfrmFixedType.hWnd, "是否取消所有下级的停用标记", vbYesNo, mfrmFixedType.mTitle)
                blnYes = IIf(intResponse = 6, True, False)
            End If
        End If
        If UpdateIsActive(.Tab, strCode, Not blnRemark, blnYes) Then
            If blnLevel Then mfrmFixedType.ToolRefresh
            blnSuceess = True
            If .Tab = 0 Then gclsSys.SendMessage CStr(mfrmFixedType.hWnd), Message.msgClass
            If .Tab = 1 Then gclsSys.SendMessage CStr(mfrmFixedType.hWnd), Message.msgClass2
        End If
End With
End Sub

Private Sub mfrmFixedType_ListNew()
    mfrmFixedType.MousePointer = vbHourglass
    Select Case mfrmFixedType.sstPages.Tab
        Case 0
            frmFixedTypeCard.AddCard , vbModal
            Set frmFixedTypeCard = Nothing
        Case 1
            frmFixedMethodCard.AddCard , vbModal
            Set frmFixedMethodCard = Nothing
    End Select
    mfrmFixedType.MousePointer = vbDefault
End Sub

Private Sub mfrmFixedType_ListShowAll()
    With mfrmFixedType
        If .chkShowall = 0 Then
            Select Case .sstPages.Tab
                Case 0
                     .ShowAll(.sstPages.Tab) = "FixedType.blnIsInActive=0 "
                Case 1
                    .ShowAll(.sstPages.Tab) = "FixedMethod.blnIsInActive=0 "
            End Select
        Else
            .ShowAll(.sstPages.Tab) = ""
'            Select Case .sstPages.Tab
'                Case 0
'                     .SpSelect(.sstPages.Tab) = "FixedType.lngFixedTypeID As id,IIF(FixedType.blnIsInActive,'√','') As 停用"
'                Case 1
'                    .SpSelect(.sstPages.Tab) = "FixedMethod.lngFixedMethodID As id,IIF(FixedMethod.blnIsInActive,'√','') As 停用"
'            End Select
        End If
        .ToolRefresh
    End With
End Sub

Private Sub mfrmFixedType_ListUsed()
    Dim lngID As Long
    
    lngID = mfrmFixedType.ListID
    Select Case mfrmFixedType.sstPages.Tab
        Case 0
            UseCode Message.msgFixed, lngID
        Case 1
            UseCode Message.msgFixedMethod, lngID
    End Select
    mfrmFixedType.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
    Select Case intTab
        Case 0
             If blnIsInActive Then
                    strSql = "UPDATE FixedType SET blnIsInActive = " & IIf(blnIsInActive, 1, 0) & " WHERE strFixedTypeCode = '" & strCode & "' Or strFixedTypeCode like '" & strCode & "-%'"
             Else
                If blnYes Then
                    strSuSql = "UPDATE FixedType SET blnIsInActive = " & IIf(blnIsInActive, 1, 0) & " WHERE strFixedTypeCode='" & strCode & "' Or strFixedTypeCode like '" & strCode & "-%'"
                End If
                strSql = "UPDATE FixedType SET blnIsInActive = " & IIf(blnIsInActive, 1, 0) & " WHERE strFixedTypeCode  in  ('" & strCode
                Do Until CodePrefix(strCode) = ""
                    strCode = CodePrefix(strCode)
                    strSql = strSql & "','" & strCode
                Loop
                strSql = strSql & "')"
                
            End If
        Case 1
            strSql = "UPDATE FixedMethod SET blnIsInActive = " & IIf(blnIsInActive, 1, 0) & " WHERE strFixedMethodCode = '" & strCode & "'"
    End Select
    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
    Select Case intTab
        Case 0
            strSql = "Select blnIsInActive,strFixedTypeCode  as  code  from FixedType  Where lngFixedTypeID=" & lngID
        Case 1
            strSql = "Select blnIsInActive,strFixedMethodCode as code from FixedMethod  Where lngFixedMethodID=" & lngID
    End Select
    Set recTmp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    If Not recTmp.EOF Then
        ListIsInActive = IIf(recTmp!blnIsInActive = 1, True, False)
        strCode = recTmp!Code
    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 FixedType where blnIsInActive=1 and strFixedTypecode like '" & strCode & "-%'"
    Set tmp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    If tmp.RowCount <> 0 Then
        IsLowerCode = True
    Else
        IsLowerCode = False
    End If
End Function

Private Sub mfrmFixedType_ListUserMenu(ByVal Index As Integer)
    If Index = 7 Then
        frmFixedDefineCard.Show vbModal
        Set frmFixedDefineCard = Nothing
    End If
End Sub

Public Function ShowEachList(ByVal lngID As Long, Optional intTab As Integer = 0) As Boolean
    strWhere = Choose(intTab + 1, "FixedType.lngFixedTypeID=", "FixedMethod.lngFixedMethodID=") & lngID
    ShowEachList = mfrmFixedType.Showlist(lngID, intTab, strWhere)
End Function