clslist.cls

金算盘软件代码

    If intResult = -1 Then Exit Function
    If intResult > 0 Then
        If blnShowMsg Then
            strMsg = "本张单据是由" & ID2String(40, intResult, True) & "核销生成的折扣单据，确实要" & IIf(blnByVoid = False, "删除", "作废") & "吗？"
            If ShowMsg(thehWnd, strMsg, vbQuestion + vbYesNo + vbDefaultButton2, "提示信息") <> vbYes Then
                Exit Function
            End If
        End If
        blnDisCount = True
    End If
    
'确定是否有折扣单据
    If blnShowMsg Then
        strSQL = "SELECT lngDiscountActivityID FROM ActivityDetail WHERE ROWNUM <= 1 AND lngDiscountActivityID<>0 AND lngActivityID=" & lngActivityID
        Set recTemp = gclsBase.BaseDB.OpenResultset(strSQL, rdOpenStatic)
        If Not (recTemp.BOF And recTemp.EOF) Then
            strMsg = "本张单据已核销并生成了折扣单据，确实要" & IIf(blnByVoid = False, "删除", "作废") & "吗？"
            If ShowMsg(thehWnd, strMsg, vbQuestion + vbYesNo + vbDefaultButton2, "提示信息") <> vbYes Then
                Set recTemp = Nothing
                Exit Function
            End If
        End If
        recTemp.Close
    End If
'如果删除作废的单据，应只删除单据体
    intResult = IsVoid(lngActivityID)
    If intResult = -1 Then Exit Function
    blnIsOldVoid = False
    If intResult = 1 Then
        blnIsOldVoid = True
        If blnDisCount Then
            GoTo theBegin
        ElseIf mblnIsBill = False Then
            GoTo theBegin
        End If
    End If
'如果是折扣单据，则不进行确定是否收款
    If blnDisCount Then GoTo theBegin
'如果本张收（付）款单已经和对应的应收应付单据核销，则不能轻易删除，应给出警告信息
    bIsDoIt = False
    intResult = IsDoIt(lngActivityID)
    If intResult = -1 Then
        Exit Function
    ElseIf intResult = 1 Then
        bIsDoIt = True
        '作废时直接删除对应的勾对单据
        If blnByVoid Then GoTo theBegin
        
        If blnShowMsg Then
            If mvartheType = 1 Then
                strMsg = "本张收款单已经核销，其对应单据的核销标志将要清除，确实要删除吗？"
            ElseIf mvartheType = 2 Then
                strMsg = "本张付款单已经核销，其对应单据的核销标志将要清除，确实要删除吗？"
            ElseIf mvartheType = 3 Then
                strMsg = "本张应收单已经收款，其对应单据的收款标志将要一起删除，确实要删除吗？"
            ElseIf mvartheType = 4 Then
                strMsg = "本张应付单已经付款，其对应单据的付款标志将要一起删除，确实要删除吗？"
            End If
        Else
            strMsg = ID2String(lngReceiptTypeID, lngActivityID) & "单已经核销，其对应单据的核销标志将要清除，确实要删除吗？"
        End If
        If blnShowMsg And strMsg <> "" Then
            If ShowMsg(thehWnd, strMsg, vbQuestion + vbYesNo + vbDefaultButton2, "删除提示") <> vbYes Then
                Exit Function
            End If
        End If
    End If
    
theBegin:
    Screen.MousePointer = vbHourglass
   If blnTrans Then gclsBase.BaseWorkSpace.BeginTrans
   
'如果没有进行核销，则不进行对照表等的维护
    If bIsDoIt Then If blnDeleteCashToArap(lngActivityID, 1, False) = False Then GoTo DelErr
    
    If blnDisCount Then If ClearDiscount(lngActivityID, blnTrans) = False Then GoTo DelErr
'维护 CUSTOMER 表中的 strLastFCDate 和 lngLastFCReceiptID 字段
   If blnModifyCWFYDate(lngActivityID) = False Then GoTo DelErr
    
    If Not blnByVoid Then
        '1)先删除科目发生额表中的数据
        If blnIsOldVoid = False Then If DelTheDetaily(lngActivityID) = False Then GoTo DelErr
        '2)
        strSQL = "DELETE FROM Activity WHERE Activity.lngActivityID =" & lngActivityID
        If gclsBase.ExecSQL(strSQL) = False Then GoTo DelErr
        '3)
        strSQL = "DELETE FROM ActivityDetail WHERE ActivityDetail.lngActivityID =" & lngActivityID
        If gclsBase.ExecSQL(strSQL) = False Then GoTo DelErr
    Else
        '1)删除科目发生额表中的数据
        If DelTheDetaily(lngActivityID) = False Then GoTo DelErr
        
        strSQL = "UPDATE Activity SET Activity.blnIsVoid = 1 WHERE Activity.lngActivityID =" & lngActivityID
        If gclsBase.ExecSQL(strSQL) = False Then GoTo DelErr
        
        strSQL = "UPDATE ActivityDetail SET ActivityDetail.dblCurrPaymentAmount = 0 WHERE ActivityDetail.lngActivityID = " & lngActivityID
        If gclsBase.ExecSQL(strSQL) = False Then GoTo DelErr
    End If

    If blnTrans Then gclsBase.BaseWorkSpace.CommitTrans
