clslistitem.cls

金算盘软件代码

                            vbExclamation + MB_TASKMODAL, "修改商品税率"
                    mfrmItem.ToolRefresh
                End If
            End If
        Case 4
            If lngID > 0 Then
                If CheckIDUsed("Position", "lngPositionID", lngID) Then
                    frmPositionCard.EditCard lngID, vbModal
                    Set frmPositionCard = Nothing
                Else
                    ShowMsg 0, "该货位不存在，不能进行修改！", _
                            vbExclamation, "修改货位"
                    mfrmItem.ToolRefresh
                End If
            End If
    End Select
    mfrmItem.MousePointer = vbDefault
    mfrmItem.Enabled = True
End Sub

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

lngID = mfrmItem.ListID
If lngID = 0 Then Exit Sub
With mfrmItem.sstPages
        blnRemark = ListIsInActive(.Tab, lngID, strCode)
        If IsLevelWCode(Choose(.Tab + 1, "商品类型编码", "商品劳务编码", "商品税率编码", "商品货位编码", "商品库存编码")) And Trim(strCode) <> "" Then
            If blnRemark And IsLowerCode(.Tab, strCode) Then
                intResponse = ShowMsg(mfrmItem.hWnd, "是否取消所有下级的停用标记", vbYesNo, mfrmItem.mTitle)
                blnYes = IIf(intResponse = 6, True, False)
            End If
        End If
        If .Tab = 3 And lngID = 1 Then
                MsgBox "零税率不能停用", vbExclamation, mfrmItem.mTitle
                Exit Sub
            End If
        If UpdateIsActive(.Tab, strCode, Not blnRemark, blnYes) Then
            mfrmItem.ToolRefresh
            If .Tab = 0 Then gclsSys.SendMessage CStr(mfrmItem.hWnd), Message.msgItemType
            If .Tab = 2 Then gclsSys.SendMessage CStr(mfrmItem.hWnd), Message.msgItem
            If .Tab = 3 Then gclsSys.SendMessage CStr(mfrmItem.hWnd), Message.msgTax
            If .Tab = 4 Then gclsSys.SendMessage CStr(mfrmItem.hWnd), Message.msgPosition
        End If
    End With
End Sub


Private Sub mfrmItem_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 = mfrmItem.ListID
If lngID = 0 Then Exit Sub
With mfrmItem.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(mfrmItem.hWnd, "是否取消所有下级的停用标记", vbYesNo, mfrmItem.mTitle)
                blnYes = IIf(intResponse = 6, True, False)
            End If
        End If
        If .Tab = 3 And lngID = 1 Then
                MsgBox "零税率不能停用", vbExclamation, mfrmItem.mTitle
                Exit Sub
            End If
        If UpdateIsActive(.Tab, strCode, Not blnRemark, blnYes) Then
            If blnLevel Then mfrmItem.ToolRefresh
            blnSuceess = True
            If .Tab = 0 Then gclsSys.SendMessage CStr(mfrmItem.hWnd), Message.msgItemType
            If .Tab = 2 Then gclsSys.SendMessage CStr(mfrmItem.hWnd), Message.msgItem
            If .Tab = 3 Then gclsSys.SendMessage CStr(mfrmItem.hWnd), Message.msgTax
            If .Tab = 4 Then gclsSys.SendMessage CStr(mfrmItem.hWnd), Message.msgPosition
        End If
    End With
End Sub

Private Sub mfrmItem_ListNew()
    mfrmItem.MousePointer = vbHourglass
    Select Case mfrmItem.sstPages.Tab
        Case 0
             frmItemTypeCard.AddCard , vbModal
             Set frmItemTypeCard = Nothing
        Case 1
            frmItemNatureCard.AddCard , vbModal
            Set frmItemNatureCard = Nothing
        Case 2
            frmItemCard.AddCard , vbModal
            Set frmItemCard = Nothing
        Case 3
            frmItemTax.AddCard , vbModal
            Set frmItemTax = Nothing
        Case 4
            frmPositionCard.AddCard , vbModal
            Set frmPositionCard = Nothing
    End Select
    
    mfrmItem.MousePointer = vbDefault
End Sub

Private Sub mfrmItem_ListPopAfter(ByVal blnNew As Boolean, ByVal blnEdit As Boolean)
    If blnNew Then mfrmItem_ListNew
    If blnEdit Then mfrmItem_ListEdite
End Sub

Private Sub mfrmItem_ListPopBefore(blnNew As Boolean, blnEdit As Boolean)
    blnNew = False
    blnEdit = False
End Sub

Private Sub mfrmItem_ListShowAll()
    With mfrmItem
        If .chkShowall = 0 Then
            Select Case .sstPages.Tab
                Case 0
                     .ShowAll(.sstPages.Tab) = "  ItemType.blnIsInActive=0 "
                Case 2
                    .ShowAll(.sstPages.Tab) = " Item.blnIsInActive =0"
                Case 3
                    .ShowAll(.sstPages.Tab) = "Tax.blnIsInActive=0"
                Case 4
                    .ShowAll(.sstPages.Tab) = "  Position.blnIsInActive =0"
            End Select
        Else
            .ShowAll(.sstPages.Tab) = ""
