clssales.cls

金算盘软件代码

                    dblTempPrice = recTemp_1(0)
                    Set recTemp_1 = Nothing
'                    .rdoColumns(3) = lngTempID
'                    .rdoColumns(6) = dblTempPrice      '最近销售价
                    strSQL = "UPDATE Item SET"
                    strSQL = strSQL & " lngRecentSaleReceiptDetailID=" & lngTempID & " , dblRecenetSalePrice=" & dblTempPrice
                    strSQL = strSQL & " WHERE lngItemID=" & !ModifyID
                    If gclsBase.ExecSQL(strSQL) = False Then
                        GoTo TheErr
                    End If
                End If
'                .Update
            End If

            If .rdoColumns(0) = .rdoColumns(4) Then '当前ID是最高销售价格单据子表ID
                strSQL = "SELECT Max(ItemActivityDetail.dblCurrPrice) AS 表达式1" _
                       & " FROM ItemActivity , ItemActivityDetail WHERE ItemActivity.lngActivityID = ItemActivityDetail.lngActivityID" _
                       & " AND (((ItemActivity.lngActivityTypeID)=11) AND ((ItemActivityDetail.lngItemID)=" & lngItemID & ") AND ((ItemActivityDetail.lngActivityDetailID)<>" & lngActivityDetailID & "))"
                Set recTemp_1 = gclsBase.BaseDB.OpenResultset(strSQL, rdOpenStatic)
'                .Edit
                If (recTemp_1.BOF And recTemp_1.EOF) Or (IsNull(recTemp_1(0))) Then
'                    .rdoColumns(4) = 0
'                    .rdoColumns(7) = 0
                    strSQL = "UPDATE Item SET"
                    strSQL = strSQL & " lngMaxSalePriceReceiptDetailID=0 , dblMaxSalePrice=0 "
                    strSQL = strSQL & " WHERE lngItemID=" & !ModifyID
                    If gclsBase.ExecSQL(strSQL) = False Then
                        GoTo TheErr
                    End If
                Else
                    dblCurrPrice_Temp = recTemp_1(0)
                    Set recTemp_1 = Nothing
                    strSQL = "SELECT ItemActivityDetail.lngActivityDetailID " _
                           & " FROM ItemActivity , ItemActivityDetail WHERE ItemActivity.lngActivityID = ItemActivityDetail.lngActivityID " _
                           & " AND (((ItemActivityDetail.dblCurrPrice)=" & dblCurrPrice_Temp & ") AND ((ItemActivity.lngActivityTypeID)=11) AND ((ItemActivityDetail.lngItemID)=" & lngItemID & "))"
                    Set recTemp_1 = gclsBase.BaseDB.OpenResultset(strSQL, rdOpenStatic)
                    If recTemp_1.BOF And recTemp.EOF Then Exit Function
                    
'                    .rdoColumns(4) = recTemp_1(0)
'                    .rdoColumns(7) = dblCurrPrice_Temp
                    strSQL = "UPDATE Item SET"
                    strSQL = strSQL & " lngMaxSalePriceReceiptDetailID=" & recTemp_1(0) & " , dblMaxSalePrice=" & dblCurrPrice_Temp
                    strSQL = strSQL & " WHERE lngItemID=" & !ModifyID
                    Set recTemp_1 = Nothing
                    If gclsBase.ExecSQL(strSQL) = False Then
                        GoTo TheErr
                    End If
                End If
'                .Update
            End If
            '3)
            If .rdoColumns(0) = .rdoColumns(5) Then '当前ID是最低销售价格单据子表ID
                strSQL = "SELECT Min(ItemActivityDetail.dblCurrPrice) AS 表达式1" _
                       & " FROM ItemActivity, ItemActivityDetail WHERE ItemActivity.lngActivityID = ItemActivityDetail.lngActivityID" _
                       & " AND (((ItemActivity.lngActivityTypeID)=11) AND ((ItemActivityDetail.lngItemID)=" & lngItemID & ") AND ((ItemActivityDetail.lngActivityDetailID)<>" & lngActivityDetailID & "))"
                Set recTemp_1 = gclsBase.BaseDB.OpenResultset(strSQL, rdOpenStatic)
'                .Edit
                If (recTemp_1.BOF And recTemp_1.EOF) Or (IsNull(recTemp_1(0))) Then
'                    .rdoColumns(5) = 0
'                    .rdoColumns(8) = 0
                    strSQL = "UPDATE Item SET"
                    strSQL = strSQL & " lngMinSalePriceReceiptDetailID=0 , dblMinSalePrice=0 "
                    strSQL = strSQL & " WHERE lngItemID=" & !ModifyID
                    If gclsBase.ExecSQL(strSQL) = False Then
                        GoTo TheErr
                    End If
                Else
                   dblCurrPrice_Temp = recTemp_1(0)
                    Set recTemp_1 = Nothing
                    strSQL = "SELECT ItemActivityDetail.lngActivityDetailID " _
                           & " FROM ItemActivity,ItemActivityDetail WHERE ItemActivity.lngActivityID = ItemActivityDetail.lngActivityID " _
                           & " AND (((ItemActivityDetail.dblCurrPrice)=" & dblCurrPrice_Temp & ") AND ((ItemActivity.lngActivityTypeID)=11) AND ((ItemActivityDetail.lngItemID)=" & lngItemID & "))"
                    Set recTemp_1 = gclsBase.BaseDB.OpenResultset(strSQL, rdOpenStatic)
                    If recTemp_1.BOF And recTemp.EOF Then Exit Function
                    
