clspurchase.cls

金算盘软件代码

            If gclsBase.ExecSQL(strSQL) = False Then DeleteItemCostDetail = -1
'''            strSql = "SELECT ItemCostDetail.lngItemID,ItemCostDetail.lngInActivityDetailID," _
'''                   & " ItemCostDetail.lngOutActivityDetailID,ItemCostDetail.dblQuantity,ItemCostDetail.dblAmount " _
'''                   & " FROM ItemCostDetail,ItemActivityDetail WHERE ItemCostDetail.lngInActivityDetailID = ItemActivityDetail.lngActivityDetailID " _
'''                   & " AND (((ItemActivityDetail.lngActivityID)=" & lngActivityID & "))"
'''            Set recTmp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
'''            Do While Not recTmp.EOF
'''               strSql = "DELETE ItemCostDetail WHERE lngItemID=" & recTmp(0) & " AND lngInActivityDetailID=" & recTmp(1) _
'''                  & " AND lngOutActivityDetailID=" & recTmp(2) & " AND dblQuantity=" & recTmp(3) & " AND dblAmount=" & recTmp(4)
'''               If gclsBase.ExecSQL(strSql) = False Then
'''                  recTmp.Close
'''                  Set recTmp = Nothing
'''                  DeleteItemCostDetail = -1
'''                  Exit Do
'''               End If
'''               recTmp.MoveNext
'''            Loop
'''            recTmp.Close
'''            Set recTmp = Nothing
        Case Else
'            DeleteItemCostDetail = 1
    End Select
'    DeleteItemCostDetail = 1
End Function

'//////////////////////////////////////结束：对照表处理////////////////////////////////////////////////////




'////////////////////////////////////////////////////////////////////////////////
'//
'//                                 删除列表记录
'//
'////////////////////////////////////////////////////////////////////////////////
'<接口>
'blnByVoid：删除功能由作废调用
Public Function DeletePurchase(arglngActivityID As Long, Optional blnByVoid As Boolean, Optional ByVal blnWriteOffBill As Boolean = False, Optional ByRef blnIsWriteOff As Boolean = False, Optional blnAlert As Boolean = True, Optional ByVal blnNoTrans As Boolean, Optional ByVal blnOtherBill As Boolean = False) As Boolean
    Dim strSQL As String
    Dim recTemp As rdoResultset
    Dim intResult As Integer
    lngActivityID = arglngActivityID
    '-----------------------------------------
    Dim intYear As Integer '凭证会计年度
    Dim bytPeriod As Byte   '凭证会计期间
    Dim lngReceiptTypeID As Long
    Dim strReceiptNo As String
    Dim lngReceiptNo As Long
    '------------------------------------------
    If blnByVoid Then
        strDelOrVoid = "作废！"
    Else
        strDelOrVoid = "删除！"
    End If
    
    mblnOtherBill = blnOtherBill
    strSQL = "SELECT ItemActivity.lngActivityTypeID, ItemActivity.blnIsVoid, decode(ItemActivity.lngActivityTypeID,1,'商品采购',2,'直运采购',3,'受托入库',4,'受托结算',5,'加工入库',6,'加工费用',7,'采购发票',8,'自制入库',9,'盘盈入库',10,'其他入库') AS 采购类型 ,ItemActivity.* " & _
                    "From ItemActivity WHERE (ItemActivity.lngActivityID)=" & lngActivityID
    Set recTemp = gclsBase.BaseDB.OpenResultset(strSQL, rdOpenStatic)
    If recTemp.EOF Then
        cMsgBox "此单据已被删除！"
        Set recTemp = Nothing
        Exit Function
    End If
    lngActivityTypeID = recTemp(0)
    If lngActivityTypeID = 1 Then
        If blnOtherBill = False Then
            mlngInvoiceActivityID = recTemp!lngInvoiceActivityID
        End If
    End If
    strBillNO = ID2String(lngActivityTypeID + 1, lngActivityID) & "号"
    blnIsVoid = (recTemp(1) <> 0)
    blnIsPrinted = (recTemp!blnIsPrinted <> 0)
    mblnIsCash = (recTemp!blnIsCash <> 0)
    #If conVersionType = 16 Then
        '财务版
        strTypeName = "采购发票"
    #Else
        strTypeName = recTemp(2)
    #End If
    '-------------------------------------------------------------------
    intYear = gclsBase.FYearOfDate(C2Date(recTemp!strDate))
    bytPeriod = gclsBase.PeriodOfDate(C2Date(recTemp!strDate))
    lngReceiptTypeID = recTemp!lngReceiptTypeID
    strReceiptNo = LTrim(recTemp!strReceiptNo)
    lngReceiptNo = recTemp!lngReceiptNo
    blnIsInvoice = (recTemp!blnIsInvoice <> 0) Or (recTemp!lngReceiptTypeID = 8)
    '--------------------------------------------------------------------
    Set recTemp = Nothing
    
   blnNoAlert = False
    If blnAlert Then
        If BeforeDelete(blnByVoid, , , , blnWriteOffBill) <> 1 Then Exit Function  '判断单据能否删除
    End If
    
    If mblnOtherBill = False Then
        If blnNoAlert = False Then
          If Not blnWriteOffBill Then
              If Not blnByVoid And blnAlert Then ' 非作废操作调用无须删除提问
                  If blnIsVoid = False Then
                      If ShowMsg(thehWnd, "您确实要删除" & strBillNO & strTypeName & "单据吗？", MB_YESNO + MB_ICONQUESTION + MB_DEFBUTTON2 + MB_SYSTEMMODAL, "提示信息") <> IDYES Then Exit Function
                  Else
                      If ShowMsg(thehWnd, "您确实要删除" & strBillNO & "已经作废的" & strTypeName & "单据吗？", MB_YESNO + MB_ICONQUESTION + MB_DEFBUTTON2 + MB_SYSTEMMODAL, "提示信息") <> IDYES Then Exit Function
                  End If
              End If
          End If
        End If
   End If
