clspurchase.cls

金算盘软件代码

        blnIsPay = False
    End If
    
    If recTemp!dblExpenseAmountOfSum <> 0 Then
        If mblnOtherBill = False Then
            blnNoAlert = True
            If ShowMsg(thehWnd, strBillNO & strTypeName & "单据已进行费用分摊，继续" & strDelOrVoid & "吗？", MB_YESNO + MB_ICONQUESTION + MB_DEFBUTTON2 + MB_SYSTEMMODAL, "提示信息") <> IDYES Then GoTo EndProc
        End If
    End If
   
    BeforeDelete = 1
EndProc:
    If Not recTemp Is Nothing Then
        recTemp.Close
        Set recTemp = Nothing
    End If
    Exit Function
TheErr:
    BeforeDelete = -1
    If Not recTemp Is Nothing Then
        Set recTemp = Nothing
    End If
End Function

'判断有批次管理标志的入库类型业务是否已发生了出库类型等对应业务
Private Function IsProduce() As Integer
    Dim strSQL As String
    Dim recTemp As rdoResultset
On Error GoTo TheErr
    
    '判断批次商品有无出库等业务
    strSQL = "SELECT PositionItemDetail.lngInActivityDetailID" _
           & " FROM PositionItemDetail,ItemActivityDetail WHERE PositionItemDetail.lngInActivityDetailID = ItemActivityDetail.lngActivityDetailID" _
           & " AND (((ItemActivityDetail.lngActivityID)=" & lngActivityID & ") AND ((PositionItemDetail.lngOutActivityDetailID)<>0))"
    Set recTemp = gclsBase.BaseDB.OpenResultset(strSQL, rdOpenStatic)
    If Not recTemp.EOF Then
        IsProduce = 1 '批次商品已发生出库业务
    Else
        IsProduce = 0 '没有发生出库业务
    End If
    Set recTemp = Nothing
    Exit Function
TheErr:
    If Not recTemp Is Nothing Then
        Set recTemp = Nothing
    End If
    IsProduce = -1
End Function


'//////////////////////////////////////////////////////////////////////////////////////////
'
'                                           对照表处理
'
'//////////////////////////////////////////////////////////////////////////////////////////

'删除所有的对照表
Private Function DeleteObtendTables(ByVal blnWriteOffBill As Boolean) As Integer
    On Error GoTo TheErr
    Dim strSQL As String
    Dim intResult As Integer
'    Dim recTmp As rdoResultset
    '删除发票对照表
    If ClearInvoiceObtend(blnWriteOffBill) = False Then
        GoTo TheErr
    End If

    '1) 删除货位批次明细表
    If lngActivityTypeID = 1 Or lngActivityTypeID = 3 Or lngActivityTypeID = 5 Or lngActivityTypeID = 8 Or lngActivityTypeID = 9 Or lngActivityTypeID = 10 Then
        '商品采购、受托入库、加工入库、自制入库、盘赢、其他入库
        If ModifyPositionWhenDeleteOutBill(lngActivityID) = False Then GoTo TheErr
    End If
    '2)修改入库成本表  不需做任何处理
    '3)删除费用分摊对照表
    intResult = DeleteExpenseToPurchase()
    If intResult = -1 Then GoTo TheErr
    If intResult = 0 Then
        DeleteObtendTables = 0
        Exit Function
    End If

'    '5)直运采购(与直运销售)/采购(与发票)/受托入库(与受托结算)        intResult = DeletePurchaseToSale()
    '6)加工入库与加工出库对照表
    If lngActivityTypeID = 5 Then
        intResult = DeleteEntrustInToOut()
        If intResult = -1 Then GoTo TheErr
        If intResult = 0 Then
            DeleteObtendTables = 0
            Exit Function
        End If
    End If
    
   '7)盘点表与盘赢/盘亏单对照表
   '8)采购发票、受托结算单       intResult = DeleteInvoiceAndBalance()
    '如果明细可能来自《商品采购订单》
'    If lngActivityTypeID = 1 Or lngActivityTypeID = 2 Or lngActivityTypeID = 3 Then
'        If ChangeItemInfo() = -1 Then GoTo TheErr
'
'        '改变订单的数量, 清除关闭标志
    
    '判断是否为工程--PurchaseToBill,若有则只需删除（判断标志：ItemActivityDetail.lngJobID<>0）
