clslistcustomer.cls

金算盘软件代码

End Sub

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

lngID = mfrmCustomer.ListID
If lngID = 0 Then Exit Sub
With mfrmCustomer.sstPages
        blnRemark = ListIsInActive(.Tab, lngID, strCode)
        If IsLevelWCode(Choose(.Tab + 1, "单位类型编码", "往来单位编码", "工程编码")) And Trim(strCode) <> "" Then
            If blnRemark And IsLowerCode(.Tab, strCode) Then
                intResponse = ShowMsg(mfrmCustomer.hWnd, "是否取消所有下级的停用标记", vbYesNo, mfrmCustomer.mTitle)
                blnYes = IIf(intResponse = 6, True, False)
            End If
        End If
        If UpdateIsActive(.Tab, strCode, Not blnRemark, blnYes) Then
            mfrmCustomer.ToolRefresh
            If .Tab = 0 Then gclsSys.SendMessage CStr(mfrmCustomer.hWnd), Message.msgCustomerType
            If .Tab = 1 Then gclsSys.SendMessage CStr(mfrmCustomer.hWnd), Message.msgCustomer
            If .Tab = 2 Then gclsSys.SendMessage CStr(mfrmCustomer.hWnd), Message.msgJob
        End If
    End With
End Sub


Private Sub mfrmCustomer_ListInActive(blnLevel As Boolean, blnSuceess As Boolean)
    Dim blnYes As Boolean
Dim strCode As String
Dim lngID As Long
Dim blnRemark As Boolean
blnSuceess = False
blnLevel = False
lngID = mfrmCustomer.ListID
If lngID = 0 Then Exit Sub
With mfrmCustomer.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(mfrmCustomer.hWnd, "是否取消所有下级的停用标记", vbYesNo, mfrmCustomer.mTitle)
                blnYes = IIf(intResponse = 6, True, False)
            End If
        End If
        If UpdateIsActive(.Tab, strCode, Not blnRemark, blnYes) Then
            If blnLevel Then mfrmCustomer.ToolRefresh
            blnSuceess = True
            If .Tab = 0 Then gclsSys.SendMessage CStr(mfrmCustomer.hWnd), Message.msgCustomerType
            If .Tab = 1 Then gclsSys.SendMessage CStr(mfrmCustomer.hWnd), Message.msgCustomer
            If .Tab = 2 Then gclsSys.SendMessage CStr(mfrmCustomer.hWnd), Message.msgJob
        End If
    End With
End Sub

Private Sub mfrmCustomer_ListNew()
    mfrmCustomer.MousePointer = vbHourglass
    Select Case mfrmCustomer.sstPages.Tab
        Case 0
             frmCustomerTypeCard.AddCard , vbModal
            Set frmCustomerTypeCard = Nothing
        Case 1
             frmCustomerCard.AddCard , vbModal
            Set frmCustomerCard = Nothing
        Case 2
            frmJobCard.AddCard , vbModal
            Set frmJobCard = Nothing
    End Select
    mfrmCustomer.MousePointer = vbDefault
End Sub

Private Sub mfrmCustomer_ListShowAll()
    With mfrmCustomer
        If .chkShowall = 0 Then
            Select Case .sstPages.Tab
                Case 0
                     .ShowAll(.sstPages.Tab) = " CustomerType.blnIsInActive=0 "
                Case 1
                    .ShowAll(.sstPages.Tab) = " Customer.blnIsInActive=0 "
                Case 2
                    .ShowAll(.sstPages.Tab) = "Job.blnIsInActive=0  "
            End Select
        Else
            .ShowAll(.sstPages.Tab) = ""
'            Select Case .sstPages.Tab
'                Case 0
'                     .SpSelect(.sstPages.Tab) = "CustomerType.lngCustomerTypeID As id,IIF(CustomerType.blnIsInActive,'√','') As 停用 "
'                Case 1
'                    .SpSelect(.sstPages.Tab) = "Customer.lngCustomerID As id,IIF(Customer.blnIsInActive,'√','') As 停用 "
'                Case 2
'                    .SpSelect(.sstPages.Tab) = "Job.lngJobID As id,IIF(Job.blnIsInActive,'√','') As 停用 "
'            End Select
        End If
        .ToolRefresh
    End With
End Sub

Private Sub mfrmCustomer_ListUsed()
    Dim lngID As Long
    
    lngID = mfrmCustomer.ListID
    Select Case mfrmCustomer.sstPages.Tab
        Case 0
            UseCode Message.msgCustomerType, lngID
        Case 1
            UseCode Message.msgCustomer, lngID
        Case 2
            UseCode Message.msgJob, lngID
    End Select
    mfrmCustomer.ZOrder 1
End Sub

Private Sub mfrmCustomer_ListUserMenu(ByVal Index As Integer)
#If conVersionType <> 16 Then
    If Index = 7 Then frmCustomerDiscountCard.ShowCard
#End If
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 CustomerType SET blnIsInActive = " & IIf(blnIsInActive, 1, 0) & " WHERE strCustomerTypeCode = '" & strCode & "' Or strCustomerTypeCode like '" & strCode & "-%'"
             Else
                If blnYes Then
                    strSuSql = "UPDATE CustomerType SET blnIsInActive = " & IIf(blnIsInActive, 1, 0) & " WHERE strCustomerTypeCode='" & strCode & "' Or strCustomerTypeCode like '" & strCode & "-%'"
                End If
                strSql = "UPDATE CustomerType SET blnIsInActive = " & IIf(blnIsInActive, 1, 0) & " WHERE strCustomerTypeCode  in  ('" & strCode
                Do Until CodePrefix(strCode) = ""
                    strCode = CodePrefix(strCode)
                    strSql = strSql & "','" & strCode
                Loop
                strSql = strSql & "')"
                
            End If
        Case 1
            strSql = "UPDATE Customer SET blnIsInActive = " & IIf(blnIsInActive, 1, 0) & " WHERE strCustomerCode = '" & strCode & "'"
        Case 2
            strSql = "UPDATE Job SET blnIsInActive = " & IIf(blnIsInActive, 1, 0) & " WHERE strJobCode = '" & 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,strCustomerTypeCode as Code  from CustomerType Where lngCustomerTypeID=" & lngID
        Case 1
            strSql = "Select blnIsInActive,strCustomerCode  as code from Customer Where lngCustomerID=" & lngID
        Case 2
            strSql = "Select blnIsInActive,strJobCode  as code  from Job Where lngJobID=" & 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
    Select Case intTab
        Case 0
            strSql = "select blnIsInActive from CustomerType where blnIsInActive=1 and strCustomerTypecode like '" & strCode & "-%'"
    End Select
    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 = Choose(intTab + 1, "CustomerType.lngCustomerTypeID=", "Customer.lngCustomerID=", "Job.lngJobID=") & lngID
    ShowEachList = mfrmCustomer.Showlist(lngID, intTab, strWhere)
End Function