'                    .rdoColumns(5) = recTemp_1(0)
'                    .rdoColumns(8) = dblCurrPrice_Temp
                    strSQL = "UPDATE Item SET"
                    strSQL = strSQL & " lngMinSalePriceReceiptDetailID=" & recTemp_1(0) & " , dblMinSalePrice=" & dblCurrPrice_Temp
                    strSQL = strSQL & " WHERE lngItemID=" & !ModifyID
                    Set recTemp_1 = Nothing
                    If gclsBase.ExecSQL(strSQL) = False Then
                        GoTo TheErr
                    End If
                End If
'                .Update
            End If
            
            .MoveNext
        Loop
    End With

    If Not recTemp Is Nothing Then
        Set recTemp = Nothing
    End If
    If Not recTemp_1 Is Nothing Then
        Set recTemp_1 = Nothing
    End If
    ChangeItemInfo = 1
    Exit Function
TheErr:
    If Not recTemp Is Nothing Then
        Set recTemp = Nothing
    End If
    If Not recTemp_1 Is Nothing Then
        Set recTemp_1 = Nothing
    End If
    ChangeItemInfo = -1
End Function

'商品成本资料明细
'商品性质表中存在：成本方法
Private Function DeleteItemCostDetail() As Integer
    Dim strSQL As String
'    Dim recTmp As rdoResultset
    strSQL = "DELETE FROM ItemCostDetail WHERE ItemCostDetail.lngOutActivityDetailID IN " & _
        " (SELECT ItemActivityDetail.lngActivityDetailID FROM ItemActivityDetail " & _
        " WHERE ItemActivityDetail.lngActivityID=" & lngActivityID & ")"
    If gclsBase.ExecSQL(strSQL) = False Then DeleteItemCostDetail = -1

    DeleteItemCostDetail = 1
    
'   strSql = "SELECT ItemCostDetail.lngItemID,ItemCostDetail.lngInActivityDetailID," _
'          & " ItemCostDetail.lngOutActivityDetailID,ItemCostDetail.dblQuantity,ItemCostDetail.dblAmount " _
'          & " FROM ItemCostDetail,ItemActivityDetail WHERE ItemCostDetail.lngOutActivityDetailID = 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
End Function

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






'////////////////////////////////////////////////////////////////////////////////
'//
'//                                 删除列表记录
'//
'////////////////////////////////////////////////////////////////////////////////
'<接口>
'blnByVoid：删除功能由作废调用
Public Function DeleteSales(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 = False) As Boolean
    Dim strSQL As String
    Dim recTemp As rdoResultset
    Dim intResult As Integer
    '-----------------------------------------
    Dim intYear As Integer '凭证会计年度
    Dim bytPeriod As Byte   '凭证会计期间
    Dim lngReceiptTypeID As Long
    Dim strReceiptNo As String
    Dim lngReceiptNo As Long
    '------------------------------------------
    lngActivityID = arglngActivityID
    If blnByVoid Then
        strDelOrVoid = "作废！"
    Else
        strDelOrVoid = "删除！"
    End If
    
    strSQL = "SELECT ItemActivity.lngActivityTypeID, ItemActivity.blnIsVoid, Decode(ItemActivity.lngActivityTypeID,11,'商品销售',12,'直运销售',13,'委托出库',14,'委托结算',15,'加工出库',16,'分期出库',17,'分期结算',18,'销售发票',19,'领用出库',20,'成本调整',21,'盘亏出库',22,'其他出库')AS 销售类型 ,ItemActivity.* From ItemActivity WHERE (ItemActivity.lngActivityID)=" & lngActivityID
    Set recTemp = gclsBase.BaseDB.OpenResultset(strSQL, rdOpenStatic)
    If recTemp.BOF And recTemp.EOF Then
        cMsgBox "此单据已被删除！"
        Set recTemp = Nothing
        Exit Function
    End If
    lngActivityTypeID = recTemp(0)
    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 = recTemp!strReceiptNo
    lngReceiptNo = recTemp!lngReceiptNo
    blnIsInvoice = (recTemp!blnIsInvoice <> 0) Or (recTemp!lngReceiptTypeID = 20)
    '--------------------------------------------------------------------
    
    Set recTemp = Nothing
   blnNoAlert = False
   If blnAlert = True Then
       If BeforeDelete(blnByVoid, , , , blnWriteOffBill) <> 1 Then Exit Function  '判断单据能否删除
   End If
    
    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
'    '删除作废单据无须判断
'    If Not blnIsVoid Then
'        If blnAlert = True Then
'            If BeforeDelete(blnByVoid, , , , blnWriteOffBill) <> 1 Then Exit Function  '判断单据能否删除
'        End If
'    End If
    
    On Error GoTo DeleteErr
    
    Dim i As Long
    If Not blnNoTrans Then
        gclsBase.BaseWorkSpace.BeginTrans
    End If
    If Not blnWriteOffBill Then
'        gclsBase.BaseWorkSpace.BeginTrans
        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.DeleteSales(lngWriteOffID(i), False, True) = False Then
                    If Not blnNoTrans Then
                        gclsBase.BaseWorkSpace.RollBacktrans
                    End If
'                    gclsBase.BaseWorkSpace.rollbacktrans
                    blnIsWriteOff = False
                    DeleteSales = False
                    Set clsTmp = Nothing