clspurchase.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 = "clsPurchase"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
'蔡奇科

'返回 -1：出错  0：取消操作（包括：不能删除，用户取消删除）  1：成功

Option Explicit

Private lngActivityID     As Long       '单据业务ID
Private lngActivityTypeID As Long    '业务类型ID
Private strTypeName       As String   '业务类型名称
Private strBillNO         As String   '单据号
Private blnIsVoid         As Boolean  '是否作废
Private thehWnd           As Long     '列表窗体的句柄
Private strDelOrVoid      As String   '提示信息：“删除！” 或 “作废”
Private blnIsInvoice  As Boolean  '单据开票标志（单货同到）
Private blnIsPay  As Boolean  '单据已付款标志
Private lngWriteOffID() As Long
Private blnNoAlert As Boolean    '不提示警告信息标志
Private blnIsPrinted As Boolean  '是否已打印标志
Private mlngInvoiceActivityID As Long
Private mblnOtherBill As Boolean
Private mblnIsCash As Boolean
Private mstrErrMsg As String   '错误信息

'为对话框提供窗口句柄
Public Sub SethWnd(arghWnd As Long)
    thehWnd = arghWnd
End Sub

Private Sub cMsgBox(strMsg As String, Optional strTitle As String)
    If Trim(strTitle) = "" Then
        strTitle = "提示信息"
    End If
    ShowMsg thehWnd, strMsg, MB_OK + MB_ICONEXCLAMATION + MB_SYSTEMMODAL, strTitle
End Sub

'单据删除（作废）前的规则验证
Public Function BeforeDelete(Optional ByVal blnByVoid As Boolean = False, _
                                            Optional ByVal lngReceiptID As Long = 0, _
                                            Optional ByVal lngReceiptTypeID As Long = 0, _
                                            Optional ByVal strReceiptTypeName As String = "", _
                                            Optional ByVal blnWriteOffBill As Boolean = False) As Integer
    Dim strSQL As String
    Dim recTemp As rdoResultset
    Dim strVoucher As String
    Dim intResult As Integer