'            Select Case .sstPages.Tab
'                Case 0
'                    .ShowAll(.sstPages.Tab) = ""
'                     '.SpSelect(.sstPages.Tab) = " ItemType.lngItemTypeID As id ,IIF(ItemType.blnIsInActive,'√','') As 停用 "
'                Case 2
'                    .ShowAll(.sstPages.Tab) = ""
'                Case 3
'                    .ShowAll(.sstPages.Tab) = ""
'                Case 4
'                    .ShowAll(.sstPages.Tab) = ""
'            End Select
        End If
        .ToolRefresh
    End With
End Sub

Private Sub mfrmItem_ListUsed()
    Dim lngID As Long
    
    lngID = mfrmItem.ListID
    Select Case mfrmItem.sstPages.Tab
        Case 0
            UseCode Message.msgItemType, lngID
        Case 1
            UseCode Message.msgItemNature, lngID
        Case 2
            UseCode Message.msgItem, lngID
        Case 3
            UseCode Message.msgItem, lngID
        Case 4
            UseCode Message.msgPosition, lngID
        Case 5
    End Select
    mfrmItem.ZOrder 1
End Sub

Private Sub mfrmItem_ListUserMenu(ByVal Index As Integer)
#If conVersionType <> 16 Then
    Select Case Index
        Case 7:
            frmAdaptCard.ShowCard
            Unload frmAdaptCard
            Set frmAdaptCard = Nothing
    '#If conTest = 1 Then
'        Case 8:
'            With frmItemDiscListCard
'                .Show vbModal
'            End With
'            Unload frmItemDiscListCard
'            Set frmItemDiscListCard = Nothing
    '#End If
        End Select
#Else
    If gclsBase.ControlAccount Then
        If Index = 7 Then
            frmAdaptCard.ShowCard
            Unload frmAdaptCard
            Set frmAdaptCard = Nothing
        End If
    End If
#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 ItemType SET blnIsInActive = " & IIf(blnIsInActive, 1, 0) & " WHERE strItemTypeCode = '" & strCode & "' Or strItemTypeCode like '" & strCode & "-%'"
             Else
                If blnYes Then
                    strSuSql = "UPDATE ItemType SET blnIsInActive = " & IIf(blnIsInActive, 1, 0) & " WHERE strItemTypeCode='" & strCode & "' Or strItemTypeCode like '" & strCode & "-%'"
                End If
                strSql = "UPDATE ItemType SET blnIsInActive = " & IIf(blnIsInActive, 1, 0) & " WHERE strItemTypeCode  in  ('" & strCode
                Do Until CodePrefix(strCode) = ""
                    strCode = CodePrefix(strCode)
                    strSql = strSql & "','" & strCode
                Loop
                strSql = strSql & "')"
                
            End If
        Case 4
            If blnIsInActive Then
                strSql = "UPDATE Position SET blnIsInActive = " & IIf(blnIsInActive, 1, 0) & " WHERE strPositionCode = '" & strCode & "' Or strPositionCode like '" & strCode & "-%'"
            Else
                If blnYes Then
                    strSuSql = "UPDATE Position SET blnIsInActive = " & IIf(blnIsInActive, 1, 0) & " WHERE strPositionCode='" & strCode & "' Or strPositionCode like '" & strCode & "-%'"
                End If
                strSql = "UPDATE Position SET blnIsInActive = " & IIf(blnIsInActive, 1, 0) & " WHERE strPositionCode  in  ('" & strCode
                Do Until CodePrefix(strCode) = ""
                    strCode = CodePrefix(strCode)
                    strSql = strSql & "','" & strCode
                Loop
                strSql = strSql & "')"
                
            End If
                
        Case 2
            strSql = "UPDATE Item SET blnIsInActive = " & IIf(blnIsInActive, 1, 0) & " WHERE strItemCode = '" & strCode & "'"
        Case 3
            strSql = "UPDATE Tax SET blnIsInActive = " & IIf(blnIsInActive, 1, 0) & " WHERE lngTaxID = " & 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,strItemTypeCode as Code from ItemType Where lngItemTypeID=" & lngID
        Case 2
            strSql = "Select blnIsInActive,strItemCode as  Code  from Item Where lngItemID=" & lngID
        Case 3
            strSql = "Select blnIsInActive,lngTaxID as Code from Tax Where lngTaxID=" & lngID
        Case 4
            strSql = "Select blnIsInActive,strPositionCode as Code from Position Where lngPositionID=" & lngID
        Case 5
            strSql = "Select blnIsInActive,strItemTypeCode as  Code  from ItemType Where lngItemTypeID=" & 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 ItemType where blnIsInActive=1 and strItemTypecode like '" & strCode & "-%'"
        Case 4
            strSql = "select blnIsInActive from Position where blnIsInActive=1 and strPositioncode like '" & strCode & "-%'"
    End Select
If Trim(strSql) <> "" Then
    Set tmp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    If tmp.RowCount <> 0 Then
        IsLowerCode = True
    Else
        IsLowerCode = False
    End If
End If
End Function

Public Function ShowEachList(ByVal lngID As Long, Optional intTab As Integer = 0) As Boolean
    strWhere = Choose(intTab + 1, "ItemType.lngItemTypeID=", "ItemNature.lngItemNatureID=", "Item.lngItemID=", "Tax.lngTaxID=", "Position.lngPositionID=", "Item.lngItemID=") & lngID
    ShowEachList = mfrmItem.Showlist(lngID, intTab, strWhere)
End Function