'维护最大编号表
    If Not blnByVoid Then blnMaxNODecrease intYear, bytPeriod, lngReceiptTypeID, strReceiptNo, lngReceiptNo
'------------------------------------------------------------------------------
    gclsSys.SendMessage 0, 30 + lngReceiptTypeID
    DeleteRow1 = True
    Screen.MousePointer = vbDefault
    Exit Function
DelErr:
    If blnTrans Then gclsBase.BaseWorkSpace.RollBacktrans
    
    Screen.MousePointer = vbDefault
    If blnShowMsg Then
        If blnByVoid = False Then
            cMsgBox "删除本张" & strListName & "失败！"
        Else
            cMsgBox "作废本张" & strListName & "失败！"
        End If
    End If
End Function


'删除 折扣单据
Private Function ClearDiscount(ByVal lngActivityID As Long, Optional ByVal blnTrans As Boolean = False) As Boolean
    Dim strSQL As String
    Dim QTmp As New rdoQuery
    Dim rec As Boolean
    
    If blnTrans Then gclsBase.BaseWorkSpace.BeginTrans
    
    strSQL = "{ ? = CALL " & gclsBase.UID & ".ClearDiscount(" & lngActivityID & "," & IIf(gclsBase.ControlAccount, 1, 0) & ")}"
    QTmp.SQL = strSQL
    Set QTmp.ActiveConnection = gclsBase.BaseDB
    QTmp(0).Type = rdTypeNUMERIC
    QTmp(0).Direction = rdParamReturnValue
    QTmp.Execute
    rec = IIf(QTmp(0).Value = 0, True, False)
    If rec Then
        If blnTrans Then gclsBase.BaseWorkSpace.CommitTrans
    Else
        If blnTrans Then gclsBase.BaseWorkSpace.RollBacktrans
    End If
    Set QTmp = Nothing
    ClearDiscount = rec
    