'    strSql = "DELETE  FROM PurchaseToBill WHERE PurchaseToBill.lngPurchaseActivityDetailID IN " & _
'        "(SELECT ItemActivityDetail.lngActivityDetailID FROM ItemActivityDetail " & _
'        "WHERE ItemActivityDetail.lngActivityID=" & lngActivityID & " AND ItemActivityDetail.lngJobID<>0)"
'    If gclsBase.ExecSQL(strSql) = False Then GoTo TheErr
'''    strSql = "SELECT PurchaseToBill.lngPurchaseActivityDetailID,PurchaseToBill.lngSaleActivityDetailID,PurchaseToBill.dblCurrAmount " _
'''           & " FROM PurchaseToBill,ItemActivityDetail WHERE PurchaseToBill.lngPurchaseActivityDetailID = ItemActivityDetail.lngActivityDetailID " _
'''           & " AND (((ItemActivityDetail.lngActivityID)=" & lngActivityID & ") AND ((ItemActivityDetail.lngJobID)<>0))"
'''    Set recTmp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
'''    Do While Not recTmp.EOF
'''       strSql = "DELETE PurchaseToBill WHERE lngPurchaseActivityDetailID=" & recTmp(0) & _
'''         " AND lngSaleActivityDetailID=" & recTmp(1) & " AND dblCurrAmount=" & recTmp(2)
'''       If gclsBase.ExecSQL(strSql) = False Then
'''         recTmp.Close
'''         Set recTmp = Nothing
'''         GoTo TheErr
'''       End If
'''       recTmp.MoveNext
'''    Loop
'''    recTmp.Close
'''    Set recTmp = Nothing

    If blnIsPay Then
        ' 已付款
        If mblnIsCash Then
            If mdlAccount.DeleteCash(lngActivityID, thehWnd, lngActivityTypeID + 1, strSQL) = False Then
                mstrErrMsg = strSQL
                GoTo TheErr
            End If
        End If
        If blnDeleteCashToArap(lngActivityID, 2, False) = False Then
            GoTo TheErr
        End If
    End If
    If DeleteItemCostDetail() = -1 Then GoTo TheErr
    If SetStockTakingPost() = False Then GoTo TheErr
    DeleteObtendTables = 1
    Exit Function
TheErr:
    DeleteObtendTables = -1
End Function


'算法：除《调拨》外，对照表的“出”操作为改一条，加一条。《调拨》的“出”操作为改一条加二条
'判断“入”操作是否对应有“出”操作的算法：如果“入”操作对应ID号只有一条记录，则表示无“出”

'货位商品批次明细表
Private Function DeletePositionItemDetail() As Integer
    Dim strSQL As String
'    Dim recTmp As rdoResultset
    On Error GoTo DeleteErr
    strSQL = "DELETE FROM PositionItemDetail WHERE PositionItemDetail.lngInActivityDetailID IN " & _
        "(SELECT ItemActivityDetail.lngActivityDetailID FROM ItemActivityDetail " & _
        " WHERE ItemActivityDetail.lngActivityID=" & lngActivityID & ")"
    If gclsBase.ExecSQL(strSQL) = False Then GoTo DeleteErr
'''    strSql = " SELECT PositionItemDetail.lngItemID,PositionItemDetail.lngPositionID,PositionItemDetail.lngInActivityDetailID," _
'''           & " PositionItemDetail.lngOutActivityDetailID,PositionItemDetail.dblQuantity " _
'''           & " FROM PositionItemDetail,ItemActivityDetail WHERE PositionItemDetail.lngInActivityDetailID = ItemActivityDetail.lngActivityDetailID " _
'''           & " AND (((ItemActivityDetail.lngActivityID)=" & lngActivityID & "))"
'''    Set recTmp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
'''    Do While Not recTmp.EOF
'''      strSql = "DELETE PositionItemDetail WHERE lngItemID=" & recTmp(0) & _
'''         " AND lngPositionID=" & recTmp(1) & " AND lngInActivityDetailID=" & recTmp(2) & _
'''         " AND lngOutActivityDetailID=" & recTmp(3) & " AND dblQuantity=" & recTmp(4)
'''      If gclsBase.ExecSQL(strSql) = False Then
'''         recTmp.Close
'''         Set recTmp = Nothing
'''         GoTo DeleteErr
'''      End If
'''      recTmp.MoveNext
'''    Loop
'''    recTmp.Close
'''    Set recTmp = Nothing
    DeletePositionItemDetail = 1
    Exit Function
