clssales.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 = "clsSales"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
'蔡奇科
'销售单
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 blnIsReceive  As Boolean  '单据已收款标志
Private lngWriteOffID() As Long
Private blnNoAlert As Boolean    '不提示警告信息标志
Private blnIsPrinted 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 = "作废"
        blnIsVoid = False
    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 strReceiptTypeName <> "" Then
        strTypeName = strReceiptTypeName
    End If
    If strBillNO = "" Then
        strBillNO = ID2String(lngReceiptTypeID, lngReceiptID) & "号"
    End If

    BeforeDelete = 0 '取消删除
    
    '删除作废单据无须判断
    If Not blnIsVoid Then
        If blnIsPrinted Then
         If BillRePrintRight(lngReceiptTypeID, True) Then
            If ShowMsg(thehWnd, strBillNO & strTypeName & "单据已经打印，您确实要" & strDelOrVoid & "吗？", MB_YESNO + MB_ICONQUESTION + MB_SYSTEMMODAL + MB_DEFBUTTON2, strDelOrVoid & "单据") = vbNo Then
               Exit Function
            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 + 2, lngActivityID) Then
             cMsgBox strBillNO & strTypeName & "单据已经结帐，不能" & strDelOrVoid
            Exit Function
         End If
    
        Select Case IsProduce()
        Case -1
            GoTo TheErr
        Case 1
            cMsgBox strBillNO & strTypeName & "单据的批次商品已发生出库业务，不能" & strDelOrVoid
            Exit Function
        End Select
        
        If blnCostAdjustIsAuto(lngActivityID) = True Then
            blnNoAlert = True
            If ShowMsg(thehWnd, strBillNO & strTypeName & "单据是由系统自动生成，继续" & strDelOrVoid & "吗？", MB_YESNO + MB_ICONQUESTION + MB_DEFBUTTON2 + MB_SYSTEMMODAL, "提示信息") <> IDYES Then
'            cMsgBox strBillNO & strTypeName & "单据是由系统自动生成，不能" & strDelOrVoid & "！"
               Exit Function
            End If
        End If
        Select Case IsVoucher_ItemActivity(lngActivityID, strVoucher)
        Case -1
            GoTo TheErr
        Case 1
            cMsgBox strBillNO & strTypeName & "单据已生成凭证“" & strVoucher & "”，不能" & strDelOrVoid & "！"
            Exit Function
        End Select
        
        If Not blnWriteOffBill Then
            If blnModifyOrderQuantityOK(thehWnd, lngActivityID, True, strDelOrVoid) = False Then
                Exit Function
            End If
        End If
    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 clsSales
                    Set clsTmp = New clsSales
                    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 blnDelWriteOffBillNote(thehWnd, lngReceiptTypeID, lngActivityID, strDelOrVoid) = False Then
            GoTo TheErr
        End If
    End If
    '删除作废单据无须判断
    If blnIsVoid Then
        BeforeDelete = 1
        Exit Function
    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 ShowMsg(thehWnd, strBillNO & strTypeName & "单据已开票，继续" & strDelOrVoid & "吗？", MB_YESNO + MB_ICONQUESTION + MB_DEFBUTTON2 + MB_SYSTEMMODAL, "提示信息") <> IDYES Then
            GoTo TheErr
         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 " _
                 & " 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 Abs(recTemp(6)) > 10 ^ (-5) Or Abs(recTemp(7)) > 10 ^ (-5) Then
        If lngActivityTypeID = 15 Then
            cMsgBox strBillNO & strTypeName & "单据中的商品已加工入库，不能" & strDelOrVoid & "！"
            Exit Function
        End If
    End If
    Select Case lngActivityTypeID
    Case 11, 12, 14, 17
        If BillPublic.blnIsInvoice(False, 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 Select
    If lngActivityTypeID = 21 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
'        Set recTemp = Nothing
    End If
    
    If recTemp(2) + recTemp(3) <> 0 Then '付款数量、原币付款金额
        Select Case lngActivityTypeID
        Case 11, 12, 14, 17
            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
        blnIsReceive = True
    Else
        blnIsReceive = False
    End If