'    If blnAlert Then
'        If BeforeDelete(blnByVoid, , , , blnWriteOffBill) <> 1 Then Exit Function  '判断单据能否删除
'    End If
    
'    gclsSys.SendMessage thehWnd, 31 + lngActivityTypeID
'    DeletePurchase = True
'    Exit Function
    
    Dim i As Long
    If Not blnNoTrans Then
        gclsBase.BaseWorkSpace.BeginTrans
    End If
    If Not blnWriteOffBill And Not blnIsVoid Then
'        gclsBase.BaseWorkSpace.BeginTrans
        For i = LBound(lngWriteOffID) To UBound(lngWriteOffID)
            If lngWriteOffID(i) <> 0 Then
                Dim clsTmp As clsPurchase
                Set clsTmp = New clsPurchase
                clsTmp.SethWnd thehWnd
                If clsTmp.DeletePurchase(lngWriteOffID(i), False, True, , , True) = False Then
                    If Not blnNoTrans Then
                        gclsBase.BaseWorkSpace.RollBacktrans
                    End If
'                    gclsBase.BaseWorkSpace.rollbacktrans
                    blnIsWriteOff = False
                    DeletePurchase = False
                    Set clsTmp = Nothing
                    Exit Function
                End If
                Set clsTmp = Nothing
                blnIsWriteOff = True
            End If
        Next
'        gclsBase.BaseWorkSpace.CommitTrans
    End If
'    On Error GoTo DeleteErr
        
    '1）单据是作废单据，不执行c
    If Not blnIsVoid Then
        If DeleteRelation(lngActivityID, lngActivityTypeID, thehWnd) <> 1 Then GoTo DeleteErr   '删除关系(删除采购发票与受托结算单时须标记对应商品入库单及受托入库单)
        If ChangeAllItem_from_Activity("D", lngActivityID) = False Then GoTo DeleteErr
        If ChangeAllAccount_from_Activity("D", lngActivityID) = False Then GoTo DeleteErr
        If ModifyItemTable(lngActivityID, False) = False Then GoTo DeleteErr   '维护商品表（再定量、再销量、价格）
        If DeleteObtendTables(blnWriteOffBill) <> 1 Then GoTo DeleteErr
    End If
    
    '2）作废操作不执行
    If Not blnByVoid Then
        If DeleteItemActivityANDItemActivityDetail(lngActivityID) <> 0 Then GoTo DeleteErr
    Else
        If gclsBase.ExecSQL("UPDATE ItemActivity SET blnIsVoid = 1," & _
            " blnIsCash = 0 WHERE lngActivityID=" & lngActivityID) = False Then GoTo DeleteErr
    End If
    
'------------------------------------------------------------------------------
    If Not blnByVoid Then blnMaxNODecrease intYear, bytPeriod, lngReceiptTypeID, strReceiptNo, lngReceiptNo
'------------------------------------------------------------------------------
    If Not blnNoTrans Then
        gclsBase.BaseWorkSpace.CommitTrans
    End If
    DeletePurchase = True
    gclsSys.SendMessage 0, 31 + lngActivityTypeID
    If Not recTemp Is Nothing Then
        Set recTemp = Nothing
    End If
    Exit Function