DeleteErr:
    DeletePositionItemDetail = -1
End Function

'/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
'SM
'费用分摊对照表( 1/5 )
'费用分摊包括：采购费用分摊、加工费用分摊
Public Function DeleteExpenseToPurchase(Optional ByVal lngActivityID1 As Long = 0, Optional ByVal lngActivityTypeID1 As Long = 0, Optional ByVal blnDoTrans As Boolean = False) As Integer
    Dim strSQL As String
    Dim recTmp As rdoResultset
    
    If lngActivityID1 <> 0 Then
        lngActivityID = lngActivityID1
    End If
    If lngActivityTypeID1 <> 0 Then
        lngActivityTypeID = lngActivityTypeID1
    End If
    If lngActivityTypeID <> 1 And lngActivityTypeID <> 5 And lngActivityTypeID <> 6 Then '不是“商品采购”和“加工入库”类型
        DeleteExpenseToPurchase = 1
        Exit Function
    End If
    On Error GoTo DeleteErr
    If blnDoTrans Then
      gclsBase.BaseWorkSpace.BeginTrans
    End If
    strSQL = "SELECT lngActivityDetailID FROM ItemActivityDetail WHERE lngActivityID=" & lngActivityID
    Set recTmp = gclsBase.BaseDB.OpenResultset(strSQL, rdOpenStatic)
    If recTmp.BOF And recTmp.EOF Then
        GoTo DeleteErr
    End If
    With recTmp
        Do While Not .EOF
            If Not DeleteExpenseToPurchaseDetail(recTmp(0), lngActivityTypeID) Then
                GoTo DeleteErr
            End If
            .MoveNext
        Loop
    End With
OK:
    DeleteExpenseToPurchase = 1
    If Not recTmp Is Nothing Then
        recTmp.Close
        Set recTmp = Nothing
    End If
    If blnDoTrans Then
      gclsBase.BaseWorkSpace.CommitTrans
    End If
    Exit Function
DeleteErr:
    If Not recTmp Is Nothing Then
        recTmp.Close
        Set recTmp = Nothing
    End If
    DeleteExpenseToPurchase = -1
    If blnDoTrans Then
      gclsBase.BaseWorkSpace.RollBacktrans
    End If
End Function
Public Function DeleteExpenseToPurchaseDetail(ByVal lngActivityDetailID As Long, Optional ByVal lngActivityTypeID As Long = 0) As Boolean
    Dim strSQL As String
    Dim recTmp As rdoResultset
    Dim strDetailID As String
    Dim strItemIDList As String
    Dim recTmp3 As rdoResultset
    
    If lngActivityTypeID = 0 Then
        strSQL = "SELECT lngActivityTypeID FROM ItemActivityDetail,ItemActivity WHERE ItemActivityDetail.lngActivityID" _
            & "=ItemActivity.lngActivityID AND ItemActivityDetail.lngActivityDetailID=" & lngActivityDetailID
        Set recTmp = gclsBase.BaseDB.OpenResultset(strSQL, rdOpenForwardOnly)
        If recTmp.BOF And recTmp.EOF Then
            recTmp.Close
            Set recTmp = Nothing
            DeleteExpenseToPurchaseDetail = True
            Exit Function
        Else
            lngActivityTypeID = recTmp!lngActivityTypeID
            recTmp.Close
            Set recTmp = Nothing
        End If
    End If
    If lngActivityTypeID <> 1 And lngActivityTypeID <> 5 And lngActivityTypeID <> 6 Then '不是“商品采购”和“加工入库”类型
        DeleteExpenseToPurchaseDetail = True
        Exit Function
    End If
    strDetailID = " ( "
    On Error GoTo DeleteErr
'    gclsBase.BaseWorkSpace.BeginTrans
    '非费用商品
    strSQL = "SELECT ExpenseToPurchase.dblAmount, ItemActivityDetail_1.dblExpenseAmount, ItemActivityDetail_1.dblEntrustAmount, " _
           & " ItemActivityDetail.lngActivityDetailID,ItemActivityDetail_1.lngActivityDetailID,ItemActivity.lngVoucherID FROM ItemActivityDetail,ExpenseToPurchase,ItemActivityDetail ItemActivityDetail_1,ItemActivity " & _
           " WHERE ItemActivityDetail.lngActivityDetailID = ExpenseToPurchase.lngPurchaseActivityDetailID  " & _