'    Dim strSql As String
'    Dim recTmp As rdoResultset
'    Dim intDirection As Integer
'    Dim blnOK As Boolean
'    Dim lngDetailID As Long
'    Dim recARAPTmp As rdoResultset
'
'    On Error GoTo Err_Handle
'
'    '1  先从对照表中取出应收/应付的来源号和对应的明细ID
'     strSql = "SELECT CashToArap.strARAPSource AS strSource,CashToArap.lngArapActivityDetailID AS lngArapID,CashToArap.dblCurrDisCount AS dblDisCount," _
'            & "ActivityDetail.lngActivityDetailID AS lngDetailID " _
'            & "FROM CashToArap,ActivityDetail WHERE ActivityDetail.lngActivityDetailID = CashToArap.lngCashActivityDetailID " _
'            & " AND ActivityDetail.lngDiscountActivityID = " & lngActivityID & " AND CashToArap.strCashSource = '1'"
'
'    Set recTmp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
'    If recTmp.BOF And recTmp.EOF Then
'        recTmp.Close
'        ClearDiscount = True
'        GoTo EndProc
'    End If
'    '取出 现金/银行 明细 ID 号
'    lngDetailID = recTmp!lngDetailID
'
'    If blnTrans Then gclsBase.BaseWorkSpace.BeginTrans
'
'    '2  再据来源号和明细ID确定方向，并更新原币付款金额
'    Do While Not recTmp.EOF
'        Select Case recTmp!strSource
'        Case "0"
'            If gclsBase.ControlAccount Then
'                '确定方向
'                strSql = "SELECT lngActivityTypeID FROM ArapInit WHERE lngARAPInitID = " & recTmp!lngARAPID
'                Set recARAPTmp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenForwardOnly)
'                If recARAPTmp.BOF And recARAPTmp.EOF Then
'                Else
'                    Select Case recARAPTmp!lngActivityTypeID
'                    Case 1, 2, 4, 6, 34, 37, 40 '贷
'                        intDirection = -1
'                    Case Else           '借
'                        intDirection = 1
'                    End Select
'                End If
'                '构造更新字符串
'                strSql = "UPDATE ArapInit SET dblCurrPaymentAmount = dblCurrPaymentAmount - (" & intDirection * recTmp!dblDiscount & _
'                        ") WHERE lngARAPInitID = " & recTmp!lngARAPID
'            Else
'                '确定方向
'                strSql = "SELECT intDirection FROM ArapInit1 WHERE lngARAPInitID = " & recTmp!lngARAPID
'                Set recARAPTmp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenForwardOnly)
'                If recARAPTmp.BOF And recARAPTmp.EOF Then
'                Else
'                    If recARAPTmp!intDirection = 1 Then '借
'                        intDirection = 1
'                    Else                '贷
'                        intDirection = -1
'                    End If
'                End If
'                '构造更新字符串
'                strSql = "UPDATE ArapInit1 SET dblCurrPaymentAmount = dblCurrPaymentAmount - (" & intDirection * recTmp!dblDiscount & _
'                        ") WHERE lngARAPInitID = " & recTmp!lngARAPID
'            End If
'        Case "1"
'            '确定方向
'            strSql = "SELECT Activity.lngActivityTypeID AS lngActivityTypeID,ActivityDetail.blnIsReceipt AS blnIsReceipt " & _
'                    " FROM Activity,ActivityDetail " & _
'                    " WHERE Activity.lngActivityID = ActivityDetail.lngActivityID AND ActivityDetail.lngActivityDetailID = " & recTmp!lngARAPID
'            Set recARAPTmp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenForwardOnly)
'            If recARAPTmp.BOF And recARAPTmp.EOF Then
'            Else
'                If recARAPTmp!blnIsReceipt <> 0 Then '主表记录
'                    Select Case recARAPTmp!lngActivityTypeID
'                    Case 35, 36, 38     '借
'                        intDirection = 1
'                    Case Else           '贷
'                        intDirection = -1
'                    End Select
'                Else
'                    Select Case recARAPTmp!lngActivityTypeID
'                    Case 35, 36, 38, 40 '贷
'                        intDirection = -1
'                    Case Else       '借
'                        intDirection = 1
'                    End Select
'                End If
'            End If
'            '构造更新字符串
'            strSql = "UPDATE ActivityDetail SET dblCurrPaymentAmount = dblCurrPaymentAmount - (" & intDirection * recTmp!dblDiscount & _
'                    ") WHERE lngActivityDetailID = " & recTmp!lngARAPID
'        Case "2"
'            '确定方向
'            strSql = "SELECT ItemActivity.lngActivityTypeID AS lngActivityTypeID FROM ItemActivity,ItemActivityDetail " & _
'                    " WHERE ItemActivity.lngActivityID = ItemActivityDetail.lngActivityID AND ItemActivityDetail.lngActivityDetailID = " & recTmp!lngARAPID
'            Set recARAPTmp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenForwardOnly)
'            If recARAPTmp.BOF And recARAPTmp.EOF Then
'            Else
'                Select Case recARAPTmp!lngActivityTypeID
'                Case 1, 2, 4, 6 '贷
'                    intDirection = -1
'                Case Else       '借
'                    intDirection = 1
'                End Select
'            End If
'            '构造更新字符串
'            strSql = "UPDATE ItemActivityDetail SET dblCurrPaymentAmount = dblCurrPaymentAmount - (" & intDirection * recTmp!dblDiscount & _
'                    ") WHERE lngActivityDetailID = " & recTmp!lngARAPID
'        Case "3"
'            '确定方向
'            strSql = "SELECT VoucherDetail.intDirection FROM VoucherDetail WHERE lngVoucherDetailID = " & recTmp!lngARAPID
'            Set recARAPTmp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenForwardOnly)
'            If recARAPTmp.BOF And recARAPTmp.EOF Then
'            Else
'                If recARAPTmp!intDirection = 1 Then '借
'                    intDirection = 1
'                Else                '贷
'                    intDirection = -1
'                End If
'            End If
'            '构造更新字符串
'            strSql = "UPDATE VoucherDetail SET dblCurrPaymentAmount = dblCurrPaymentAmount - (" & intDirection * recTmp!dblDiscount & _
'                    ") WHERE lngVoucherDetailID = " & recTmp!lngARAPID
'        End Select
'
'        blnOK = gclsBase.ExecSQL(strSql)
'        If blnOK = False Then GoTo EndProc
'
'        recTmp.MoveNext
'    Loop
'
'    recARAPTmp.Close
'    '清除对照表中的折扣金额
'    strSql = "UPDATE CashToArap SET dblCurrDiscount = 0 WHERE CashToArap.lngCashActivityDetailID = " & lngDetailID & " AND CashToArap.strCashSource = '1' AND CashToArap.dblCurrDiscount <> 0 "
'    blnOK = gclsBase.ExecSQL(strSql)
'    If blnOK = False Then GoTo EndProc
'    '清除业务明细表中的折扣单据ID
'    strSql = "UPDATE ActivityDetail SET lngDiscountActivityID = 0 WHERE ActivityDetail.lngDiscountActivityID = " & lngActivityID
'    blnOK = gclsBase.ExecSQL(strSql)
'    If blnOK = False Then GoTo EndProc
'    '清除折扣单据的明细中的原币付款金额
'    strSql = "UPDATE ActivityDetail SET dblCurrPaymentAmount = 0 WHERE ActivityDetail.lngActivityID = " & lngActivityID
'    blnOK = gclsBase.ExecSQL(strSql)
'    If blnOK = False Then GoTo EndProc
'    '事务提交
'    If blnTrans Then gclsBase.BaseWorkSpace.CommitTrans
'    ClearDiscount = True
'
'EndProc:
'    Set recTmp = Nothing
'    Set recARAPTmp = Nothing
'    Exit Function
'Err_Handle:
'    '事务回滚
'    If blnTrans Then gclsBase.BaseWorkSpace.RollBacktrans
'    GoTo EndProc
End Function