clslistcheck.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 = "clsListCheck"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

Private WithEvents mfrmCheck As frmAListTemplate '模版窗体
Attribute mfrmCheck.VB_VarHelpID = -1
Private clsListType As String
Public Function SetListType(ByVal strList As String)
    mfrmCheck.strListType = strList
    clsListType = strList
End Function
Private Sub Class_Initialize()
    Set mfrmCheck = New frmAListTemplate
    
    mfrmCheck.blnReceptionList = True
    mfrmCheck.blnunDefaultWhere = True
    mfrmCheck.mTitle = "票据管理"
    mfrmCheck.mHelpID = 30047
    
    mfrmCheck.Tabs = 2
    mfrmCheck.SpTabCaption(0) = "票据购买(&M)"
    mfrmCheck.SpViewID(0) = 1197
    mfrmCheck.SpTabCaption(1) = "票据领用(&N)"
    mfrmCheck.SpViewID(1) = 1198
    
   
    mfrmCheck.SpSelect(0) = "Check1.lngActivityID As id,' ' As ""作废"""
    mfrmCheck.SpSelect(1) = "CheckDetail.lngActivityDetailID As id,decode(CheckDetail.blnIsInActive,1,'√',' ') As ""作废"""
    
    mfrmCheck.ShowAll(1) = " CheckDetail.blnIsInActive=0"
    
    mfrmCheck.blnEditByRight(0) = IsCanDo(338, gclsBase.OperatorID)
    mfrmCheck.blnEditByRight(1) = IsCanDo(338, gclsBase.OperatorID)
    
    mfrmCheck.SpPrintID(0) = 27
    mfrmCheck.SpPrintID(1) = 28
   
    mfrmCheck.SpPrintTitle(0) = "票据购买列表" & Chr(1) & gclsBase.BaseName & Chr(1) & gclsBase.OperatorName
    mfrmCheck.SpPrintTitle(1) = "票据领用列表" & Chr(1) & gclsBase.BaseName & Chr(1) & gclsBase.OperatorName
    
    mfrmCheck.SpMenuCount = 2
    mfrmCheck.SpPosition = 7
    mfrmCheck.SpEnableOnPageNo(0) = IIf(IsCanDo(338, gclsBase.OperatorID), 2, 0)
    mfrmCheck.blnConstant(0) = False
    mfrmCheck.SpMenuName(0) = "报销(&C)"
    mfrmCheck.SpEnableOnPageNo(1) = IIf(IsCanDo(338, gclsBase.OperatorID), 2, 0)
    mfrmCheck.blnConstant(1) = True
    mfrmCheck.SpMenuName(1) = "批量删除(&C)"
    
    mfrmCheck.MenuEnbaleOnPage(0) = 2
    mfrmCheck.MenuEnbaleOnPage(1) = 2
    mfrmCheck.MenuEnbaleOnPage(2) = 3
    mfrmCheck.MenuEnbaleOnPage(3) = 3
    mfrmCheck.MenuEnbaleOnPage(4) = 3
    mfrmCheck.MenuEnbaleOnPage(5) = 3
    mfrmCheck.MenuEnbaleOnPage(6) = 3
    mfrmCheck.MenuEnbaleOnPage(7) = 3
End Sub

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

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

Private Sub mfrmCheck_ListDel()
    Dim lngID As Long
    Dim blnSucess As Boolean
    lngID = mfrmCheck.ListID
    If lngID = 0 Then Exit Sub
    blnSucess = False
    Select Case mfrmCheck.sstPages.Tab
        Case 0
            blnSucess = DelCheckBuy(mfrmCheck.hWnd, lngID, True)
        Case 1
            blnSucess = DelCheckUse(mfrmCheck.hWnd, lngID, True)
    End Select
    If blnSucess Then
        With mfrmCheck
           .ToolRefresh
        End With
    End If
End Sub

Private Sub mfrmCheck_ListEdite()
    Dim lngID As Long
    lngID = mfrmCheck.ListID
    mfrmCheck.Enabled = False
    mfrmCheck.MousePointer = vbHourglass
    Select Case mfrmCheck.sstPages.Tab
        Case 0
            If lngID > 0 Then
                frmBuyTicket.EditACard lngID
                Set frmBuyTicket = Nothing
            End If
        Case 1
            If lngID > 0 Then
                frmLendTicket.EditACard lngID
                Set frmLendTicket = Nothing
            End If
    End Select
    mfrmCheck.MousePointer = vbDefault
    mfrmCheck.Enabled = True