'On Error GoTo theErr
    If blnByVoid Then
        strDelOrVoid = "作废"
    Else
        strDelOrVoid = "删除"
    End If
    If lngReceiptID <> 0 Then
        lngActivityID = lngReceiptID
    End If
    If lngReceiptTypeID <> 0 Then
        lngActivityTypeID = ReceiptType2ActivityType(lngReceiptTypeID)
    ElseIf lngActivityTypeID <> 0 Then
        lngReceiptTypeID = ActivityType2ReceiptType(lngActivityTypeID)
    End If
    If strBillNO = "" Then
        strBillNO = ID2String(lngReceiptTypeID, lngReceiptID) & "号"
    End If
    If strReceiptTypeName <> "" Then
        strTypeName = strReceiptTypeName
    End If
    
    BeforeDelete = 0 '取消删除
    If blnSelectRealVoucher() Then
        cMsgBox strBillNO & strTypeName & "单据核销的入库单已生成非暂估的凭证，不能" & strDelOrVoid
        Exit Function
    End If
    '删除作废单据无须判断
    If Not blnIsVoid Then
        If blnIsPrinted Then
         If BillRePrintRight(lngReceiptTypeID, True) Then
            If mblnOtherBill = False Then
                If ShowMsg(thehWnd, strBillNO & strTypeName & "单据已经打印，您确实要" & strDelOrVoid & "吗？", MB_YESNO + MB_ICONQUESTION + MB_SYSTEMMODAL + MB_DEFBUTTON2, strDelOrVoid & "单据") = vbNo Then
                   Exit Function
                End If
            End If
            blnNoAlert = True
         Else
            cMsgBox strBillNO & strTypeName & "单据中的商品已经打印，不能" & strDelOrVoid & "！"
            Exit Function
         End If
        End If
        '已调价
        If blnItemAdjusted(lngActivityID) Then
            cMsgBox strBillNO & strTypeName & "单据中的商品已经调价，不能" & strDelOrVoid
            Exit Function
        End If
        '已结帐
        If blnBillIsClosed(lngActivityTypeID + 1, lngActivityID) Then
            cMsgBox strBillNO & strTypeName & "单据已经结帐，不能" & strDelOrVoid
            Exit Function
        End If
        
        Select Case IsVoucher_ItemActivity(lngActivityID, strVoucher)
        Case -1
            GoTo TheErr
        Case 1
            cMsgBox strBillNO & strTypeName & "单据已生成凭证“" & strVoucher & "”，不能" & strDelOrVoid
            Exit Function
        End Select
        
        Select Case IsProduce()
        Case -1
            GoTo TheErr
        Case 1
            cMsgBox strBillNO & strTypeName & "单据的批次商品已发生出库业务，不能" & strDelOrVoid
            Exit Function
        End Select
        Select Case lngActivityTypeID
        Case 1, 2, 4, 6
            If mblnOtherBill = False And blnWriteOffBill = False Then
                If BillPublic.blnIsInvoice(True, lngActivityID) = True Then
                     blnNoAlert = True
                     If ShowMsg(thehWnd, strBillNO & strTypeName & "单据已开票，继续" & strDelOrVoid & "吗？", MB_YESNO + MB_ICONQUESTION + MB_DEFBUTTON2 + MB_SYSTEMMODAL, "提示信息") <> IDYES Then
                        GoTo TheErr
                     End If
                End If
            End If
        End Select
        '7)盘赢入库单由盘点表生成判断
        If lngActivityTypeID = 9 Then
            If DeleteStockTakingToReceipt() <> 1 Then
                blnNoAlert = True
                If ShowMsg(thehWnd, strBillNO & "盘盈单是由盘点表产生，继续" & strDelOrVoid & "吗？", MB_YESNO + MB_ICONQUESTION + MB_DEFBUTTON2 + MB_SYSTEMMODAL, "提示信息") <> IDYES Then
                    Exit Function
                End If
            End If
        End If
        If Not blnWriteOffBill Then
            If blnModifyOrderQuantityOK(thehWnd, lngActivityID, True, strDelOrVoid) = False Then
                Exit Function
            End If
        End If
    End If
    '删除作废单据无须判断
    If blnIsVoid Then
        BeforeDelete = 1
        Exit Function
    End If
    
    If Not blnWriteOffBill Then
        Dim i As Long
        If Not blnWriteOff(thehWnd, lngReceiptTypeID, lngActivityID, strDelOrVoid, lngWriteOffID) Then
            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.BeforeDelete(False, lngWriteOffID(i), lngReceiptTypeID, , True) <> 1 Then
                        Set clsTmp = Nothing
                        GoTo TheErr
                    End If
                    Set clsTmp = Nothing
                End If
            Next
        Else
            GoTo TheErr
        End If
        If mblnOtherBill = False Then
            If blnDelWriteOffBillNote(thehWnd, lngReceiptTypeID, lngActivityID, strDelOrVoid) = False Then
                GoTo TheErr
            End If
        End If
    End If
    If Not mblnOtherBill Then
        If lngActivityTypeID = 1 Then
