clslistcustomer.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 = "clsListCustomer"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Private WithEvents mfrmCustomer As frmAListTemplate '模版窗体
Attribute mfrmCustomer.VB_VarHelpID = -1
Private clsListType As String
Public Function SetListType(ByVal strList As String)
    mfrmCustomer.strListType = strList
    clsListType = strList
End Function
Private Sub Class_Initialize()
    Set mfrmCustomer = New frmAListTemplate
    
    mfrmCustomer.blnReceptionList = False
    mfrmCustomer.mTitle = "往来单位"
    mfrmCustomer.mHelpID = 30005

#If conVersionType <> 16 Then
    mfrmCustomer.Tabs = 3
#Else
    mfrmCustomer.Tabs = 2
#End If
    mfrmCustomer.SpTabCaption(0) = "单位类型(&M)"
    mfrmCustomer.SpViewID(0) = 8
    mfrmCustomer.SpTabCaption(1) = "往来单位(&N)"
    mfrmCustomer.SpViewID(1) = 7
#If conVersionType <> 16 Then
    mfrmCustomer.SpTabCaption(2) = "工程(&G)"
    mfrmCustomer.SpViewID(2) = 12
#End If
   
    mfrmCustomer.SpSelect(0) = "CustomerType.lngCustomerTypeID As id,decode(CustomerType.blnIsInActive,1,'√',' ') As ""停用"" "
    mfrmCustomer.SpSelect(1) = "Customer.lngCustomerID As id,decode(Customer.blnIsInActive,1,'√',' ') As ""停用"" "
#If conVersionType <> 16 Then
    mfrmCustomer.SpSelect(2) = "Job.lngJobID As id,decode(Job.blnIsInActive,1,'√',' ') As ""停用"" "
#End If
    mfrmCustomer.ShowAll(0) = "CustomerType.blnIsInActive=0"
    mfrmCustomer.ShowAll(1) = " Customer.blnIsInActive=0"
#If conVersionType <> 16 Then
    mfrmCustomer.ShowAll(2) = " Job.blnIsInActive=0"
#End If
    mfrmCustomer.blnEditByRight(0) = IsCanDo(11, gclsBase.OperatorID)
    mfrmCustomer.blnEditByRight(1) = IsCanDo(11, gclsBase.OperatorID)
#If conVersionType <> 16 Then
    mfrmCustomer.blnEditByRight(2) = IsCanDo(15, gclsBase.OperatorID)
#End If
    mfrmCustomer.SpPrintID(0) = 54
    mfrmCustomer.SpPrintID(1) = 16
#If conVersionType <> 16 Then
    mfrmCustomer.SpPrintID(2) = 64
#End If
    mfrmCustomer.SpPrintTitle(0) = "单位类型列表 " & Chr(1) & gclsBase.BaseName & Chr(1) & gclsBase.OperatorName
    mfrmCustomer.SpPrintTitle(1) = "往来单位列表" & Chr(1) & gclsBase.BaseName & Chr(1) & gclsBase.OperatorName
#If conVersionType <> 16 Then
    mfrmCustomer.SpPrintTitle(2) = "工程列表" & Chr(1) & gclsBase.BaseName & Chr(1) & gclsBase.OperatorName
#End If
    
#If conVersionType <> 16 Then
    mfrmCustomer.SpMenuCount = 1
    mfrmCustomer.SpPosition = 7
    mfrmCustomer.SpEnableOnPageNo(0) = 2
    mfrmCustomer.blnConstant(0) = False
    mfrmCustomer.SpMenuName(0) = "调整折扣率(&Z)"
#End If
    mfrmCustomer.MenuEnbaleOnPage(0) = 7
    mfrmCustomer.MenuEnbaleOnPage(1) = 7
    mfrmCustomer.MenuEnbaleOnPage(2) = 7
    mfrmCustomer.MenuEnbaleOnPage(3) = 7
    mfrmCustomer.MenuEnbaleOnPage(4) = 7
    mfrmCustomer.MenuEnbaleOnPage(5) = 7
    mfrmCustomer.MenuEnbaleOnPage(6) = 7
    mfrmCustomer.MenuEnbaleOnPage(7) = 7
End Sub

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

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

Private Sub mfrmCustomer_ListDel()
    Dim lngID As Long
    Dim blnSucess As Boolean
    lngID = mfrmCustomer.ListID
    If lngID = 0 Then Exit Sub
    blnSucess = False
    Select Case mfrmCustomer.sstPages.Tab
        Case 0
             If frmCustomerTypeCard.DelCard(lngID) Then
                'UpDatePreFlage
                blnSucess = True
                gclsSys.SendMessage CStr(mfrmCustomer.hWnd), Message.msgCustomerType
            End If
            Unload frmCustomerTypeCard
            Set frmCustomerTypeCard = Nothing
        Case 1
            If frmCustomerCard.DelCard(lngID) Then
                blnSucess = True
                gclsSys.SendMessage CStr(mfrmCustomer.hWnd), Message.msgCustomer
            End If
            Unload frmCustomerCard
            Set frmCustomerCard = Nothing
        Case 2
            If frmJobCard.DelCard(lngID) Then
                blnSucess = True
                gclsSys.SendMessage CStr(mfrmCustomer.hWnd), Message.msgJob
            End If
            Unload frmJobCard
            Set frmJobCard = Nothing
    End Select
    If blnSucess Then
        With mfrmCustomer
           .ToolRefresh
        End With
    End If
End Sub

Private Sub mfrmCustomer_ListEdite()
    Dim lngID As Long
    lngID = mfrmCustomer.ListID
    mfrmCustomer.Enabled = False
    mfrmCustomer.MousePointer = vbHourglass
    Select Case mfrmCustomer.sstPages.Tab
        Case 0
            If lngID > 0 Then
                If CheckIDUsed("CustomerType", "lngCustomerTypeID", lngID) Then
                    frmCustomerTypeCard.EditCard lngID, vbModal
                    Set frmCustomerTypeCard = Nothing
                Else
                    ShowMsg 0, "该单位类型不存在,不能进行修改!", vbExclamation + MB_TASKMODAL, "修改单位类型"
                    mfrmCustomer.ToolRefresh
                End If
            End If
        Case 1
            If lngID > 0 Then
                If CheckIDUsed("Customer", "lngCustomerID", lngID) Then
                    frmCustomerCard.EditCard lngID, vbModal
                    Set frmCustomerCard = Nothing
                Else
                    ShowMsg 0, "该往来单位不存在,不能进行修改！", _
                            vbExclamation + MB_TASKMODAL, "修改往来单位"
                    mfrmCustomer.ToolRefresh
                End If
            End If
        Case 2
            If lngID > 0 Then
                If CheckIDUsed("Job", "lngJobID", lngID) Then
                    frmJobCard.EditCard lngID, vbModal
                    Set frmJobCard = Nothing
                Else
                    ShowMsg 0, "该工程不存在,不能进行修改！", _
                           vbExclamation + MB_TASKMODAL, "修改工程"
                    mfrmCustomer.ToolRefresh
                End If
            End If
    End Select
    mfrmCustomer.MousePointer = vbDefault
    mfrmCustomer.Enabled = True