End Sub

Private Sub mfrmCheck_oListInActive()
Dim blnYes As Boolean
Dim strCode As String
Dim lngID As Long
Dim blnRemark As Boolean
Dim blnSuccess As Boolean
lngID = mfrmCheck.ListID
blnSuccess = False
With mfrmCheck.sstPages
        If .Tab = 0 Then Exit Sub
        If lngID = 0 Then Exit Sub
        blnRemark = mfrmCheck.IsInActive
        blnSuccess = DelCheckUse(mfrmCheck.hWnd, lngID, False, blnRemark)
        If blnSuccess Then
            mfrmCheck.ToolRefresh
            If .Tab = 1 Then gclsSys.SendMessage CStr(mfrmCheck.hWnd), Message.msgRCheckUser
        End If
End With
End Sub

Private Sub mfrmCheck_ListInActive(blnLevel As Boolean, blnSuceess As Boolean)
    Dim blnYes As Boolean
Dim strCode As String
Dim lngID As Long
Dim blnRemark As Boolean
'Dim blnSuccess As Boolean
blnLevel = False
blnSuceess = False
lngID = mfrmCheck.ListID
'blnSuceess = False
With mfrmCheck.sstPages
        If .Tab = 0 Then Exit Sub
        If lngID = 0 Then Exit Sub
        blnRemark = mfrmCheck.IsInActive
        blnSuceess = DelCheckUse(mfrmCheck.hWnd, lngID, False, blnRemark)
        If blnSuceess Then
            'mfrmCheck.ToolRefresh
            If .Tab = 1 Then gclsSys.SendMessage CStr(mfrmCheck.hWnd), Message.msgRCheckUser
        End If
End With
End Sub

Private Sub mfrmCheck_ListNew()
    mfrmCheck.MousePointer = vbHourglass
    Select Case mfrmCheck.sstPages.Tab
        Case 0
            frmBuyTicket.NewCard
            Set frmBuyTicket = Nothing
        Case 1
            frmLendTicket.NewCard
            Set frmLendTicket = Nothing
    End Select
    mfrmCheck.MousePointer = vbDefault
End Sub

Private Sub mfrmCheck_ListShowAll()
    With mfrmCheck
        If .chkShowall = 0 Then
            Select Case .sstPages.Tab
                Case 0
                    ' .ShowAll(.sstPages.Tab) = "FixedType.blnIsInActive=0 "
                Case 1
                    .ShowAll(.sstPages.Tab) = "CheckDetail.blnIsInActive=0 "
            End Select
        Else
            .ShowAll(.sstPages.Tab) = ""
        End If
        .ToolRefresh
    End With
End Sub

Private Sub mfrmCheck_ListUsed()
    Dim lngID As Long
    
    lngID = mfrmCheck.ListID
    Select Case mfrmCheck.sstPages.Tab
        Case 0
            UseCode Message.msgRCheckBuy, lngID
        Case 1
            UseCode Message.msgRCheckUser, lngID
    End Select
    mfrmCheck.ZOrder 1
End Sub

Private Function UpdateIsActive(ByVal intTab As Integer, ByVal lngID As Long, ByVal blnIsInActive As Boolean, ByVal blnYes As Boolean) As Boolean
    Dim strSql As String
    Dim strSuSql As String
    Select Case intTab
        Case 1
            strSql = "UPDATE CheckDetail SET blnIsInActive = " & IIf(blnIsInActive, 1, 0) & " WHERE lngActivityDetailID = " & lngID & ""
    End Select
    UpdateIsActive = gclsBase.ExecSQL(strSql)
End Function

Private Sub mfrmCheck_ListUserMenu(ByVal Index As Integer)
    Dim strIn As String
    Dim lngID As Long
    
    
    If mfrmCheck.sstPages.Tab = 1 Then
        lngID = mfrmCheck.ListID
        If Index = 7 Then
            frmLendTicket.CheckACard lngID
        ElseIf Index = 8 Then
           frmDelAllTicket.DelTicket mfrmCheck.strInID
        End If
    End If
End Sub