'            strSql = "SELECT * FROM ItemActivity WHERE lngActivityID=" & lngActivityID
'            Set recTemp = gclsBase.BaseDB.OpenRecordset(strSql, dbOpenForwardOnly)
'            If Not (recTemp.BOF And recTemp.EOF) Then
'                mlngInvoiceActivityID = recTemp!lngInvoiceActivityID
'            End If
'            recTemp.Close
'            Set recTemp = Nothing
            If mlngInvoiceActivityID > 0 Then
                If ShowMsg(thehWnd, strBillNO & strTypeName & "单据是由发票核销自动生成的单据，如果" & strDelOrVoid & "，将删除其他同时生成的单据，您确实要" & strDelOrVoid & "吗？", MB_YESNO + MB_ICONQUESTION + MB_DEFBUTTON2 + MB_SYSTEMMODAL, "提示信息") <> IDYES Then
                    GoTo TheErr
                End If
                blnNoAlert = True
                If DelOtherBill() = False Then
                    GoTo TheErr
                End If
            End If
        End If
    End If
    
   Dim lngTmp As Long
   lngTmp = lngActivityIsSelected(lngActivityID)
   Select Case lngActivityTypeID
   Case 2
      If lngTmp <> 0 Then
         cMsgBox strBillNO & strTypeName & "单据中的商品已经销售，不能" & strDelOrVoid & "！"
         GoTo TheErr
      End If
   Case 13
      If lngTmp = 16 Then
         cMsgBox strBillNO & strTypeName & "单据中的商品已经结算，不能" & strDelOrVoid & "！"
         GoTo TheErr
      ElseIf lngTmp <> 0 Then
         cMsgBox strBillNO & strTypeName & "单据中的商品已经调拨，不能" & strDelOrVoid & "！"
         GoTo TheErr
      End If
   Case 3, 16
      If lngTmp <> 0 Then
         cMsgBox strBillNO & strTypeName & "单据中的商品已经结算，不能" & strDelOrVoid & "！"
         GoTo TheErr
      End If
   Case Else
      If lngTmp <> 0 Then
         blnNoAlert = True
         If mblnOtherBill = False Then
            If ShowMsg(thehWnd, strBillNO & strTypeName & "单据已开票，继续" & strDelOrVoid & "吗？", MB_YESNO + MB_ICONQUESTION + MB_DEFBUTTON2 + MB_SYSTEMMODAL, "提示信息") <> IDYES Then
               GoTo TheErr
            End If
         End If
      End If
   End Select
    
    strSQL = "SELECT Sum(ItemActivityDetail.dblSettlementQuantity) AS dblSettlementQuantityOfSum, " _
                 & " Sum(ItemActivityDetail.dblCurrSettlementAmount) AS dblCurrSettlementAmountOfSum, " _
                 & " Sum(ItemActivityDetail.dblPaymentQuantity) AS dblPaymentQuantityOfSum, " _
                 & " Sum(ItemActivityDetail.dblCurrPaymentAmount) AS dblCurrPaymentAmountOfSum, " _
                 & " Sum(ItemActivityDetail.dblInvoiceQuantity) AS dblInvoiceQuantityOfSum, " _
                 & " Sum(ItemActivityDetail.dblCurrInvoiceAmount) AS dblCurrInvoiceAmountOfSum, " _
                 & " Sum(ItemActivityDetail.dblEntrustQuantity) AS dblEntrustQuantityOfSum, " _
                 & " Sum(ItemActivityDetail.dblEntrustAmount) AS dblEntrustAmountOfSum, " _
                 & " Sum(ItemActivityDetail.dblExpenseAmount) AS dblExpenseAmountOfSum " _
                 & " FROM ItemActivityDetail Where (((ItemActivityDetail.lngActivityID) = " & lngActivityID & ")) GROUP BY ItemActivityDetail.lngActivityID"
    Set recTemp = gclsBase.BaseDB.OpenResultset(strSQL, rdOpenStatic)
    If recTemp.BOF And recTemp.EOF Then GoTo TheErr
    '1 采购     与 发票
    '2 销售     与 发票
    '3 直运采购 与 直运销售
    '4 受托入库（源） 与 受托结算  3 -- 4
    '5 委托出库（源） 与 委托结算 13 -- 14
    '6 分期出库（源） 与 分期结算 16 -- 17
    
    If recTemp(2) + recTemp(3) <> 0 Then '付款数量、原币付款金额
        If mblnOtherBill = False Then
            Select Case lngActivityTypeID
            Case 1, 2, 4, 6
                blnNoAlert = True
                If mblnIsCash Then
                    If ShowMsg(thehWnd, strDelOrVoid & strBillNO & strTypeName & "单据将删除其对应的现金结算单据，继续" & strDelOrVoid & "吗？", MB_YESNO + MB_ICONQUESTION + MB_DEFBUTTON2 + MB_SYSTEMMODAL, "提示信息") <> IDYES Then GoTo EndProc
                Else
                    If ShowMsg(thehWnd, strBillNO & strTypeName & "单据已付款或已核销，继续" & strDelOrVoid & "吗？", MB_YESNO + MB_ICONQUESTION + MB_DEFBUTTON2 + MB_SYSTEMMODAL, "提示信息") <> IDYES Then GoTo EndProc
                End If
            End Select
        End If
        blnIsPay = True
    Else