DeleteErr:
   On Error Resume Next
   If Not blnNoTrans Then
        gclsBase.BaseWorkSpace.RollBacktrans
    End If
    If Not recTemp Is Nothing Then
        Set recTemp = Nothing
    End If
    
    blnIsWriteOff = False
    Screen.MousePointer = vbDefault
    If mstrErrMsg = "" Then
        cMsgBox Left(strDelOrVoid, 2) & strTypeName & "单据失败！"
    Else
        cMsgBox mstrErrMsg
    End If
End Function

Private Sub Class_Terminate()
    Erase lngWriteOffID
End Sub

Private Function SetStockTakingPost() As Boolean
    Dim strSQL As String
    Dim recTmp As rdoResultset
    Dim lngStockTakingID As Long
    
    On Error GoTo ErrHandle
    
    If lngActivityTypeID <> 9 And lngActivityTypeID <> 21 Then
        GoTo EndProc
        
    End If
    strSQL = "SELECT lngOrderDetailID FROM ItemActivityDetail,ItemActivity WHERE " _
        & "ItemActivityDetail.lngActivityID=ItemActivity.lngActivityID " _
        & "AND ItemActivity.blnIsVoid=0 AND ItemActivity.lngActivityTypeID IN(9,21) AND lngOrderDetailID <> 0 And " _
        & "ItemActivity.lngActivityID=" & lngActivityID
    Set recTmp = gclsBase.BaseDB.OpenResultset(strSQL, rdOpenForwardOnly)
    If recTmp.BOF And recTmp.EOF Then
        GoTo EndProc
    End If
    lngStockTakingID = recTmp(0)
    recTmp.Close
    Set recTmp = Nothing
    strSQL = "SELECT lngOrderDetailID FROM ItemActivityDetail,ItemActivity WHERE " _
        & "ItemActivityDetail.lngActivityID=ItemActivity.lngActivityID " _
        & "AND ItemActivity.blnIsVoid=0 AND ItemActivity.lngActivityTypeID IN(9,21) AND lngOrderDetailID=" & lngStockTakingID & "  And " _
        & "ItemActivity.lngActivityID<>" & lngActivityID
    Set recTmp = gclsBase.BaseDB.OpenResultset(strSQL, rdOpenForwardOnly)
    If recTmp.BOF And recTmp.EOF Then
        strSQL = "UPDATE StockTaking set blnIsPost=0 WHERE lngStockTakingID=" & lngStockTakingID
        If gclsBase.ExecSQL(strSQL) = False Then
            GoTo ErrHandle
        End If
    Else
        GoTo EndProc
    End If
    
EndProc:
    SetStockTakingPost = True
    If Not recTmp Is Nothing Then
        recTmp.Close
        Set recTmp = Nothing
    End If
    Exit Function
ErrHandle:
    SetStockTakingPost = False
    If Not recTmp Is Nothing Then
        recTmp.Close
        Set recTmp = Nothing
    End If
    Exit Function
End Function

Private Function ClearInvoiceObtend(ByVal blnWriteOffBill As Boolean) As Boolean
    Dim strSQL As String
    
    Select Case lngActivityTypeID
    Case 1, 2, 4, 6
        strSQL = "UPDATE ItemActivityDetail SET ItemActivityDetail.dblInvoiceQuantity=" & _
            " (SELECT ItemActivityDetail.dblInvoiceQuantity-NVL(Sum(PurchaseToInvoice.dblQuantity),0) " & _
            " FROM PurchaseToInvoice,ItemActivityDetail ItemActivityDetail_1 " & _
            " Where PurchaseToInvoice.lngInvoiceDetailID = ItemActivityDetail.lngActivityDetailID " & _
            " AND PurchaseToInvoice.lngReceiptDetailID = ItemActivityDetail_1.lngActivityDetailID " & _
            " AND ItemActivityDetail_1.lngActivityID = " & lngActivityID & "), " & _
            " ItemActivityDetail.dblCurrInvoiceAmount=" & _
            "(SELECT ItemActivityDetail.dblCurrInvoiceAmount-NVL(Sum(PurchaseToInvoice.dblCurrAmount),0) FROM PurchaseToInvoice,ItemActivityDetail ItemActivityDetail_1 " & _
            " Where PurchaseToInvoice.lngInvoiceDetailID = ItemActivityDetail.lngActivityDetailID " & _
            " AND PurchaseToInvoice.lngReceiptDetailID = ItemActivityDetail_1.lngActivityDetailID " & _
            " AND ItemActivityDetail_1.lngActivityID = " & lngActivityID & ") " & _
            " WHERE EXISTS (SELECT ItemActivityDetail_1.lngActivityID FROM PurchaseToInvoice,ItemActivityDetail ItemActivityDetail_1 " & _
            " WHERE PurchaseToInvoice.lngInvoiceDetailID = ItemActivityDetail.lngActivityDetailID " & _